home *** CD-ROM | disk | FTP | other *** search
- ; *******************************************************
- ; * REC module containing the REC nucleus and some of *
- ; * the really indispensable operators and predicates *
- ; * such as those defining two byte binary numbers and *
- ; * ASCII constant strings. The model of a pushdown *
- ; * list is assumed in the expectation that additional *
- ; * operators and predicates will also follow reversed *
- ; * Polish notation. There are additionally many small *
- ; * service routines which may be used externally. *
- ; * *
- ; * REC86 was obtained from the previously existing *
- ; * REC80 by applying SORCIM's TRANS86 translator and *
- ; * then adjusting the resulting code manually. It is *
- ; * intended that REC86 will be functionally identical *
- ; * to REC80. All error corrections, additions, or *
- ; * alterations are made simultaneously to the two *
- ; * programs, when they are not purely cosmetic. *
- ; * Braces, creating a different style of subroutine *
- ; * definition, were incorporated in REC at the time *
- ; * the translation to the Intel 8086 was made. *
- ; * *
- ; * This version supports separate code, data (base *
- ; * page, pointers and PDL), extra (WS) and stack *
- ; * segments. [G. Cisneros, Feb 1984] *
- ; * *
- ; * REC86 contains the following compiling entries: *
- ; * *
- ; * reclp left parenthesis *
- ; * recco colon *
- ; * recsc semicolon *
- ; * recrp right parenthesis *
- ; * recop operator *
- ; * recpr predicate *
- ; * recsq single quotes *
- ; * recdq double quotes *
- ; * reccm comments *
- ; * reco1 operator with one ASCII parameter *
- ; * recp1 predicate with one ASCII parameter *
- ; * recms unary minus sign *
- ; * recdd decimal digit *
- ; * recol operator, with lookahead *
- ; * recpl predicate, with lookahead *
- ; * *
- ; * REC86 contains the following operators and *
- ; * predicates: *
- ; * *
- ; * ' single quote *
- ; * " double quote *
- ; * nu two byte decimal number *
- ; * O decimal ASCII string to number *
- ; * # number to decimal ASCII string *
- ; * L erase argument (lift) *
- ; * @ execute subroutine *
- ; * { initiate program segment *
- ; * } discontinue program segment *
- ; * ? report detected error *
- ; * *
- ; * The following are initialization programs which *
- ; * can be called at the outset of a compilation. *
- ; * *
- ; * inre initialize REC temporary registers *
- ; * *
- ; * * * * * * * * * * * * * * * * * * * * * * * * * * * *
- ; * *
- ; * REC86 - Copyright (C) 1982, 1984 *
- ; * Universidad Autonoma de Puebla *
- ; * All Rights Reserved *
- ; * *
- ; * [Harold V. McIntosh, 25 April 1982] *
- ; * [Gerardo Cisneros, 8 February 1984] *
- ; * *
- ; 14 April 1983 - AR recognizes @@ *
- ; 14 April 1983 - cosmetic changes: use of <lea> *
- ; 14 April 1983 - suppress TLU and TLV *
- ; 14 January 1984 - 4 explicit jmps's for sorcim.cnv *
- ; 8 February 1984 - Individual segments *
- ; 3 July 1984 - @@ takes 1- and 2-byte arguments from *
- ; the PDL; compilation of combinations included - GCS *
- ; 15 Aug 1984 - E.P.s for nL, LL and &L - GCS *
- ; 29 June 1985 - word-size @ table for x - GCS *
- ; *******************************************************
-
- ; =======================================================
- ; The nucleus of REC is a compiler for control symbols,
- ; operators and predicates, some auxiliary subroutines,
- ; and an initilazation routine.
- ;
- ; The compiler proper uses only the folowing external
- ; references:
- ;
- ; RAM storage xpd, ypd, zpd
- ; I-O routine read
- ; skip instruction skp
- ;
- ; The RAM storage must be initialized, which may be
- ; accomplished by calling inre.
- ;
- ; The location in which the object code is placed is
- ; passed along through the register pair (dx), which is
- ; continually updated to reflect the next available byte.
- ; None of the other registers are either conserved nor
- ; significant after the completion of compilation.
- ;
- ; The usage of the registers is the following
- ;
- ; pair (cx) contains the execution pointer
- ; pair (dx) contains the object program counter
- ; pair (bx) contains the compiling address
- ;
- ; =======================================================
-
- ; Equivalences defining INTEL 8086 instructions and some
- ; constants.
-
- CA equ 0E8H ;call w/16 bit displacement
- JU equ 0E9H ;jump w/16 bit displacement
- RN equ 0C3H ;return w/o change of segment
- POBX equ 05BH ;pop bx
- PUBX equ 053H ;push bx
- JUBX equ 0E3FFH ;jmp bx
- PUME equ 036FFH ;push direct address
- POME equ 0068FH ;pop into memory
- INBX equ 043H ;inc bx
- LDME equ 006C7H ;ld mem,imm
-
- ; Compile a left parenthesis.
-
- RECLP: pop bp
- push ZPD ;save the linkage to semicolon exits
- push YPD ;save the higher linkage to false jumps
- push XPD ;save the repeat references
- mov ax,0 ;initialze the new chains
- mov ZPD,ax ;null TRUE exit list
- mov YPD,ax ;null FALSE jump list
- mov XPD,dx ;new parenthesis level begins here
- jmp bp
-
- ; Compile a colon.
-
- RECCO: mov bx,XPD ;pick up reference to left parenthesis
- sub bx,dx
- lea bx,-3[bx]
- call RECJU ;and insert a jump to its location
- jmp RECFY ;fill in any FALSE predicate jumps
-
- ; Compile a semicolon.
-
- RECSC: mov bx,ZPD ;pick up link to TRUE exit chain
- call RECJU ;insert this one on it too
- mov ZPD,bx ;store it as the new head of the chain
- jmp RECFY ;fill in any FALSE predicate jumpe
-
- ; Compile an operator.
-
- RECOP: xchg bx,dx
- mov cs:byte ptr [bx],CA ;store the 8086 code for a call
- lea bx,3[bx] ;advance (dx) to receive next byte
- sub cx,bx
- mov cs:(-2)[bx],cx
- xchg bx,dx
- ret
-
- ; Compile a predicate.
-
- RECPR: call RECOP ;call its subroutine, same as operator
- RECYJ: mov bx,YPD ;linkage to FALSE exits
- call RECJU ;incorporate a jump if result FALSE
- mov YPD,bx ;update for new head of chain
- ret
-
- ; Compile a right parenthesis.
-
- RECRP: pop bp ;recover xpd, which is hidden
- pop XPD ;replace it
- cmp XPD,0
- jz RECFP ;if so, continue with recfp
- pop bx ;recover wpd
- call RECJU ;link expr to ypd on its own level
- push bx ;but save pointer until we finish up
- call RECFY ;false predicates in last segment
- pop YPD ;replace ypd for higher level
- mov bx,ZPD ;now we have destination for semicolons
- call recfc ;so insert all the correct addresses
- pop ZPD ;replace old zpd
- jmp bp
-
- ; Final right parentheses get a different treatment.
-
- RECFP: mov bx,dx ;compile pointer in bx
- mov cs:byte ptr [bx],RN ;store a <ret> for false exit
- inc bx ;ready for next byte
- push bx ;save compile pointer
- mov dx,(offset SKP) ;address of skip - TRUE exit from REC
- call RECFY ;use it for last segment
- mov bx,ZPD ;destination of semicolons now known
- call recfc ;so fill out that chain
- pop dx ;compile pointer that was saved
- pop YPD ;restore old ypd
- pop ZPD ;restore old zpd
- ret ;return one level higher than expected
-
- ; Insert a new element in a chain of jmp's which will
- ; eventually have destination addresses. In the interim
- ; each is given the address of its predecessor. On entry
- ; (dx) holds the address where the instruction will be
- ; stored and (bx) holds the address of its predecessor.
- ; On exit, (dx) is incremented by 3 to point to the next
- ; free byte, and (bx) has the starting value of (dx).
-
- RECJU: xchg bx,dx ;(bx) and (dx) exchanged is better
- mov cs:byte ptr [bx],JU ;store the jump instruction
- inc bx
- mov cs:[bx],dx ;store old link
- lea dx,2[bx]
- ret
-
- ; When the destination of a linked chain of jumps is
- ; finally known, the destination can be substituted into
- ; each one of the links. On entry, (bx) contains the
- ; address of the first link unless it is zero signifying
- ; a null chain.
-
- recfc: or bx,bx ;test for end of chain
- jz recfx ;if address is zero, chain ends
- mov ax,dx
- dec ax
- dec ax
- recfi: mov cx,cs:[bx] ;save next link
- mov cs:[bx],ax ;store destination
- sub cs:[bx],bx
- mov bx,cx ;update link
- or bx,bx
- jnz recfi ;continue
- recfx: ret
-
- ; Call recfc with the intention of filling the y chain.
-
- RECFY: mov bx,YPD
- call recfc
- mov YPD,bx
- ret
-
- ; Subroutine which will initialize the temporary
- ; registers used by the REC compiler.
-
- INRE: mov bx,0
- mov XPD,bx
- mov YPD,bx
- mov ZPD,bx
- ret
-
-
- ; =======================================================
- ; The following are specialized compiling subroutines
- ; which apply to special structures and depend on the
- ; model of a pushdown list with a linked chain structure
- ; and special registers px and py delimiting the top
- ; segment on the chain.
- ; =======================================================
-
- ; -------------------------------------------------------
- ; Compilation of quoted expressions. Single and double
- ; quotes may alternate with one another to an arbitrary
- ; depth. Both kinds of quotes are executed in the same
- ; way, by loading the quoted expression from the program
- ; onto the pushdown list.
- ; -------------------------------------------------------
-
- ; Compile single quotes.
-
- RECSQ: call RECOP ;record call to qu
- inc dx ;set aside two bytes
- inc dx ;to hold length of ASCII chain
- push dx ;keep beginning for future reference
- push cs:QUEN ;delay cleanup until ret
- SQ: call word ptr read ;read the next character
- cmp al,'''' ;test for single quote
- jz SQ2 ;if so go after entire chain
- cmp al,'"' ;test for double quotes
- jnz SQ1
- call DQ1 ;if so, read it all
- SQ1: xchg bx,dx
- mov cs:[bx],al
- xchg bx,dx ;otherwise keep on storing
- inc dx ;and advancing pointer
- jmp SQ ;go after next character
- SQ2: ret
-
- ; Compile double quotes.
-
- RECDQ: call RECOP ;record call to qu
- inc dx ;set aside two bytes
- inc dx ;to hold length of chain
- push dx ;put chain origin away for reference
- push cs:QUEN ;delay cleanup until ret
- DQ0: call word ptr read ;read the next character
- cmp al,'"' ;test for double quotes
- jz DQ2 ;if so, chain finished
- cmp al,'''' ;check for single quotes
- jnz DQ1
- call SQ1 ;if so go after whole chain
- DQ1: xchg bx,dx
- mov cs:[bx],al
- xchg bx,dx ;otherwise keep on storing
- inc dx ;and advancing pointer
- jmp DQ0 ;go after next character
- DQ2: ret
-
- ; Cleanup for both quote compilers.
-
- QUEN dw ENQU ;for the direct push
- ENQU: pop bx ;beginning of chain in (bx)
- mov cx,dx
- sub cx,bx
- mov cs:(-2)[bx],cx ;store length
- ret
-
- ; (') (") Execute single or double quote.
-
- QU: pop bx ;get call location off the 8080 stack
- mov cx,cs:[bx] ;count
- inc bx ;
- inc bx ;
- mov si,bx ;save source origin
- add bx,cx ;calculate source end = return adress
- push bx
- call NARG ;check space, put dest. pointer in (bx)
- cld
- mov di,bx
- mov bp,ds
- mov es,bp
- mov ax,cs
- mov ds,ax
- repnz movsb
- mov ds,bp ;restore (ds)
- mov PY,di ;record end of argument
- ret
-
- ; -------------------------------------------------------
- ; Comments are enclosed in square brackets, which must be
- ; balanced. Code may be disabled by enclosing it in
- ; square brackets, but care must be taken that the
- ; expression so isolated does not contain individual
- ; brackets, such as arguments of arrobas or quoted
- ; brackets, which might disrupt the balance. Since
- ; comments are ignored by the compiler they are not
- ; executed.
- ; -------------------------------------------------------
-
- ; Compile comments by ignoring them.
-
- RECCM: call word ptr read ;get next character
- cmp al,']' ;test for closing ]
- jz RECCX ;if so we're done
- cmp al,'[' ;test for beginning of new level
- jnz RECCM ;otherwise keep on reading
- call RECCM ;if so go after it recursively
- jmp RECCM
- RECCX: ret
-
- ; -------------------------------------------------------
- ; Sometimes, notably in compiling arroba as a call to a
- ; subroutine named by a single letter, a parameter will
- ; follow a subroutine call as its calling sequence.
- ; -------------------------------------------------------
-
- ; Operator with one ASCII parameter.
-
- RECO1: call RECOP ;always compile the subroutine call
- call word ptr read ;read the parameter
- mov bx,dx
- mov cs:[bx],al ;store as a 1-byte calling sequence
- inc dx ;always ready for next byte
- ret
-
- ; Predicate with one ASCII parameter.
-
- RECP1: call RECO1 ;compile as the analogous operator
- jmp RECYJ ;then take account of false exit
-
- ; Predicate, with lookahead, to compile often-used
- ; combinations like Ez and ED
-
- RECPL: call RECOL ;compile as the analogous operator
- jmp short pl0 ;short jump because recol may skip
- call RECYJ ;call to link into chain
- jmp skp86 ;skip, we have the next character
- pl0: jmp RECYJ ;no skip, just link into chain
-
- ; Operator, with lookahead, to compile often-used
- ; combinations like pG and TL into a single call.
-
- RECOL: mov bl,al ;save first character
- ol1: call word ptr read ;get the next valid character
- call svc86
- jmp short ol1
- add al,' ' ;restore to ASCII
- push ax ;save, in case combination not found
- push cx ;save exec addr of first letter
- push dx ;as well as the compilation ptr
- mov bh,al ;both letters in BX
- mov dx,CMT ;combination table address
- xchg bx,dx ;switch letters and address
- ol2: mov cx,[bx] ;get next combination
- jcxz ol4 ;end of table, exit loop
- cmp cx,dx ;else compare letters
- jz ol3 ;exit loop if found
- add bx,4 ;advance pointer to table
- jmp short ol2 ;try next
-
- ol3: pop dx ;found, get comp. ptr.
- pop cx ;get rid of old exec addr
- mov cx,2[bx] ;get exec. addr. of combination
- pop ax ;get rid of saved character
- jmp RECOP ;off to compile call
-
- ol4: pop dx ;not found, fetch comp. ptr.
- pop cx ;and exec. addr. of first letter
- call RECOP ;compile that
- pop ax ;retrieve the second character
- jmp skp86 ;and skip, since no read necessary
-
- ; -------------------------------------------------------
- ; Decimal numbers are of such frequent occurrence in the
- ; form of counters, arguments, or just data that it is
- ; convenient to compile them on sight without requiring
- ; any special delimiters. Likewise, negative numbers are
- ; easier to designate using a minus sign than using their
- ; modular form, but this should not prevent the use of a
- ; minus sign as an operator.
- ; -------------------------------------------------------
-
- ; Compile a minus sign. This involves determining whether
- ; it is followed immediately by a decimal digit, in which
- ; case it is compiled as part of a negative number.
-
- RECMS: call word ptr read ;read in one byte
- call MS1 ;decide whether it is a digit
- push ax ;it was not, save it
- call RECOP ;compile call to binary minus
- pop ax ;recover the extra character
- jmp skp86 ;skip because we have next character
-
- MS1: call RND ;return if not digit
- inc sp ;erase call to ms1
- inc sp ;
- call RECDS ;read and convert digit string
- mov cx,cs:GNU ;fake that it was nu, not ms
- push ax ;save terminating character
- neg bx ;negate (bx)
- jmp DD1 ;continue as though positive number
-
- GNU dw NU
-
- ; Compile a decimal digit, which requires reading any
- ; further digits which follow, and saving the terminator.
-
- RECDD: push cx ;save execution address
- call RECDS ;read and transform rest of digits
- pop cx ;recover execution address
- push ax ;recover terminating character
- DD1: call RECOP ;compile subroutine call
- xchg bx,dx ;(dx) and (bx) must be interchanged
- mov cs:[bx],dx ;put word in calling sequence
- inc bx ;
- inc bx ;ready for next byte
- xchg bx,dx ;put (dx) and (bx) back as they were
- pop ax ;recover terminating character
- jmp skp86 ;skip over character read call
-
- ; Multiply (bx) by 10 and add A. (dx) is conserved.
-
- TXP: mov cx,bx ;transfer (bx) to (cx)
- add bx,bx ;multiply (bx) by 2
- add bx,bx ;another 2 makes 4
- add bx,cx ;the original (bx) makes 5
- add bx,bx ;another 2 makes 10
- add bx,ax ;add in the accumulator
- ret
-
- ; The heart of number compilation.
-
- RECDS: and al,0FH ;mask ASCII down to binary value
- mov BL,al ;put it into register pair (bx)
- mov BH,0 ;fill out H with a zero
- RD1: call word ptr read ;read the next character
- call RND ;quit if it is not another digit
- call TXP ;multiply (bx) by ten and add A
- jmp RD1 ;continuing while digits keep coming
-
- ; Execute a number, which means load it on pdl.
-
- NU: mov cx,2 ;two bytes will be required
- call NARG ;close last argument, open new
- pop dx ;get beginning of calling sequence
- xchg bx,dx
- mov ax,cs:[bx] ;fetch number from code segment
- xchg bx,dx
- mov [bx],ax ;and copy it over
- inc dx ;on to the high order byte
- inc bx ;and the place to store it
- inc dx ;move on to program continuation
- inc bx ;always leave PDL ready for next byte
- push dx ;put back the return address
- mov PY,bx ;mark end of the argument
- ret
-
- ; (O) Transform an ASCII character string on the PDL into
- ; a two-byte number. Predicate - false if the argument
- ; is not a digit string or null, leaving the argument
- ; unchanged.
-
- UCO: mov cx,2 ;two bytes are required
- call OARG ;check that they are available
- mov bx,PY ;fetch the end of the argument string
- mov byte ptr [bx],0 ;put a zero there to mark its end
- mov dx,PX ;load pointer to argument string
- mov bx,0 ;zero in (bx) to start the conversion
- O1: xchg bx,dx
- mov al,[bx]
- xchg bx,dx ;fetch one character
- inc dx ;get ready for next
- or al,al ;test for zero
- jz O2 ;go to accumulation phase
- call RND ;FALSE, chain unaltered if non-digit
- call TXP ;otherwise continue to work up value
- jmp O1 ;and keep on reading bytes
- O2: xchg bx,dx ;safeguard converted number in (dx)
- mov bx,PX ;get pointer to argument
- mov [bx],dx ;store low byte
- inc bx ;increment pointer
- inc bx ;increment pointer again
- mov PY,bx ;store to close argument
- jmp SKP ;TRUE exit from predicate
-
- ; (#) Change two-byte binary number into a decimal-based
- ; ASCII string without sign. The special cases of a zero-
- ; byte or a one-byte argument are also considered.
-
- NS: mov cx,05H ;five bytes may be required
- call OARG ;reuse the old argument
- mov cx,PY
- mov bx,PX
- sub cx,bx
- mov ax,0 ;put zero in (dx) for default
- jcxz NS1 ;load nothing
- mov al,[bx] ;load low byte
- dec cx ;test for one byte
- jcxz NS1 ;only byte and it's loaded
- mov ah,1[bx] ;load high byte
- NS1: mov bp,bx ;save pointer for ASCII string
- mov cl,'0' ;prepare to write a zero
- mov bx,-10000 ;will there be 5 digits?
- add bx,ax ;
- jb NS2 ;
- mov bx,-1000 ;will there be 4 digits?
- add bx,ax ;
- jb NS3 ;
- mov bx,-100 ;will there be 3 digits?
- add bx,ax ;
- jb NS4 ;
- mov bx,-10 ;will there be 2 digits?
- add bx,ax ;
- jb NS5 ;
- jmp NS6 ;write one no matter what
- NS2: mov bx,10000 ;ten thousands digit
- call NSA ;
- NS3: mov bx,1000 ;thousands digit
- call NSA ;
- NS4: mov bx,100 ;hundreds digit
- call NSA ;
- NS5: mov bx,10 ;tens digit
- call NSA ;
- NS6: add cl,al ;units digit
- mov ds:[bp],cl ;store the digit
- inc bp ;position pointer for next byte
- mov PY,bp ;done, store it as terminator
- ret
-
- NSA: mov dx,0 ;clear extension for div
- div bx ;div bx into axdx
- add cl,al ;form ASCII digit
- mov ax,dx ;put remainder in ax
- mov ds:[bp],cl ;store new digit
- inc bp ;advance pointer
- mov cl,'0' ;load a fresh ASCII zero
- ret
-
- ; =======================================================
- ; Some simple procedures to compile REC expressions into
- ; subroutines, deposit a reference to them in a symbol
- ; table, and eventually to recover the space and erase
- ; the symbol table reference.
- ; =======================================================
-
- ; Table search. The table whose address is stored at fxt
- ; is consulted for its pair of addresses at position 4*A.
- ; Thus on entry, A holds the table index. This table
- ; alternates the address of a compiling subroutine with
- ; the execution address of the same entry. On exit, (cx)
- ; holds the execution address, (dx) is preserved, and a
- ; jump is made to the compiling address.
-
- rects: mov ah,0
- mov bp,ax ;save the character
- add ax,ax
- add ax,ax
- mov bx,FXT ;load base address of table
- add bx,ax
- mov ax,bp ;restore letter to AX
- add al,' ' ;but in original ASCII form
- push word ptr [bx] ;put the first entry in (cx)
- mov cx,2[bx] ;table pointer is going
- ret ;then off to the compilation
-
- ; Pick out left delimiters: (, {, or [.
-
- left: call word ptr read
- cmp al,'('
- jz eft
- cmp al,'{'
- jz eft
- cmp al,'['
- jnz left
- call reccm
- jmp short left
- eft: ret
-
- ; A main program to compile characters one by one as
- ; they are read in from the console. Note that the
- ; compiling programs invoked by rects can generate skips
- ; when they have already read the following character.
- ; This occurs most notably when compiling digits. Also
- ; note that svc86 normalizes characters when it accepts
- ; them.
-
- recre: call word ptr read ;read a character from whereever
- recrr: call svc86 ;check for space, control character
- jmp short recre ;not valid, go back for another
- call rects ;look up in table and compile it
- jmp short recre ;read another character and repeat
- jmp short recrr ;repeat but next character already read
-
- ; A subroutine which will pass over comments, and wait
- ; for an opening left parenthesis or brace before compiling
- ; a REC expression.
-
- EMCE: call UCL ;entry here erases an argument from PDL
- EMCX: call left ;get a character from whereever
- mov dx,C1
- mov bx,C1
- mov bp,sp
- xchg bx,[bp]
- push bx
- call recrr ;compiling prgrm one char already read
- cmp dx,C2 ;compare with high limit
- ja emc0
- cmp dx,C0 ;compare with low limit
- jb emc0
- mov C1,dx
- ret
- emc0: mov bx,'pC' ;Type fatal error msg and quit
- jmp FERR
-
- EMCU: pop dx
- pop bx
- push dx
- push bx
- mov dx,(offset EMCV)
- push dx
- jmp bx
- EMCV: jmp EMCW
- pop C1
- jmp skp86
- EMCW: pop C1
- ret
-
- ; ({) Introduce a series of definitions.
-
- LBR: xchg bx,dx
- mov cs:byte ptr [bx],CA ;insert a call to the executable subroutine
- xchg bx,dx
- inc dx
- mov cx,dx ;place to put call address - keep in BC
- inc dx ;make room
- inc dx
- call RECYJ ;link in the FALSE exit
- call RECJU
- push bx ;keep this address
- push XPD
- mov XPD,0 ;this is top level for ensuing subroutines
- mov bx,0
- LB1: push dx ;record entry point to subroutine
- inc bx ;increment count of subroutines
- push bx ;keep it next to top on stack
- push cx ;jump address at entry - keep it on top
- call left
- call recrr ;compile at least one subroutine
- LB2: call word ptr read ;get possible name of subroutine
- cmp al,'}' ;no name - we execute this one
- jz LB3
- call svc86 ;convert name into serial number
- jmp short LB2 ;punctuation instead of name
- add al,' '
- mov ah,0
- mov bx,VRT
- add ax,ax
- add bx,ax
- ; add bx,ax ;word-size entries
- pop cx ;get this out of the way
- mov bp,sp
- xchg bx,[bp] ;store table address, put subr count in bx
- jmp LB1
- LB3: cld
- mov ax,cs
- mov es,ax
- pop bx ;origin of brace compilation
- mov di,dx
- lea ax,2[bx]
- sub ax,di
- neg ax
- mov cs:[bx],ax
- pop cx ;number of subroutines + 1
- push cx ;we'll need it again later
- mov bp,cx ;put it in bp too
- dec bp
- add bp,bp
- add bp,bp
- add bp,sp
- mov al,POBX
- stosb
- jmp LB5
- LB4: mov ax,PUME ;for each defined symbol we insert the
- stosw
- mov ax,[bp]
- stosw
- mov ax,LDME ;
- stosw
- mov ax,[bp]
- stosw
- mov ax,2[bp]
- stosw
- sub bp,4 ;we read the stack backwards
- LB5: loop LB4
- mov al,PUBX
- stosb
- mov al,CA
- stosb
- pop cx
- pop ax
- sub ax,di
- dec ax
- dec ax
- stosw
- push cx
- mov al,JU ; jmp $+6
- stosb
- push di ; inx h
- inc di ; inx h
- inc di ; inx h
- mov al,POBX
- stosb
- mov al,INBX
- stosb
- stosb
- stosb
- mov al,PUBX
- stosb
- pop bx
- lea ax,2[bx]
- sub ax,di
- neg ax
- mov cs:[bx],ax
- mov al,POBX
- stosb
- pop cx
- jmp LB7
- LB6: mov ax,POME ;after an expression in braces is
- stosw
- pop ax
- stosw
- inc sp
- inc sp
- LB7: loop LB6
- mov ax,JUBX ;the whole thing is finished off by a return
- stosw
- mov dx,di
- pop cx
- mov XPD,cx
- pop bx
- jcxz LB8
- lea ax,2[bx]
- sub ax,dx
- neg ax
- mov cs:[bx],ax
- ret
- LB8: mov cx,cs:[bx]
- mov ax,(offset SKP)-2 ;top level true return
- sub ax,bx
- mov cs:[bx],ax
- mov cs:byte ptr (-4)[bx],RN ;top level false return
- inc sp ;return one level higher than expected
- inc sp
- ret
-
- ; (@) Subroutine which will transform an ASCII character
- ; into a table reference, and then jump to the address
- ; so encountered. This is essentially REC's subroutine
- ; call mechanism, necessarily a predicate since it calls
- ; a REC expression, which is itself a predicate.
-
- AR: pop bx ;entry if name is a parameter
- mov al,cs:[bx] ;read the calling sequence
- inc bx ;advance pointer for return
- push bx ;put it back on 8080 stack
- cmp al,'@'
- jnz XAR
- mov bx,PX ;argument on PDL, compute size
- mov ax,[bx] ;but fetch two bytes anyway
- mov cx,PY
- sub cx,bx
- call UCL ;lift it before going on
- cmp cx,2 ;is it an address?
- jnz XAR ;no, assume a letter
- jmp ax ;yes, jump to it
-
- XAR: mov ah,0 ;clear the high byte
- add ax,ax ;compute address of table entry
- ; add ax,ax ;word-size entries
- mov di,ax
- mov bx,VRT ;entry when index is in register A
- jmp word ptr [bx+di] ;then use it as jump address
-
- ; =======================================================
- ; Some general service routines.
- ; =======================================================
-
- ; Skip on valid character, meaning, not control symbol.
- ; If valid, 20H (space) is subtracted, making A = 1, etc.
-
- svc86: cmp al,'!' ;reject space, excl is lower limit
- jb sv
- cmp al,7FH ;seven bits is upper limit
- jnb sv
- sub al,' ' ;normalize to begin with (excl) = 1
- pop bp
- inc bp
- inc bp
- jmp bp
- sv: ret ;don't skip for control or flag bit
-
- ; Return if not decimal. A unchanged if not decimal, else
- ; reduced to binary.
-
- RND: cmp al,':' ;colon follows 9 in ASCII alphabet
- jnb RTN
- cmp al,'0' ;ASCII zero is lower limit
- jb RTN
- sub al,'0' ;normalize to get binary values
- mov ah,0 ;zero for uncomplicated arithmetic
- ret
- RTN: inc sp
- inc sp
- ret
-
- ; Second level return on error.
-
- RR2: pop bx ;entry to clear two items from PDL
- mov bp,sp
- xchg bx,[bp] ;
- RR1: pop bx ;entry to clear one item from PDL
- mov bp,sp
- xchg bx,[bp] ;
- RER: pop ax ;site where ther error occurred
- cmp ER,0 ;only record the first error
- jnz RRR
- mov ER,ax
- RRR: ret
-
- ; (?) Test whether an error has been reported: predicate
- ; which is true if er is nonzero, in which case it will
- ; reset er. It will also, if TRUE, place the calling
- ; address of the last reported error on the pushdown
- ; list. If false, only a FALSE return is generated. Note
- ; the ironic circumstance that, if PDL is exhausted, qm
- ; can generate an error trying to report an error - but
- ; the TRUE result will still be valid.
-
- QM: cmp ER,0 ;test the error cell
- jz QQ ;FALSE return if no error
- mov cx,2 ;we want two bytes for error address
- call NARG ;check space, prepare for new argument
- mov ax,ER ;fetch error address
- mov [bx],ax ;transfer it to REC PDL
- inc bx ;
- inc bx ;pointer must always advance
- mov PY,bx ;end of the argument
- mov ER,0 ;reset ER
- jmp SKP ;TRUE return - there was an error
- QQ: ret
-
- ; Generate a skip (skp), which is often combined with the
- ; erasure of an argument on the pushdown list (cucl).
-
- CUCL: call UCL ;erase the top argument
- SKP: pop bp
- add bp,3 ;assume the skip will be over a
- jmp bp ;three-byte instruction, such as a jump
-
- skp86: pop bp
- inc bp
- inc bp
- jmp bp
-
- ; Test PDL space beginning at top argument. On entry (cx)
- ; contains the total space required. On exit, (cx) stays
- ; unchanged, (dx) holds pz, while (bx) holds px+(cx).
- ; If the space is not available, return is made from the
- ; calling program after noting the error. Otherwise
- ; normal return to the calling program occurs. The likely
- ; use of oarg is to record a result without having to go
- ; through ucl, NARG.
-
- OARG: mov dx,PZ ;load limit of PDL
- dec dx ;keep one byte margin
- mov bx,PX ;load beginning of current argument
- add bx,cx
- jc NRER ;Error if PX+(cx) wraps around 64K
- sub dx,bx
- jb NRER ;No space, take nearby NRER exit
- ret ;yes, continue normally
-
- ; Check space for, and then set up, a new argument. On
- ; entry, (cx) should contain the amount of additional
- ; space required. The program will automatically add
- ; two more bytes for the pointer which would close the
- ; argument and then, if the required space is available,
- ; close it, define the new px, and leave its value in
- ; (bx). (dx) will contain the old value of px to be used
- ; in case the superseded argument is still interesting.
- ; When space is not available, the error return rer is
- ; taken.
- ;
- ; The entry RARG can be taken when it is known that
- ; sufficient space is available but the pointers still
- ; have to be set up.
-
- NARG: mov di,cx
- mov bx,PY ;load end of current argument
- lea ax,3[bx+di]
- cmp ax,PZ
- jnb NRER ;check available space
- cmp ax,PX
- jb NRER ;Error if (ax) wrapped around 64K
- RARG: mov dx,PX ;entry if no space check needed
- mov bx,PY
- mov [bx],dx ;low byte of closing link
- inc bx ;on to high byte
- inc bx ;beginning of new space
- mov PX,bx ;which is recorded by px
- ret ;and remains in (bx)
- NRER: mov bx,'DP' ;quit on PDL overflow
- jmp FERR
-
- ; (&L) A commonly used combination, erasing only the lower arg.
-
- XLFT: mov si,PX
- mov cx,PY ;pointers to top
- sub cx,si
- call UCL ;"lift" it
- test dx,dx ;empty PDL?
- jz xlre
- call UCL ;lift the lower one
- call RARG ;close the next
- mov di,bx ;new px to di
- cld
- mov ax,ds
- mov es,ax
- repnz movsb ;move down the old top
- mov PY,di ;record new end
- xlre: ret
-
- ; (L) Remove argument from pushdown list. There are no
- ; requirements for entry to ucl. On exit, (cx) remains
- ; unchanged, (dx) holds the end of the former argument
- ; and (bx) holds the beginning of the former argument -
- ; the one that was exposed when the current argument was
- ; erased. Erasing non-existent arguments creates an error
- ; condition which is noted and ignored.
-
- LFTW: call UCL ;entry point for LL
-
- UCL: mov bx,PX ;pointer to current argument
- dec bx ;just behind the present
- dec bx
- mov dx,[bx] ;argument is the address
- or dx,dx ;so we always test out of caution
- jz ULE
- mov PY,bx ;(bx) now holds end of previous arg.
- mov PX,dx ;pointer to beginning of prev. arg.
- xchg bx,dx
- ret
- ULE: inc bx ;restore bx
- inc bx
- call RER ;record error if pointer was zero
-
- ; Null program for undefined operators.
-
- NOOP: ret
-
- ; =======================================================
- ;
- ; Some of the service routines, which might be external
- ; references in other modules, are:
- ;
- ; oarg space when reusing an argument
- ; NARG close old argument, space for new
- ; rarg same as NARG when space is assured
- ; skp generic skip
- ; rer return on error
- ; rr2 rer after popping two addresses
- ; rtn generic return
- ; ucl lift argument from PDL (L)
- ; cucl lift argument, then skip
- ;
- ; Three entry points can be used according to the variant
- ; of the compiling operator C desired. One of them could
- ; also be used by a main program.
- ;
- ; emce lift pushdown, open block, compile
- ; emcx compile a sequence of subroutines
- ;
- ; =======================================================
-
- ; END
