Programmer 7500/MAX_PROGRAMMERS.iso/INFO/MISC/REC.ZIP/FXT86F.ASM

Assembly Source File | 1986-02-04 | 32.5 KB | 1,422 lines

;    =======================================================
;
;    REC module containing RAM storage, I/O programs, main
;    program, and the directory. The complete set of modules
;    comprises REC.MAC, PDL.MAC, MARKOV.MAC, RECLIB.MAC, and
;    FXT.MAC.  RECLIB.MAC may be omitted if the operator X
;    isn't used, and must be substituted by another module
;    if the collection of subroutines to be called by X is
;    to be changed.
;
;    FXT.MAC 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:
;        `    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.
;    ------------------------------------------------------
;
;         FXT86  -  Copyright (C) 1982, 1984
;            Universidad Autonoma de Puebla
;        49 Poniente 1102 -  Puebla, Puebla, Mexico
;            All Rights Reserved
;
;        [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)
;    April 1984 - Disposable initialization code - GCS
;    9 May 1984 - Arguments of C reversed (GCS)
;    31 May 1984 - Cp, PD and WS ovfl cause termination - 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
;    15 Aug 1984 - Operator pair table extended - GCS
;    29 Jun 1985 - word-sized entries in var/sub tbl; x in. GCS
;    6 Jul 1985 - Version for MS-DOS. - GCS
;    29 Jul 1985 - 0<adr>C leaves <adr>,C2-<adr> on PDL- GCS
;    8 Aug 1985 - Qm added to pair table - GCS
;    2 Feb 1986 - overflow handling, i fixed - GCS
;    =======================================================

;    Absolute program locations used by CP/M.


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:                ;space holder
    DB    0E4H        ;8-bit 8086 static IN instruction
QI    db    00H
    ret

QOU:                ;space holder
    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
chi:    mov    dl,-1
    mov    ah,6
    int    bdos
    test    al,al
    jz    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 CP/M takes two forms:  <FCB, n, K>
;    which leaves <FCB, code> on the pushdown list, or else
;    <FCB, n, k> which leaves nothing on the pushdown list.
;    In either case - FCB is a two-byte parameter, usually
;    the address of the file control block - but it could
;    also be a DMA address or sometimes even null for the
;    sake of uniformity.  Approximately thirty options are
;    available which are numbered serially, indicated by the
;    argument n.  The difference between K and k is that the
;    former conserves the parameter FCB for possible use by
;    a subsequent CP/M call, and reports a result in the
;    one-byte result <code>.  This could be the character
;    read by an input routine or an error code for the disk
;    routines.
;
;    The options are:
;
;    num    function        "FCB"    "code"
;    ---    --------        -----    ------
;
;    0    system reset        -    -
;    1    read console        -    char
;    2    write console        char    -
;    3    read reader        -    char
;    4    write punch        char    -
;    5    write list        char    -
;    6    -            -    -
;    7    read i/o stat        -    stat
;    8    write i/ stat        stat    -
;    9    print buffer        buffer    -
;    10    read buffer        buffer    -
;    11    console status        -    stat
;
;    12    lift disk head        -    -
;    13    init disk only        -    -
;    14    select disk        disk    -
;    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    read 1 record        fcb    code
;    21    write 1 record        fcb    code
;    22    create file        fcb    code
;    23    rename file        fcb    code
;    24    read login        -    logv
;    25    read disklog        -    disk
;    26    set DMA address     dma    -
;    27    read bitmap        -    -
;
;    Fuller details of all the CP/M options and the way they
;    function can be obtained through consulting Digital
;    Research's manuals for CP/M, especially their "CP/M
;    Interface Guide."
;
;    =======================================================

;    (K)  Set up communication with CP/M - top into (bx),
;    next into (dx).  Preserve next, call BDOS, (Aze) into
;    top.

CPM:    call    DXLD        ;fetch function number and lift
    mov    cx,dx        ;move it to cx
    call    ESLD        ;get FCB org and segment
    mov    dx,[bx]        ;FCB offset to dx
;    cmp    cx,26        ;is it 'set DMA addr'?
;    jnz    CPM1
;    call    CPSG        ;yes, set DMA base first
CPM1:    push    ds        ;save current data seg base
    mov    ah,cl
    mov    cx,es
    mov    ds,cx        ;set ds to FCB's segment
    int    bdos        ;call bdos with args in cx, dx
    pop    ds        ;restore data segment base
    mov    ah,0        ;clear upper half of ax
    push    ax        ;save it on 8086 stack
    call    PUTW        ;transfer to PDL
    ret

;    (k)  Call to CP/M without any value returned.

CPML:    mov    bx,PX        ;fetch argument pointer
    call    ONEL        ;function number to 8086 stack
    call    CXLD        ;FCB org and segment to cx and es
    mov    dx,cx        ;we want org in dx
    pop    cx        ;get function number into cx
;    cmp    cx,26        ;is it 'set DMA base'?
;    jnz    CPML1        ;no, skip
;CPML0:    call    CPSG        ;yes, set DMA base
CPML1:    push    ds        ;save data segment base
    mov    ah,cl
    mov    cx,es
    mov    ds,cx        ;set FCB segment base
    int    bdos        ;execute indicated operation
    pop    ds        ;restore data segment base
    ret

;CPSG:    push    es
;    push    cx
;    push    dx
;    mov    ah,51        ;(33H) set DMA base
;    mov    dx,es        ;the segment base itself
;    int    bdos
;    pop    dx
;    pop    cx
;    pop    es
;    ret


;    -------------------------------------------------------
;    Disk input-output routine working through CP/M.
;    -------------------------------------------------------

;    Set up a file control block with a given file name and
;    the default extension REC.  The pushdown list contains
;    the disk unit designation, then by the filename without
;    any extension. No protection is afforded against an
;    overly long file name, a nonexistent disk, or the like.
;    Some errors of this type must be caught by CP/M since
;    REC cannot know such things as the exact number of disk
;    drives that there will be.

DIIN:    cld
    mov    ax,ds
    mov    es,ax
    mov    cx,11        ;filename field is 11 bytes long
    mov    di,(offset TFCB)+1    ;field begins at second byte
    mov    al,' '        ;fill it with blanks
    repnz    stosb
    mov    bx,PX        ;fetch pointer to top argument
    mov    al,[bx]        ;load disk unit designator
    sub    al,'@'        ;set CP/M disk numbering convention
    mov    TFCB,al        ;store it in file control block
    call    UCL        ;pop top argument
    mov    si,PX        ;fetch pointer to file name
    mov    cx,PY        ;end of file name
    sub    cx,si        ;place py - px in (cx)
    mov    di,(offset TFCB)+1    ;destination origin
    repnz    movsb
CPIN:    cmp    byte ptr TFCB+9,' '
    jnz    CPIN2
    mov    byte ptr TFCB+9,'R'    ;set default extension 'REC'
    mov    byte ptr TFCB+10,'E'
    mov    byte ptr TFCB+11,'C'
CPIN2:    mov    dx,(offset TBUF)    ;origin of CP/M's sector buffer
    mov    RSEG,ds        ;CP/M's buffer is in the data seg
    mov    RX,dx        ;initial address of pseudotty
    mov    RY,dx        ;provoke disk read
    mov    es,RSEG        ;set DMA address and base
    mov    cx,26
    call    CPML1
;    call    CPML0
    mov    cx,15H        ;clear tail of FCB before opening
    mov    di,(offset TFCB)+12
    mov    al,00H
    repnz    stosb
    mov    ah,15        ;<open file>
    mov    dx,(offset TFCB)    ;file control block
    int    bdos        ;
    cmp    al,0FFH    ;check for error
    jz    CPIR
    ret
CPIR:    jmp    boot

;    Read from disk buffer, replenish buffer when empty.

DIRE:    push    bx        ;save 3 8080 register pairs
    push    dx        ;
    push    cx        ;
    mov    bx,RX        ;pointer to current byte
    cmp    bx,RY        ;skip if equal
    jnz    DI5        ;still have bytes in the buffer
    mov    ah,20        ;<read next record>
    mov    dx,(offset TFCB)    ;file control block
    int    bdos        ;
    test    al,al
    jnz    dier        ;quit if read not OK
    mov    bx,(offset TBUF)+TSIZ    ;end of buffer
    mov    RY,bx        ;store it in ry
    mov    bx,(offset TBUF)    ;beginning of buffer
    mov    RX,bx        ;store it in rx
DI5:    mov    al,[bx]        ;common continuation
    inc    bx        ;byte in acc, advance pointer
    mov    RX,bx        ;store position of next byte
    pop    cx        ;replace 3 register pairs
    pop    dx        ;
    pop    bx        ;
    ret
dier:    mov    bx,'dR'        ;report RD ovfl and quit
    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    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        ;code segment base to stack
    push    C1        ;origin on stack
    call    PUTW        ;C1 on the PDL
    call    PUTW        ;cs too
    call    CONC        ;make a single argument
    jmp    short UC9    ;then to the PDL
UC1:    call    DIIN        ;setup the CP/M FCB for given file
    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

;    (X)  noop in this version

LIBO:    ret


;    Single-shot compilation from a disk file

SSHOT:    call    EMCX        ;compile the program file
    mov    dx,(offset TFCB)
    mov    ah,16        ;close the file
    int    bdos
    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    bx,es:P1
    mov    cl,[bx]
    inc    cx
    mov    di,(offset TBUF)
    mov    si,bx
    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

tylo:    call    STATS        ;type out memory usage stats
nodi:    call    bure
    call    INRE
    call    EMCX
    call    EMCU
    jmp    short nodi
    nop
    jmp    nodi

;    Report space overflows and quit

FERR:    mov    EMSG,bx
    mov    dx,(offset EMSGS)
    mov    ah,9
    int    bdos
    jmp    boot

;    END OF PERMANENT CODE.  THE INSTRUCTIONS FOLLOWING THIS
;    WILL BE OVERWRITTEN AS SOON AS THE FIRST REC PROGRAM
;    IS COMPILED.

ENDREC:

;    ================
;    = main program =
;    ================


MAIN:    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,05FH        ;number of subroutine entries
;    mov    bx,cs
    mov    ax,(offset boot)    ;CP/M exit routine
;vtc0:    stosw            ;store boot routine address
    repnz    stosw
;    xchg    ax,bx
;    stosw            ;store segment base
;    xchg    ax,bx
;    loop    vtc0
    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 one 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:    shl    ax,cl
    cli
    mov    sp,ax
    mov    ax,es
    mov    ss,ax
    sti
    mov    dx,offset boot
    push    dx
    cmp    byte ptr 05BH[bx],' '
    jnz    majn
    jmp    tylo        ;to TTY: loop if command tail empty
majn:    call    svcmb
    call    CPIN        ;open disk file for REC program
    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

svcmb:    cld
    mov    bx,(offset TBUF)    ;pointer to command buffer
    mov    di,P1    ;next byte of WS
    mov    cl,[bx]    ;get count
    inc    cl    ;plus one to include count itself
    mov    ch,0
    mov    si,bx
    mov    es,WSEG    ;load ES with WS base
mb0:    lodsb
    cmp    al,'a'    ;fold upper into lowercase
    jb    mb1
    cmp    al,'z'
    ja    mb1
    sub    al,32
mb1:    stosb
    loop    mb0
    mov    P3,di
    mov    bx,P1
    inc    bx
    mov    P1,bx
    mov    P2,bx
    mov    ax,ds
    mov    es,ax
    call    fica
    call    UCD    ;delete first name including its terminator
    mov    di,P3    ;save parsed filenames at p3 and following
    mov    es,WSEG    ;reload ES with WS base
    call    ficb
    call    ficb
    mov    bx,P0
    mov    P1,bx    ;p1 back to start of text
    ret

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.

fica:    mov    di,(offset TFCB)
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    cmerr    ;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

;    command line error

cmerr:    mov    al,'?'
    call    CHOU    ;type a question mark
    pop    bx    ;pop rets from call zsep,
    pop    bx    ;call fsep/ffil,
    pop    bx    ;call fica/b and
    pop    bx    ;call svcmb
    mov    bx,P0    ;restore workspace pointers
    mov    P1,bx
    mov    P2,bx
    mov    P3,bx

STATS:    mov    ah,9        ;(09) write message
    mov    dx,(offset logo)
    int    bdos
    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    05CH 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    ' ovfl$'

;    Prompt and crlf

bume    db    0DH,0AH,'REC86F> $'
crlf    db    0DH,0AH,'$'

;    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


;    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

;    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

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    '       February 2, 1986',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