Turbo Toolbox

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

/ Turbo Toolbox / Turbo_Toolbox.iso / sharew / exoten / rec / fxt87.asm < prev next >

Wrap

Assembly Source File | 1980-01-01 | 40.4 KB | 1,744 lines

; ======================================================= ; ; REC module containing RAM storage, I/O programs, main ; program, and the directory. The complete set of modules ; comprises REC86.ASM, PDL86.ASM, MKV86.ASM, LIB86.ASM, and ; FXT86.ASM. ; ; FXT86.ASM contains the following REC operators and ; predicates: ; ; C compile a REC expression ; i input from designated port ; k call CP/M without residue ; K call CP/M, preserve FCB, return value ; o output from designated port ; R read one character from console ; t type message given header ; T type argument on PDL ; W write argument on LST: ; X noop: reserved for user extension ; ` test if a character waits at keyboard ; ; ------------------------------------------------------ ; REC version released during the 1984 Summer School of ; the Microcomputer Applications Group of the I.C.U.A.P. ; ------------------------------------------------------ ; 8086 version with segments for code, PDL and WS. ; ------------------------------------------------------ ; ; FXT87 - Copyright (C) 1986 ; Gerardo Cisneros S. ; Harold V. McIntosh ; Derechos Reservados ; ; [Harold V. McIntosh, 28 August 1980] ; [Gerardo Cisneros, 8 February 1984] ; ; Modification 1 - 1 January 1981. ; a) Main program derives the values of const, ; conin, conou from the address rst0 supposing ; that BIOS starts out with the standard jump ; vector. Thus, REC need not be reassembled ; to have fast access to I/O when CP/M varies. ; b) T protected by pushes and pops of dx and bx. ; c) Some changes made in memory allocation. ; 24 May 1981 - Zero flag to restrain L from too many pops ; 25 March 1982 - Y is now a predicate ; 29 May 1983 - ~ discontinued as argument exchange ; 29 May 1983 - ~ for unary negative or complement ; 29 May 1983 - N for numerical comparison on PDL ; 29 May 1983 - h discontinued, replaced by ''w ; 30 May 1983 - CPIR: jumps to BOOT rather than RER ; 8 July 1983 - C has object program origin as argument ; 8 July 1983 - C is an operator ; 8 July 1983 - C0 defined as lower bound of compile area ; 8 July 1983 - x moved from RECLIB ; 8 July 1983 - x is a predicate to call REC subroutines ; 9 July 1983 - Buffered CP/M input if no disk file given ; 14 July 1983 - W had its arguments reversed ; 14 January 1984 - <QIN ds 0>, <QOU ds 0> for sorcim.cnv ; 14 January 1984 - default extension .REC for 1st file ; 8 February 1984 - separate segments (GCS) ; Apr 1984 - Disposable initialization code - GCS ; 9 May 1984 - Arguments of C reversed (GCS) ; 31 May 1984 - Error messages for Cp, PD and WS ovfl - GCS ; 11 June 1984 - DIIN/CPIN set up DMA address and seg. - GCS ; 18 June 1984 - Set DMA, then open; initialize VT - GCS ; 20 June 1984 - Rd ovf error on EOF and end of buffer - GCS ; 3 July 1984 - @@ takes over x, x is library predicate; ; entry point for TL and combination table included. - GCS ; 14 Aug 1984 - Operator pair table extended - GCS ; 29 June 1985 - word-size entries in VT, x in. - GCS ; 6 July 1985 - 0<adr>C to give <org,siz> of Cpl. - GCS ; 8 Aug 1985 - Qm included in pair table - GCS ; 2 Feb 1986 - i fixed -GCS ; 11 Jul 1986 - V2 system calls, PATH search - GCS ; 10 Sept 1986 - R modified to read extended chars - GCS ; 9 Aug 1989 - Table of "..."x combinations added - GCS ; 6 Sep 1990 - Leave free memory data at ds:2-3&5-6 - GCS ; 11 Sep 1990 - Initial WS pointers p1 & p2 at p0 - GCS ; ======================================================= bdos equ 021H ;MS-DOS software interrupt vector DSIZ equ 0020H ;size of two parsed filenames FSIZ equ 0010H ;CP/M file name size TSIZ equ 0080H ;CP/M disk buffer size ; Linkage to input-output through ports. QIN: DB 0E4H ;8-bit 8086 static IN instruction QI db 00H ret QOU: DB 0E6H ;8-bit 8086 static OUT instruction QO db 00H ret ; ======================================================= ; Programs related to input-output and disk usage. ; ======================================================= ; bootstrap routine boot: mov ax,04C00H int bdos ; Buffer read routine. PTY: push bx ;conserve (bx) mov es,RSEG ;get segment address for buffer mov bx,RX ;pointer to read buffer cmp bx,RY jz ptye mov al,es:[bx] ;fetch byte inc bx ;advance pointer to next byte mov RX,bx ;update buffer pointer pop bx ;restore (bx) - preserve all reg pairs ret ptye: mov bx,'dR' ;Report Rd ovfl and quit jmp FERR ; Console character read routine. CP/M-86 compatible version ; with direct access to CONIN. chin: push cx push dx mov ah,7 int bdos test al,al jnz chi mov ah,7 int bdos or al,80H chi: pop dx pop cx ret ; Buffered console character read routine, which is more ; practical for use with CP/M. Up to 126 characters may ; be read using CP/M function 10, which is sufficient for ; bootstrapping or generating test programs. CHIN should ; be used for longer input sequences, which must be error ; free - incoming through a modem, for example. buin: push bx push cx push dx mov bx,RX cmp bx,RY jnz BI5 BI4: mov ah,9 ;(09) write message mov dx,(offset bume) int bdos mov ah,10 ;(0A) buffered read mov dx,(offset TBUF) int bdos mov ah,9 ;(09) write message mov dx,(offset crlf) int bdos mov bx,(offset TBUF)+2 mov RX,bx mov al,-1[bx] mov ah,0 add ax,bx cmp ax,bx jz BI4 mov RY,ax BI5: mov al,[bx] inc bx mov RX,bx pop dx pop cx pop bx ret ; Buffered read for repetitive compilation bure: mov al,TSIZ-2 mov TBUF,al mov ax,(offset buin) mov read,ax mov ax,(offset TBUF) mov RX,ax mov RY,ax ret ; Console character out routine. CP/M-86 compatible version ; with direct access to CONOUT chou: push cx push dx mov dl,al mov ah,6 ;(06) direct console IO int bdos pop cx pop dx ret ; (`) Test for presence of waiting character (FALSE if ; none waiting. CP/M-86 compatible version with access ; to CONST. chaw: push cx push dx ; mov dl,-2 mov ah,11 ;(11) Check keyboard status int bdos pop dx pop cx test al,al jnz chw ret chw: jmp SKP ; Printer output routine. PROU: push bx push dx push cx mov ah,5 ;(05) output through LST: mov dl,al int bdos pop cx pop dx pop bx ret ; (R) REC read operator. UCR: mov cx,1 ;one byte to be inserted call NARG ;close last arg, verify space push bx call word ptr tyin ;get byte from console input pop bx mov [bx],al ;store on PDL inc bx ;advance pointer mov PY,bx ;record end of argument ret ; (t) Write indirect operator. <org,siz,t> prints the ; indicated message, leaves no residue. LCT: mov bx,PX ;fetch argument pointer call ONEL ;move one argument to 8086 stack call CXLD ;get org and segment mov bx,cx ;org to bx pop dx ;size to dx add dx,bx ;org+size=end jmp UT1 ;use write cycle in UCT ; (TL) Often-used combination for which a single call ; is compiled. UCTL: call UCT ;type argument and jmp UCL ;lift it ; (T) REC write operator. <'XXX' T> will write XXX on ; the console, leaving it on the PDL. uct: mov dx,PY ;fetch terminal address mov bx,PX ;beginning address to (bx) mov ax,ds mov es,ax ut1: cmp dx,bx jz ut2 ;they match, we're done mov al,es:[bx] ;get byte out of memory push bx push dx push es call word ptr tyou ;tyou is in the data segment pop es pop dx ;recover the saved registers pop bx inc bx ;advance pointer jmp UT1 ;repeat ut2: ret ; (W) REC print operator. <org, siz, W> will print the ; indicated text on the list device, and then erase its ; arguments. UCW: mov bx,PX ;pointer to arguments call ONEL ;size from PDL to 8086 stack call CXLD ;org and segment addr to cx and es mov bx,cx ;place text origin in (bx) pop dx ;place length in (dx) UWW: test dx,dx ;check for zero length jz UWX ;no more to print mov al,es:[bx] ;fetch a byte push bx ;we need to be sure that dx and bx are push dx ;preserved whatever the print routine push es call PROU ;send it to printer pop es pop dx ;recover bx pop bx ;and dx dec dx ;diminish count inc bx ;advance pointer jmp UWW ;repeat UWX: ret ; (i) Input from designated port. <port, i> leaves ; <port, byte> so that after disposing of <byte>, <port> ; can be reused. LCI: mov bx,PX ;get pointer to top argument on PDL mov al,[bx] ;only the low order byte matters mov cs:QI,al ;place it in teme IN instruction mov cx,1 ;we're only going to read one byte call NARG ;prepare a place for it on the PDL call QIN ;execute the captive IN instruction mov [bx],al ;storing the incoming byte on the PDL inc bx ;always ready for the next byte mov PY,bx ;close off the argument ret ;and we're through ; (o) Output from designated port - <port, byte, o> ; leaves <port>, facilitating multiple OUTs through the ; same port. LCO: mov bx,PX ;pointer to last argument - output byte mov CH,[bx] ;tuck it into register b call UCL ;erase the top argument mov al,[bx] ;(bx) points to next argument - get it mov cs:QO,al ;store in tame OUT instruction mov al,CH ;output must be from accumulator jmp QOU ;execute the prepared OUT instruction ; ======================================================= ; ; Communication with MS-DOS takes two forms: <args, n, K> ; which leaves <arg, code> on the pushdown list, or else ; <args, n, k> which leaves nothing on the pushdown list. ; In either case "args" is one or two arguments, depending ; on the function call and "n" is the MS-DOS function ; number. Each argument contains values for one or two ; registers; up to four registers may be assigned values. ; Since some functions require an argument in AL, this is ; taken from the HIGH order byte of "n". For most ; functions the value returned ("code") is the value of ; AX. Functions which will take two arguments from the ; PDL are 27H, 29H, 3CH, 3EH and all others above 3EH. ; Functions beyond 3EH not actually requiring the second ; argument will nevertheless lift an extra argument; ; loading an extra 0 will do. If a two byte argument XX ; is given where two registers R1:R2 are expected (R1 ; being the high order word), R1 will be assigned the ; value of DS and XX will be loaded into R2. With the ; exception of functions 2BH and 2DH, where arg1 is ; read as CX:DX, if arg1 is WW:XX and arg2 is YY:ZZ, ; XX will be loaded into DX and SI, ZZ will be loaded ; into BX and DI, YY (or DS if YY is absent) will be ; loaded into ES, and WW will be loaded into DS (unless ; WW is absent, in which case DS does not change) ; In the list below "fcb" and "buffer" represent the ; addresses of a file control block and a buffer, ; respectively. Some functions return additional values ; besides AX. These are indicated in the list; each PDL ; argument produced by K is separated by a slash. Addr4 ; means a 4 byte address (seg:offset). An asterisk ; indicates that an extra value -1 (on error, in which ; case the remaining AX value is the error code) or ; an extra copy of AX (if no error) is returned. ; ; The functions are: ; ; num function "arg1" "arg2" "code" ; --- -------- ----- ------ ------ ; ; 0 program terminate 0 - - ; 1 kbd input 0 - char ; 2 video output char - AX ; 3 aux input 0 - char ; 4 aux output char - AX ; 5 printer output char - AX ; 6 direct cons I/O DX - AX ; 7 dir cons input, no echo 0 - AX ; 8 cons input, no echo 0 - AX ; 9 print string buffer - AX ; 10 buffered kbd input buffer - AX ; 11 keyboard status 0 - stat ; 12 char inp w/buffer flush DX - AX ; 13 disk reset 0 - AX ; 14 select disk disk - AX ; 15 open file fcb - code ; 16 close file fcb - code ; 17 search once fcb - code ; 18 search again fcb - code ; 19 delete file fcb - code ; 20 sequential read fcb - code ; 21 write 1 record fcb - code ; 22 create file fcb - code ; 23 rename file fcb - code ; 25 current disk 0 - disk ; 26 set DMA address dma - AX ; 27 alloc tbl addr not implemented ; 33 random read fcb - code ; 34 random write fcb - code ; 35 file size fcb - code ; 36 set random rec field fcb - AX ; 37 set vector addr - AX ; 38 create new pgm seg seg - AX ; 39 random block read fcb CX AX ; 40 random block write fcb CX AX ; 41 parse file name DS:SI ES:DI AX ; 42 get date 0 - CX:DX/AX ; 43 set date CX:DX - AX ; 44 get time 0 - CX:DX/AX ; 45 set time CX:DX - AX ; 46 set/reset verify flag 0 - AX ; 47 get DMA address 0 - addr4/AX ; 48 get DOS version No. 0 - AX ; 49 term and stay res. DX - - ; 51 ctrl-break check DX - DX ; 53 get vector 0 - addr4 ; 54 get disk free space disk - ax:cx/dx:bx/code ; 56 ret country dep info addr - AX/* ; 57 create subdir addr - AX/* ; 58 remove dir entry addr - AX/* ; 59 change curr dir addr - AX/* ; 60 create a file addr attrib AX/* ; 61 open a file addr - AX/* ; 62 close a file 0 handle AX/* ; 63 read file/dev buffer No:Hdl AX/* ; 64 write file/dev buffer No:Hdl AX/* ; 65 delete file addr 0 AX/* ; 66 move file pointer DX CX:Hdl dx:ax/ax/* ; 67 change file mode addr 0 CX/AX/* ; 68 IOCTL 0 handle dx/ax/* ; 69 duplicate a handle 0 handle AX/* ; 70 force dupl of handle 0 CX:BX AX/* ; 71 get curr dir disk buffer AX/* ; 72 allocate memory 0 BX AX/* ; 73 free allocated mem 0 ES:0 AX/* ; 74 mod alloc mem blocks 0 ES:BX BX/AX/* ; 75 load or exec a pgm DS:DX ES:BX AX/* ; 76 terminate a process 0 0 - ; 77 get ret code 0 0 AX/* ; 78 find first addr attrib AX/* ; 79 find next 0 0 AX/* ; 84 get verify state 0 0 AX/* ; 86 rename a file DS:DX ES:DI AX/* ; 87 get/set file date/time DX CX:BX AX/* ; ; ======================================================= ; (K) Set up communication with MS-DOS. CPM: call CPM0 ;use code in common with k lahf ;save flags for #42H and #45H cmp al,2AH ;was it get date? jnc cpm5 cpm4b: mov ax,bp ;extend al sign if below cbw push ax cpm4a: call PUTW ;to PDL (jmp PUTW won't do) ret cpm5: jz cpm6 ;treat #2A and #2C the same cmp al,2CH ;get time? jnz cpm8 cpm6: push bp ;AX returned by bdos push cx push dx cpm7: call PUTW ;two words go to the PDL call PUTW call CONC ;concatenate them jmp short cpm4a ;then put AX on the PDL cpm8: cmp al,2FH ;get DMA? jz cpm9 ;treat the same as #35H cmp al,35H ;get vector? jnz cpm10 cpm9: push es ;return ES:BX push bx call PUTW ;two words go to the PDL call PUTW jmp CONC ;concatenate them cpm10: cmp al,33H ;ctrl-break check/set? jnz cpm11 push dx ;yes, return DX jmp short cpm4a cpm11: cmp al,42H ;LSEEK? jnz cpm12c sahf ;yes, get returned carry bit mov ax,bp jnc cpm11a mov bp,0FFFFH ;carry on, ret -1 code cpm11a: push bp ;else original ax push ax ;ax or error code push dx jmp short cpm7 ;conc ax and dx cpm12c: cmp al,36H ;get disk free space? ja cpm14 jnz cpm13 push bp ;ax/error code (-1) on top push dx ;ret DX:BX next push bx push bp ;and CX:AX below push cx call PUTW ;two words go to the PDL call PUTW call CONC ;concatenate them jmp short cpm7 cpm13: cmp al,30H ;get version No.? jnz cpm4b ;sign extend if not cpm13a: push bp jmp short cpm4a cpm14: push ax cmp al,43H ;CHMOD? jnz cpm15 push cx cpm14a: call PUTW cpm12: pop ax sahf mov ax,bp jnc cpm12a mov bp,0FFFFH ;unsuccessful, ind by -1 cpm12a: push bp push ax cpm12b: call PUTW ;handle/err code to PDL jmp short cpm4a ;"carry" ind to PDL cpm15: cmp al,44H ;IOCTL? jnz cpm16 push dx jmp short cpm14a cpm16: cmp al,4AH ;SETBLOCK? jnz cpm12 push bx jmp short cpm14a ; Common code for K and k. CPM0: mov bx,PX ;pointer to function number call ONEL ;transfer to stack mov bp,sp ;access it through bp mov al,[bp] ;this is the function number cmp al,27H ;random block read? jz cpm0a ;yes, 2 more args cmp al,29H ;parse file name? jz cpm0a ;yes, 2 more args cmp al,3CH ;create? jz cpm0a ;yes, 2 more args cmp al,3EH ;close? jb cpm1 ;everything else below uses 1 arg cpm0a: call CXLD ;top arg to ES:CX, lift from PDL cpm1: push cx ;keep while loading lower push es call ESLD ;DS or high word to ES mov dx,[bx] ;low word of arg to DX mov cx,es ;save high word in CX pop es ;retrieve 2nd arg (if any) pop di mov al,1[bp] ;function number (inverted) into ax mov ah,[bp] push ds ;save ds before modifying mov ds,cx ;high word of 1st arg ends up in ds mov cx,es ;high word of 2nd will be in cx and es mov bx,di ;low word of 2nd goes to di and bx mov si,dx ;low word of 1st goes to dx and si cmp ah,2BH ;set date? jz cpm2 ;yes, set CX from high(1st) cmp ah,2DH ;set time? jnz cpm3 cpm2: mov cx,ds ;set CX from high(1st) cpm3: cmp ah,47H ;get current dir? jnz cpm4 mov ds,cx ;yes: set ds:si from 2nd arg mov si,bx cpm4: int bdos ;DO IT! pop ds ;restore our data seg base pop bp ;retrieve original function No. to al xchg bp,ax ;save returned ax in bp ret ; (k) Call to CP/M without any value returned. CPML: call CPM0 ;use common code jmp UCL ;get rid of lowest argument ; ------------------------------------------------------- ; Disk input-output routine working through CP/M. ; ------------------------------------------------------- ; Set up a to read a source file whose name is given on the ; PDL. A default extension .REC is appended if not present; ; an error exit is taken if the file cannot be opened. ; The file handle is stored at FLDES if the open is ; successful. DIIN: mov bx,PX ;point at drive designator mov al,[bx] cmp al,'@' ;is it default? jne di1 call UCL ;yes, get rid of it jmp short CPIN di1: inc bx ;no, append a colon mov byte ptr [bx],':' inc bx mov PY,bx call EXCH ;attach it to the filename call CONC CPIN: call GXS ;find out about the extension call LCW call NU db 2 dw 4 call LCB jmp short rcxt ;not 4 chars, add .REC nop ;beware of true skip call QU dw 4 db '.REC' call UCE ;check last 4 chars jmp short rcxt nop ;beware of true skip call LCW ;restore workspace jmp short cp1 ;.REC found rcxt: call LCW ;restore WS call QU ;append extension dw 4 db '.REC' call CONC cp1: call NU ;terminate with NUL db 2 dw 0 call CONC mov dx,PX ;start of string mov ax,3D00H ;sys call: open for reading int bdos jc cp2 mov FLDES,ax ;else we have a handle mov dx,(offset TBUF) mov RX,dx ;set buffer pointers mov RY,dx mov RSEG,ds cp2: ret ;immediate return if carry set ; Read from disk buffer, replenish buffer when empty. DIRE: push bx mov bx,RX ;pointer to current byte cmp bx,RY ;skip if equal jnz DI5 ;still have bytes in the buffer? push dx ; push cx ; mov bx,FLDES ;no, get file handle mov dx,(offset TBUF) mov cx,080H ;128-byte sectors mov ah,03FH ;sys call: read int bdos jc dier test ax,ax jz dier ;ax=0 means no more bytes mov bx,(offset TBUF) ;start of buffer mov RX,bx ;store it in rx add ax,bx ;end of buffer mov RY,ax ;store it in ry pop cx pop dx mov ah,0 DI5: mov al,[bx] ;common continuation inc bx ;byte in acc, advance pointer mov RX,bx ;store position of next byte pop bx ret dier: mov bx,'dR' jmp FERR ; (C) REC compiling operator which takes the designation ; of the compiling source from the PDL. The alternatives ; are: ; ; ''<dest>C input program from console ; 'file' 'D'<dest> C take<file.rec> from disk D ; p<dest>C pushdown list ; q<dest>C workspace ; <org,siz,dest,C> memory from address org onward ; ; where <dest> designates the destination area for the ; compilation: C1 if null, the address given otherwise. ; In general, if the top argument is of length zero, the ; console is the source, if it is of length one the named ; disk is the source [@=current disk, A, B, ... up to the ; system's limit], and if the argument has length 2, the ; combination of <org, siz> from the memory applies. It ; is the programmer's responsibility to avoid nonexistent ; memory, disk units, and the like. UCC: push c1 mov cx,PY sub cx,PX jnz UC5 mov dx,C1 ;use compile pointer jmp short UC6 UC5: call ESLD ;get segment, ignore mov dx,[bx] ;get address to use UC6: mov C1,dx ;record as C1 call UCL ;remove <dest> argument mov ax,PY ;check length of <source> argument sub ax,PX jz UC2 ;zero means console cmp ax,1 ;test for one byte jz UC1 ;one means disk designation cmp ax,2 ;verify that we've got two bytes jnz UC7 ;no provision for other than 1, 2 bytes mov bx,(offset PTY) ;setup readin from pseudoteletype mov read,bx ; call CXLD ;load two numerical arguments jcxz UC8 ;zero means return cpl. area ptrs. mov dx,[bx] ;bx contains PX for second argument call ESLD ;load segment address of buffer mov RX,dx ;origin of REC source code add dx,cx ;length of source code mov RY,dx ;end of source code mov RSEG,es ;segment of source code jmp short UC4 ;compile once rx, ry set up UC8: mov bx,C2 ;compute size sub bx,C1 push bx ;size on stack push cs push C1 ;origin on stack call PUTW call PUTW call CONC ;make 4-byte address cs:C1 jmp short UC9 ;then to the PDL UC1: call DIIN ;setup the CP/M FCB for given file jc OPFL ;carry says open failed pop dx ;recover c1 mov bx,(offset DICL) push bx ;set return through DICL (close) push dx ;c1 back on the stack mov bx,(offset DIRE) ;setup input from disk reader jmp UC3 ;compile once input source set up UC2: mov bx,(offset CHIN) ;input from the console UC3: mov read,bx ; UC4: call EMCE push dx call PUTW UC9: call PUTW pop c1 ret UC7: pop c1 call RER OPFL: call UCTL ;type filename mov dx,(offset nfil) jmp FERM ;type error message and quit ; (X) noop in this version LIBO: ret ; Close the file after compiling DICL: mov bx,FLDES ;get the handle mov ah,3EH ;sys call: close int bdos ret ; Single-shot compilation from a disk file SSHOT: call EMCX ;compile the program file call DICL ;close it mov cx,DSIZ mov di,(offset TFCB) mov si,P3 mov ax,ds mov ds,WSEG mov es,ax repnz movsb ;retrieve parsed filenames mov si,es:P1 mov bx,si mov cl,[si] inc cx mov di,(offset TBUF) repnz movsb ;retrieve command line mov ds,ax ;restore data segment base value inc bx mov P2,bx call UCD ;delete character count from workspace call EMCU ;execute the program file jmp short bootie ;return to CP/M if false nop ;beware jump span bootie: jmp boot ; Multiple compilations from the console nodi: call bure ;no disk file: compile interactively call INRE call EMCX call EMCU jmp short nodi nop jmp nodi ; Type error message and quit FERR: mov EMSG,bx mov dx,(offset EMSGS) FERM: mov ah,9 int bdos jmp boot ; Undefined subroutine exit USUB: shr al,1 ;restore character cmp al,' ' jb usu1 cmp al,'~' ja usu1 ;leave BEL for control chars mov usby,al ;others get typed usu1: mov dx,(offset usms) jmp short FERM ; END OF PERMANENT CODE. THE INSTRUCTIONS FOLLOWING THIS ; WILL BE OVERWRITTEN AS SOON AS THE FIRST REC PROGRAM ; IS COMPILED. ENDREC: ; ================ ; = main program = ; ================ MAIN: ; finit db 9BH,0DBH,0E3H mov ax,dgroup mov es,ax mov cx,080H mov si,0 mov di,si cld repnz movsw ;transfer PSP to data segment mov ax,es mov ds,ax mov di,(offset VT) ;set up to initialize vars/subs mov cx,021H ;the number of variables mov ax,0000 repnz stosw ;set variables to zero mov cx,05EH ;number of subroutine entries mov ax,(offset usub) ;undef subroutine exit repnz stosw mov word ptr [di],0000 ;clear entry for DEL mov bx,02 mov dx,cs sub [bx],dx mov ax,[bx] ;get total No. of paragraphs-c.s.base shr ax,1 ;half of leftover mov dx,01000H ;tentative size for compile area cmp ax,dx jnb vtc1 mov dx,ax ;less than 128k, use half vtc1: sub [bx],dx ;subtract c.s.paragraphs mov ax,cs add ax,dx mov es,ax ;new data segment base mov di,offset dlst mov si,di mov cx,di inc cx std repnz movsb ;move data to new segment mov ax,es mov ds,ax mov cl,4 shl dx,cl dec dx ;sacrifice a byte to avoid C2=0 mov C2,dx mov ax,[bx] ;get leftover shr ax,1 mov dx,01000H cmp ax,dx jnb vtc2 mov dx,ax vtc2: sub [bx],dx ;subtract d.s.paragraphs mov ax,ds add ax,dx mov es,ax mov WSEG,ax shl dx,cl ;first address beyond data segment dec dx dec dx xchg dx,bx mov word ptr [bx],0FFFFH ;end-of-PDL marker mov PZ,bx xchg dx,bx mov ax,[bx] ;leftover once more shr ax,1 mov dx,01000H cmp ax,dx jnb vtc3 mov dx,ax vtc3: sub [bx],dx mov ax,es add ax,dx shl dx,cl dec dx dec dx xchg dx,bx mov es:word ptr [bx],0 ;mark end of ws mov P4,bx xchg dx,bx mov es,ax mov ax,[bx] ;leftover is for stack mov dx,01000H cmp ax,dx jb vtc4 mov ax,dx vtc4: sub [bx],dx ;final number of free paragraphs shl ax,cl cli mov sp,ax mov ax,es mov ss,ax sti add ax,dx ;address of next free paragraph mov [bx+4],ax ;to be saved at offset 6 of PSP mov dx,offset boot push dx cld mov si,(offset TBUF) ;pointer to command buffer mov cl,[si] ;get count mov ch,0 jcxz mj1 ;tail empty? inc si ;no, get rid of leading blanks mj0: lodsb cmp al,' ' jnz majn loop mj0 mj1: call STATS ;tail empty: type memory usage stats jmp nodi ;and go to TTY: loop majn: dec si ;command line tail to WS mov di,P1 ;next byte of WS mov es,WSEG ;load ES with WS base mb0: lodsb cmp al,'a' ;fold lower into upper case jb mb1 cmp al,'z' ja mb1 sub al,32 mb1: stosb loop mb0 mov P3,di mov P2,di ;delimit the tail call QU ;find a blank dw 1 db ' ' call UCF jmp short mb2 nop ;beware of true skip call UCD ;get rid of the blank call UCJ ;span the name mb2: call QUEM ;first argument to PDL complement call UCD ;delete from WS call UCZ ;span WS call LCQ call PE ;set up new tail length call LCJ call UCI ;insert at start of WS call UCL ;lift p1 from PDL call UCZ call MVENV ;move environment string to WS call QU dw 5 db 'PATH=' ;look for PATH string call UCF jmp short mb8 ;skip if not found nop ;beware of true skip call QU ;else delimit up to NUL dw 1 db 0 call UCU nop nop ;PATH found, U must be true nop call BRA ;restrict to PATHs call LCJ ;null at start of WS call UCQ ;start with a null pathname jmp short mb5 mb4: call UCL ;lift failed filename call QU ;look for next path dw 1 db ';' call UCU jmp short mb7 ;skip if last nop call UCQ ;otherwise copy it call LCZ call UCA ;advance over semicolon nop nop nop ;filler for false exit mb5: call SLOP ;append \ if needed, try to open jc mb4 ;loop if not opened call KET ;found, reopen WS jmp mb9 ;go clean up mb7: call UCZ ;span last pathname call KET ;reopen WS mb8: call UCQ ;last chance call SLOP ;append \ if needed, try to open jnc mb9 ;carry says open failed call UCTL ;type filename mov dx,(offset nfil) jmp FERM ;type error message and quit mb9: call UCL ;get rid of last filename call ENLF ;get rid of bare filename mov dx,P0 ;reset P1 and P2 inc dx mov P1,dx mov P2,dx mov di,P3 ;save parsed filenames at p3 and following mov es,WSEG ;reload ES with WS base cld call ficb call ficb call LCJ call NU db 2 dw 2573 call UCU ;delimit tail once more nop nop ;false exit filler nop call LCQ ;get its length call PE call UCJ call LCF ;reinsert it nop nop ;false exit filler nop call UCJ ;p1 back to p0 call LFTW mov bx,(offset DIRE) ;REC input through disk mov read,bx ;REC compiler's I-O linkage call INRE ;initialize REC compiler RAM jmp SSHOT ;compile once from disk file ; Make a full pathname, try to open it SLOP: mov bx,PY cmp bx,PX jz mb6 ;null path, try name by itself mov al,-1[bx] ;get last character cmp al,':' jz mb6 ;no \ needed if colon cmp al,'\' jz mb6 ;nor if last is \ mov byte ptr [bx],'\' inc bx mov PY,bx mb6: call LCL ;copy from PDL complement (lyG) call GWI call GA call CONC ;append path to filename call CPIN ;try opening it ret ; Move the environment string to the WS MVENV: call NU ;insert <CR,LF> at end db 2 dw 2573 call UCI call LCJ ;null at p1 cld mov ax,ENVR ;set up to move environment string to WS mov di,P3 mov es,WSEG ;get WS segment base before changing ds push ds mov ds,ax mov si,0000 ;environment string starts at ax:0000 mb3: lodsb stosb ;movsb won't do, we have to test cmp al,0 jne mb3 ;move while not a NUL cmp byte ptr [si],0 ;is next a NUL too? jne mb3 ;keep on moving if not pop ds ;done, restore ds mov P3,di ;update WS pointer ret ; return when separator found fsep: call zsep jnz fsep1 ret fsep1: call rech ;read one character jmp fsep ; Advance to a non blank character in the console ; buffer unless there is none, indicated by a 00. zonb: call rech ;read one character test al,al jnz zonb1 ret zonb1: cmp al,' ' jz zonb ;zero or non-blank ret ; Generate a file control block in the manner of CCP. ficb: call zonb ;zero or non-blank push ax jz ficd sbb al,'@' mov dl,al ;save possible disk id mov bx,P2 mov bp,ds mov ds,WSEG mov al,(byte ptr[bx]) mov ds,bp cmp al,':' jz ficc xor al,al jmp ficd ficc: call rech ;get rid of colon pop ax call rech ;get first of filename push ax mov al,dl ficd: stosb mov cx,08 pop ax call ffil call fsep mov cx,03 cmp al,'.' jnz ficp call rech ;read one character call ffil call fsep jmp ficq ficp: call bfil ficq: mov cx,04 mov ah,al mov al,0 jmp kfil ; Fill a field ffil0: call rech ;read one character ffil: call zsep jz bfil cmp al,'*' jz qfil stosb loop ffil0 ret ; Block fill qfil: mov ah,al mov al,'?' jmp kfil bfil: mov ah,al mov al,' ' kfil: repnz stosb mov al,ah ret ; Fetch a character into a from command line rech: mov bx,P1 dec bx ;length is kept one back of p1 mov si,P2 ;both pointers before altering DS mov bp,ds mov ds,WSEG mov al,(byte ptr[bx]) ;number of characters not taken out test al,al mov al,0DH ;carriage return faked on empty buffer jz recx dec byte ptr[bx] mov bx,si mov al,byte ptr[bx] inc bx mov ds,bp mov P2,bx recx: mov ds,bp ret ; Set ZF if AL contains a separator zsep: test al,al jz zret cmp al,0DH jz zret cmp al,' ' jc zscc ;ctrl chars jz zret cmp al,'=' jz zret cmp al,'_' jz zret cmp al,'.' jz zret cmp al,':' jz zret cmp al,';' jz zret cmp al,'<' jz zret cmp al,'>' zret: ret zscc: xor al,al ret ; Memory usage stats STATS: mov bx,P0 mov P1,bx mov P2,bx ;null at start of WS mov ah,9 ;(09) write message mov dx,(offset logo) int bdos call MVENV ;copy env. string to the WS call QU ;use REC ops to show RAM usage dw 6 db 'Code ' MOV ax,C2 MOV cs:stt0,ax call NU db 2 stt0 dw 0 MOV cs:stt1,cs call NU db 2 stt1 dw 0 call RLCT call QU dw 7 db ' CPL ' mov bp,C2 sub bp,C0 call RCTL call QU dw 6 db 'Data ' MOV ax,PZ MOV cs:stt2,ax call NU db 2 stt2 dw 0 MOV cs:stt3,ds call NU db 2 stt3 dw 0 call RLCT call QU dw 7 db ' PDL ' mov bp,PZ sub bp,(offset PD)+2 call RCTL call QU dw 6 db 'Extra ' MOV ax,P4 MOV cs:stt4,ax call NU db 2 stt4 dw 0 MOV ax,WSEG MOV cs:stt5,ax call NU db 2 stt5 dw 0 call RLCT call QU dw 7 db ' WS ' mov bp,P4 sub bp,P0 call RCTL call QU dw 6 db 'Stack ' MOV cs:stt6,sp call NU db 2 stt6 dw 0 MOV cs:stt7,ss call NU db 2 stt7 dw 0 call RLCT call QU dw 7 db ' STK ' mov bp,sp call RCTL ret TCRL: call NU db 2 dw 2573 call UCT call UCL ret RLCT: call HX call QU dw 1 db ':' call CONC call EXCH call HX call CONC call QU dw 1 db 'H' call CONC RLCT2: call CONC call UCT call UCL ret RCTL: mov cx,2 call NARG mov [bx],bp inc bx inc bx mov PY,bx call NS call RLCT2 call TCRL ret code ends ; ----------------------------------------------------- ; RAM memory which is required for the operation of REC ; ----------------------------------------------------- ; ============= pdlist segment org 0 dsbeg db 02CH dup(?) ENVR dw ? ;here's the environment str address db 02EH dup(?) TFCB db 024H dup(?) TBUF db ? org 0100H ;origin of data in data segment ; ============= ; Relay area for input and output subroutines. read dw chin ;character input for REC compiler tyin dw chin ;single character input for R tyou dw chou ;single character output for T ; Error message buffer EMSGS db 0DH,0AH EMSG dw 2020H db ' overflow$' ; Prompt and crlf bume db 0DH,0AH,'REC87> $' crlf db 0DH,0AH,'$' nfil db 0DH,0AH,'File not found$' usms db 0DH,0AH,'Undefined subroutine ' usby db 07H,'$ ' ; Temporary storage used by the REC compiler. XPD dw 0000 ;colon jump back to left parenthesis YPD dw 0000 ;false predicate jump chain ZPD dw 0000 ;semicolon exit chain ; Pointers to the directories. FXT dw FT ;pointer to fixed operator directory VRT dw VT ;pointer to variable directory SBT dw STB ;pointer to subroutine directory CMT dw CTB ;pointer to compination directory QUT dw QTB ;pointer to "..." comb. table ; Pointers to the area of compiled subroutines. C0 dw ENDREC ;lower limit of compile area C1 dw ENDREC ;beginning of present compilation C2 dw 0 ;upper limit of compile area ; Pointers to REC/MARKOV pushdown list. PX dw PD+2 ;beginning of pushdown text PY dw PD+2 ;end of pushdown text PZ dw 0 ;end of available pushdown space ; Workspace pointers. P0 dw 0 ;beginning of workspace P1 dw 0 ;beginning of marked segment P2 dw 0 ;end of marked segment P3 dw 0 ;end of text P4 dw 0 ;end of workspace WSEG dw 0 ;WS segment address ; Number conversion and arithmetic buffers FRST db 0 ;first character of input string ARG1 dw 0,0 ;8-byte buffer for digit collection ARG1M db 0 ARG1X db 0 ARG1B db 0 ARG1H db 0 ARGHH db 0 DCPT db 0 ;decimal point flag and DDCT db 0 ;decimal digit count BINXPT equ DCPT ARG2 dw 0 ;alternate 8-byte buffer ARG2B dw 0 ARG2M db 0,0,0 ARG2H db 0 DCXPT dw 0 ;decimal exponent DXSG db 0 ;flag for sign of decimal exponent NSIZ db 0 ;operand size in bytes ; I-O pointers. RX dw 0000 RY dw 0000 RSEG dw 0000 FLDES dw 0000 ;source file handle ; Error flag. ER dw 0000 ; Holder for return address from h RTADDR dw 0000 ; ======= here is the table of definitions of REC operators ===== FT dw NOOP ;blank dw NOOP dw RECOP ; [exclm] binary to hex string dw HX dw RECDQ ; " quoted expression dw QU dw RECOP ; # binary to decimal string dw NS dw RECOL ; $ fetch a variable cell dw VBLE dw RECOP ; % restrict to one byte dw PE dw RECOL ; & exchange top numeric pair dw EXCH dw RECSQ ; ' quoted expression dw QU dw RECLP ; ( dw NOOP dw RECRP ; ) dw NOOP dw RECOP ; * multiply dw MPY dw RECOP ; + add dw SUM dw NOOP ; , separator like space dw NOOP dw RECMS ; - subtract dw DIF dw RECDD ; . decimal point dw NU dw RECOP ; / divide [remainder, quotient] dw DVD dw RECDD ; 0 number dw NU dw RECDD ; 1 number dw NU dw RECDD ; 2 number dw NU dw RECDD ; 3 number dw NU dw RECDD ; 4 number dw NU dw RECDD ; 5 number dw NU dw RECDD ; 6 number dw NU dw RECDD ; 7 number dw NU dw RECDD ; 8 number dw NU dw RECDD ; 9 number dw NU dw RECCO ; : dw NOOP dw RECSC ; ; dw NOOP dw RECOP ; < restrict workspace dw BRA dw RECPR ; = test equality of top pair dw EQL dw RECOL ; > open workspace dw KET dw RECPR ; ? test for error report dw QM dw RECP1 ; @ execute subroutine dw AR dw RECPR ; A advance pointer 1 dw UCA dw RECPR ; B retract pointer 1 dw UCB dw RECOP ; C compile dw UCC dw RECOP ; D delete text dw UCD dw RECPL ; E equality between WS and PD dw UCE dw RECPL ; F find specified text dw UCF dw RECOP ; G fetch a block from memory dw GA dw RECPR ; H ASCII hex to binary dw HE dw RECOL ; I insert dw UCI dw RECOL ; J jump to front dw UCJ dw RECOP ; K call CP/M, keep (dx), put value dw CPM dw RECOL ; L erase top of PDL dw UCL dw RECPR ; M compare PDL and workspace dw UCM dw RECPR ; N numerical comparison dw UCN dw RECPR ; O decimal ASCII string to binary dw UCO dw RECOP ; P put block into buffered memory dw UCP dw RECOL ; Q put workspace segment on PD dw UCQ dw RECOP ; R read from keyboard dw UCR dw RECOP ; S store block in memory dw SA dw RECOL ; T write on screen dw UCT dw RECPR ; U search, yielding interval dw UCU dw RECPR ; V U, including endpoints dw UCV dw RECOP ; W write on printer dw UCW dw RECO1 ; X call library operator dw LIBO dw RECPR ; Y recover previous position of p1 dw UCY dw RECOL ; Z pointer 2 to end of text dw UCZ dw RECCM ; [ comment dw NOOP dw RECOP ; \ insert single byte in pair dw IP dw RECOP ; ] dw NOOP dw RECOL ; ^ increment top argument dw INCR dw RECOP ; _ exit to monitor dw boot dw RECPR ; ` true for waiting character dw CHAW dw RECPR ; a segment forward from p1 dw LCA dw RECPR ; b segment backward from p2 dw LCB dw RECOP ; c create block on PDL dw BLOK dw RECPR ; d decrement but skip on zero dw decR dw RECPR ; e extend workspace dw LCE dw RECPR ; f block fill dw LCF dw RECOP ; g non-incrementing byte fetch dw GB dw RECOP ; h store/restore machine state dw MST dw RECOP ; i input from designated port dw LCI dw RECOL ; j null interval at p1 dw LCJ dw RECOP ; k call CP/M: no returned values dw CPML dw RECOP ; l put pz on PDL dw Lcl dw RECOP ; m set aside top argument dw LCM dw RECOL ; n recover set-aside argument dw LCN dw RECOP ; o output from designated port dw LCO dw RECOL ; p put px, py-px on PDL dw GXS dw RECOL ; q put p1, p2-p1 on PDL dw LCQ dw RECOP ; r indirect replacement of address dw IND dw RECOP ; s store block in memory wrt limit dw LCS dw RECOP ; t type out indicated interval dw LCT dw RECOP ; u incrementing byte fetch dw GBI dw RECOP ; v incrementing byte store dw SAI dw RECOP ; w store workspace header dw LCW dw RECP1 ; x call library predicate dw LIBP dw RECOP ; y fetch byte pair to PDL incr org dw GWI dw RECOL ; z null interval at p2 dw LCZ dw LBR ; { start a definition string dw NOOP dw RECOP ; | concatinate top two arguments dw CONC dw RECOP ; } end a definition string dw NOOP dw RECOP ; ~ complement or negate top arg dw COMP dw RECOP ; del dw NOOP ; Table of often-used combinations to compile as single ; operators or predicates. CTB db 'Ez' ;to the right if same dw EZE db 'JZ' ;span text dw SPAN db 'z<' ;null WS at p2 dw ZCL db 'Z>' ;reopen with p2 at end dw ZOP db 'Jj' ;p1 and p2 at p0 dw BEG db 'Z<' ;restrict from p1 to p3 dw UZCL db 'pG' ;duplicate PDL argument dw DUPP db 'ED' ;delete if same dw EDE db 'J>' ;open with p1 at old p0 dw JOP db 'Iz' ;insert and collapse dw IZE db 'jJ' ;p1 and p2 to p0 and p1 dw LJUJ db '><' ;reopen and restrict dw OPCL db '^^' ;increase by 2 dw INTW db 'QD' ;copy and delete dw QUDE db 'FD' ;find and delete dw EFDE db 'nL' ;lift from PDL complement dw ENLF db '&S' ;exch args and store dw XSTO db 'LL' ;lift twice dw LFTW db '$r' ;contents of var cell dw VREP db '$S' ;save in var cell dw VSTO db '&L' ;lift lower dw XLFT db 'qL' ;p1 to PDL dw GTP1 db 'J<' ;restrict from p0 dw JCL db 'I<' ;insert and restrict dw ICL db 'TL' ;type and lift dw UCTL db 'Qm' ;Copy WS to PDL complement dw QUEM dw 0000 ;end-of-table marker QTB db '=',1 ;compare pdl to program const dw QEQL db 'E',1 ;compare WS to program const dw QUCE db 'F',1 ;find program const in WS dw QUCF db 'I',0 ;insert program const in WS dw QUCI db 'M',1 ;program const is upper bd in lex comp dw QUCM db 'U',1 ;find program const in WS, excl bounds dw QUCU db 'V',1 ;find program const in WS, incl bounds dw QUCV dw 0 VT dw 021H dup(?) ;REC-defined subroutine table & vars. STB dw 05FH dup(?) PD dw 0 ;beginning of PDL logo db 0DH,0AH,' REC(8086)/ICUAP',0DH,0AH db 'Universidad Autonoma de Puebla',0DH,0AH db ' September 11, 1990',0DH,0AH,0AH,'$' dlst db 0 pdlist ends ; ============= stack segment STACK org 0000H ;origin of stack segment ; ============= STKB dw 0 STKE dw 0 stack ends ; end