Programmer 7500

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

/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / MISC / REC.ZIP / PDL86.ASM < prev next >

Wrap

Assembly Source File | 1986-02-04 | 27.4 KB | 1,027 lines

; ======================================================= ; ; REC module for the operators and predicates pertaining ; to the pushdown list, other than the most important ; ones already contained in the REC nucleus. These ; comprise: ; ; arithmetic ; ; + sum modulo 2**16 ; - difference modulo 2**16 ; * product modulo 2**16 ; / remainder, quotient ; = equality ; ~ complement or negative ; d decrement, false on zero ; ^ increment ; N comparison of top 2 args ; ; modification of arguments ; ; H hex ASCII string to binary ; [exclm] binary to hex ASCII string ; % restrict argument to one byte ; \ embed argument in two bytes ; & exchange top arguments ; | concatinate top arguments ; ; block movements ; ; G fetch a block from memory ; g address fetch ; r replace address by contents ; u incrementing byte fetch ; y incrementing word fetch ; P put buffer block in memory ; S store block in memory ; s store into buffer ; v incrementing byte store ; m move arg to end of PDL space ; n recover arg from end of PDL ; h store/restore machine state ; ; generate pointers ; ; c reserve block, generate pointer ; p put px, py-px on PDL ; l put pz on PDL ; $ form addr of variable cell ; ; ------------------------------------------------------- ; Version of REC released during the summer school, 1984 ; ------------------------------------------------------- ; 8086 version with separate segments for code, PDL, WS. ; ------------------------------------------------------- ; ; PDL86 - Copyright (C) 1982, 1984 ; Universidad Autonoma de Puebla ; All Rights Reserved ; ; [Harold V. McIntosh, 25 April 1982] ; [Gerardo Cisneros, 8 February 1984] ; ; May 29, 1983 - & exchanges arbitrary arguments ; May 29, 1983 - ~ discontinued; use m&n instead ; May 29, 1983 - ~ Complement or Negate top element ; May 29, 1983 - N for Numerical comparison on PDL ; July 7, 1983 - $ with char arg gets subroutine addr ; January 23, 1984 - at comp:, <cmp ax,> is <cmp cx,> ; February 8, 1984 - separate segments (GCS) ; May 9, 1984 - h stores/restores machine state (GCS) ; May 24,1984 - H and exclm handle strings of arb. length (GCS) ; May 31 1984 - PDL becomes 1st module of package -GCS ; 18 June 1984 - n quits on emtpy PDL complement - GCS ; 3 July 1984 - entry points for pG, $S, $r - GCS ; 15 Aug 1984 - E.P.s for ^^ and &S - GCS ; 29 June 1984 - $ changed for word-sized entries - GCS ; 8 Aug 1985 - Qm included - GCS ; ======================================================= ; ======================================================= ; A collection of subroutines for two-byte arithmetic, ; including loading and storage of the 8080 registers ; from the pushdown list. ; ======================================================= ; ------------------------------------------------------- ; Load and store subroutines for 2-byte arithmetic. ; ------------------------------------------------------- ; Push a one-byte value onto the PDL. The value to be ; pushed should be placed on the 8080's stack in the ; low byte position (say by using <push psw>) before ; calling PUON. PUON: mov cx,1 ;one byte is required call NARG ;close old variable, reserve space pop bp ;source was pushed before calling pop ax mov [bx],al ;store byte, which is low order inc bx ;pointer to next byte mov PY,bx ;close new argument jmp bp ; Push a two-byte value onto the PDL. The value to be ; pushed should be placed on the 8080's stack before ; calling PUTW. PUTW: mov cx,2 ;two bytes are required call NARG ;close old variable, reserve space mov bp,sp mov ax,2[bp] mov [bx],ax ;store low order byte inc bx ;on to high order destination inc bx ;always leave pointer in good condition mov PY,bx ;close top argument ret 2 ; (&) Exchange top two arguments EXCH: mov ax,PY mov bx,PX ;org1 sub ax,bx ;siz1 mov dx,-2[bx] ;org2 test dx,dx jz XTER ;PDL empty lea cx,-2[bx] sub cx,dx ;siz2 jnz xta mov bp,-4[bx] ;check if only 1 arg test bp,bp jnz xta XTER: call RER xta: cmp ax,cx jnz XTNE jcxz XTRE XTEQ: mov al,[bx] xchg bx,dx mov ah,[bx] mov [bx],al xchg bx,dx mov [bx],ah inc bx inc dx loop XTEQ XTRE: ret XTNE: push cx push dx push bx push ax push dx call NARG mov ax,ds mov es,ax cld mov di,bx pop si repnz movsb pop cx pop si pop di push di repnz movsb pop word ptr [di] lea di,2[di] mov si,PX mov PX,di pop cx repnz movsb mov PY,di ret ; Load top three arguments into (cx),(dx),(bx). In ; reality so many permutations exist for places to put ; the arguments as they are taken off the REC stack that ; they are simply transferred to the 8080 stack, to be ; popped into the desired registers on return from the ; corresponding call. It is assumed that all quantities ; involved in these transactions are of two bytes. A ; sequence of entry points is provided so as to pop off ; one, two, or three arguments. THRG: mov bx,PX ;get pointer to top argument THRL: pop bp ;enter here if (bx) already loaded push word ptr [bx] push bp call UCL ;pop top argument, load (bx) from px TWOL: pop bp ;continue, or entry for two args push word ptr [bx] push bp call UCL ;pop argument, put px in (bx) ONEL: pop bp ;continue, or entry for one argument push word ptr [bx] push bp jmp UCL ;pop the last argument, quit ; Load up pointers to top two arguments. ARGG: mov di,PX ;org1 mov cx,-2[di] jcxz arge ;no second argument mov ax,PY sub ax,di ;siz1 mov bx,cx ;org2 lea dx,-2[di] mov cx,dx sub cx,bx ;siz2 cmp cx,ax jnz arge ;arguments not same length ret ARGE: call rer ARGS: call ARGG mov PX,bx mov PY,dx ret ; ------------------------------------------------------- ; Two-byte arithmetic according to the four operations. ; ------------------------------------------------------- ; (+) Add top registers on pdl: <a,b,+> leaves (a+b). ; The sum is calculated modulo 2**16, no evidence of any ; overflow remains behind. SUM: call args cmp ax,01 jz SUM1 cmp ax,02 jz SUM2 call rer SUM1: mov al,[di] or [bx],al ret SUM2: mov ax,[di] add word ptr [bx],ax ret ; (-) Subtract top from next: <a,b,-> leaves (a-b). ; Reverse subtraction can be accomplished by exchanging ; arguments: write <a,b,&,-> to get (b-a). Subtraction ; is carried out modulo 2**16; thus -1 = FFFF hex. DIF: call args cmp ax,01 jz DIF1 cmp ax,02 jz DIF2 call rer DIF1: mov al,[di] xor [bx],al ret DIF2: mov ax,[di] sub word ptr [bx],ax ret ; (*) Multiply top: <a,b,*> leaves (a*b). The product ; is for integer arithmetic, modulo 2**16, and so is not ; directly suitable for a 32-bit product. MPY: call args cmp ax,01 jz MPY1 cmp ax,02 jz MPY2 call rer MPY1: mov al,[di] and [bx],al ret MPY2: mov ax,[di] mul word ptr [bx] mov [bx],ax ret ; (/) Divide top: <a,b,/> leaves rem(a/b), int(a/b). ; Reverse division is possible by exchanging arguments; ; thus <b,a,&,/> leaves rem(b/a), int(b/a). If just ; the remainder is required, write <a,b,/,L>, while if ; only the quotient is desired, write <a,b,/,&,L>, and ; finally, if the order of the remainder and quotient is ; not satisfactory, they can be exchanged. The division ; is unsigned integer division. It can also be used to ; split a two-byte word into two parts through division ; by the corresponding power of two. DVD: call ARGG cmp word ptr [di],0000 jz DER mov ax,[bx] mov dx,0000 div word ptr [di] mov [di],ax mov [bx],dx ret DER: call RER ; (~) Complement or Negate the top of the pushdown list. comp: mov bx,PX mov cx,PY sub cx,bx cmp cx,01 jz com1 cmp cx,02 jz com2 call rer com1: not byte ptr [bx] ret com2: neg word ptr [bx] ret ; (^) Increment the top of the pushdown list. INTW: call INCR ;Entry point for ^^ INCR: mov bx,PX ;pointer to argument inc word ptr [bx] ret ; (d) Decrement top of PDL if it is not zero; otherwise ; FALSE, erasing the counter. Equivalent to ((0=;1-)). DECR: mov bx,PX ;fetch pointer to argument sub word ptr [bx],1 ;dec won't work because of c flag jb DCF jmp SKP ;no carry means TRUE DCF: jmp UCL ;when FALSE, erase counter ; (N) Numerical comparison of top two elements on PDL. <a,b,N> ; is TRUE if a .LE. b; both arguments are erased irrespective ; of the result. Numerical comparison is for integers; for one- ; byte arguments the comparison is logical. UCN: call args cmp ax,01 jz UN1 cmp ax,02 jz UN2 call rer UN1: mov al,[di] test al,[bx] jz UNF jmp UNT UN2: mov ax,[di] cmp ax,[bx] jc UNF UNT: jmp CUCL UNF: jmp UCL ; ------------------------------------------------------- ; Conversion between binary and hexadecimal ASCII strings ; ------------------------------------------------------- ; Return if not hexadecimal. A unchanged if not hex, else ; reduced to binary. RNH: cmp al,'G' ;no hex characters beyond F jnb RH2 cmp al,'A' ;hex letters equal A or beyond jb RH1 sub al,'7' ;compensate the gap between 9 and A ret RH1: jmp RND RH2: inc sp inc sp ret ; (H) Convert a hex ASCII string on the PDL into binary. ; If the length of the string is n, the result will have ; int((n+1)/2) bytes, stored in Intel form: the least ; significant byte in the lowest addressed location. HE: mov cx,PY ;compute length of string mov si,PX ;while saving pointers sub cx,si jz H4 ;leave null strings alone mov bp,cx ;save byte count cld H0: lodsb ;ck without all characters call RNH ;are hex digits, return false if not loop H0 mov cx,bp inc cx ;compute length of final number shr cx,1 mov si,PX ;reload PX to process the hex string mov bp,si ;copy of PX to be used later mov bx,si ;another copy as pointer for result mov di,cx ;copy of byte count to be used later mov dl,0 jnc H2 ;start in the middle if length odd H1: lodsb call RNH ;reduce to binary shl al,1 ;multiply by 16 shl al,1 shl al,1 shl al,1 mov dl,al ;save it while getting next nibble H2: lodsb call RNH or al,dl ;put nibbles together mov [bx],al ;and store on PDL inc bx ;keep pointing to the next byte loop H1 mov PY,bx ;update PY call HXC ;turn the string around H4: jmp SKP ;return TRUE ; Turn around string of (DI) bytes starting at (BP) and ; ending at (BX)-1 HXC: dec bx ;highest byte mov cx,di ;total byte count shr cx,1 ;half of number of bytes jcxz H5 H3: mov al,[bx] xchg ds:[bp],al mov [bx],al dec bx inc bp loop H3 H5: ret ; ([exclm]) Convert an n-byte binary number into an ASCII ; string of length 2n. The high order byte is assumed to be ; in the highest-addressed location. HX: mov cx,PY ;compute lenght of number mov si,cx mov bp,PX ;while saving pointers in other sub cx,bp ;registers jnz HX0 ret ;leave null strings alone HX0: mov di,cx shl cx,1 ;twice as many bytes will be made call OARG ;verify availability of space mov PY,bx ;update PY right away mov cx,di ;restore old count std ;conversion proceeds backwards dec si ;last byte is one below original PY HX1: lodsb ;get the byte mov ah,al ;make a copy call HSA ;produce digit from high nibble mov al,ah ;back to AL call HSB ;produce digit from low nibble loop HX1 shl di,1 ;prepare to turn string around mov bx,PY jmp short HXC HSA: ror al,1 ;shift byte right four bits ror al,1 ; ror al,1 ; ror al,1 ; HSB: and al,0FH ;mask in right nibble add al,90H ;prepare for some carries from <daa> daa ;create gap if nibble beyond 10 adc al,40H ;code for @ if we have a letter daa ;decide 3 for digit, 4 for letter dec bx ;get pointer ready for deposit mov [bx],al ;record the ASCII digit ret ; ------------------------------------------------------- ; Fetch and store bytes, addresses, and blocks to and fro ; between the PDL and the memory. The following chart ; shows the relation between all the different operators ; which are available. ; ; byte word block ; ---- ---- ----- ; ; replace - r G ; fetch, nonincrement g - - ; fetch, increment u y - ; ; store - - S ; store, increment - - v ; store w.r.t. limit - - s ; store into buffer - - P ; ; variable head cell - $ - ; ; The main operators for saving and fetching variables ; are G and S. The remainder were especially chosen ; on the one hand to scrutinize the memory under REC ; control, and on the other to give the widest possible ; latitude in defining variables in applications of REC. ; ; The following chart shows how to employ variables: ; ; 'data' [var#] $ S define 2-byte variable ; [var#] $ r fetch 2-byte variable ; 'data' ml [var#] $ S save fixed variable ; [var#] $ ryG fetch fixed variable ; 'data' [var#] $rs redefine existing fixed var ; kc Lml [var#] $ S create k-byte buffered variable ; kc [var#] $ S alternative k-byte buffered var ; 'data' [var#] $r P redefine buffered variable ; [var#] $ ryLyG fetch buffered variable ; ; Memory can be examined bytewise with the following ; combinations: ; ; org g fetch a byte, keep origin ; org u autoincrementing byte fetch ; org v autoincrementing byte store ; org (g ... v:;) read, modify, store, ready next ; o1 o2 (u~...v&:;) move from o1 to o2 ; ; ------------------------------------------------------- ; (g) (u) Fetch a byte from memory and leave on PDL. The ; sequence <org, g> leaves <org, (org)[1 byte]> on PDL. ; The sequence <org, u> leaves <org+1, (org)[1 byte]> on ; PDL. GB: mov bx,PX ;/g/ pointer to top argument push word ptr [bx] ;fetch low byte of origin jmp GBJ ;if the origin is not to be incremented GBI: mov bx,PX ;/u/ pointer to arg, which is org push word ptr [bx] ;fetch low byte of origin inc word ptr [bx] GBJ: call ESLD ;get segment address mov cx,1 ;require space for one byte call NARG ;close old arg, check space, open new pop dx ;here's the origin we saved xchg bx,dx mov al,es:[bx] xchg bx,dx ;fetch the byte there mov [bx],al ;store on the PDL inc bx ;pointer always ready for next byte mov PY,bx ;right deliniter of argument ret ; (y) Fetch two bytes from memory and leave on PDL. ; The sequence <org, y> leaves <org+2, (org)[2 bytes]> ; on PDL. GW: mov bx,PX ;/ / pointer to the argument push word ptr [bx] ;low byte of origin jmp GWJ ;common continuation of gw, gwi GWI: mov bx,PX ;/y/ pointer to the argument push word ptr [bx] ;place low byte in A add word ptr [bx],2 ;origin to be incremented by 2 GWJ: call ESLD ;get segment address mov cx,2 ;require space for two bytes call NARG ;close old arg, check space, open new pop dx ;now we're ready for that origin xchg bx,dx mov ax,es:[bx] xchg bx,dx ;fetch the byte sitting there mov [bx],ax ;and store it on PDL inc bx inc bx ;keep the pointer moving along mov PY,bx ;value's finished, store its end ret ; (G) Fetch a block from memory, leave on PDL. ; <org,siz, G> leaves (org, ...) on PDL. GA: call CXLD ;load siz into (cx) call OARG ;reuse the argument, but with siz bytes call ESLD ;get segment base mov si,[bx] ;pick up source address too cld mov di,bx mov bp,ds mov ax,es mov ds,ax mov es,bp repnz movsb mov ds,bp ;restore data segment mov PY,di ;(bx) holds the destination terminator ret ; (pG) Make a copy of the last argument, a combination ; which is compiled as a single operator DUPP: mov cx,PY ;compute size of current top sub cx,PX call NARG ;check availability of space mov ax,ds mov es,ax ;prepare for move cld mov si,dx ;old PX is in DX mov di,bx ;new PX is in BX repnz movsb ;count still in CX mov PY,di ;note new argument end ret ; (S) Store a block forward from the designated memory ; location. <'data' org S> stores 'data' starting at ; org; leaves no residue on the PDL. XSTO: call EXCH ;entry point for &S jmp short SA VSTO: call VBLE ;entry pt for combination $S SA: call CXLD ;fetch destination origin mov di,cx ;save it for a while mov si,PX mov cx,PY sub cx,si cld repnz movsb jmp UCL ;pop the second argument too ; (v) Store a block, leaving incremented address. ; <org,'data' v> leaves org+size['data'] on PDL, stores ; 'data' starting from org. SAI: mov si,PX mov cx,PY sub cx,si ;determine length of data call UCL ;pop top argument, exposing second call ESLD ;get segment address mov di,[bx] ;(bx) has px, which is destn address mov ax,si add ax,cx cmp di,ax jb LVB cld repnz movsb mov [bx],di ret LVB: std add si,cx add di,cx mov [bx],di dec si dec di repnz movsb ret ; (s) Store into an area of limited size. The sequence ; <'data' org s> will store 'data' beginning at org+2, ; supposing that siz('data') is less than or equal to ; (org, org+1). In either event no residue is left, but ; an error notation is generated if the data doesn't fit. ; No data at all is stored if all will not fit. If it ; matters to know how much of the space was used, the ; operator P should probably be used instead. LCS: call CXLD ;fetch destination origin mov bx,cx ;save it while calling psiz mov si,PX mov cx,PY sub cx,si ;determine length of data mov ax,es:[bx] ;low byte of capacity cmp ax,cx jnb LST call UCL call RER ;note error, return if it won't fit LST: cld inc bx inc bx mov di,bx repnz movsb jmp UCL ;pop second argument ; (P) Store into a buffer and note length. Used to ; store data of variable length into an area whose ; maximum length is fixed. The buffer has the form ; ; /available/used/data/data/.../data/.../end/ ; ; The sequence <'data' org P> will store the data ; in the buffer beginning at org. (org, org+1) holds ; the maximum length of data that may be stored in the ; buffer, (org+2, org+3) is siz('data'), and 'data' is ; stored from org+4 onward if it will fit. If it will ; not, P is a noop and error is set. UCP: call CXLD ;pointer to destination mov bx,cx ;save destination while calling psiz mov si,PX mov cx,PY sub cx,si ;load (cx) with length of data inc cx ;data has to appear two bytes larger inc cx ;to include cell showing its size mov ax,es:[bx] ;low byte of destination capacity inc bx ; inc bx ; cmp ax,cx jnb UP1 call RER ;capacity exceeded: mark error, return UP1: dec cx ;we want to store the true size dec cx ;subtract out the two byte margin mov es:[bx],cx ;low byte into usage cell inc bx ;just keep moving along inc bx ;ready to start moving data cld mov di,bx mov ax,ds mov es,ax repnz movsb jmp UCL ;lift second argument, leave nothing ; (r) Replace address on top of pdl by its contents. VREP: call VBLE ;entry pt for combination $r IND: call ESLD ;get segment address mov dx,[bx] ;load word xchg bx,dx ;(bx) now has top argument mov ax,es:[bx] ;indirect address xchg bx,dx ;address of top argument again mov [bx],ax ;store low indirect byte add bx,2 ;set PY in case old arg had 4 bytes mov PY,bx ret ; ($) Generate the address of the nth cell in the array ; of variables, which is a block of four-byte addresses. ; These cells may be used to store data directly - for ; example counters or addresses - or indirectly through ; pointers to the actual location of the data. By giving ; a one-byte character argument, <'x'$>, the location where ; the address of subroutine x is stored may be obtained. VBLE: mov bx,PX ;pointer to argument mov cx,PY sub cx,bx cmp cx,2 jz VBLF mov cx,2 call OARG ;reuse old arg with size 2 mov bx,PX mov al,[bx] mov ah,0 jmp VBLG VBLF: mov ax,[bx] VBLG: add ax,ax ; add ax,ax ;word-size entries add ax,VRT mov [bx],ax add bx,2 mov PY,bx ret ; (l) Load pz onto PDL. LCL: push PZ ;putw requires arg on 8080 stack call PUTW ;record two-byte argument ret ;can't use simply <jmp putw> ; (m) Set aside top argument on PDL. It is moved to the ; other end of the array reserved for the PDL, which can ; be used as a temporary storage stack without name. The ; mechanism by which pz is moved and the block size is ; recorded makes this an attractive mechanism to create ; storage space for REC variables. LCM: mov si,PY mov cx,si sub cx,PX ;get length of top argument mov ax,ds ;source in data seg lcm1: push cx call UCL ;pop top argument mov di,PZ ;load destination origin std dec si dec di mov bp,ds ;save ds mov ds,ax ;set source mov es,bp ;set destination repnz movsb mov ds,bp ;reset ds lea bx,-1[di] mov PZ,bx pop word ptr [bx] ;recover length ret ; (Qm) Copy WS to PDL complement. A combination ; essential to Convert's variable binding mechanism. QUEM: mov si,P2 ;source is top of segment mov cx,si ;compute the string's length sub cx,P1 call NARG ;check PDL space mov ax,WSEG ;source segment in ax jmp short lcm1 ;use code at m ; (n) Recover segment which was set aside. LCN: mov cx,0 ;there won't be any net length change call NARG ;close old argument, ready for new mov di,bx ;place destination origin in (dx) mov PY,di ;leave null string in case of error mov bx,PZ ;place source origin in (bx) mov cx,[bx] ;place length in cx cmp cx,0FFFFH ;check for top of PDL flag jnz lcn1 call RER ;quit if PDL complement empty lcn1: lea si,2[bx] cld mov ax,ds mov es,ax repnz movsb mov PY,di ;end of destination is end of argument mov PZ,si ;update pz ret ; (nL) Lift from PDL complement ENLF: mov bx,PZ ;place source origin in (bx) mov cx,[bx] ;place length in cx cmp cx,0FFFFH ;check for top of PDL flag jnz enlf1 call RER ;quit if PDL complement empty enlf1: add bx,cx ;compute start of next compl. arg. inc bx inc bx mov PZ,bx ;store new upper limit of PDL ret ; (|) Concatinate the top arguments on the PDL. CONC: mov si,PX mov cx,PY sub cx,si ;get length of top argument call UCL ;pop top argument, set up pntrs to next mov di,dx ;new py is destination cld mov ax,ds mov es,ax repnz movsb mov PY,di ;record new terminal address ret ; (%) Restrict multiple-byte argument to one byte. PE: mov ax,PX cmp ax,PY jz PE1 ;leave a null argument in peace inc ax ;add one to it mov PY,ax ;store as limit to the argument PE1: ret ; (\) Embed a single byte in a pair. IP: mov cx,2 ;we want to have two bytes call OARG ;verify that that much space remains mov bx,PX ;pointer to argument inc bx ;pass over first byte mov byte ptr [bx],0 ;make high byte zero inc bx ;pass on to next byte mov PY,bx ;record end of argument ret ; (p) Put px and siz on the pushdown list. GXS: mov dx,PX mov bx,PY mov cx,bx sub cx,dx ;calculate length of top argument push cx ;put length on 8080 stack push dx ;put origin on 8080 stack call PUTW ;put top of 8080 stack on REC PDL call PUTW ;put the next item there too ret ;can't combine <call, ret> into <jmp> ; (c) Reserve a block on the pushdown list. <n,c> creates ; a block of length n, and puts n-2 at the front of the ; block as a size indicator. Then, if n .ge. 2, it will ; be there as a length indicator for a buffer. <=====maybe change this? BLOK: mov bx,PX ;pointer to argument mov cx,[bx] ;fetch the argument mov [bx],cx ;store header sub word ptr [bx],2 call OARG ;is there enough space to reuse arg? mov PY,bx ;increment in (bx), it goes into py push PX ;px has origin of block just formed call PUTW ;record block origin as new argument ret ;can't replace <call putw, ret> by jmp ; (h) Save the state of the machine and leave the SP value on ; the PDL, if arg is null; otherwise restore the state of the ; machine from values at the stack pointed to by the address ; on the PDL. MST: pop rtaddr ;put return address aside pushf ;Flags to the stack push ax ;Accumulator to stack push bx ;BX to stack push cx ;CX to stack push dx ;DX to stack push bp ;Base pointer to stack push si ;Source index to stack push di ;Destination index to stack push ds ;Data segment to stack push es ;Extra segment to stack mov ax,PY ;compute argument length sub ax,PX ;and lift top call UCL ;before pushing pointers ; push PX ;PDL pointers ; push PY ; push PZ ; push P0 ;WS pointers ; push P1 ; push P2 ; push P3 ; push P4 ; push WSEG test ax,ax jnz mrst ;restore if arg nonnull mov cx,4 ;need 4 bytes for SS and SP call NARG ;A ROYAL MESS WILL ENSUE IF NARG FAILS mov [bx],ss ;record stack segment value mov 2[bx],sp ;record stack pointer value add bx,cx ;compute new PY mov PY,bx ;and update it jmp short mrst2 mrst: xchg bx,dx ;get previous PY back in BX cmp al,2 ;see if top arg has size 2 jnz mrst1 call UCL ;yes, clean up stack xchg dx,bx ;get PY back into BX mov ss,2[bx] ;restoring pointers should be below mov sp,4[bx] ;the 2-byte argument add sp,20 ;get rid of stored stuff (10 regs) ; add sp,38 ;get rid of stored stuff (10 regs + 9 ptrs) jmp short mrst2 mrst1: mov ss,2[bx] ;fetch SS from the PDL mov sp,4[bx] ;SP too, now it points to previous store ; pop WSEG ;so we can pop everything ; pop P4 ;we pushed in reverse ; pop P3 ; pop P2 ; pop P1 ; pop P0 ; pop PZ ; pop PY ; pop PX pop es pop ds pop di pop si pop bp pop dx pop cx pop bx pop ax popf mrst2: push rtaddr ;restore return address ret ;and exit ; Load a single variable into (cx) from the pushdown ; list. No register is sure to be preserved. CXLD: mov bx,PX ;pointer to argument mov cx,[bx] ;fetch low order byte call ESLD ;get segment address jmp UCL ;erase argument [(cx) is unchanged] ; Load register pair (dx) from the pushdown list. ; (cx) will be preserved, (bx) not. DXLD: mov bx,PX ;pointer to argument push word ptr [bx] ;fetch word call UCL ;erase argument pop dx ;restore (dx) since UCL modified it ret ; (=) Test the two top arguments on the pushdown list ; for equality. The arguments may be of any length, but ; will be equal only when of the same length and composed ; of the same sequence of bytes. The top argument will be ; popped whatever the outcome, but when equality is true ; both will be popped. EQL: mov di,PX ;under argument mov cx,PY sub cx,di ;obtain length of top argument call UCL ;lift top argument mov si,PX mov bx,PY sub bx,si cmp bx,cx ;compare lengths jnz EQF cld mov ax,ds mov es,ax repz cmpsb jnz EQF jmp CUCL ;both agree, erase second arg, TRUE EQF: ret ;disagree so FALSE ; Load (es) with (ds) if PDL argument length is 2 bytes ; Load!(es) from upper two bytes if length is 4 bytes ESLD: mov ax,PY mov bx,PX sub ax,bx cmp ax,2 jnz esl1 mov ax,ds ;two-byte argument mov es,ax ret esl1: cmp ax,4 jnz esl2 mov ax,2[bx] ;four-byte argument mov es,ax ret esl2: call RR1 ;error record with one lift ; ------------------------------------------------------- ; ; Some of the service routines which are likely to be ; external references in other modules are: ; ; puon push one byte on PDL ; putw push address on PDL ; thrl load three arguments onto 8080 stack ; twol load two arguments onto 8080 stack ; onel load one argument onto 8080 stack ; bcld load (cx) from PDL, pop PDL ; deld load (dx) from PDL, pop PDL ; ; ------------------------------------------------------- ; END