Oakland CPM Archive

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

/ Oakland CPM Archive / oakcpm.iso / sigm / vol164 / pdl86.asm < prev next >

Wrap

Assembly Source File | 1984-04-29 | 21.6 KB | 860 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 ; ! 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 ; ======================================================= ; ======================================================= ; 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: ld cx,#1 ;one byte is required call NARG ;close old variable, reserve space pop bp ;source was pushed before calling pop ax sto al,[bx] ;store byte, which is low order inc bx ;pointer to next byte sto bx,PY ;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: ld cx,#2 ;two bytes are required call NARG ;close old variable, reserve space mov bp,sp ld ax,[bp+2] sto ax,[bx] ;store low order byte inc bx ;on to high order destination inc bx ;always leave pointer in good condition sto bx,PY ;close top argument ret 2 ; (&) Exchange top two arguments, assumed two-byte. EXCH: ld ax,PY ld bx,PX ;org1 sub ax,bx ;siz1 ld dx,[bx-2] ;org2 lea cx,[bx-2] sub cx,dx ;siz2 cmp ax,cx jnz XTNE jcxz XTRE XTEQ: ld al,[bx] xchg bx,dx ld ah,[bx] sto al,[bx] xchg bx,dx sto ah,[bx] 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 rep movsb pop cx pop si pop di push di rep movsb pop [di] lea di,[di+2] ld si,PX sto di,PX pop cx rep movsb sto di,PY 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: ld bx,PX ;get pointer to top argument THRL: pop bp ;enter here if (bx) already loaded push [bx] push bp call UCL ;pop top argument, load (bx) from px TWOL: pop bp ;continue, or entry for two args push [bx] push bp call UCL ;pop argument, put px in (bx) ONEL: pop bp ;continue, or entry for one argument push [bx] push bp jmp UCL ;pop the last argument, quit ; Load up pointers to top two arguments. ARGG: ld di,PX ;org1 ld cx,[di-2] jcxz arge ;no second argument ld ax,PY sub ax,di ;siz1 mov bx,cx ;org2 lea dx,[di-2] mov cx,dx sub cx,bx ;siz2 cmp cx,ax jnz arge ;arguments not same length ret ARGE: call rer ARGS: call ARGG sto bx,PX sto dx,PY 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: ld al,[di] or [bx],al ret SUM2: ld ax,[di] add [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: ld al,[di] xor [bx],al ret DIF2: ld ax,[di] sub [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: ld al,[di] and [bx],al ret MPY2: ld ax,[di] mul [bx] sto ax,[bx] 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 [di],#0000 jz DER ld ax,[bx] ld dx,#0000 div [di] sto ax,[di] sto dx,[bx] ret DER: call RER ; (~) Complement or Negate the top of the pushdown list. comp: ld bx,PX ld cx,PY sub cx,bx cmp ax,#01 jz com1 cmp ax,#02 jz com2 call rer com1: notb [bx] ret com2: neg [bx] ret ; (^) Increment the top of the pushdown list. INCR: ld bx,PX ;pointer to argument inc [bx] ret ; (d) Decrement top of PDL if it is not zero; otherwise ; FALSE, erasing the counter. Equivalent to ((0=;1-)). DECR: ld bx,PX ;fetch pointer to argument sub [bx],#1 ;dec won't work because of c flag jc 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: ld al,[di] test al,[bx] jz UNF jmp UNT UN2: ld 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 jnc RH2 cmp al,#'A' ;hex letters equal A or beyond jc 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: ld cx,#2 ;two bytes required for result call OARG ;check if they are available ld bx,PY ;fetch terminal address of string stob #ZE,[bx] ;zero signals its end ld dx,PX ;fetch beginning of string ld bx,#ZE ;place zero in (bx) to prime conversion H1: xchg bx,dx ld 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) ld bx,PX ;place to store the result sto dx,[bx] ;store low byte inc bx ;on to high byte inc bx ;pointer must always be one ahead sto bx,PY ;store terminal address jmp SKP ;TRUE return from predicate ; (!) 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: ld cx,PY sub cx,PX cmp cx,#1 ;see if it's one byte jnz HS ;if not, continue elsewhere HN: ld cx,#2 ;two nibble result for 1 byte call OARG ;see that there's that much space ld bx,PX ld dl,[bx] ;load low bit jmp HSI ; HS: ld cx,#4 ;four nibble result for 2 bytes call OARG ;be sure there's space for it ld bx,PX ;pointer to first byte ld 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 sto bx,PY ;store end of argument ret HSA: ROR al ;shift byte right four bits ROR al ; ROR al ; ROR al ; 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 sto al,[bx] ;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: ld bx,PX ;/g/ pointer to top argument push [bx] ;fetch low byte of origin jmp GBJ ;if the origin is not to be incremented GBI: ld bx,PX ;/u/ pointer to arg, which is org push [bx] ;fetch low byte of origin inc [bx] GBJ: ld 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 ld al,[bx] xchg bx,dx ;fetch the byte there sto al,[bx] ;store on the PDL inc bx ;pointer always ready for next byte sto bx,PY ;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: ld bx,PX ;/ / pointer to the argument push [bx] ;low byte of origin jmp GWJ ;common continuation of gw, gwi GWI: ld bx,PX ;/y/ pointer to the argument push [bx] ;place low byte in A add [bx],#2 ;origin to be incremented by 2 GWJ: ld 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 ld ax,[bx] xchg bx,dx ;fetch the byte sitting there sto ax,[bx] ;and store it on PDL inc bx inc bx ;keep the pointer moving along sto bx,PY ;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 ld bx,PX ;fetch the destination address ld si,[bx] ;but the source address is stored there cld mov di,bx mov ax,ds mov es,ax rep movsb sto di,PY ;(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 ld si,PX ld cx,PY sub cx,si cld mov ax,ds mov es,ax rep 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: ld si,PX ld cx,PY sub cx,si ;determine length of data call UCL ;pop top argument, exposing second ld di,[bx] ;(bx) has px, which is destn address mov ax,ds mov es,ax mov ax,si add ax,cx cmp di,ax jc LVB cld rep movsb sto di,[bx] ret LVB: std add si,cx add di,cx sto di,[bx] dec si dec di rep 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 ld si,PX ld cx,PY sub cx,si ;determine length of data ld ax,[bx] ;low byte of capacity cmp ax,cx jnc 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 rep 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 ld si,PX ld 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 ld ax,[bx] ;low byte of destination capacity inc bx ; inc bx ; cmp ax,cx jnc 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 sto cx,[bx] ;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 rep movsb jmp UCL ;lift second argument, leave nothing ; (r) Replace address on top of pdl by its contents. IND: ld bx,PX ;pointer to top argument ld dx,[bx] ;load low byte xchg bx,dx ;(bx) now has top argument ld ax,[bx] ;low byte of indirect address xchg bx,dx ;address of top argument again sto ax,[bx] ;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: ld bx,PX ;pointer to argument ld cx,PY sub cx,bx cmp cx,#2 jz VBLF ld cx,#2 call OARG ld bx,PX ld al,[bx] ld ah,#0 jmp VBLG VBLF: ld ax,[bx] VBLG: add ax,ax add ax,VRT sto ax,[bx] add bx,#2 sto bx,PY 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: ld si,PY mov cx,si sub cx,PX ;get length of top argument push cx call UCL ;pop top argument ld di,PZ ;load destination origin std dec si dec di mov ax,ds mov es,ax rep movsb lea bx,[di-1] sto bx,PZ pop [bx] ;recover length ret ; (n) Recover segment which was set aside. LCN: ld 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) ld bx,PZ ;place source origin in (bx) ld cx,[bx] ;place length in cx lea si,[bx+2] cld mov ax,ds mov es,ax rep movsb sto di,PY ;end of destination is end of argument sto si,PZ ;update pz ret ; (|) Concatinate the top arguments on the PDL. CONC: ld si,PX ld 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 rep movsb sto di,PY ;record new terminal address ret ; (%) Restrict multiple-byte argument to one byte. PE: ld ax,PX cmp ax,PY jz PE1 ;leave a null argument in peace inc ax ;add one to it sto ax,PY ;store as limit to the argument PE1: ret ; (\) Embed a single byte in a pair. IP: ld cx,#2 ;we want to have two bytes call OARG ;verify that that much space remains ld bx,PX ;pointer to argument inc bx ;pass over first byte stob #ZE,[bx] ;make high byte zero inc bx ;pass on to next byte sto bx,PY ;record end of argument ret ; (p) Put px and siz on the pushdown list. GXS: ld dx,PX ld 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: ld bx,PX ;pointer to argument ld cx,[bx] ;fetch the argument sto cx,[bx] ;store header sub [bx],#2 call OARG ;is there enough space to reuse arg? sto bx,PY ;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: ld bx,PX ;pointer to argument ld 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: ld bx,PX ;pointer to argument push [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: ld di,PX ;under argument ld cx,PY sub cx,di ;obtain length of top argument call UCL ;lift top argument ld si,PX ld 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 ; ------------------------------------------------------- ; ; 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 ; ; ------------------------------------------------------- LINK MKV86.ASM