Oakland CPM Archive

home *** CD-ROM | disk | FTP | other *** search

/ Oakland CPM Archive / oakcpm.iso / sigm / vol164 / rec80.mac < prev next >

Wrap

Text File | 1984-04-29 | 38.2 KB | 1,218 lines

; ******************************************************* ; * 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. * ; * * ; * The source language for these programs is the one * ; * used by the Microsoft M80 macro assembler. * ; * * ; * REC.MAC 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 * ; * * ; * REC.MAC 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 * ; * * ; * * * * * * * * * * * * * * * * * * * * * * * * * * * * ; * * ; * Version circulated at the Summer School, 1980. * ; * * ; * REC80 - Copyright (C) 1980 * ; * Universidad Autonoma de Puebla * ; * All Rights Reserved * ; * * ; * [Harold V. McIntosh, 28 August 1980] * ; * * ; 28 April 1982 - RER only records first error * ; 12 May 1983 - @@ consults PDL for subroutine name * ; ******************************************************* ; External references to REC RAM memory, situated in FXT. ext read,tyin,tyou ;I-O subroutines ext xpd,ypd,zpd ;program reference points ext px,py,pz ;pointers to pushdown list ext c1 ;pointers to compiling area ext fxt,vrt ;pointers to directories ext er ;error deposit ; ======================================================= ; 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 DE, 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 BC contains the execution pointer ; pair DE contains the object program counter ; pair HL contains the compiling address ; ; ======================================================= ; Equivalences defining INTEL 8080 instructions and some ; constants. ca equ (call) ;call ju equ (jmp) ;jump rn equ (ret) ;return po equ (pop h) ;pop h pu equ (push h);push h lh equ (lhld) ;lhld sh equ (shld) ;shld ix equ (inx h) ;inx h lx equ (lxi h) ;lxi h, xt equ (xthl) ;xthl ze equ 0000H ;zero ff equ 00FFH ;one byte complement of zero ; Compile a left parenthesis. reclp:: lhld zpd ;save the linkage to semicolon exits xthl ;which must be put under return address push h ; lhld ypd ;save the higher linkage to false jumps xthl ;which is also tucked away push h ; lhld xpd ;save the repeat references xthl ;as are all three data push h ; lxi h,ze ;initialze the new chains shld zpd ;null TRUE exit list shld ypd ;null FALSE jump list dad d ; shld xpd ;new parenthesis level begins here ret ; Compile a colon. recco:: lhld xpd ;pick up reference to left parenthesis call recju ;and insert a jump to its location jmp recfy ;fill in any FALSE predicate jumps ; Compile a semicolon. recsc:: lhld zpd ;pick up link to TRUE exit chain call recju ;insert this one on it too shld zpd ;store it as the new head of the chain jmp recfy ;fill in any FALSE predicate jumpe ; Compile an operator. recop:: mvi a,ca ;get the 8080 code for a CALL stax d ;include it in the compiled code inx d ;advance DE to receive next byte ldax b ;BC points to subroutine address inx b ;we got low byte, get ready for high stax d ;low byte into CALL instruction inx d ;advance pointers at first opportunity ldax b ;fetch high byte stax d ;incorporate it in compiled code inx d ;keep DE positioned ret ; Compile a predicate. recpr:: call recop ;call its subroutine, same as operator recyj: lhld ypd ;linkage to FALSE exits call recju ;incorporate a jump if result FALSE shld ypd ;update for new head of chain ret ; Compile a right parenthesis. recrp:: pop h ;recover xpd, which is hidden xthl ;under return to <call recrp> shld xpd ;replace it mov a,h ;xpd = 0 is signal for top level ora l ;test HL for zero jz recfp ;if so, continue with recfp pop h ;recover wpd xthl ;hidden under same return address call recju ;link expr to ypd on its own level push h ;but save pointer until we finish up call recfy ;false predicates in last segment pop h ;back to higher level shld ypd ;replace ypd for higher level lhld zpd ;now we have destination for semicolons call recfc ;so insert all the correct addresses pop h ;recover old zpd xthl ;which is also under return address shld zpd ;replace old zpd ret ; Final right parentheses get a different treatment. recfp: pop h ;fetch return to <call recrp> xchg ;exchange it with compile pointer mvi m,rn ;store a <ret> for false exit inx h ;ready for next byte push h ;save compile pointer lxi d,skp ;address of skip - TRUE exit from REC call recfy ;use it for last segment lhld zpd ;destination of semicolons now known call recfc ;so fill out that chain pop d ;compile pointer that was saved pop h ;old ypd shld ypd ;restore it pop h ;old zpd shld zpd ;restore it 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 ; DE holds the address where the instruction will be ; stored and HL holds the address of its predecessor. ; On exit, DE is incremented by 3 to point to the next ; free byte, and HL has the starting value of DE. recju: xchg ;HL and DE exchanged is better mvi m,ju ;store the jump instruction inx h ;advance pointer push h ;preserve location of new link mov m,e ;store low order byte of old link inx h ;advance pointer mov m,d ;store high order byte of old link inx h ;advance pointer pop d ;recover new link xchg ;restore original roles to DE, HL 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, HL contains the ; address of the first link unless it is zero signifying ; a null chain. recfc: mov a,l ;look at low byte of link address ora h ;superimpose the high byte rz ;if the address was zero, chain ends mov c,m ;save low byte of next link mov m,e ;store low byte of destination inx h ;advance to high byte mov b,m ;save high byte of next link mov m,d ;store high byte of destination mov l,c ;update low byte of link mov h,b ;update high byte of link jmp recfc ;continue ; Call recfc with the intention of filling the y chain. recfy: lhld ypd call recfc shld ypd ret ; Subroutine which will initialize the temporary ; registers used by the REC compiler. inre:: lxi h,ze shld xpd shld ypd shld zpd 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 inx d ;set aside two bytes inx d ;to hold length of ASCII chain push d ;keep beginning for future reference lxi h,enqu ;cleanup subroutine push h ;delay its execution until ret sq: call read ;read the next character cpi '''' ;test for single quote rz ;if so go after entire chain cpi '"' ;test for double quotes cz dq1 ;if so, read it all sq1: stax d ;otherwise keep on storing inx d ;and advancing pointer jmp sq ;go after next character ; Compile double quotes. recdq:: call recop ;record call to qu inx d ;set aside two bytes inx d ;to hold length of chain push d ;put chain origin away for reference lxi h,enqu ;cleanup subroutine push h ;delay its execution until ret dq: call read ;read the next character cpi '"' ;test for double quotes rz ;if so chain finished cpi '''' ;check for single quotes cz sq1 ;if so go after whole chain dq1: stax d ;otherwise keep on storing inx d ;and advancing pointer jmp dq ;go after next character ; Cleanup for both quote compilers. enqu: xchg ;put compile pointer in HL pop d ;put origin of chain into DE call siz ;length returns in BC xchg ;address of chain front back in HL dcx h ;back one byte mov m,b ;store high order byte of length dcx h ;back another byte mov m,c ;store low order byte of length ret ; (') (") Execute single or double quote. qu:: pop h ;get call location off the 8080 stack mov c,m ;low order byte of count inx h ; mov b,m ;high order byte of count inx h ; push h ;save source origin dad b ;calculate source end = return adress xthl ;exchange it for source origin push h ;but we're not ready to use it yet call narg ;check space, put dest. pointer in HL pop d ;put source pointer in DE call miuc ;move from program to pushdown list shld py ;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 read ;get next character cpi ']' ;test for closing ] rz ;if so we're done cpi '[' ;test for beginning of new level cz reccm ;if so go after it recursively jmp reccm ;otherwise keep on reading ; ------------------------------------------------------- ; 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 read ;read the parameter stax d ;store as a 1-byte calling sequence inx d ;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 ; ------------------------------------------------------- ; 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 read ;read in one byte call ms1 ;decide whether it is a digit push psw ;it was not, save it call recop ;compile call to binary minus pop psw ;recover the extra character jmp skp ;skip because we have next character ms1: call rnd ;return if not digit inx sp ;erase call to ms1 inx sp ; call recds ;read and convert digit string lxi b,gnu ;fake that it was nu, not ms push psw ;save terminating character call nhl ;negate HL 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:: rrc ;undo multiplication by 4 rrc ; push b ;save execution address call recds ;read and transform rest of digits pop b ;recover execution address push psw ;recover terminating character dd1: call recop ;compile subroutine call xchg ;DE and HL must be interchanged mov m,e ;put low order byte in calling sequence inx h ; mov m,d ;put high order byte there too inx h ;ready for next byte xchg ;put DE and HL back as they were pop psw ;recover terminating character jmp skp ;skip over character read call ; Negate HL. BC and DE are conserved. nhl: mov a,l ;fetch low byte into accumulator cma ;complement it mov l,a ;replace it in HL mov a,h ;fetch high byte into accumulator cma ;complement it mov h,a ;replace it in HL inx h ;negatice is complement plus 1 ret ; Multiply HL by 10 and add A. DE is conserved. txp: mov b,h ;transfer HL to BC mov c,l ; dad h ;multiply HL by 2 dad h ;another 2 makes 4 dad b ;the original HL makes 5 dad h ;another 2 makes 10 add l ;add in the accumulator mov l,a ;returning sum to low byte rnc ;nothing more if no carry inr h ;otherwise increment high byte ret ; The heart of number compilation. recds: ani 0FH ;mask ASCII down to binary value mov l,a ;put it into register pair HL mvi h,ze ;fill out H with a zero rd1: call read ;read the next character call rnd ;quit if it is not another digit call txp ;multiply HL by ten and add A jmp rd1 ;continuing while digits keep coming ; Execute a number, which means load it on pdl. nu:: lxi b,02H ;two bytes will be required call narg ;close last argument, open new pop d ;get beginning of calling sequence ldax d ;fetch the low order byte mov m,a ;and copy it over inx d ;on to the high order byte inx h ;and the place to store it ldax d ;pick it up mov m,a ;and set it down inx d ;move on to program continuation inx h; ;always leave PDL ready for next byte push d ;put back the return address shld py ;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:: lxi b,2 ;two bytes are required call oarg ;check that they are available lhld py ;fetch the end of the argument string mvi m,ze ;put a zero there to mark its end lhld px ;load pointer to argument string xchg ;put it in register DE lxi h,ze ;zero in HL to start the conversion o1: ldax d ;fetch one character inx d ;get ready for next ora a ;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 ;safeguard converted number in DE lhld px ;get pointer to argument mov m,e ;store low byte inx h ;increment pointer mov m,d ;store high byte inx h ;increment pointer again shld py ;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:: lxi b,05H ;five bytes may be required call oarg ;reuse the old argument call psiz ;get length of argument mov a,c ;suppose length less than 256 xchg ;pointer to low byte into HL lxi d,ze ;put zero in DE for default ora a ;test for zero bytes jz ns1 ;load nothing mov e,m ;load low byte dcr a ;test for one byte jz ns1 ;only byte and it's loaded inx h ;advance to high byte mov d,m ;load high byte dcx h ;back to low byte ns1: push h ;save pointer for ASCII string mvi a,'0' ;prepare to write a zero lxi h,-10000 ;will there be 5 digits? dad d ; jc ns2 ; lxi h,-1000 ;will there be 4 digits? dad d ; jc ns3 ; lxi h,-100 ;will there be 3 digits? dad d ; jc ns4 ; lxi h,-10 ;will there be 2 digits? dad d ; jc ns5 ; jmp ns6 ;write one no matter what ns2: lxi b,-10000 ;ten thousands digit call nsa ; ns3: lxi b,-1000 ;thousands digit call nsa ; ns4: lxi b,-100 ;hundreds digit call nsa ; ns5: lxi b,-10 ;tens digit call nsa ; ns6: add e ;units digit pop h ;recover pointer to PDL mov m,a ;store the digit inx h ;position pointer for next byte shld py ;done, store it as terminator ret nsa: mov l,c ;put power of ten in HL mov h,b ; dad d ;subtract it once jnc nsb ;can't subtract inr a ;increase the count xchg ;put diminished number in DE jmp nsa ;repeat the cycle nsb: pop h ;get <call nsa> return address xthl ;we really wanted pointer to PDL mov m,a ;store new digit inx h ;advance pointer xthl ;put it back on 8080 stack mvi a,'0' ;load a fresh ASCII zero pchl ;return to the <call nsa> ; ======================================================= ; 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. Compiling and execution are ; two separate activities, for the latter the predicates ; @ or x have to be used. The pair emcu, emcv are used ; by REC's main program, and can be used as parts of ; subroutines in other REC modules to go through their ; execution sequence. Compilation is the province of the ; two entry points emce and emcx. ; ======================================================= ; Table look up. On entry, A holds the serial number ; of a table reference, HL the origin of the table. ; On exit, HL holds HL+4*A, DE is preserved, the ; other registers to be ignored. The entry point tlv ; produces the same results with the exception that HL ; becomes HL+2*A. tlu:: add a ;multiply A by 2 tlv:: add a ;multiply A by 2 mov c,a ;insert A as low byte of BC mvi b,ze ;make the high byte zero jnc tlw ;finished if A was small inr b ;carry if A was larger tlw: dad b ;add to base address ret ; 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, BC ; holds the execution address, DE is preserved, and a ; jump is made to the compiling address. rects: lhld fxt ;load base address of table call tlu ;read the table mov c,m ;put the first entry in BC inx h ;low byte first, then high byte mov b,m ; inx h ;keep advancing the pointer push b ;jump address activated by a ret mov b,h ;table pointer is going mov c,l ;to be stored in BC ret ;then off to the compilation ; Advance to following ( or { bypassing [comments] left:: call read cpi '(' rz cpi '{' rz cpi '[' cz reccm jmp left ; 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 svc normalizes characters when it accepts ; them. recre:: call read ;read a character from whereever recrr:: call svc ;check for space, control character jmp recre ;not valid, go back for another call rects ;look up in table and compile it jmp recre ;read another character and repeat jmp recrr ;repeat but next character already read ; A subroutine which will pass over comments, and wait ; for an opening left parenthesis before compiling a REC ; expression. A series of definitions may be enclosed in ; braces, along with a subroutine to be executed. emce:: call ucl ;entry here erases an argument from PDL emcx:: call left ;only ( or { can enclose a REC expression lhld c1 ;next location available in compile area xchg ;take it as compiling origin lhld c1 ;but also save it to restore later xthl ;save it under ret on PDL push h ; call recrr ;compiling prgrm one char already read xchg ;location for code which follows this one shld c1 ;for which c1 is the pointer ret ; <call emcu> executes the subroutine whose address is on the ; top of the 8080's stack, but then removes its definition from ; REC's compiling area - as well as any subsequent definitions. ; The cleanup is done by emcv (true) or emcw (false). emcu:: pop d ;<call emcu>'s return address pop h ;subroutine address push d ;we don't need the return yet push h ;emcv will need the origin, so we lxi d,emcv ;load them both onto the 8080 stack push d ;to be used after the subroutine call pchl ;execute the subroutine emcv:: jmp emcw ;it is a predicate, this is FALSE return pop h ;and this its TRUE return shld c1 ;original origin erases definition jmp skp ;pass on TRUE return to original call emcw: pop h ;same as above but FALSE return shld c1 ; ret ; ; ({) Any REC expression (xxx) may have a series of subroutine ; definitions associated with it, but then the entire sequence ; should be enclosed in braces: {(...) a (...) b ... (xxx)}. ; Each of the secondary subroutines is compiled, as well as the ; primary subroutine, but their initial addresses are not yet ; recorded in the definition table VRT. Rather, some special ; code is generated, in which a call to the primary subroutine ; will be surrounded by a series of pushes and then pops, which ; are chosen so that the symbols representing subroutines have ; the assignments within the braces only while the principal ; subroutine is being executed. Consequently, any subroutine ; definition made at a given brace level is valid throughout ; that whole level, superceding any previous definitions of ; the same subroutines, and of course susceptible to being ; superceded within any of its own subbraces. lbr:: mvi a,ca ;start with: call special stax d ; jmp false inx d ; jmp true mov c,e ;place to put <call> address - keep in BC mov b,d ; inx d ;make room inx d ; call recyj ;link into 'predicate false' chain call recju ;a <jmp> to the 'true' continuation push h ;keep this address until very end lhld xpd ;force the appearance of a main program push h ; lxi h,ze ;initialize definition counter shld xpd ;this is top level for ensuing subroutines lb1: push d ;record entry point to subroutine inx h ;increment count of subroutines push h ;keep it next to top on stack push b ;call address at entry - keep it on top call left ;ignore non-REC-expressions call recrr ;compile one subroutine lb2: call read ;get possible name of subroutine cpi '}' ;no name so it's principal jz lb3 ;we compile the principal for execution call svc ;convert name into serial number jmp lb2 ;punctuation instead of name adi ' ' ;32 variables in VRT - leave space for them lhld vrt ; call tlv ;convert serial to offset pop b ;get this out of the way xthl ;store table address, put subr count in HL jmp lb1 ;on to next definition ; The preface and the code for all the subroutines has now been ; compiled. The top of the 8080 stack has the location of the ; call instruction to the special code which we are now going ; to compile. DE as always is the next address where code will ; be deposited. Still more information is on the 8080 stack - ; the number of subroutines, their names and starting addresses, ; the saved value of XPD, address of the 'true' jump. lb3: pop h ;origin of brace compilation mov m,e ;store next compilation address there inx h ; mov m,d ; pop b ;number of subroutines push b ;we'll need it again later mov l,c ;put it in HL mov h,b ; dcx h ;calculate SP+4(HL-1), dad h ;which is space used by names, addrs dad h ; dad sp ; xchg ; lb4: dcx b ;loop: count off the secondary subroutines mov a,c ; ora b ; jz lb5 ;finished: compile special code mvi m,lh ;for each defined symbol we insert the inx h ;code which will set it up in the jump ldax d ;table, namely mov m,a ; lhld table entry inx h ; xthl inx d ; push h ldax d ; lxi h,jump address mov m,a ; shld table entry inx h ; inx d ; mvi m,xt ; inx h ; mvi m,pu ; inx h ; mvi m,lx ; inx h ; ldax d ; mov m,a ; inx h ; inx d ; ldax d ; mov m,a ; inx h ; dcx d ; dcx d ; dcx d ; mvi m,sh ; inx h ; ldax d ; mov m,a ; inx h ; inx d ; ldax d ; mov m,a ; inx h ; dcx d ; dcx d ; dcx d ; dcx d ; dcx d ; jmp lb4 ; ; We have compiled all the subroutines, including the ; principal one. Now we compile a call to it, followed ; by an adjustment to the pushdown stack which will ; remember whether it was TRUE or FALSE as a predicate. lb5: pop b ;number of subroutines pop d ;origin of principal subroutine push b ;we don't want this right now mvi m,ca ;after the definitions are set up we inx h ;will call the executable subexpression mov m,e ;and then adjust it for a delayed skip inx h ;so as not to have to put the code which mov m,d ;follows twice in two flow branches inx h ; call principal mvi m,ju ; jmp $+6 inx h ; xthl push h ; inx h inx h ; inx h inx h ; inx h mvi m,xt ; xthl inx h ; mvi m,ix ; inx h ; mvi m,ix ; inx h ; mvi m,ix ; inx h ; mvi m,xt ; inx h ; xchg ; pop h ; mov m,e ; inx h ; mov m,d ; xchg ; pop b ; ; Restore original meaning of all subroutine names. lb6: dcx b ;loop to compile pops mov a,c ;count out number of definitions ora b ; jz lb7 ;go compile termination mvi m,po ;after an expression in braces finishes inx h ;execution, all its definitions are mvi m,xt ;erased and the earlier ones replaced inx h ; pop h mvi m,sh ; xthl inx h ; shld table entry pop d ; mov m,e ; inx h ; mov m,d ; inx h ; pop d ; jmp lb6 ; ; Terminal code must be compiled, and XPD restored to its ; original level. There are two cases - when we are dealing ; with a main program, and when a brace lies within a larger ; REC expression. lb7: mvi m,rn ;'false' exit is always <ret> inx h ;PC ready for next byte xchg ;PC back in DE pop h ;saved XPD shld xpd ;restored mov a,l ;test it for zero ora h ; pop h ;address of 'true' jump jz lb8 ;zero means main program mov m,e ;jump up to here to continue inx h ; mov m,d ; ret ; Terminal code for a main program or defined subroutine. ; Here there is a stack pointer adjustment which suppresses ; the return from <call rects> following recrr. The reason is ; that lbr has already detected }, the closing right brace, ; which therefore will not appear in the input stream to be ; interpreted through FXT, as recrr would expect. lb8: lxi b,skp ;'true' exit realized by <jmp skp> mov m,c ; inx h ; mov m,b ; dcx h ;'false' exit realized by <jmp here>, dcx h ; dcx h ; mov m,d ; dcx h ; mov m,e ; xchg ; mvi m,rn ;a terminal <ret>, inx h ;and an updated PC. xchg ; inx sp ;we won't go back to recrr inx 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 h ;entry if name is a parameter mov a,m ;read the calling sequence inx h ;advance pointer for return push h ;put it back on 8080 stack cpi '@' ;@@ means consult PDL for subroutine jnz xar ;otherwise proceed nar:: lhld px ;entry if subroutine index is argument mov a,m ;get low byte of argument push psw ;put it in temporary storage call ucl ;lift the pushdown list, erasing it pop psw ;recover index xar:: lhld vrt ;entry when index is in register A call tlv ;locate entry in directory (vrt) mov e,m ;low byte of entry into E inx h ;on to high byte mov d,m ;place it in D xchg ;first exchange entry into HL pchl ;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. svc:: cpi '!' ;reject space, excl is lower limit rc ;control or space - no skip cpi 7FH ;seven bits is upper limit rnc ;no skip if upper limit passed sui ' ' ;normalize to begin with (excl) = 1 jmp skp ;generate skip for printable ASCII ; Return if not decimal. A unchanged if not decimal, else ; reduced to binary. rnd:: cpi ':' ;colon follows 9 in ASCII alphabet jnc rtn ;not decimal at or beyond this limit cpi '0' ;ASCII zero is lower limit jc rtn ;not decimal below this limit sui '0' ;normalize to get binary values ret ; Return if equal. Return out of calling routine if HL ; is equal to DE, otherwise normal return to sequential ; execution in calling program. req:: mov a,e ;compare low bytes cmp l ; rnz ;not zero means equality impossible mov a,d ;compare high bytes cmp h ; rnz ;not zero means not equal rtn:: inx sp ;entry for general "returns" inx sp ;eliminate return address ret ;return is to next higher level ; Second level return on error. rr2:: pop h ;entry to clear two items from PDL xthl ; rr1:: pop h ;entry to clear one item from PDL xthl ; rer:: push h ; lxi h,er ; mov a,m ; inx h ; ora m ; pop h ; xthl ;get return address into HL jnz rrr ; shld er ;so that it can be recorded rrr: pop h ;but preserve the original HL 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. (?!TL;;) will give ; minimal evidence of an error. Generally an error handling ; subroutine will have the form (?(<correction>;<more drastic ; correction>;...<fatal error message>_;);). If the error ; cannot be ignored or handled within a simple subroutine, ; then the treatment of errors should have been incorporated ; into the whole structure of the program from the beginning. qm:: lhld er ;fetch the error cell xchg ;set it aside in DE lxi h,ze ;load zero into HL shld er ;use it to reset er mov a,e ;prepare to test whether er was ora d ;zero by superposing D and E rz ;FALSE return if no error push d ;keep DE on the 8080 stack lxi b,02H ;we want two bytes for error address call narg ;check space, prepare for new argument pop d ;we are ready to store error address mov m,e ;store low byte inx h ;advance for high byte mov m,d ;store it also inx h ;pointer must always advance shld py ;end of the argument jmp skp ;TRUE return - there was an error ; 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:: xthl ;get the return address, but save HL inx h ;assume the skip will be over a inx h ;three-byte instruction, such as a jump inx h ; xthl ;restore HL, which must be preserved ret ;return to the altered address ; Calculate the length of a proposed insertion on PDL. ; On return, BC holds HL - DE, which means py - px. ; However, the alternative entry <siz> can be used when ; HL and DE have been previously loaded. psiz:: lhld px ;get the beginning of the segment xchg ;pass it to DE lhld py ;get the end of the segment siz:: mov a,l ;-- alternate entry for other sizes -- sub e ;subtract the beginning mov c,a ;from the end mov a,h ;to get the length sbb d ;of the interval mov b,a ;which is placed in BC ret ; Skip on not greater. On entry, HL holds an address, ; DE a limit. A skip is generated if the address is ; less than or equal to the limit. BC is not altered. ; An alternate entry sing (skip if increment not greater) ; expects to find an increment in BC, which is added ; to HL and remains with it. sing:: dad b ;add the increment sng:: mov a,e ;put limit low byte in the accumulator sub l ;compare with low byte of address mov a,d ;put limit high byte in accumulator sbb h ;compare with high byte of address rc ;return if it is greater jmp skp ;generate skip if less or equal ; Skip on equal. On entry, DE and HL contain two-byte ; numbers. Comparison is made, which at most alters A; ; if they are equal a skip is generated. The alternate ; entry <sieq> (skip if increment equal) permits testing ; whether an increment to HL located in BC will reach ; equality with DE, but then HL remains incremented. sieq:: dad b ;add the increment seq:: mov a,e ;two byte comparison cmp l ;of the registers DE rnz ;and HL generating mov a,d ;a return when they cmp h ;are not equal and rnz ;a three-byte skip when jmp skp ;they are equal ; Move by increment until count. On entry, BC contains ; the number of bytes to be moved, DE the address of ; the source, and HL the destination. On exit, BC is ; zero, DE lies beyond the source, and HL shows ; the next byte following the end of the destination. miuc:: mov a,c ;determine whether zero bytes ora b ;remain to be moved rz ;if so return ldax d ;fetch source byte mov m,a ;deposit in destination dcx b ;decrement counter inx d ;increment source pointer inx h ;increment destination pointer jmp miuc ;repeat the cycle ; Move by decrement until count. On entry, BC holds the ; number of bytes to be moved, DE the byte beyond the ; source, and HL the byte beyond the destination. On ; exit, BC is zero, DE lies at the beginning of the ; source, and HL lies at the front of the destination. mduc:: mov a,c ;determine whether zero bytes ora b ;remain to be moved rz ;if so, return dcx b ;decrement count dcx d ;retract source pointer dcx h ;retract destination pointer ldax d ;fetch source byte mov m,a ;store at destination jmp mduc ;repeat the cycle ; Test PDL space beginning at top argument. On entry BC ; contains the total space required. On exit, BC stays ; unchanged, DE holds pz, while HL holds px+BC. ; 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:: lhld pz ;load limit of PDL dcx h ;keep one byte margin xchg ;place it in DE lhld px ;load beginning of current argument call sing ;check available space jmp rer ;no, note error, quit calling program ret ;yes, continue normally ; Check space for, and then set up, a new argument. On ; entry, BC 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 ; HL. DE 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:: lhld pz ;load limit of PDL dcx h ;keep one byte margin xchg ;place it in DE lhld py ;load end of current argument inx h ;include a margin of 2 inx h ;for the link closing current arg call sing ;check available space jmp rer ;no, note error, quit calling program rarg:: lhld px ;entry if no space check needed xchg ;put beginning of arg in DE lhld py ;end of argument into HL mov m,e ;low byte of closing link inx h ;on to high byte mov m,d ;argument ends with pointer to front inx h ;beginning of new space shld px ;which is recorded by px ret ;and remains in HL ; (L) Remove argument from pushdown list. There are no ; requirements for entry to ucl. On exit, BC remains ; unchanged, DE holds the end of the former argument ; and HL 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. ucl:: lhld px ;pointer to current argument dcx h ;just behind the present mov d,m ;argument is the address dcx h ;of the previous argument mov e,m ;load it into DE mov a,e ;zero signals non-existent argument ora d ;so we always test out of caution cz rer ;record error if pointer was zero shld py ;HL now holds end of previous arg. xchg ;exchange pointers shld px ;pointer to beginning of prev. arg. ret ; Null program for undefined operators. noop:: ret ; ======================================================= ; ; Some of the service routines, which might be external ; references in other modules, are: ; ; psiz size of argument on PDL ; siz size of an interval ; oarg space when reusing an argument ; narg close old argument, space for new ; rarg same as narg when space is assured ; sng skip when not greater ; sing skip when increment not greater ; seq skip when equal ; sieq skip when increment equal ; skp generic skip ; req return on equal ; rer return on error ; rr2 rer after popping two addresses ; rtn generic return ; miuc move by increment until count ; mduc move by decrement until count ; 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