home *** CD-ROM | disk | FTP | other *** search
- ; =======================================================
- ;
- ; REC module containing RAM storage, I/O programs, main
- ; program, and the directory. The complete set of modules
- ; comprises REC.MAC, PDL.MAC, MARKOV.MAC, RECLIB.MAC, and
- ; FXT.MAC. RECLIB.MAC may be omitted if the operator X
- ; isn't used, and must be substituted by another module
- ; if the collection of subroutines to be called by X is
- ; to be changed.
- ;
- ; FXT.MAC contains the following REC operators and
- ; predicates:
- ;
- ; C compile a REC expression
- ; i input from designated port
- ; k call CP/M without residue
- ; K call CP/M, preserve FCB, return value
- ; o output from designated port
- ; R read one character from console
- ; t type message given header
- ; T type argument on PDL
- ; W write argument on LST:
- ; ` test if a character waits at keyboard
- ;
- ; ------------------------------------------------------
- ; REC version released during the 1984 Summer School of
- ; the Microcomputer Applications Group of the I.C.U.A.P.
- ; ------------------------------------------------------
- ; 8086 version with segments for code, PDL and WS.
- ; ------------------------------------------------------
- ;
- ; FXT86 - Copyright (C) 1982, 1984
- ; Universidad Autonoma de Puebla
- ; 49 Poniente 1102 - Puebla, Puebla, Mexico
- ; All Rights Reserved
- ;
- ; [Harold V. McIntosh, 28 August 1980]
- ; [Gerardo Cisneros, 8 February 1984]
- ;
- ; Modification 1 - 1 January 1981.
- ; a) Main program derives the values of const,
- ; conin, conou from the address rst0 supposing
- ; that BIOS starts out with the standard jump
- ; vector. Thus, REC need not be reassembled
- ; to have fast access to I/O when CP/M varies.
- ; b) T protected by pushes and pops of dx and bx.
- ; c) Some changes made in memory allocation.
- ; 24 May 1981 - Zero flag to restrain L from too many pops
- ; 25 March 1982 - Y is now a predicate
- ; 29 May 1983 - ~ discontinued as argument exchange
- ; 29 May 1983 - ~ for unary negative or complement
- ; 29 May 1983 - N for numerical comparison on PDL
- ; 29 May 1983 - h discontinued, replaced by ''w
- ; 30 May 1983 - CPIR: jumps to BOOT rather than RER
- ; 8 July 1983 - C has object program origin as argument
- ; 8 July 1983 - C is an operator
- ; 8 July 1983 - C0 defined as lower bound of compile area
- ; 8 July 1983 - x moved from RECLIB
- ; 8 July 1983 - x is a predicate to call REC subroutines
- ; 9 July 1983 - Buffered CP/M input if no disk file given
- ; 14 July 1983 - W had its arguments reversed
- ; 14 January 1984 - <QIN ds 0>, <QOU ds 0> for sorcim.cnv
- ; 14 January 1984 - default extension .REC for 1st file
- ; 8 February 1984 - separate segments (GCS)
- ; April 1984 - Disposable initialization code - GCS
- ; 9 May 1984 - Arguments of C reversed (GCS)
- ; 31 May 1984 - Cp, PD and WS ovfl cause termination - GCS
- ; 11 June 1984 - DIIN/CPIN set up DMA address and seg. - GCS
- ; 18 June 1984 - Set DMA, then open; initialize VT - GCS
- ; 20 June 1984 - Rd ovf error on EOF and end of buffer - GCS
- ; 3 July 1984 - @@ takes over x, x is library predicate;
- ; entry point for TL and combination table included - GCS
- ; 15 Aug 1984 - Operator pair table extended - GCS
- ; 29 Jun 1985 - word-sized entries in var/sub tbl; x in. GCS
- ; 6 Jul 1985 - Version for MS-DOS. - GCS
- ; 29 Jul 1985 - 0<adr>C leaves <adr>,C2-<adr> on PDL- GCS
- ; 8 Aug 1985 - Qm added to pair table - GCS
- ; 2 Feb 1986 - overflow handling, i fixed - GCS
- ; =======================================================
-
- ; Absolute program locations used by CP/M.
-
-
- bdos equ 021H ;MS-DOS software interrupt vector
-
- DSIZ equ 0020H ;size of two parsed filenames
- FSIZ equ 0010H ;CP/M file name size
- TSIZ equ 0080H ;CP/M disk buffer size
-
-
- ; Linkage to input-output through ports.
-
- QIN: ;space holder
- DB 0E4H ;8-bit 8086 static IN instruction
- QI db 00H
- ret
-
- QOU: ;space holder
- DB 0E6H ;8-bit 8086 static OUT instruction
- QO db 00H
- ret
-
- ; =======================================================
- ; Programs related to input-output and disk usage.
- ; =======================================================
-
- ; bootstrap routine
-
- boot: mov ax,04C00H
- int bdos
-
-
- ; Buffer read routine.
-
- PTY: push bx ;conserve (bx)
- mov es,RSEG ;get segment address for buffer
- mov bx,RX ;pointer to read buffer
- cmp bx,RY
- jz ptye
- mov al,es:[bx] ;fetch byte
- inc bx ;advance pointer to next byte
- mov RX,bx ;update buffer pointer
- pop bx ;restore (bx) - preserve all reg pairs
- ret
- ptye: mov bx,'dR' ;report Rd ovfl and quit
- jmp FERR
-
- ; Console character read routine. CP/M-86 compatible version
- ; with direct access to CONIN.
-
- chin: push cx
- push dx
- chi: mov dl,-1
- mov ah,6
- int bdos
- test al,al
- jz chi
- pop dx
- pop cx
- ret
-
- ; Buffered console character read routine, which is more
- ; practical for use with CP/M. Up to 126 characters may
- ; be read using CP/M function 10, which is sufficient for
- ; bootstrapping or generating test programs. CHIN should
- ; be used for longer input sequences, which must be error
- ; free - incoming through a modem, for example.
-
- buin: push bx
- push cx
- push dx
- mov bx,RX
- cmp bx,RY
- jnz BI5
- BI4: mov ah,9 ;(09) write message
- mov dx,(offset bume)
- int bdos
- mov ah,10 ;(0A) buffered read
- mov dx,(offset TBUF)
- int bdos
- mov ah,9 ;(09) write message
- mov dx,(offset crlf)
- int bdos
- mov bx,(offset TBUF)+2
- mov RX,bx
- mov al,-1[bx]
- mov ah,0
- add ax,bx
- cmp ax,bx
- jz BI4
- mov RY,ax
- BI5: mov al,[bx]
- inc bx
- mov RX,bx
- pop dx
- pop cx
- pop bx
- ret
-
- ; Buffered read for repetitive compilation
-
- bure: mov al,TSIZ-2
- mov TBUF,al
- mov ax,(offset buin)
- mov read,ax
- mov ax,(offset TBUF)
- mov RX,ax
- mov RY,ax
- ret
-
- ; Console character out routine. CP/M-86 compatible version
- ; with direct access to CONOUT
-
- chou: push cx
- push dx
- mov dl,al
- mov ah,6 ;(06) direct console IO
- int bdos
- pop cx
- pop dx
- ret
-
- ; (`) Test for presence of waiting character (FALSE if
- ; none waiting. CP/M-86 compatible version with access
- ; to CONST.
-
- chaw: push cx
- push dx
- ; mov dl,-2
- mov ah,11 ;(11) Check keyboard status
- int bdos
- pop dx
- pop cx
- test al,al
- jnz chw
- ret
- chw: jmp SKP
-
- ; Printer output routine.
-
- PROU: push bx
- push dx
- push cx
- mov ah,5 ;(05) output through LST:
- mov dl,al
- int bdos
- pop cx
- pop dx
- pop bx
- ret
-
- ; (R) REC read operator.
-
- UCR: mov cx,1 ;one byte to be inserted
- call NARG ;close last arg, verify space
- push bx
- call word ptr tyin ;get byte from console input
- pop bx
- mov [bx],al ;store on PDL
- inc bx ;advance pointer
- mov PY,bx ;record end of argument
- ret
-
- ; (t) Write indirect operator. <org,siz,t> prints the
- ; indicated message, leaves no residue.
-
- LCT: mov bx,PX ;fetch argument pointer
- call ONEL ;move one argument to 8086 stack
- call CXLD ;get org and segment
- mov bx,cx ;org to bx
- pop dx ;size to dx
- add dx,bx ;org+size=end
- jmp UT1 ;use write cycle in UCT
-
- ; (TL) Often-used combination for which a single call
- ; is compiled.
-
- UCTL: call UCT ;type argument and
- jmp UCL ;lift it
-
- ; (T) REC write operator. <'XXX' T> will write XXX on
- ; the console, leaving it on the PDL.
-
- uct: mov dx,PY ;fetch terminal address
- mov bx,PX ;beginning address to (bx)
- mov ax,ds
- mov es,ax
- ut1: cmp dx,bx
- jz ut2 ;they match, we're done
- mov al,es:[bx] ;get byte out of memory
- push bx
- push dx
- push es
- call word ptr tyou ;tyou is in the data segment
- pop es
- pop dx ;recover the saved registers
- pop bx
- inc bx ;advance pointer
- jmp UT1 ;repeat
- ut2: ret
-
- ; (W) REC print operator. <org, siz, W> will print the
- ; indicated text on the list device, and then erase its
- ; arguments.
-
- UCW: mov bx,PX ;pointer to arguments
- call ONEL ;size from PDL to 8086 stack
- call CXLD ;org and segment addr to cx and es
- mov bx,cx ;place text origin in (bx)
- pop dx ;place length in (dx)
- UWW: test dx,dx ;check for zero length
- jz UWX ;no more to print
- mov al,es:[bx] ;fetch a byte
- push bx ;we need to be sure that dx and bx are
- push dx ;preserved whatever the print routine
- push es
- call PROU ;send it to printer
- pop es
- pop dx ;recover bx
- pop bx ;and dx
- dec dx ;diminish count
- inc bx ;advance pointer
- jmp UWW ;repeat
- UWX: ret
-
- ; (i) Input from designated port. <port, i> leaves
- ; <port, byte> so that after disposing of <byte>, <port>
- ; can be reused.
-
- LCI: mov bx,PX ;get pointer to top argument on PDL
- mov al,[bx] ;only the low order byte matters
- mov cs:QI,al ;place it in teme IN instruction
- mov cx,1 ;we're only going to read one byte
- call NARG ;prepare a place for it on the PDL
- call QIN ;execute the captive IN instruction
- mov [bx],al ;storing the incoming byte on the PDL
- inc bx ;always ready for the next byte
- mov PY,bx ;close off the argument
- ret ;and we're through
-
- ; (o) Output from designated port - <port, byte, o>
- ; leaves <port>, facilitating multiple OUTs through the
- ; same port.
-
- LCO: mov bx,PX ;pointer to last argument - output byte
- mov CH,[bx] ;tuck it into register b
- call UCL ;erase the top argument
- mov al,[bx] ;(bx) points to next argument - get it
- mov cs:QO,al ;store in tame OUT instruction
- mov al,CH ;output must be from accumulator
- jmp QOU ;execute the prepared OUT instruction
-
- ; =======================================================
- ;
- ; Communication with CP/M takes two forms: <FCB, n, K>
- ; which leaves <FCB, code> on the pushdown list, or else
- ; <FCB, n, k> which leaves nothing on the pushdown list.
- ; In either case - FCB is a two-byte parameter, usually
- ; the address of the file control block - but it could
- ; also be a DMA address or sometimes even null for the
- ; sake of uniformity. Approximately thirty options are
- ; available which are numbered serially, indicated by the
- ; argument n. The difference between K and k is that the
- ; former conserves the parameter FCB for possible use by
- ; a subsequent CP/M call, and reports a result in the
- ; one-byte result <code>. This could be the character
- ; read by an input routine or an error code for the disk
- ; routines.
- ;
- ; The options are:
- ;
- ; num function "FCB" "code"
- ; --- -------- ----- ------
- ;
- ; 0 system reset - -
- ; 1 read console - char
- ; 2 write console char -
- ; 3 read reader - char
- ; 4 write punch char -
- ; 5 write list char -
- ; 6 - - -
- ; 7 read i/o stat - stat
- ; 8 write i/ stat stat -
- ; 9 print buffer buffer -
- ; 10 read buffer buffer -
- ; 11 console status - stat
- ;
- ; 12 lift disk head - -
- ; 13 init disk only - -
- ; 14 select disk disk -
- ; 15 open file fcb code
- ; 16 close file fcb code
- ; 17 search once fcb code
- ; 18 search again fcb code
- ; 19 delete file fcb code
- ; 20 read 1 record fcb code
- ; 21 write 1 record fcb code
- ; 22 create file fcb code
- ; 23 rename file fcb code
- ; 24 read login - logv
- ; 25 read disklog - disk
- ; 26 set DMA address dma -
- ; 27 read bitmap - -
- ;
- ; Fuller details of all the CP/M options and the way they
- ; function can be obtained through consulting Digital
- ; Research's manuals for CP/M, especially their "CP/M
- ; Interface Guide."
- ;
- ; =======================================================
-
- ; (K) Set up communication with CP/M - top into (bx),
- ; next into (dx). Preserve next, call BDOS, (Aze) into
- ; top.
-
- CPM: call DXLD ;fetch function number and lift
- mov cx,dx ;move it to cx
- call ESLD ;get FCB org and segment
- mov dx,[bx] ;FCB offset to dx
- ; cmp cx,26 ;is it 'set DMA addr'?
- ; jnz CPM1
- ; call CPSG ;yes, set DMA base first
- CPM1: push ds ;save current data seg base
- mov ah,cl
- mov cx,es
- mov ds,cx ;set ds to FCB's segment
- int bdos ;call bdos with args in cx, dx
- pop ds ;restore data segment base
- mov ah,0 ;clear upper half of ax
- push ax ;save it on 8086 stack
- call PUTW ;transfer to PDL
- ret
-
- ; (k) Call to CP/M without any value returned.
-
- CPML: mov bx,PX ;fetch argument pointer
- call ONEL ;function number to 8086 stack
- call CXLD ;FCB org and segment to cx and es
- mov dx,cx ;we want org in dx
- pop cx ;get function number into cx
- ; cmp cx,26 ;is it 'set DMA base'?
- ; jnz CPML1 ;no, skip
- ;CPML0: call CPSG ;yes, set DMA base
- CPML1: push ds ;save data segment base
- mov ah,cl
- mov cx,es
- mov ds,cx ;set FCB segment base
- int bdos ;execute indicated operation
- pop ds ;restore data segment base
- ret
-
- ;CPSG: push es
- ; push cx
- ; push dx
- ; mov ah,51 ;(33H) set DMA base
- ; mov dx,es ;the segment base itself
- ; int bdos
- ; pop dx
- ; pop cx
- ; pop es
- ; ret
-
-
- ; -------------------------------------------------------
- ; Disk input-output routine working through CP/M.
- ; -------------------------------------------------------
-
- ; Set up a file control block with a given file name and
- ; the default extension REC. The pushdown list contains
- ; the disk unit designation, then by the filename without
- ; any extension. No protection is afforded against an
- ; overly long file name, a nonexistent disk, or the like.
- ; Some errors of this type must be caught by CP/M since
- ; REC cannot know such things as the exact number of disk
- ; drives that there will be.
-
- DIIN: cld
- mov ax,ds
- mov es,ax
- mov cx,11 ;filename field is 11 bytes long
- mov di,(offset TFCB)+1 ;field begins at second byte
- mov al,' ' ;fill it with blanks
- repnz stosb
- mov bx,PX ;fetch pointer to top argument
- mov al,[bx] ;load disk unit designator
- sub al,'@' ;set CP/M disk numbering convention
- mov TFCB,al ;store it in file control block
- call UCL ;pop top argument
- mov si,PX ;fetch pointer to file name
- mov cx,PY ;end of file name
- sub cx,si ;place py - px in (cx)
- mov di,(offset TFCB)+1 ;destination origin
- repnz movsb
- CPIN: cmp byte ptr TFCB+9,' '
- jnz CPIN2
- mov byte ptr TFCB+9,'R' ;set default extension 'REC'
- mov byte ptr TFCB+10,'E'
- mov byte ptr TFCB+11,'C'
- CPIN2: mov dx,(offset TBUF) ;origin of CP/M's sector buffer
- mov RSEG,ds ;CP/M's buffer is in the data seg
- mov RX,dx ;initial address of pseudotty
- mov RY,dx ;provoke disk read
- mov es,RSEG ;set DMA address and base
- mov cx,26
- call CPML1
- ; call CPML0
- mov cx,15H ;clear tail of FCB before opening
- mov di,(offset TFCB)+12
- mov al,00H
- repnz stosb
- mov ah,15 ;<open file>
- mov dx,(offset TFCB) ;file control block
- int bdos ;
- cmp al,0FFH ;check for error
- jz CPIR
- ret
- CPIR: jmp boot
-
- ; Read from disk buffer, replenish buffer when empty.
-
- DIRE: push bx ;save 3 8080 register pairs
- push dx ;
- push cx ;
- mov bx,RX ;pointer to current byte
- cmp bx,RY ;skip if equal
- jnz DI5 ;still have bytes in the buffer
- mov ah,20 ;<read next record>
- mov dx,(offset TFCB) ;file control block
- int bdos ;
- test al,al
- jnz dier ;quit if read not OK
- mov bx,(offset TBUF)+TSIZ ;end of buffer
- mov RY,bx ;store it in ry
- mov bx,(offset TBUF) ;beginning of buffer
- mov RX,bx ;store it in rx
- DI5: mov al,[bx] ;common continuation
- inc bx ;byte in acc, advance pointer
- mov RX,bx ;store position of next byte
- pop cx ;replace 3 register pairs
- pop dx ;
- pop bx ;
- ret
- dier: mov bx,'dR' ;report RD ovfl and quit
- jmp FERR
-
- ; (C) REC compiling operator which takes the designation
- ; of the compiling source from the PDL. The alternatives
- ; are:
- ;
- ; ''<dest>C input program from console
- ; 'file' 'D'<dest> C take<file.rec> from disk D
- ; p<dest>C pushdown list
- ; q<dest>C workspace
- ; <org,siz,dest,C> memory from address org onward
- ;
- ; where <dest> designates the destination area for the
- ; compilation: C1 if null, the address given otherwise.
- ; In general, if the top argument is of length zero, the
- ; console is the source, if it is of length one the named
- ; disk is the source [@=current disk, A, B, ... up to the
- ; system's limit], and if the argument has length 2, the
- ; combination of <org, siz> from the memory applies. It
- ; is the programmer's responsibility to avoid nonexistent
- ; memory, disk units, and the like.
-
- UCC: push c1
- mov cx,PY
- sub cx,PX
- jnz UC5
- mov dx,C1 ;use compile pointer
- jmp UC6
- UC5: call ESLD ;get segment, ignore
- mov dx,[bx] ;get address to use
- UC6: mov C1,dx ;record as C1
- call UCL ;remove <dest> argument
- mov ax,PY ;check length of <source> argument
- sub ax,PX
- jz UC2 ;zero means console
- cmp ax,1 ;test for one byte
- jz UC1 ;one means disk designation
- cmp ax,2 ;verify that we've got two bytes
- jnz UC7 ;no provision for other than 1, 2 bytes
- mov bx,(offset PTY) ;setup readin from pseudoteletype
- mov read,bx ;
- call CXLD ;load two numerical arguments
- jcxz UC8 ;zero means return cpl. area ptrs.
- mov dx,[bx] ;bx contains PX for second argument
- call ESLD ;load segment address of buffer
- mov RX,dx ;origin of REC source code
- add dx,cx ;length of source code
- mov RY,dx ;end of source code
- mov RSEG,es ;segment of source code
- jmp short UC4 ;compile once rx, ry set up
- UC8: mov bx,C2 ;compute size
- sub bx,C1
- push bx ;size on stack
- push cs ;code segment base to stack
- push C1 ;origin on stack
- call PUTW ;C1 on the PDL
- call PUTW ;cs too
- call CONC ;make a single argument
- jmp short UC9 ;then to the PDL
- UC1: call DIIN ;setup the CP/M FCB for given file
- mov bx,(offset DIRE) ;setup input from disk reader
- jmp UC3 ;compile once input source set up
- UC2: mov bx,(offset CHIN) ;input from the console
- UC3: mov read,bx ;
- UC4: call EMCE
- push dx
- call PUTW
- UC9: call PUTW
- pop c1
- ret
- UC7: pop c1
- call RER
-
- ; (X) noop in this version
-
- LIBO: ret
-
-
- ; Single-shot compilation from a disk file
-
- SSHOT: call EMCX ;compile the program file
- mov dx,(offset TFCB)
- mov ah,16 ;close the file
- int bdos
- mov cx,DSIZ
- mov di,(offset TFCB)
- mov si,P3
- mov ax,ds
- mov ds,WSEG
- mov es,ax
- repnz movsb ;retrieve parsed filenames
- mov bx,es:P1
- mov cl,[bx]
- inc cx
- mov di,(offset TBUF)
- mov si,bx
- repnz movsb ;retrieve command line
- mov ds,ax ;restore data segment base value
- inc bx
- mov P2,bx
- call UCD ;delete character count from workspace
- call EMCU ;execute the program file
- jmp short bootie ;return to CP/M if false
- nop ;beware jump span
- bootie: jmp boot
-
- ; Multiple compilations from the console
-
- tylo: call STATS ;type out memory usage stats
- nodi: call bure
- call INRE
- call EMCX
- call EMCU
- jmp short nodi
- nop
- jmp nodi
-
- ; Report space overflows and quit
-
- FERR: mov EMSG,bx
- mov dx,(offset EMSGS)
- mov ah,9
- int bdos
- jmp boot
-
- ; END OF PERMANENT CODE. THE INSTRUCTIONS FOLLOWING THIS
- ; WILL BE OVERWRITTEN AS SOON AS THE FIRST REC PROGRAM
- ; IS COMPILED.
-
- ENDREC:
-
- ; ================
- ; = main program =
- ; ================
-
-
- MAIN:
- ; finit
- db 9BH,0DBH,0E3H
- mov ax,dgroup
- mov es,ax
- mov cx,080H
- mov si,0
- mov di,si
- cld
- repnz movsw ;transfer PSP to data segment
- mov ax,es
- mov ds,ax
- mov di,(offset VT) ;set up to initialize vars/subs
- mov cx,021H ;the number of variables
- mov ax,0000
- repnz stosw ;set variables to zero
- mov cx,05FH ;number of subroutine entries
- ; mov bx,cs
- mov ax,(offset boot) ;CP/M exit routine
- ;vtc0: stosw ;store boot routine address
- repnz stosw
- ; xchg ax,bx
- ; stosw ;store segment base
- ; xchg ax,bx
- ; loop vtc0
- mov bx,02
- mov dx,cs
- sub [bx],dx
- mov ax,[bx] ;get total No. of paragraphs-c.s.base
- shr ax,1 ;half of leftover
- mov dx,01000H ;tentative size for compile area
- cmp ax,dx
- jnb vtc1
- mov dx,ax ;less than 128k, use half
- vtc1: sub [bx],dx ;subtract c.s.paragraphs
- mov ax,cs
- add ax,dx
- mov es,ax ;new data segment base
- mov di,offset dlst
- mov si,di
- mov cx,di
- inc cx
- std
- repnz movsb ;move data to new segment
- mov ax,es
- mov ds,ax
- mov cl,4
- shl dx,cl
- dec dx ;sacrifice one byte to avoid C2=0
- mov C2,dx
- mov ax,[bx] ;get leftover
- shr ax,1
- mov dx,01000H
- cmp ax,dx
- jnb vtc2
- mov dx,ax
- vtc2: sub [bx],dx ;subtract d.s.paragraphs
- mov ax,ds
- add ax,dx
- mov es,ax
- mov WSEG,ax
- shl dx,cl ;first address beyond data segment
- dec dx
- dec dx
- xchg dx,bx
- mov word ptr [bx],0FFFFH ;end-of-PDL marker
- mov PZ,bx
- xchg dx,bx
- mov ax,[bx] ;leftover once more
- shr ax,1
- mov dx,01000H
- cmp ax,dx
- jnb vtc3
- mov dx,ax
- vtc3: sub [bx],dx
- mov ax,es
- add ax,dx
- shl dx,cl
- dec dx
- dec dx
- xchg dx,bx
- mov es:word ptr [bx],0 ;mark end of ws
- mov P4,bx
- xchg dx,bx
- mov es,ax
- mov ax,[bx] ;leftover is for stack
- mov dx,01000H
- cmp ax,dx
- jb vtc4
- mov ax,dx
- vtc4: shl ax,cl
- cli
- mov sp,ax
- mov ax,es
- mov ss,ax
- sti
- mov dx,offset boot
- push dx
- cmp byte ptr 05BH[bx],' '
- jnz majn
- jmp tylo ;to TTY: loop if command tail empty
- majn: call svcmb
- call CPIN ;open disk file for REC program
- mov bx,(offset DIRE) ;REC input through disk
- mov read,bx ;REC compiler's I-O linkage
- call INRE ;initialize REC compiler RAM
- jmp SSHOT ;compile once from disk file
-
- svcmb: cld
- mov bx,(offset TBUF) ;pointer to command buffer
- mov di,P1 ;next byte of WS
- mov cl,[bx] ;get count
- inc cl ;plus one to include count itself
- mov ch,0
- mov si,bx
- mov es,WSEG ;load ES with WS base
- mb0: lodsb
- cmp al,'a' ;fold upper into lowercase
- jb mb1
- cmp al,'z'
- ja mb1
- sub al,32
- mb1: stosb
- loop mb0
- mov P3,di
- mov bx,P1
- inc bx
- mov P1,bx
- mov P2,bx
- mov ax,ds
- mov es,ax
- call fica
- call UCD ;delete first name including its terminator
- mov di,P3 ;save parsed filenames at p3 and following
- mov es,WSEG ;reload ES with WS base
- call ficb
- call ficb
- mov bx,P0
- mov P1,bx ;p1 back to start of text
- ret
-
- fsep: call zsep
- jnz fsep1
- ret
- fsep1: call rech ;read one character
- jmp fsep
-
- ; Advance to a non blank character in the console
- ; buffer unless there is none, indicated by a 00.
-
- zonb: call rech ;read one character
- test al,al
- jnz zonb1
- ret
- zonb1: cmp al,' '
- jz zonb ;zero or non-blank
- ret
-
- ; Generate a file control block in the manner of CCP.
-
- fica: mov di,(offset TFCB)
- ficb: call zonb ;zero or non-blank
- push ax
- jz ficd
- sbb al,'@'
- mov dl,al ;save possible disk id
- mov bx,P2
- mov bp,ds
- mov ds,WSEG
- mov al,(byte ptr[bx])
- mov ds,bp
- cmp al,':'
- jz ficc
- xor al,al
- jmp ficd
- ficc: call rech ;get rid of colon
- pop ax
- call rech ;get first of filename
- push ax
- mov al,dl
- ficd: stosb
- mov cx,08
- pop ax
- call ffil
- call fsep
- mov cx,03
- cmp al,'.'
- jnz ficp
- call rech ;read one character
- call ffil
- call fsep
- jmp ficq
- ficp: call bfil
- ficq: mov cx,04
- mov ah,al
- mov al,0
- jmp kfil
-
- ; Fill a field
-
- ffil0: call rech ;read one character
- ffil: call zsep
- jz bfil
- cmp al,'*'
- jz qfil
- stosb
- loop ffil0
- ret
-
- ; Block fill
-
- qfil: mov ah,al
- mov al,'?'
- jmp kfil
- bfil: mov ah,al
- mov al,' '
- kfil: repnz stosb
- mov al,ah
- ret
-
- ; Fetch a character into a from command line
-
- rech: mov bx,P1
- dec bx ;length is kept one back of p1
- mov si,P2 ;both pointers before altering DS
- mov bp,ds
- mov ds,WSEG
- mov al,(byte ptr[bx]) ;number of characters not taken out
- test al,al
- mov al,0DH ;carriage return faked on empty buffer
- jz recx
- dec byte ptr[bx]
- mov bx,si
- mov al,byte ptr[bx]
- inc bx
- mov ds,bp
- mov P2,bx
- recx: mov ds,bp
- ret
-
- ; Set ZF if AL contains a separator
-
- zsep: test al,al
- jz zret
- cmp al,0DH
- jz zret
- cmp al,' '
- jc cmerr ;ctrl chars
- jz zret
- cmp al,'='
- jz zret
- cmp al,'_'
- jz zret
- cmp al,'.'
- jz zret
- cmp al,':'
- jz zret
- cmp al,';'
- jz zret
- cmp al,'<'
- jz zret
- cmp al,'>'
- zret: ret
-
- ; command line error
-
- cmerr: mov al,'?'
- call CHOU ;type a question mark
- pop bx ;pop rets from call zsep,
- pop bx ;call fsep/ffil,
- pop bx ;call fica/b and
- pop bx ;call svcmb
- mov bx,P0 ;restore workspace pointers
- mov P1,bx
- mov P2,bx
- mov P3,bx
-
- STATS: mov ah,9 ;(09) write message
- mov dx,(offset logo)
- int bdos
- call QU ;use REC ops to show RAM usage
- dw 6
- db 'Code '
- MOV ax,C2
- MOV cs:stt0,ax
- call NU
- db 2
- stt0 dw 0
- MOV cs:stt1,cs
- call NU
- db 2
- stt1 dw 0
- call RLCT
- call QU
- dw 7
- db ' CPL '
- mov bp,C2
- sub bp,C0
- call RCTL
- call QU
- dw 6
- db 'Data '
- MOV ax,PZ
- MOV cs:stt2,ax
- call NU
- db 2
- stt2 dw 0
- MOV cs:stt3,ds
- call NU
- db 2
- stt3 dw 0
- call RLCT
- call QU
- dw 7
- db ' PDL '
- mov bp,PZ
- sub bp,(offset PD)+2
- call RCTL
- call QU
- dw 6
- db 'Extra '
- MOV ax,P4
- MOV cs:stt4,ax
- call NU
- db 2
- stt4 dw 0
- MOV ax,WSEG
- MOV cs:stt5,ax
- call NU
- db 2
- stt5 dw 0
- call RLCT
- call QU
- dw 7
- db ' WS '
- mov bp,P4
- sub bp,P0
- call RCTL
- call QU
- dw 6
- db 'Stack '
- MOV cs:stt6,sp
- call NU
- db 2
- stt6 dw 0
- MOV cs:stt7,ss
- call NU
- db 2
- stt7 dw 0
- call RLCT
- call QU
- dw 7
- db ' STK '
- mov bp,sp
- call RCTL
- ret
- TCRL: call NU
- db 2
- dw 2573
- call UCT
- call UCL
- ret
- RLCT: call HX
- call QU
- dw 1
- db ':'
- call CONC
- call EXCH
- call HX
- call CONC
- call QU
- dw 1
- db 'H'
- call CONC
- RLCT2: call CONC
- call UCT
- call UCL
- ret
- RCTL: mov cx,2
- call NARG
- mov [bx],bp
- inc bx
- inc bx
- mov PY,bx
- call NS
- call RLCT2
- call TCRL
- ret
-
- code ends
-
- ; -----------------------------------------------------
- ; RAM memory which is required for the operation of REC
- ; -----------------------------------------------------
-
- ; =============
- pdlist segment
- org 0
- dsbeg db 05CH dup(?)
- TFCB db 024H dup(?)
- TBUF db ?
- org 0100H ;origin of data in data segment
- ; =============
-
- ; Relay area for input and output subroutines.
-
- read dw chin ;character input for REC compiler
- tyin dw chin ;single character input for R
- tyou dw chou ;single character output for T
-
- ; Error message buffer
-
- EMSGS db 0DH,0AH
- EMSG dw 2020H
- db ' ovfl$'
-
- ; Prompt and crlf
-
- bume db 0DH,0AH,'REC87> $'
- crlf db 0DH,0AH,'$'
-
- ; Temporary storage used by the REC compiler.
-
- XPD dw 0000 ;colon jump back to left parenthesis
- YPD dw 0000 ;false predicate jump chain
- ZPD dw 0000 ;semicolon exit chain
-
- ; Pointers to the directories.
-
- FXT dw FT ;pointer to fixed operator directory
- VRT dw VT ;pointer to variable directory
- SBT dw STB ;pointer to subroutine directory
- CMT dw CTB ;pointer to compination directory
-
-
- ; Pointers to the area of compiled subroutines.
-
- C0 dw ENDREC ;lower limit of compile area
- C1 dw ENDREC ;beginning of present compilation
- C2 dw 0 ;upper limit of compile area
-
- ; Pointers to REC/MARKOV pushdown list.
-
- PX dw PD+2 ;beginning of pushdown text
- PY dw PD+2 ;end of pushdown text
- PZ dw 0 ;end of available pushdown space
-
- ; Workspace pointers.
-
- P0 dw 0 ;beginning of workspace
- P1 dw 0 ;beginning of marked segment
- P2 dw 0 ;end of marked segment
- P3 dw 0 ;end of text
- P4 dw 0 ;end of workspace
- WSEG dw 0 ;WS segment address
-
- ; Number conversion and arithmetic buffers
-
- FRST db 0 ;first character of input string
- ARG1 dw 0,0 ;8-byte buffer for digit collection
- ARG1M db 0
- ARG1X db 0
- ARG1B db 0
- ARG1H db 0
- ARGHH db 0
- DCPT db 0 ;decimal point flag and
- DDCT db 0 ;decimal digit count
- BINXPT equ DCPT
- ARG2 dw 0 ;alternate 8-byte buffer
- ARG2B dw 0
- ARG2M db 0,0,0
- ARG2H db 0
- DCXPT dw 0 ;decimal exponent
- DXSG db 0 ;flag for sign of decimal exponent
- NSIZ db 0 ;operand size in bytes
-
- ; I-O pointers.
-
- RX dw 0000
- RY dw 0000
- RSEG dw 0000
-
- ; Error flag.
-
- ER dw 0000
-
- ; Holder for return address from h
-
- RTADDR dw 0000
-
- ; ======= here is the table of definitions of REC operators =====
-
- FT dw NOOP ;blank
- dw NOOP
- dw RECOP ; [exclm] binary to hex string
- dw HX
- dw RECDQ ; " quoted expression
- dw QU
- dw RECOP ; # binary to decimal string
- dw NS
- dw RECOL ; $ fetch a variable cell
- dw VBLE
- dw RECOP ; % restrict to one byte
- dw PE
- dw RECOL ; & exchange top numeric pair
- dw EXCH
- dw RECSQ ; ' quoted expression
- dw QU
- dw RECLP ; (
- dw NOOP
- dw RECRP ; )
- dw NOOP
- dw RECOP ; * multiply
- dw MPY
- dw RECOP ; + add
- dw SUM
- dw NOOP ; , separator like space
- dw NOOP
- dw RECMS ; - subtract
- dw DIF
- dw RECDD ; . decimal point
- dw NU
- dw RECOP ; / divide [remainder, quotient]
- dw DVD
- dw RECDD ; 0 number
- dw NU
- dw RECDD ; 1 number
- dw NU
- dw RECDD ; 2 number
- dw NU
- dw RECDD ; 3 number
- dw NU
- dw RECDD ; 4 number
- dw NU
- dw RECDD ; 5 number
- dw NU
- dw RECDD ; 6 number
- dw NU
- dw RECDD ; 7 number
- dw NU
- dw RECDD ; 8 number
- dw NU
- dw RECDD ; 9 number
- dw NU
- dw RECCO ; :
- dw NOOP
- dw RECSC ; ;
- dw NOOP
- dw RECOP ; < restrict workspace
- dw BRA
- dw RECPR ; = test equality of top pair
- dw EQL
- dw RECOL ; > open workspace
- dw KET
- dw RECPR ; ? test for error report
- dw QM
- dw RECP1 ; @ execute subroutine
- dw AR
- dw RECPR ; A advance pointer 1
- dw UCA
- dw RECPR ; B retract pointer 1
- dw UCB
- dw RECOP ; C compile
- dw UCC
- dw RECOP ; D delete text
- dw UCD
- dw RECPL ; E equality between WS and PD
- dw UCE
- dw RECPL ; F find specified text
- dw UCF
- dw RECOP ; G fetch a block from memory
- dw GA
- dw RECPR ; H ASCII hex to binary
- dw HE
- dw RECOL ; I insert
- dw UCI
- dw RECOL ; J jump to front
- dw UCJ
- dw RECOP ; K call CP/M, keep (dx), put value
- dw CPM
- dw RECOL ; L erase top of PDL
- dw UCL
- dw RECPR ; M compare PDL and workspace
- dw UCM
- dw RECPR ; N numerical comparison
- dw UCN
- dw RECPR ; O decimal ASCII string to binary
- dw UCO
- dw RECOP ; P put block into buffered memory
- dw UCP
- dw RECOL ; Q put workspace segment on PD
- dw UCQ
- dw RECOP ; R read from keyboard
- dw UCR
- dw RECOP ; S store block in memory
- dw SA
- dw RECOL ; T write on screen
- dw UCT
- dw RECPR ; U search, yielding interval
- dw UCU
- dw RECPR ; V U, including endpoints
- dw UCV
- dw RECOP ; W write on printer
- dw UCW
- dw RECO1 ; X call library operator
- dw LIBO
- dw RECPR ; Y recover previous position of p1
- dw UCY
- dw RECOL ; Z pointer 2 to end of text
- dw UCZ
- dw RECCM ; [ comment
- dw NOOP
- dw RECOP ; \ insert single byte in pair
- dw IP
- dw RECOP ; ]
- dw NOOP
- dw RECOL ; ^ increment top argument
- dw INCR
- dw RECOP ; _ exit to monitor
- dw boot
- dw RECPR ; ` true for waiting character
- dw CHAW
- dw RECPR ; a segment forward from p1
- dw LCA
- dw RECPR ; b segment backward from p2
- dw LCB
- dw RECOP ; c create block on PDL
- dw BLOK
- dw RECPR ; d decrement but skip on zero
- dw decR
- dw RECPR ; e extend workspace
- dw LCE
- dw RECPR ; f block fill
- dw LCF
- dw RECOP ; g non-incrementing byte fetch
- dw GB
- dw RECOP ; h store/restore machine state
- dw MST
- dw RECOP ; i input from designated port
- dw LCI
- dw RECOL ; j null interval at p1
- dw LCJ
- dw RECOP ; k call CP/M: no returned values
- dw CPML
- dw RECOP ; l put pz on PDL
- dw Lcl
- dw RECOP ; m set aside top argument
- dw LCM
- dw RECOL ; n recover set-aside argument
- dw LCN
- dw RECOP ; o output from designated port
- dw LCO
- dw RECOL ; p put px, py-px on PDL
- dw GXS
- dw RECOL ; q put p1, p2-p1 on PDL
- dw LCQ
- dw RECOP ; r indirect replacement of address
- dw IND
- dw RECOP ; s store block in memory wrt limit
- dw LCS
- dw RECOP ; t type out indicated interval
- dw LCT
- dw RECOP ; u incrementing byte fetch
- dw GBI
- dw RECOP ; v incrementing byte store
- dw SAI
- dw RECOP ; w store workspace header
- dw LCW
- dw RECP1 ; x call library predicate
- dw LIBP
- dw RECOP ; y fetch byte pair to PDL incr org
- dw GWI
- dw RECOL ; z null interval at p2
- dw LCZ
- dw LBR ; { start a definition string
- dw NOOP
- dw RECOP ; | concatinate top two arguments
- dw CONC
- dw RECOP ; } end a definition string
- dw NOOP
- dw RECOP ; ~ complement or negate top arg
- dw COMP
- dw RECOP ; del
- dw NOOP
-
- ; Table of often-used combinations to compile as single
- ; operators or predicates.
-
- CTB db 'Ez' ;to the right if same
- dw EZE
- db 'JZ' ;span text
- dw SPAN
- db 'z<' ;null WS at p2
- dw ZCL
- db 'Z>' ;reopen with p2 at end
- dw ZOP
- db 'Jj' ;p1 and p2 at p0
- dw BEG
- db 'Z<' ;restrict from p1 to p3
- dw UZCL
- db 'pG' ;duplicate PDL argument
- dw DUPP
- db 'ED' ;delete if same
- dw EDE
- db 'J>' ;open with p1 at old p0
- dw JOP
- db 'Iz' ;insert and collapse
- dw IZE
- db 'jJ' ;p1 and p2 to p0 and p1
- dw LJUJ
- db '><' ;reopen and restrict
- dw OPCL
- db '^^' ;increase by 2
- dw INTW
- db 'QD' ;copy and delete
- dw QUDE
- db 'FD' ;find and delete
- dw EFDE
- db 'nL' ;lift from PDL complement
- dw ENLF
- db '&S' ;exch args and store
- dw XSTO
- db 'LL' ;lift twice
- dw LFTW
- db '$r' ;contents of var cell
- dw VREP
- db '$S' ;save in var cell
- dw VSTO
- db '&L' ;lift lower
- dw XLFT
- db 'qL' ;p1 to PDL
- dw GTP1
- db 'J<' ;restrict from p0
- dw JCL
- db 'I<' ;insert and restrict
- dw ICL
- db 'TL' ;type and lift
- dw UCTL
- db 'Qm' ;copy WS to PDL complement
- dw QUEM
- dw 0000 ;end-of-table marker
-
- VT dw 021H dup(?) ;REC-defined subroutine table & vars.
- STB dw 05FH dup(?)
- PD dw 0 ;beginning of PDL
-
- logo db 0DH,0AH,' REC(8086)/ICUAP',0DH,0AH
- db 'Universidad Autonoma de Puebla',0DH,0AH
- db ' February 2, 1986',0DH,0AH,0AH,'$'
-
- dlst db 0
-
- pdlist ends
-
- ; =============
- stack segment STACK
- org 0000H ;origin of stack segment
- ; =============
-
- STKB dw 0
- STKE dw 0
- stack ends
-
-
- ; end