Oakland CPM Archive

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

/ Oakland CPM Archive / oakcpm.iso / sigm / vol214 / rec86f.lbr / PDL86F.AQ6 / PDL86F.A86

Wrap

Text File | 1986-02-09 | 22.5 KB | 813 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: ; ; comparison ; ; = equality ; ; modification of arguments ; ; H hex ASCII string to binary ; [exclm] binary to hex ASCII string ; & 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, 1980 ; ------------------------------------------------------- ; 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 22, 1984 - arithmetic operators moved to ATH and FLT (GCS) ; May 23, 1984 - H and exclm handle any length (GCS) ; May 31, 1984 - PDL becomes 1st module of REC86F.CMD -GCS ; 18 June 1984 - n quits on empty PDL complement - GCS ; 3 July 1984 - entry points for pG, $S and $r - GCS ; 15 Aug 1984 - E.P.s for nL and &S - GCS ; ======================================================= ; ============= org 0000H ; ============= jmp MAIN ;<===============================<<< ; ======================================================= ; 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 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, assumed two-byte. EXCH: mov ax,PY mov bx,PX ;org1 sub ax,bx ;siz1 mov dx,-2[bx] ;org2 lea cx,-2[bx] sub cx,dx ;siz2 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 movs byte [di],[si] pop cx pop si pop di push di repnz movs byte [di],[si] pop word ptr [di] lea di,2[di] mov si,PX mov PX,di pop cx repnz movs byte [di],[si] mov PY,di ret ; Load top two arguments into the machine's stack. 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 or two arguments. TWOL: mov bx,PX pop bp ;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 ; ------------------------------------------------------- ; 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: lods byte ptr [si] ;check that 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: lods byte ptr [si] 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: lods byte ptr [si] 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: lods byte ptr [si] ;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 jmps 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 movs byte [di],[si] 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 DUP: 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 movs byte [di],[si] ;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 jmps 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 movs byte [di],[si] 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 movs byte [di],[si] mov [bx],di ret LVB: std add si,cx add di,cx mov [bx],di dec si dec di repnz movs byte [di],[si] 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 movs byte [di],[si] 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 movs byte [di],[si] jmp UCL ;lift second argument, leave nothing ; (r) Replace address on top of pdl by its contents. VREP: call VBLE ;entry point 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 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 push cx call UCL ;pop top argument mov di,PZ ;load destination origin std dec si dec di mov ax,ds mov es,ax repnz movs byte [di],[si] lea bx,-1[di] mov PZ,bx pop word ptr [bx] ;recover length ret ; (n) Recover segment which was set aside. LCN: mov cx,ZE ;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 ;see whether PDL complement is empty jnz lcn1 call RER ;it is, quit after recording error lcn1: lea si,2[bx] cld mov ax,ds mov es,ax repnz movs byte [di],[si] 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 movs byte [di],[si] mov PY,di ;record new terminal address 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 jmps 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) jmps 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 cmps byte [di],[si] 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