Oakland CPM Archive

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

/ Oakland CPM Archive / oakcpm.iso / sigm / vol167 / pdl86.a86 < prev next >

Wrap

Text File | 1984-04-29 | 22.2 KB | 848 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 ; ; 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 ; ------------------------------------------------------- ; ; PDL86 - Copyright (C) 1982 ; Universidad Autonoma de Puebla ; All Rights Reserved ; ; [Harold V. McIntosh, 25 April 1982] ; ; 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,> ; ======================================================= ; ======================================================= ; 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, 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 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. 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] jz 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 ; Cummulation to convert a hex ASCII string to binary. HXP: add bx,bx ;shift left 4 bits add bx,bx ; add bx,bx ; add bx,bx ; or bl,al ;or in the nibble in the accumulator ret ; (H) Convert a hex ASCII string on the PDL into binary. ; Whatever the length of the argument, conversion will be ; made to a two-byte binary number. Thus, if more than ; four hex digits are present, the result will be reduced ; modulo 2**16. It should be noted that the conversion ; starts with the first byte of the argument and procedes ; onward. HE: mov cx,2 ;two bytes required for result call OARG ;check if they are available mov bx,PY ;fetch terminal address of string mov byte ptr [bx],(offset ZE) ;zero signals its end mov dx,PX ;fetch beginning of string mov bx,(offset ZE) ;place zero in (bx) to prime conversion H1: xchg bx,dx mov al,[bx] xchg bx,dx ;fetch ASCII character inc dx ;ready for the next one or al,al ;check the terminator byte jz H2 ;when end reached, close off argument call RNH ;if not hex digit, forget it all call HXP ;otherwise times 16 plus new digit jmp H1 ;repeat the cycle H2: xchg bx,dx ;binary number into (dx) mov bx,PX ;place to store the result mov [bx],dx ;store low byte inc bx ;on to high byte inc bx ;pointer must always be one ahead mov PY,bx ;store terminal address jmp SKP ;TRUE return from predicate ; ([exclm]) Convert a two-byte binary number into an ASCII ; string. A one-byte number will also be converted, but ; into two nibbles rather than four, to serve in some ; applications where the leading zeroes are not wanted. HX: mov cx,PY sub cx,PX cmp cx,1 ;see if it's one byte jnz HS ;if not, continue elsewhere HN: mov cx,2 ;two nibble result for 1 byte call OARG ;see that there's that much space mov bx,PX mov dl,[bx] ;load low bit jmp HSI ; HS: mov cx,4 ;four nibble result for 2 bytes call OARG ;be sure there's space for it mov bx,PX ;pointer to first byte mov dx,[bx] ;load low byte mov al,dh ;separate high byte first call HSA ;write out left nibble mov al,dh ;high byte again call HSB ;write out right nibble HSI: mov al,dl ;separate low byte call HSA ;write out left nibble mov al,dl ;low byte second trip call HSB ;write out right nibble mov PY,bx ;store end of argument ret 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 mov [bx],al ;record the ASCII digit inc bx ;pointer ready for next deposit 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, nonincement 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' n$ S define 2-byte variable ; n$ r fetch 2-byte variable ; 'data' ml n$ S save fixed variable ; n$ ryG fetch fixed variable ; 'data' n$rs redefine existing fixed var ; kc Lml n$ S create k-byte buffered variable ; kc n$ S alternative k-byte buffered var ; 'data' n$r P redefine buffered variable ; n$ 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: 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,[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: 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,[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 mov bx,PX ;fetch the destination address mov si,[bx] ;but the source address is stored there cld mov di,bx mov ax,ds mov es,ax repnz movs byte [di],[si] mov PY,di ;(bx) holds the destination terminator 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. SA: call CXLD ;fetch destination origin mov di,cx ;save it for a while mov si,PX mov cx,PY sub cx,si cld mov ax,ds mov es,ax 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 mov di,[bx] ;(bx) has px, which is destn address mov ax,ds mov es,ax 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,[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 mov ax,ds mov es,ax 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,[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 [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. IND: mov bx,PX ;pointer to top argument mov dx,[bx] ;load low byte xchg bx,dx ;(bx) now has top argument mov ax,[bx] ;low byte of indirect address xchg bx,dx ;address of top argument again mov [bx],ax ;store low indirect byte ret ; ($) Generate the address of the nth cell in the array ; of variables, which is a block of two-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 mov bx,PX mov al,[bx] mov ah,0 jmp VBLG VBLF: mov ax,[bx] VBLG: 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,(offset 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 bx,PZ ;place source origin in (bx) mov cx,[bx] ;place length in cx 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 ; (|) 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 ; (%) 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],(offset ZE) ;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 ; 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 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 ; ------------------------------------------------------- ; ; 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