Oakland CPM Archive/oakcpm.iso/cpm/list/ep-src.ark/RUN.MAC

Text File | 1988-05-21 | 26KB | 1,227 lines

    .comment    `
This version of CCC.C is incompatible with the code generated
by the standard version of cc.  It is missing sdei, etc., and
routines are at different addresses.

            `
    .xlist

FALSE    equ    0
TRUE    equ    NOT FALSE
MPM2    equ    FALSE

USERST    equ    FALSE    ;True to use a restart vector for CDB interfacing
RSTNUM    equ    6    ;Use "RST n" as default debugger vector. Has no
            ;effect if USERST is false.
rstloc    equ  RSTNUM*8    ;Memory address where "RST n" vector falls

nfcbs    equ    9    ;maximum # of files open at one time
base    equ    0    ;start of ram in system (either 0 or 4200h)
.bdos    equ    base+5    ;the rest of these do not vary between CP/M systems.
tpa    equ    base+100h
tbuff    equ    base+80h
fcb    equ    base+5ch
origin    equ    tpa
exitad    equ    base    ;warm boot location

cntrlc    equ    3
cr    equ    0dh
lf    equ    0ah
newlin    equ    0ah
errorv    equ    255


conin    equ 1        ;get a character from console
conout    equ 2        ;write a character to console
lstout    equ 5        ;write a character to list device
dconio    equ 6        ;direct console I/O (only for CP/M 2.0)
pstrng    equ 9        ;print string (terminated by '$')
getlin    equ 10        ;get buffered line from console
cstat    equ 11        ;get console status
select    equ 14        ;select disk
openc    equ 15        ;open a file
closec    equ 16        ;close a file
delc    equ 19        ;delete a file
reads    equ 20        ;read a sector (sequential)
;writs    equ 21        ;write a sector (sequential)
creatc    equ 22        ;make a file
renc    equ 23        ;rename file
sdma    equ 26        ;set dma
gsuser    equ 32        ;get/set user code
readr    equ 33        ;read random sector
writr    equ 34        ;write random sector
cfsizc    equ 35        ;compute file size
srrecc    equ 36        ;set random record

    aseg
    org    origin

;
; The "lxi sp,0" instruction at the start of the code is changed by
; CLINK, if the "-t" option is NOT used, into:
;        lhld    base+6
;        sphl
;
; If "-t <addr>" is used, then the sequence becomes:
;        lxi    sp,<addr>
;        nop
;
; If "-n" is used, to indicate no-warm-boot, then the the sequence becomes:
;        jmp    snobsp
;        nop
;

    lxi    sp,0    ;These two instructions change depending on whether
    nop        ;or not the CLINK "-t" or "-n" options are given.

    nop
    nop

    jmp    skpfex    ;skip over the following vector (don't ask...)

fexitv:    jmp    exitad    ;final exit vector. If "-n" used, this
            ;becomes address of the "nobret" routine.

skpfex:    call    init    ;do ARGC & ARGV processing, plus misc. initializations
    call    _main    ;go crunch!!!!
    jmp    vexit    ;close open files and reboot

extrns:    ds    2        ;set by CLINK to external data base address
cccsiz:    dw    _main-origin    ;size of this code (for use by CLINK)
codend:    ds    2        ;set by CLINK to (last addr of code + 1)
freram:    ds    2        ;set by CLINK to (last addr of externals + 1)

;
; Jump vectors to some file i/o utility routines:
;

error:    jmp    verror    ;loads -1 into HL and returns
.exit:    jmp    vexit    ;close all open files and reboot

.close:    jmp    vclose    ;close a file
setfcb:    jmp    vsetfcb    ;set up fcb at HL given filename at DE
fgfd:    jmp    vfgfd    ;return C set if file fd in A not open
fgfcb:    jmp    vfgfcb    ;compute address of internal fcb for fd in A
setfcu:    jmp    vsetfcu    ;set up FCB and process user number prefix
setusr:    jmp    vsetusr ;set user area to upper 5 bits of A, save previous
rstusr:    jmp    vrstusr    ;restore user area to what it was before setusr call
snobsp: jmp    vsnobsp    ;set up SP for non-boot ("-tn") CLINK option
nobret:    jmp    vnobret    ;return to CCP when non-boot ("-tn") in effect.

;khack:    jmp    vkhack    ;Kirkland interrupt vector initialization
    ds    3

clrex:    jmp    vclrex    ;routine to clear external data area

;no    ds    9    ;reserved

;
; The following routines fetch a variable value from either
; the local stack frame or the external area, given the relative
; offset of the datum required immediately following the call;
; for the "long displacement" routines, the offset must be 16 bits,
; for the "short displacement" routines, the offset must be 8 bits.
;(DELETED!!)
;ldei:
;sdei:
;lsei:
;ssei:
;ldli:
;sdli:

;
; Flag conversion routines:
;
;(DELETED!)
;pzinh:
;pnzinh:
;pcinh:
;pncinh:
;ppinh:
;pminh:
;pzind:
;pnzind:
;pcind:
;pncind:
;ppind:
;pmind:

;
; Relational operator routines: take args in DE and HL,
; and return a flag bit either set or reset.
;
; ==, >, < :
;

eqwel:    mov    a,l    ;return Z if HL == DE, else NZ
    cmp    e
    rnz        ;if L <> E, then HL <> DE
    mov    a,h    ;else HL == DE only if H == D
    cmp    d
    ret

blau:    xchg        ;return C if HL < DE, unsigned
albu:    mov    a,d    ;return C if DE < HL, unsigned
    cmp    h
    rnz        ;if D <> H, C is set correctly
    mov    a,e    ;else compare E with L
    cmp    l
    ret

bgau:    xchg        ;return C if HL > DE, unsigned
agbu:    mov    a,h    ;return C if DE > HL, unsigned
    cmp    d
    rnz        ;if H <> D, C is set correctly
    mov    a,l    ;else compare L with E
    cmp    e
    ret

blas:    xchg        ;return C if HL < DE, signed
albs:    mov    a,h    ;return C if DE < HL, signed
    xra    d
    jp    albu    ;if same sign, do unsigned compare
    mov    a,d
    ora    a
    rp        ;else return NC if DE is positive and HL is negative
    stc        ;else set carry, since DE is negative and HL is pos.
    ret

bgas:    xchg        ;return C if HL > DE, signed
agbs:    mov    a,h    ;return C if DE > HL, signed
    xra    d
    jp    agbu    ;if same sign, go do unsigned compare
    mov    a,h
    ora    a
    rp        ;else return NC is HL is positive and DE is negative
    stc
    ret        ;else return C, since HL is neg and DE is pos


;
; Multiplicative operators: *, /, and %:
;

smod:    mov    a,d    ;signed MOD routine: return (DE % HL) in HL
    push    psw    ;save high bit of DE as sign of result
    call    tstn    ;get absolute value of args
    xchg
     call    tstn
    xchg
    call    usmod    ;do unsigned mod
    pop    psw    ;was DE negative?
    ora    a    ;if not,
    rp        ;    all done
    mov    a,h    ;else make result negative
    cma
    mov    h,a
    mov    a,l
    cma
    mov    l,a
    inx    h
    ret

;    nop        ;maintain address compatibility with some
;    nop        ; pre-release v1.4's.

usmod:    mov    a,h    ;unsigned MOD: return (DE % HL) in HL
    ora    l
    rz
    push    d
    push    h
    call    usdiv
    pop    d
    call    usmul
    mov    a,h
    cma
    mov    h,a
    mov    a,l
    cma
    mov    l,a
    inx    h
    pop    d
    dad    d
    ret

smul:    xra    a    ;signed multiply: return (DE * HL) in HL
    sta    tmp
    call    tstn
    xchg
    call    tstn
    call    usmul
smul2:    lda    tmp
    rar
    rnc
    mov    a,h
    cma
    mov    h,a
    mov    a,l
    cma
    mov    l,a
    inx    h
    ret

tstn:    mov    a,h
    ora    a
    rp
    cma
    mov    h,a
    mov    a,l
    cma
    mov    l,a
    inx    h
    lda    tmp
    inr    a
    sta    tmp
    ret

usmul:    push    b    ;unsigned multiply: return (DE * HL) in HL
    call    usm2
    pop    b
    ret

usm2:    mov    b,h
    mov    c,l
    lxi    h,0
usm3:    mov    a,b
    ora    c
    rz
    mov    a,b
    rar
    mov    b,a
    mov    a,c
    rar
    mov    c,a
    jnc    usm4
    dad    d
usm4:    xchg
    dad    h
    xchg
    jmp    usm3

usdiv:    mov    a,h    ;unsigned divide: return (DE / HL) in HL
    ora    l    ;return 0 if HL is 0
    rz
    push    b
    call    usd1
    mov    h,b
    mov    l,c
    pop    b
    ret


usd1:    mvi    b,1
usd2:    mov    a,h
    ora    a
    jm    usd3
    dad    h
    inr    b
    jmp    usd2

usd3:    xchg

usd4:    mov    a,b
    lxi    b,0
usd5:    push    psw
usd6:    call    cmphd
    jc    usd7
    inx    b
    push    d
    mov    a,d
    cma
    mov    d,a
    mov    a,e
    cma
    mov    e,a
    inx    d
    dad    d
    pop    d
usd7:    xra    a
    mov    a,d
    rar
    mov    d,a
    mov    a,e
    rar
    mov    e,a
    pop    psw
    dcr    a
    rz
    push    psw
    mov    a,c
    ral
    mov    c,a
    mov    a,b
    ral
    mov    b,a
    jmp    usd6

sdiv:    xra    a    ;signed divide: return (DE / HL) in HL
    sta    tmp
    call    tstn
    xchg
    call    tstn
    xchg
    call    usdiv
    jmp    smul2

cmphd:    mov    a,h    ;this returns C if HL < DE
    cmp    d    ; (unsigned compare only used
    rc        ;  within C.CCC, not from C)
    rnz
    mov    a,l
    cmp    e
    ret

;
; Shift operators  << and >>:
;

sderbl:    xchg        ;shift DE right by L bits
shlrbe:    inr    e    ;shift HL right by E bits
shrbe2:    dcr    e
    rz
    xra    a
    mov    a,h
    rar
    mov    h,a
    mov    a,l
    rar
    mov    l,a
    jmp    shrbe2

sdelbl:    xchg        ;shift DE left by L bits
shllbe:    inr    e    ;shift HL left by E bits
shlbe2:    dcr    e
    rz
    dad    h
    jmp    shlbe2


;
; Routines to 2's complement HL and DE:
;

cmh:    mov    a,h
    cma
    mov    h,a
    mov    a,l
    cma
    mov    l,a
    inx    h
    ret

cmd:    mov    a,d
    cma
    mov    d,a
    mov    a,e
    cma
    mov    e,a
    inx    d
    ret


;
; The following routines yank a formal parameter value off the stack
; and place it in both HL and A (low byte), assuming the caller
; hasn't done anything to its stack pointer since IT was called.
;(DELETED!)
;ma1toh:
;ma2toh:
;ma3toh:
;ma4toh:
;ma5toh:
;ma6toh:
;ma7toh:
;
; This routine takes the first 7 args on the stack
; and places them contiguously at the "args" ram area.
; This allows a library routine to make one call    to arghak
; and henceforth have all it's args available directly
; through lhld's instead of having to hack the stack as it
; grows and shrinks. Note that arghak should be called as the
; VERY FIRST THING a function does, before even pushing BC.
;(should delete this)
arghak: lxi    d,args
    lxi    h,4    ;pass over two return address
    dad    sp    ;source for block move in HL
    push    b    ;save BC
    mvi    b,14    ;countdown in B
arghk2:    mov    a,m    ;copy loop
    stax    d
    inx    h
    inx    d
    dcr    b
    jnz    arghk2
    pop    b    ;restore BC
    ret

;
; ABSOLUTELY NO CHANGES SHOULD EVER BE MADE TO THE CODE BEFORE
; THIS POINT IN THIS SOURCE FILE (except for customizing the EQU
; statements at the beginning of the file).
;(Well, I did.)


;
; The following two routines are used when the "-tn" CLINK option
; was given, in order to preserve the SP value passed to the transient
; command by the CCP and return to the CCP after execution without
; performing a warm-boot.
;

vsnobsp:
    lxi    h,0        ;get CCP's SP value in HL
    dad    sp
    shld    spsav        ;save it for later
    lhld    base+6        ;get BIOS pointer
    lxi    d,-2100        ;subtract size of CCP plus a fudge
    dad    d
    sphl            ;make that the new SP value
    jmp    tpa+3        ;and get things under way...

vnobret:
    lhld    spsav        ;restore CCP's SP
    sphl
    ret            ;return to CCP



;
; This routine is called first to do argc & argv processing (if
; running under CP/M) and some odds and ends initializations:
;

init:    pop    h    ;store return address
    shld    tmp2    ; somewhere safe for the time being


;room on stack for arglst and comlin and fcbt

    lxi    h,-36*nfcbs
    dad    sp
    shld    .fcbt

    lxi    h,-131 -36*nfcbs
    dad    sp
    shld    .comlin
    lxi    h,-131-60 -36*nfcbs
    dad    sp
    shld    .arglst
    sphl


    nop
    nop
    nop
    nop
    nop
;    nop


    dcx    h
    dcx    h
;this is now arglst-2
;for now, let's keep total bytes the same 'til ram
;=+14
    push    h

            ;Initialize storage allocation pointers:
    lhld    freram    ;get address after end of externals
    shld    allocp    ;store at allocation pointer (for "sbrk.")
;excessive?
;    lxi    h,1000    ;default safety space between stack and
;try 256
;(now a constant)
;-    lxi    h,100H
;-    shld    alocmx    ; highest allocatable address in memory
            ; (for use by "sbrk".).

;(revise lib so don't need this stuff)
            ;Initialize random seed:
;    lxi    h,59dch    ;let's stick something wierd into the
;    shld    rseed    ;first 16 bits of the random-number seed

            ;Initialize I/O hack locations:
;    mvi    a,0dbh        ;"in" op, for "in xx; ret" subroutine
;    sta    iohack
;    mvi    a,0d3h        ;"out" op for "out xx; ret" subroutine
;    sta    iohack+3
;    mvi    a,0c9h        ;"ret" for above sobroutines
;    sta    iohack+2    ;the port number is filled in by the
;    sta    iohack+5    ;"inp" and "outp" library routines.

;    call    khack        ;initialize Kirkland debugger vector

                 ;initialize raw I/O parameters
    xra    a
    sta    freeze        ;clear freeze (^S) flag
    sta    pending        ;no pending input yet
    mvi    a,1fh
    sta    .mode        ;tty mode: all features enabled
    mvi    a,'C'-64
    sta    quitc        ;this is the standard interrupt char


            ;under CP/M: clear console, process ARGC & ARGV:
    mvi    c,cstat ;interrogate console status to see if there
    call    .bdos    ;  happens to be a stray character there...

    ora    a    ;(used to be `ani 1'...they tell me this works
;    nop        ; better for certain bizarre CP/M-"like" systems)

    jz    initzz
    mvi    c,conin   ;if input present, clear it
    call    .bdos

initzz:
    lhld    .comlin
    xchg
    lxi    h,tbuff


;note that we COULD find our own name in CCP conbuf
; if we really wanted it for argv[0]

    mov    b,m        ;first get length of it from loc. base+80h
    inx    h
    mov    a,b
    ora    a    ;if no arguments, don't parse for argv
    jnz    initl
    lxi    d,1    ;set argc to 1 in such a case.
    jmp    i5

initl:    mov    a,m    ;ok, there are arguments. parse...
    stax    d    ;first copy command line to comlin
    inx    h
    inx    d
    dcr    b
    jnz    initl
    xra    a    ;place zero following line
    stax    d

    lhld    .arglst    ;where pointers will all go
    mov    b,h
    mov    c,l
    lhld    .comlin    ;now compute pointers to each arg
    lxi    d,1        ;arg count


    xra    a        ;clear "in a string" flag
    sta    tmp1
i2:    mov    a,m    ;between args...
    inx    h
    cpi    ' '
    jz    i2
    ora    a
    jz    i5    ;if null byte, done with list
    cpi    '"'
    jnz    i2a    ;quote?
    sta    tmp1    ;yes. set "in a string" flag
    jmp    i2b

i2a:    dcx    h
i2b:    mov    a,l    ;ok, HL is a pointer to the start
    stax    b    ;of an arg string. store it.
    inx    b
    mov    a,h
    stax    b
    inx    b
    inx    d    ;bump arg count
i3:    mov    a,m
    inx    h    ;pass over text of this arg
    ora    a    ;if at end, all done
    jz    i5
    push    b    ;if tmp1 set, in a string
    mov    b,a    ; (so we have to ignore spaces)
    lda    tmp1
    ora    a
    mov    a,b
    pop    b
    jz    i3a
    cpi    '"'    ;we are in a string.
    jnz    i3    ;check for terminating quote
    xra    a    ;if found, reset "in string" flag
    sta    tmp1
    dcx    h
    mov    m,a    ;and stick a zero byte after the string
    inx    h    ;and go on to next arg
i3a:    cpi    ' '    ;now find the space between args
    jnz    i3
    dcx    h    ;found it. stick in a zero byte
    mvi    m,0
    inx    h
    jmp    i2    ;and go on to next arg

i5:    push    d    ;all done finding args. Set argc.

    mvi    b,3*nfcbs  ;now initialize all the file info
    lxi    h,fdt    ;by zeroing the fd table)
i6:    mvi    m,0
    inx    h
    dcr    b
    jnz    i6


    call    clrex    ;clear externals, if CLINK -z option NOT used

    xra    a
    sta    ungetl    ;clear the push-back byte,
    sta    errnum    ;and file error code

    lhld    tmp2
    pchl        ;all done initializing.

;
; The following routine gets called to clear the external
; data area, unless the CLINK "-z" option is used.
;

vclrex:    lhld    freram    ;clear externals
    xchg
    lhld    extrns
    call     cmh
    dad    d    ;HL now holds size of external data area
clrex1:    mov     a,h    ;loop till done
    ora    l
    rz
    dcx    d
    dcx    h
    xra    a
    stax    d
    jmp    clrex1


;
; Initialize Kirkland interrupt vector... enables
; programs compiled with "-k" to run without the debugger:
;(DELETED)

;
; General purpose error value return routine:
;

verror:    lxi    h,-1    ;general error handler...just
    ret        ;returns -1 in HL

;
; Here are file I/O handling routines, only needed under CP/M:
;

;
; Close any open files and reboot:
;

vexit:
                ;if under CP/M, close all open files
    mvi    a,7+nfcbs    ;start with largest possible fd
exit1:    push    psw        ;and scan all fd's for open files
    call    vfgfd        ;is file whose fd is in A open?
    jc    exit2        ;if not, go on to next fd
    mov    l,a        ;else close the associated file
    mvi    h,0
    push    h
    call    vclose
    pop    h
exit2:    pop    psw
    dcr    a        ;and go on to next one
    cpi    7
    jnz    exit1

    jmp    fexitv        ;done closing...now return
                ; to CP/M or whatever.


;
; Close the file whose fd is 1st arg:
;

vclose:
;    call    ma1toh    ;get fd in A
    pop    d
    pop    h
    mov    a,l
    push    h
    push    d
    sta    ..fd

    call    vfgfd    ;see if it is open
    jc    verror    ;if not, complain
    mov    a,m
    call    setusr    ;set user area to match current fd
    ani    4    ;check if open for writing


    IF NOT MPM2    ;if not MP/M, and
    jz    close2    ;the file isn't open for write, don't bother to close
    ENDIF


    push    h    ;save fd table entry addr

;    call    ma2toh    ;get the fd in A again
    lda    ..fd

    push    b
    call    vfgfcb    ;get the appropriate fcb address
    xchg        ;put it in DE
    mvi    c,closec  ;get BDOS function # for close
    call    .bdos    ;and do it!
    pop    b
    pop    h
close2:    call    rstusr    ;reset user number to original state
    mvi    m,0    ;close the file logically
    cpi    255    ;if 255 came back from .bdos, we got problems
    lxi    h,0
    rnz        ;return 0 if OK
    dcx    h    ;return -1 on error
    ret

..fd:    ds    1
;
; Determine status of file whose fd is in A...if the file
; is open, return Cy clear and with the address of the fd table
; entry for the open file in HL. If the file is not open,
; return Cy set:
;

vfgfd:    mov    d,a
    sui    8
    rc        ;if fd < 8, error
    cpi    nfcbs
    cmc        ;don't allow too big an fd either
    rc
    push    d
    mov    e,a    ;OK, we have a value in range. Now
    mvi    d,0    ;  see if the file is open or not
    lxi    h,fdt
    dad    d    ;offset for 3-byte table entries
    dad    d
    dad    d
    mov    a,m
    ani    1    ;bit 0 is high if file is open
    stc
    pop    d
    mov    a,d
    rz        ;return C set if not open
    cmc
    ret        ;else reset C and return

;
; Set up a CP/M file control block at HL with the file whose
; simple null-terminated name is pointed to by DE:
; Format for filename must be: "[white space][d:]filename.ext"
; The user number prefix hack is NOT recognized by this subroutine.
;

vsetfcb:
    push    b
    call    igwsp    ;ignore blanks and tabs
    push    h    ;save fcb ptr
    inx    d    ;peek at 2nd char of filename
    ldax    d
    dcx    d
    cpi    ':'    ;default disk byte value is 0
    mvi    a,0    ; (for currently logged disk)
    jnz    setf1
    ldax    d    ;oh oh...we have a disk designator
    call    mapuc    ;make it upper case
    sui    'A'-1    ;and fudge it a bit
    inx    d    ;advance DE past disk designator to filename
    inx    d
setf1:    mov    m,a    ;set disk byte
    inx    h
    mvi    b,8
    call    setnm    ;set filename, pad with blanks
    call    setnm3    ;ignore extra characters in filename
    ldax    d
    cpi    '.'    ;if an extension is given,
    jnz    setf2
    inx    d    ;skip the '.'
setf2:    mvi    b,3
    call    setnm    ;set the extension field and pad with blanks
    xra    a    ;and zero the appropriate fields of the fcb
    mov    m,a
    lxi    d,20
    dad    d
    mov    m,a
    inx    h
    mov    m,a    ;zero random record bytes of fcb
    inx    h
    mov    m,a
    inx    h
    mov    m,a
    pop    d
    pop    b
    ret

;
; This routine copies up to B characters from (DE) to (HL),
; padding with blanks on the right. An asterisk causes the rest
; of the field to be padded with '?' characters:
;

setnm:    push    b
setnm1:    ldax    d
    cpi    '*'    ;wild card?
    mvi    a,'?'    ;if so, pad with ? characters
    jz    pad2

setnm2:    ldax    d
    call    legfc    ;next char legal filename char?
    jc    pad    ;if not, go pad for total of B characters
    mov    m,a    ;else store
    inx    h
    inx    d
    dcr    b
    jnz    setnm1    ;and go for more if B not yet zero
    pop    b
setnm3:    ldax    d    ;skip rest of filename if B chars already found
    call    legfc
    rc
    inx    d
    jmp    setnm3

pad:    mvi    a,' '    ;pad with B blanks
pad2:    mov    m,a    ;pad with B instances of char in A
    inx    h
    dcr    b
    jnz    pad2
    pop    b
    ret

;
; Process filename having optional user area number prefix of form "<u#>/",
; return the effective user area number of the given filename in the upper
; 5 bits of A, and also store this value at "usrnum". Note that if no user
; number is specified, the current user area is presumed by default. After
; the user area prefix is processed, do a regular "setfcb":
;
; Note: a filename is considered to have a user number if the first char
;     in the name is a decimal digit and the first non-decimal-digit
;    character in the name is a slash (/).

vsetfcu:
    push    b    ;save BC
    push    h    ;save vcb pointer
    call    igwsp    ;ignore blanks and tabs
    call    isdec    ;decimal digit?
    jnc    setfc2    ;if so, go process

setfc0:    push    d    ;save text pointer
    mvi    c,gsuser  ;else get current effective user number
    mvi    e,0ffh

    call    .bdos    ;get current user area if implemented

    pop    d    ;restore text pointer

setfc1:    rlc        ;rotate into upper 5 bits of A
    rlc
    rlc
    sta    usrnum    ;and save
    pop    h    ;restore junk
    pop    b
    jmp    setfcb    ;and parse rest of filename

setfc2:    mvi    b,0    ;clear user number counter
    push    d    ;save text pointer in case we invalidate user prefix
setfc3:    sui    '0'    ;save next digit value
    mov    c,a    ; in C
    mov    a,b    ;multiply previous sum by 10
    add    a    ;*2
    add    a    ;*4
    add    a    ;*8
    add    b    ;*9
    add    b    ;*10
    add    c    ;add new digit
    mov    b,a    ;put sum in B
    inx    d    ;look at next char in text
    ldax    d    ;is it a digit?
    call    isdec
    jnc    setfc3    ;if so, go on looping and summing digits
    cpi    '/'    ;make sure number is terminated by a slash
    jz    setfc4
    pop    d    ;if not, entire number prefix is not really a
    jmp    setfc0    ; user number, so just ignore it all.

setfc4:    inx    d    ;ok, allow the user number
    pop    h    ;get old text pointer off the stack
    mov    a,b    ;get user number value
    jmp    setfc1    ;and go store it and parse rest of filename


;
; Test if char in A is legal character to be in a filename:
;

legfc:    call    mapuc
    cpi    '.'    ; '.' is illegal in a filename or extension
    stc
    rz
    cpi    ':'    ;so is ':'
    stc
    rz
    cpi    7fh    ;delete is no good
    stc
    rz
    cpi    '!'    ;if less than exclamation pt, not legal char
    ret        ;else good enough

;
; Map character in A to upper case if it is lower case:
;

mapuc:    cpi    'a'
    rc
    cpi    'z'+1
    rnc
    sui    32    ;if lower case, map to upper
    ret

;
; Ignore blanks and tabs at text pointed to by DE:
;

igwsp:    dcx    d
igwsp1:    inx    d
    ldax    d
    cpi    ' '
    jz    igwsp1
    cpi    9
    jz    igwsp1
    ret

;
; Return Cy if char in A is not a decimal digit:
;

isdec:    cpi    '0'
    rc
    cpi    '9'+1
    cmc
    ret


;
; This routine does one of two things, depending
; on the value passed in A.
;
; If A is zero, then it finds a free file slot
;  (if possible), else returns C set.
;
; If A is non-zero, then it returns the address
; of the fcb corresponding to an open file whose
; fd happens to be the value in A, or C set if there
; is no file associated with fd.
;

vfgfcb:    push    b
    ora    a    ;look for free slot?
    mov    c,a
    jnz    fgfc2    ;if not, go away
    mvi    b,nfcbs    ;yes. do it...
    lxi    d,fdt
;    lxi    h,fcbt
    lhld    .fcbt
    mvi    c,8
fgfc1:    ldax    d
    ani    1
    mov    a,c
    jnz    fgfc1a    ;found free slot?
    pop    b    ;yes. all done.
    ret

fgfc1a:    push    d
    lxi    d,36    ;fcb length to accommodate random I/O
    dad    d
    pop    d
    inx    d    ;bump to next 3-byte table entry
    inx    d
    inx    d
    inr    c
    dcr    b
    jnz    fgfc1
fgfc1b:    stc
    pop    b
    ret        ;return C if no more free slots

fgfc2:    call    vfgfd    ;compute fcb address for fd in A:
    jc    fgfc1b    ;return C if file isn't open

    sui    8
    mov    l,a    ;put (fd-8) in HL
    mvi    h,0
    dad    h    ;double it
    dad    h    ;4*a
    mov    d,h    ;save 4*a in DE
    mov    e,l
    dad    h    ;8*a
    dad    h    ;16*a
    dad    h    ;32*a
    dad    d    ;36*a
    xchg        ;put 36*a in DE
;-    lxi    h,fcbt    ;add to base of table
    lhld    .fcbt
    dad    d    ;result in HL
    mov    a,c    ;and return original fd in A
    pop    b
    ret

;
; The following two subroutines change the current CP/M user area for
; user with file I/O:
;

vsetusr:
    push    b    ;SET user number to upper bits of A, save current:
    push    h
    push    d
    push    psw    ;save A
    mvi    c,gsuser ;get user code
    mvi    e,0ffh
    call    .bdos
    sta    curusr    ;save current user number
    pop    psw    ;get new user number byte
    push    psw
    rar        ;shift user number down to low bits
    rar
    rar
    ani    1fh    ;and mask off high order garbage
setu0:    mov    e,a
    mvi    c,gsuser  ;set user code
    call    .bdos
    pop    psw
    pop    d
    pop    h
    pop    b
    ret

vrstusr:
    push    b
    push    h
    push    d
    push    psw
    lda    curusr    ;get last saved user number
    jmp    setu0    ;and go set current user area to that

;
; Ram area:
;

ram    equ    $

;no    ds    20    ;reserved by BDS

errnum:    ds    1    ;error code from file I/O operations
;pbase:    ds    2    ;screen-DMA address
;ysize:    ds    2    ;screen width
;xsize:    ds    2    ;screen height
;psize:    ds    2    ;screen length

;rseed:    ds    8    ;the random generator seed


args:
arg1:    ds    2
arg2:    ds    2
arg3:    ds    2
arg4:    ds    2
arg5:    ds    2
arg6:    ds    2
arg7:    ds    2
            ;"arghak" puts args passed on stack here.

;iohack:    ds    6    ;room for I/O subroutines for use by "inp"
            ;and "outp" library routines

allocp:    ds    2    ;pointer to free storage for use by "sbrk" func
alocmx:    dw    100H    ;highest location to be made available to the
            ;storage allocator

;room:    ds    30    ;reserved for use by BDS C system code
;uroom:    ds    20    ;available for use by user

    .comment    `
(Too much garbage here)
tmp    equ    room    ;this is misc. garbage space
tmp1    equ    room+1
tmp2    equ    room+2
tmp2a    equ    room+4
ungetl    equ    room+6    ;where characters are "ungotten"
unused    equ    room+7
curusr    equ    room+8    ;used to save current user number during file I/O
usrnum    equ    room+9    ;set by "setfcu" to user number of given filename

.mode    equ    room+10    ;tty mode
freeze    equ    room+11    ;true if output frozen (^S)
pending equ    room+12    ;true if input character waiting
pendch    equ    room+13    ;if pending true, this is the character
quitc    equ    room+14    ;the general system abort character (^C usually)
spsav    equ    room+15    ;saved SP value from CCP
;    equ    room+17    ;where next thing goes

            `


tmp:    ds    1    ;this is misc. garbage space
tmp1:    ds    1
tmp2:    ds    2
tmp2a:    ds    2
ungetl:    ds    1    ;where characters are "ungotten"
;unused
curusr:    ds    1    ;used to save current user number during file I/O
usrnum:    ds    1    ;set by "setfcu" to user number of given filename

.mode:    ds    1    ;tty mode
freeze:    ds    1    ;true if output frozen (^S)
pending:ds    1    ;true if input character waiting
pendch:    ds    1    ;if pending true, this is the character
quitc:    ds    1    ;the general system abort character (^C usually)
spsav:    ds    2    ;saved SP value from CCP


echo    equ    1    ;masks for "mode" byte...echo mode
quit    equ    2    ;quit enabled
flow    equ    4    ;^S/^Q protocol honored
strip    equ    8    ;strip parity
expand    equ    16    ;expand '\n' into CR-LF on output

;
;--------------------------------------------------------------------------
;
; The fcb table (fcbt): 36 bytes per file control block
;

;fcbt:    ds    36*nfcbs    ;reserve room for fcb's (extra byte for IMDOS)


;
; The fd table: one byte per file specifying r/w/open as follows:
;     bit 0 is high if open, low if closed
;     bit 1 is high if open for read
;     bit 2 is high if open for write     (both b1 and b2 may be high)
;    bits 3-7 contain the user number in which the file is active (0-31)
;

fdt:    ds    3*nfcbs    ;3 bytes per fcb: 1 for active, r/w, etc., and
            ;          2 to specify highest sector num seen

;
; The command line is copied here by init:
;

;
; End of CP/M-only data area
;---------------------------------------------------------------------------

.fcbt:        ds    2
.comlin:    ds    2
.arglst:    ds    2

_main    equ    $    ;where "main" program will be loaded under CP/M

    .list

    end