Subversion Repositories NedoOS

PRESRV  EQU     TRUE    ;True to preserve CRL-file address compatibility
                        ;       under various ZOPT1-ZOPT7 configurations
                        ;(changing to FALSE will shorten run-time pkg., but
                        ;will require re-CASM-ing .CSM files for new DEFF2.CRL)

USAREA  EQU     FALSE;TRUE      ;True if "user areas" are implemented on target system

USERST  EQU     FALSE   ;True to use a restart vector for CDB interfacing
RSTNUM  EQU     6       ;Use "RST n" as default CDB vector (if USERST true)
                        ;(If used, be sure corresponding ZOPTn below is FALSE)
rstloc  equ    RSTNUM*8 ;physical address of debugger restart vector

ZOPT1   EQU     FALSE   ;The following five equates control the
ZOPT2   EQU     FALSE   ;initialization of restart vectors 1 through 7
ZOPT3   EQU     FALSE   ;(rst 1 - rst 7) for use by C programs to achieve
ZOPT4   EQU     FALSE   ;optimum space efficiency. If any of these vectors are
ZOPT5   EQU     FALSE   ;used by your system for I/O, set them FALSE here!
ZOPT6   EQU     FALSE   ; (set FALSE if CDB w/RST 6 is to be used with object.)
ZOPT7   EQU     FALSE   ; (set FALSE if DDT or SID are to be used with object.)

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

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

        nop
        nop

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

fexitv: jp      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!!!!
        jp      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:  jp      verror  ;loads -1 into HL and returns
exit:   jp      vexit   ;close all open files and reboot

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

        IF      NOT CPM ;if not under CP/M, file I/O routines
        jp      verror  ;are not used.
        jp      verror
        jp      verror
        jp      verror
        jp      verror
        jp      verror
        jp      verror
        jp      verror
        jp      verror
        jp      verror
        ENDIF

clrex:  jp      vclrex  ;routine to clear external data area

        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.
;

;
; long-displacement, double-byte external indirection:
;
;       format: call ldei               ; get 16-bit value in HL
;               dw offset_from_extrns   ; >= 256
;

ldei:   pop hl  ;get address of offset
        ld      e,(hl)  ;put offset in DE
        inc hl
        ld      d,(hl)
        inc hl          
        push hl ;save return address
        lhld    extrns  ;add offset to external area base
        add hl,de
mindir: ld      a,(hl)  ;and get the value into HL
        inc hl
        ld      h,(hl)
        ld      l,a
        ret

;
; short-displacement, double-byte external indirection:
;
;       format:         call sdei               ; get 16-bit value in L
;                       db offset_from_extrns   ; < 256
;

sdei:   pop hl
        ld      e,(hl)
        inc hl
        push hl
        ld      d,0
        lhld    extrns
        add hl,de
        ld      a,(hl)
        inc hl
        ld      h,(hl)
        ld      l,a
        ret

;
; long-displacement, single-byte external indirection:
;
;       format:         call    lsei            ; get 8-bit value in L
;                       dw offset_from_extrns   ; >= 256
;

lsei:   pop hl
        ld      e,(hl)
        inc hl
        ld      d,(hl)
        inc hl
        push hl
        lhld    extrns
        add hl,de
        ld      l,(hl)
        ret

;
; short-displacement, single-byte external indirection:
;
;       format:         call    ssei            ; get 8-bit value in L
;                       db offset_from_externs  ; < 256
;

ssei:   pop hl
        ld      e,(hl)  
        inc hl
        push hl
        ld      d,0
        lhld    extrns
        add hl,de
        ld      l,(hl)
        ret

;
; long-displacement, double-byte local indirection:
;
;       format:         call    ldli            ; get 16-bit value in HL
;                       dw offset_from_BC       ; >= 256
;

ldli:   pop hl
        ld      e,(hl)
        inc hl
        ld      d,(hl)
        inc hl
        push hl
        ex de,hl
        add hl,bc
        ld      a,(hl)
        inc hl
        ld      h,(hl)
        ld      l,a
        ret

;
; short-displacement, double-byte local indirection:
;
;       format:         call    sdli            ; get 16-bit value in HL
;                       db offset_from_BC       ; < 256
;

sdli:   pop hl
        ld      e,(hl)
        inc hl
        push hl
        ex de,hl
        ld      h,0
        add hl,bc
        ld      a,(hl)
        inc hl
        ld      h,(hl)
        ld      l,a
        ret

;
; Flag conversion routines:
;

pzinh:  ld hl,1 ;return HL = true if Z set
        ret z
        dec hl
        ret

pnzinh: ld hl,0 ;return HL = false if Z set
        ret z
        inc hl
        ret

pcinh:  ld hl,1 ;return HL = true if C set
        ret c
        dec hl
        ret

pncinh: ld hl,0 ;return HL = false if C set
        ret c
        inc hl
        ret

ppinh:  ld hl,1 ;return HL = true if P (plus) flag set
        ret p
        dec hl
        ret

pminh:  ld hl,1 ;return HL = true if M (minus) flag set
        ret m
        dec hl
        ret

pzind:  ld de,1 ;return DE = true if Z set
        ret z
        dec de
        ret

pnzind: ld de,0 ;return DE = false if Z set
        ret z
        inc de
        ret

pcind:  ld de,1 ;return DE = true if C set
        ret c
        dec de
        ret

pncind: ld de,0 ;return DE = false if C set
        ret c
        inc de
        ret

ppind:  ld de,1 ;return DE = true if P (plus) flag set
        ret p
        dec de
        ret

pmind:  ld de,1 ;return DE = true if M (minus) flag set
        ret m
        dec de
        ret
        

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

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

blau:   ex de,hl                ;return C if HL < DE, unsigned
albu:   ld      a,d     ;return C if DE < HL, unsigned
        cp      h
        ret nz          ;if D <> H, C is set correctly
        ld      a,e     ;else compare E with L
        cp      l
        ret

bgau:   ex de,hl                ;return C if HL > DE, unsigned
agbu:   ld      a,h     ;return C if DE > HL, unsigned
        cp      d
        ret nz          ;if H <> D, C is set correctly
        ld      a,l     ;else compare L with E
        cp      e
        ret

blas:   ex de,hl                ;return C if HL < DE, signed
albs:   ld      a,h     ;return C if DE < HL, signed
        xor     d
        jp      p,albu  ;if same sign, do unsigned compare
        ld      a,d
        or      a
        ret p           ;else return NC if DE is positive and HL is negative
        scf             ;else set carry, since DE is negative and HL is pos.
        ret

bgas:   ex de,hl                ;return C if HL > DE, signed
agbs:   ld      a,h     ;return C if DE > HL, signed
        xor     d
        jp      p,agbu  ;if same sign, go do unsigned compare
        ld      a,h
        or      a
        ret p           ;else return NC is HL is positive and DE is negative
        scf
        ret             ;else return C, since HL is neg and DE is pos


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

smod:   ld      a,d     ;signed MOD routine: return (DE % HL) in HL
        push    af      ;save high bit of DE as sign of result
        call    tstn    ;get absolute value of args
        ex de,hl
        call    tstn
        ex de,hl
        call    usmod   ;do unsigned mod
        pop     af      ;was DE negative?
        or      a       ;if not,
        ret p           ;       all done
        ld      a,h     ;else make result negative
        cpl
        ld      h,a
        ld      a,l
        cpl
        ld      l,a
        inc hl
        ret

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

usmod:  ld      a,h     ;unsigned MOD: return (DE % HL) in HL
        or      l
        ret z
        push de
        push hl
        call    usdiv
        pop de
        call    usmul
        ld      a,h
        cpl
        ld      h,a
        ld      a,l
        cpl 
        ld      l,a
        inc hl
        pop de
        add hl,de
        ret

smul:   jp      usmul   ;turns out signed and unsigned multipilication
                        ; are equivalent for 16 bits, so just do unsigned

                        ;rst optimization of function entry sequence (ZOPT1):
fentrc: pop de  ;pop  arg byte address into DE
        push    bc      ;save BC
        ld a,(de)       ;put stack offset byte value into L, setting up
        ld      l,a     ;       HL with negative stack offset
        ld      h,0ffh
        inc de  ;DE now points to return address
        add hl,sp       ;calculate new SP value
        ld sp,hl                ;set new SP value
        ld      b,h     ;place into BC as new frame base ptr
        ld      c,l     
        ex de,hl                ;put return address in HL
        jp (hl)         ;and return
        

smul2:  lda     tmp
        rra
        ret nc
        jp      cmh

        ds      3       ;preserve address compatibility with previous versions

tstn:   ld      a,h
        or      a
        ret p
        cpl
        ld      h,a
        ld      a,l
        cpl
        ld      l,a
        inc hl
        lda     tmp
        inc     a
        sta     tmp
        ret

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

usm2:   ld      b,h
        ld      c,l
        ld hl,0
usm3:   ld      a,b
        or      c
        ret z
        ld      a,b
        rra
        ld      b,a
        ld      a,c
        rra
        ld      c,a
        jp nc,usm4
        add hl,de
usm4:   ex de,hl
        add hl,hl
        ex de,hl
        jp      usm3

usdiv:  ld      a,h     ;unsigned divide: return (DE / HL) in HL
        or      l       ;return 0 if HL is 0
        ret z
        push bc
        call    usd1
        ld      h,b
        ld      l,c
        pop bc
        ret


usd1:   ld      b,1
usd2:   ld      a,h
        or      a
        jp m,usd3
        add hl,hl
        inc     b
        jp      usd2

usd3:   ex de,hl

usd4:   ld      a,b
        ld bc,0
usd5:   push    af
usd6:   call    cmphd
        jp c,usd7
        inc bc
        push de
        ld      a,d
        cpl
        ld      d,a
        ld      a,e
        cpl
        ld      e,a
        inc de
        add hl,de
        pop de
usd7:   xor     a
        ld      a,d
        rra
        ld      d,a
        ld      a,e
        rra
        ld      e,a
        pop     af
        dec     a
        ret z
        push    af
        ld      a,c
        rla
        ld      c,a
        ld      a,b
        rla
        ld      b,a
        jp      usd6

sdiv:   xor     a       ;signed divide: return (DE / HL) in HL
        sta     tmp
        call    tstn
        ex de,hl
        call    tstn
        ex de,hl
        call    usdiv
        jp      smul2

cmphd:  ld      a,h     ;this returns C if HL < DE
        cp      d       ; (unsigned compare only used
        ret c           ;  within C.CCC, not from C)
        ret nz
        ld      a,l
        cp      e
        ret

;
; Shift operators  << and >>:
;

sderbl: ex de,hl                ;shift DE right by L bits
shlrbe: inc     e       ;shift HL right by E bits
shrbe2: dec     e
        ret z
        xor     a
        ld      a,h
        rra
        ld      h,a
        ld      a,l     
        rra
        ld      l,a
        jp      shrbe2

sdelbl: ex de,hl                ;shift DE left by L bits
shllbe: inc     e       ;shift HL left by E bits
shlbe2: dec     e
        ret z
        add hl,hl
        jp      shlbe2


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

cmh:    ld      a,h
        cpl
        ld      h,a
        ld      a,l
        cpl
        ld      l,a
        inc hl
        ret

cmd:    ld      a,d
        cpl
        ld      d,a
        ld      a,e
        cpl
        ld      e,a
        inc de
        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.
;
; The mnemonics are "lde Arg #n To HL",
; where arg #1 is the third thing on the stack (where the first
; and second things are, respectively, the return address of the
; routine making the call       to here, and the previous return
; address to the routine which actually pushed the args on the
; stack.) Thus, a call  to "ma1toh" would return with the first
; passed parameter in HL and A; "ma2toh" would return the second,
; etc. Note that if the caller has pushed [n] items on the stack
; before calling "ma [x] toh", then the [x-n]th formal parameter
; value will be returned, not the [x]th.
;

ma1toh: ld hl,4 ;get first arg
ma0toh: add hl,sp
        ld      a,(hl)
        inc hl
        ld      h,(hl)
        ld      l,a
        ret

ma2toh: ld hl,6 ;get 2nd arg
        jp      ma0toh

ma3toh: ld hl,8 ;get 3rd arg
        jp      ma0toh

ma4toh: ld hl,10        ;get 4th arg
        jp      ma0toh

ma5toh: ld hl,12        ;get 5th arg
        jp      ma0toh

ma6toh: ld hl,14        ;get 6th arg
        jp      ma0toh

ma7toh: ld hl,16        ;get 7th arg
        jp      ma0toh

;
; 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.
;

arghak: ld de,args      ;destination for block lde in DE
        ld hl,4 ;pass over two return address
        add hl,sp       ;source for block lde in HL
        push bc ;save BC
        ld      b,14    ;countdown in B
arghk2: ld      a,(hl)  ;copy loop
        ld (de),a
        inc hl
        inc de
        dec     b
        jp nz,arghk2
        pop bc  ;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).
;


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

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

        OS_HIDEFROMPARENT
        ld e,6 ;textmode
        OS_SETGFX 
        
        IF      CPM
        ld hl,arglst;-2 ;set up "argv" for the C main program
        ENDIF
        
        IF      NOT CPM
        ld hl,0
        ENDIF

        push hl

                        ;Initialize storge allocation pointers:
        lhld    freram  ;get address after end of externals
        shld    allocp  ;store at allocation pointer (for "sbrk.")
        ld hl,1000      ;default safety space between stack and
        shld    alocmx  ; highest allocatable address in memory 
                        ; (for use by "sbrk".).

                        ;Initialize random seed:
        ld hl,59dch     ;let's stick something wierd into the
        shld    rseed   ;first 16 bits of the random-number seed

                        ;Initialize I/O hack locations:
        ld      a,0dbh          ;"in" op, for "in xx; ret" subroutine
        sta     iohack
        ld      a,0d3h          ;"out" op for "out xx; ret" subroutine
        sta     iohack+3
        ld      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.

        IF      CPM
        call    khack           ;initialize Kirkland debugger vector
        ENDIF

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

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

        jp z,initzz
        ld      c,conin   ;if input present, clear it
        call    bdos

initzz: ld hl,tbuff             ;if arguments given, process them.
        ld de,comlin    ;get ready to copy command line
        ;ld     b,(hl)          ;first get length of it from loc. base+80h
        ;inc hl
        ;ld     a,b
        ;or     a       ;if no arguments, don't parse for argv
        ;jp nz,initl
        ;ld de,1        ;set argc to 1 in such a case.
        ;jp     i5

initl:  ld      a,(hl)  ;ok, there are arguments. parse...
        ld (de),a       ;first copy command line to comlin
         or a
        inc hl
        inc de
        ;dec    b
        jp nz,initl
        ;xor    a       ;place zero following line
        ;ld (de),a

        ld hl,comlin    ;now compute pointers to each arg
        ld de,0;1               ;arg count
        ld bc,arglst    ;where pointers will all go
        xor     a               ;clear "in a string" flag
        sta     tmp1
i2:     ld      a,(hl)  ;between args...
        inc hl
        cp      ' '
        jp z,i2
        or      a
        jp z,i5 ;if null byte, done with list
        cp      '"'
        jp nz,i2a       ;quote?
        sta     tmp1    ;yes. set "in a string" flag
        jp      i2b     

i2a:    dec hl
i2b:    ld      a,l     ;ok, HL is a pointer to the start
        ld (bc),a       ;of an arg string. store it.
        inc bc
        ld      a,h
        ld (bc),a
        inc bc
        inc de  ;bump arg count
i3:     ld      a,(hl)
        inc hl  ;pass over text of this arg
        or      a       ;if at end, all done
        jp z,i5
        push bc ;if tmp1 set, in a string 
        ld      b,a     ; (so we have to ignore spaces)
        lda     tmp1
        or      a
        ld      a,b
        pop bc
        jp z,i3a
        cp      '"'     ;we are in a string.
        jp nz,i3        ;check for terminating quote
        xor     a       ;if found, reset "in string" flag
        sta     tmp1
        dec hl
        ld      (hl),a  ;and stick a zero byte after the string
        inc hl  ;and go on to next arg
i3a:    cp      ' '     ;now find the space between args
        jp nz,i3
        dec hl  ;found it. stick in a zero byte
        ld      (hl),0
        inc hl
        jp      i2      ;and go on to next arg

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

        ld      b,3*nfcbs  ;now initialize all the file info
        ld hl,fdt       ;by zeroing the fd table)
i6:     ld      (hl),0
        inc hl
        dec     b
        jp nz,i6
        ENDIF

        IF      NOT CPM ;if not under CP/M, force ARGC value    
        ld hl,1 ; of one.
        push hl
        ENDIF

        call    clrex   ;clear externals, if CLINK -z option NOT used
        xor     a
        sta     ungetl  ;clear the push-back byte,
        sta     errnum  ;and file error code

        ld      a,0c3h  ;call c,'-Z' optimization initialization

;
; -Z optimization initializations:
;

        IF      ZOPT1
        sta     8       ;rst 1: jp fentrc
        ld hl,fentrc
        shld    9
        ENDIF

        IF      NOT ZOPT1 AND PRESRV
        nop
        dw      0,0,0,0         ;more NOPs
        ENDIF


        IF      ZOPT2
        sta     10h
        ld hl,fexitc ;rst 2:jp fexitc
        shld    11h
        ENDIF

        IF      NOT ZOPT2 AND PRESRV
        nop
        dw      0,0,0,0         ;more NOPs
        ENDIF


        IF      ZOPT5
        sta     28h     ;rst5:  jp sdli
        ld hl,sdli
        shld    29h
        ENDIF   

        IF      NOT ZOPT5 AND PRESRV
        nop
        dw      0,0,0,0         ;more NOPs
        ENDIF


        IF      ZOPT6
        sta     30h     ;rst6:  jp ldli
        ld hl,ldli
        shld    31h
        ENDIF

        IF      NOT ZOPT6 AND PRESRV
        nop
        dw      0,0,0,0         ;more NOPs
        ENDIF


        IF      ZOPT3
        ld hl,237eh     ;rst3:  ld a,(hl)
        shld    18h     ;       inc hl
        ld hl,6f66h     ;       ld h,(hl)
        shld    1ah     ;       ld l,a
        ld      a,0c9h  ;       ret
        sta     1ch
        ENDIF

        IF      NOT ZOPT3 AND PRESRV
        nop
        dw      0,0,0,0         ;more NOPs
        dw      0,0,0,0
        ENDIF


        IF      ZOPT4
        ld hl,2373h     ;rst4:  ld (hl),e
        shld    20h     ;       inc hl
        ld hl,0c972h ;  ld (hl),d
        shld    22h     ;       ret
        ENDIF

        IF      NOT ZOPT4 AND PRESRV
        dw      0,0,0   ;lotsa NOPs
        dw      0,0,0
        ENDIF


        IF      ZOPT7
        ld hl,235eh
        shld    38h
        ld hl,0c956h
        shld    3ah

        ld hl,2b72h
        shld    3ch
        ld hl,0c973h
        shld    3eh
        ENDIF

        IF      NOT ZOPT7 AND PRESRV
        dw      0,0,0,0,0,0     ;you guessed it -- NOPs
        dw      0,0,0,0,0,0
        ENDIF

        lhld    tmp2
        jp (hl)         ;all done initializing.
        
        IF      ZOPT2   ;object of rst 2 vector, if enabled
fexitc: pop de  ;get offset address
        ex de,hl                ;return value in DE, &offset in HL
        ld      l,(hl)  ;put byte offset in HL
        ld      h,0
        add hl,sp       ;add to SP
        ld sp,hl
        ex de,hl                ;put return value back in HL
        pop bc  ;restore BC
        ret             ;and return to previous function
        ENDIF

        IF      NOT ZOPT2 AND PRESRV
        dw      0,0,0   ;NOPs
        dw      0,0
        ENDIF


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

        IF CPM
vsnobsp:
        ld hl,0         ;get CCP's SP value in HL
        add hl,sp
        shld    spsav           ;save it for later
        lhld    base+6          ;get BIOS pointer
        ld de,-2100             ;subtract size of CCP plus a fudge
        add hl,de
        ld sp,hl                        ;make that the new SP value
        jp      tpa+3           ;and get things under way...

vnobret:
        lhld    spsav           ;restore CCP's SP
        ld sp,hl
        ret                     ;return to CCP
        ENDIF

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

vclrex: lhld    freram  ;clear externals
        ex de,hl
        lhld    extrns
        call    cmh
        add hl,de       ;HL now holds size of external data area
clrex1: ld      a,h     ;loop till done
        or      l
        ret z
        dec de
        dec hl
        xor     a
        ld (de),a
        jp      clrex1


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

        IF USERST
vkhack: ld hl,0E1H+2300H        ;pop hl - inc hl
        shld    rstloc          ; put at "RST 6" location (or wherever)
        ld hl,023H+0E900H       ;inc hl - jp (hl)
        shld    rstloc+2
        ret
        ENDIF

        IF NOT USERST
vkhack: ret
        ENDIF

        IF NOT USERST AND PRESRV
        ds 12
        ENDIF

;
; General purpose error value return routine:
;

verror: ld hl,-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      CPM             ;if under CP/M, close all open files
        ld      a,7+nfcbs       ;start with largest possible fd
exit1:  push    af              ;and scan all fd's for open files
        call    vfgfd           ;is file whose fd is in A open?
        jp c,exit2              ;if not, go on to next fd
        ld      l,a             ;else close the associated file
        ld      h,0
        push hl
        call    vclose
        pop hl
exit2:  pop     af
        dec     a               ;and go on to next one
        cp      7
        jp nz,exit1
        ENDIF

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


;
; Close the file whose fd is 1st arg:
;
       if NEDOOS != 0
vclose:
        call    ma1toh  ;get fd in A
        call    vfgfd   ;see if it is open ;return hl=fd addr
        ;jp c,verror    ;if not, complain
        push bc
        ld b,(hl)
        ld (hl),0 ;fd closed
        OS_CLOSEHANDLE
        ld hl,0 ;OK
        pop bc
        ret
       else

        IF      CPM     ;here comes a lot of CP/M stuff...
vclose:
        call    ma1toh  ;get fd in A
        call    vfgfd   ;see if it is open
        ;jp c,verror    ;if not, complain ;TODO why fail?
        ;ld     a,(hl)
        ;call   setusr  ;set user area to match current fd
        ;and    4       ;check if open for writing

        ENDIF

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

        IF CPM AND MPM2 AND PRESRV  ;always close all files under MP/M
        nop
        nop
        nop
        ENDIF

        IF CPM
        push hl ;save fd table entry addr
        call    ma2toh  ;get the fd in A again
        push bc
        call    vfgfcb  ;get the appropriate fcb address
        ex de,hl                ;put it in DE
        ld      c,closec  ;get BDOS function # for close
        call    bdos    ;and do it!
        pop bc
        pop hl
close2: ;call   rstusr  ;reset user number to original state
        ld      (hl),0  ;close the file logically
        cp      255     ;if 255 came back from bdos, we got problems
        ld hl,0 
        ret nz          ;return 0 if OK
        dec hl  ;return -1 on error
        ret
        ENDIF

       endif

;
; 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:  ld      d,a
        sub     8
        ret c           ;if fd < 8, error
        cp      nfcbs
        ccf             ;don't allow too big an fd either
        ret c
        push de
        ld      e,a     ;OK, we have a value in range. Now
        ld      d,0     ;  see if the file is open or not
        ld hl,fdt
        add hl,de       ;offset for 3-byte table entries
        add hl,de
        add hl,de
        ld      a,(hl)
        pop de
       if NEDOOS != 0        
        sub 1
        ret ;CY if not open
       else
        and     1       ;bit 0 is high if file is open
        scf
        ld      a,d
        ret z           ;return C set if not open
        ccf
        ret             ;else reset C and return
       endif

       if NEDOOS != 0
vsetfcb=0
       else
;
; 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.
;
       IF CPM
vsetfcb: push bc
        call    igwsp   ;ignore blanks and tabs 
        push hl ;save fcb ptr
        inc de  ;peek at 2nd char of filename
        ld a,(de)
        dec de
        cp      ':'     ;default disk byte value is 0
        ld      a,0     ; (for currently logged disk)
        jp nz,setf1
        ld a,(de)       ;oh oh...we have a disk designator
        call    mapuc   ;make it upper case
        sub     'A'-1   ;and fudge it a bit
        inc de  ;advance DE past disk designator to filename
        inc de
setf1:  ld      (hl),a  ;set disk byte
        inc hl
        ld      b,8
        call    setnm   ;set filename, pad with blanks
        call    setnm3  ;ignore extra characters in filename
        ld a,(de)
        cp      '.'     ;if an extension is given,
        jp nz,setf2
        inc de  ;skip the '.'
setf2:  ld      b,3
        call    setnm   ;set the extension field and pad with blanks
        xor     a       ;and zero the appropriate fields of the fcb
        ld      (hl),a
        ld de,20
        add hl,de
        ld      (hl),a
        inc hl
        ld      (hl),a  ;zero random record bytes of fcb
        inc hl
        ld      (hl),a
        inc hl
        ld      (hl),a
        pop de
        pop bc
        ret
       ENDIF
       endif
;
; 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:
;

       if NEDOOS == 0
       if CPM
setnm:  push bc
setnm1: ld a,(de)
        cp      '*'     ;wild card?
        ld      a,'?'   ;if so, pad with ? characters
        jp z,pad2

setnm2: ld a,(de)
        call    legfc   ;next char legal filename char?
        jp c,pad        ;if not, go pad for total of B characters
        ld      (hl),a  ;else store
        inc hl
        inc de
        dec     b
        jp nz,setnm1    ;and go for more if B not yet zero
        pop bc
setnm3: ld a,(de)       ;skip rest of filename if B chars already found
        call    legfc
        ret c
        inc de
        jp      setnm3

pad:    ld      a,' '   ;pad with B blanks
pad2:   ld      (hl),a  ;pad with B instances of char in A
        inc hl
        dec     b
        jp nz,pad2
        pop bc
        ret
       endif
       endif

       if NEDOOS != 0
vstfcu=0
       else
; 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 (/).

        if CPM
vstfcu: push bc ;save BC
        push hl ;save vcb pointer
        call    igwsp   ;ignore blanks and tabs 
        call    isdec   ;decimal digit?
        jp nc,setfc2    ;if so, go process

setfc0: push de ;save text pointer
        ;ld     c,gsuser  ;else get current effective user number
        ;ld     e,0ffh
        ENDIF

        IF      CPM AND USAREA
        ;call   bdos    ;get current user area if implemented
         xor a
        ENDIF

        IF      CPM AND NOT USAREA
        ld      a,0
        nop
        ENDIF

        IF      CPM
        pop de  ;restore text pointer
setfc1: rlca            ;rotate into upper 5 bits of A
        rlca
        rlca
        sta     usrnum  ;and save
        pop hl  ;restore junk
        pop bc
        jp      setfcb  ;and parse rest of filename

setfc2: ld      b,0     ;clear user number counter
        push de ;save text pointer in case we invalidate user prefix
setfc3: sub     '0'      ;save next digit value
        ld      c,a     ; in C
        ld      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
        ld      b,a     ;put sum in B
        inc de  ;look at next char in text
        ld a,(de)       ;is it a digit?
        call    isdec
        jp nc,setfc3    ;if so, go on looping and summing digits
        cp      '/'     ;make sure number is terminated by a slash
        jp z,setfc4
        pop de  ;if not, entire number prefix is not really a 
        jp      setfc0  ; user number, so just ignore it all.

setfc4: inc de  ;ok, allow the user number
        pop hl  ;get old text pointer off the stack
        ld      a,b     ;get user number value
        jp      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
        cp      '.'     ; '.' is illegal in a filename or extension
        scf
        ret z
        cp      ':'     ;so is ':'
        scf     
        ret z
        cp      7fh     ;delete is no good
        scf
        ret z
        cp      '!'     ;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:  cp      'a'
        ret c
        cp      'z'+1
        ret nc
        sub     32      ;if lower case, map to upper
        ret

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

igwsp:  dec de
igwsp1: inc de
        ld a,(de)
        cp      ' '
        jp z,igwsp1
        cp      9
        jp z,igwsp1
        ret

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

isdec:  cp      '0'
        ret c
        cp      '9'+1
        ccf
        ret
       endif
       endif

;
; 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 (fd in NEDOOS) 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 bc
        or      a       ;look for free slot?
        ld      c,a
        jp nz,fgfc2     ;if not, go away
        ld      b,nfcbs ;yes. do it...
        ld de,fdt
        if NEDOOS == 0
        ld hl,fcbt
        endif
        ld      c,8
fgfc1:  ld a,(de)
        and     1
        ld      a,c
        jp nz,fgfc1a    ;found free slot?
        pop bc  ;yes. all done.
        ret ;return DE=fd addr, A=fd
fgfc1a:
        if NEDOOS == 0
        push de
        ld de,36        ;fcb length to accommodate random I/O
        add hl,de
        pop de
        endif
        inc de  ;bump to next 3-byte table entry
        inc de
        inc de
        inc     c
        dec     b
        jp nz,fgfc1
fgfc1b: scf
        pop bc
        ret             ;return C if no more free slots
fgfc2:
        if NEDOOS != 0
        call    vfgfd   ;compute fd address for fd in A: ;return hl=fd addr
        ;jp c,fgfc1b    ;return C if file isn't open        
        else
        call    vfgfd   ;compute fd address for fd in A:
        ;jp c,fgfc1b    ;return C if file isn't open ;TODO why fail?
        sub     8
        ld      l,a     ;put (fd-8) in HL
        ld      h,0
        add hl,hl       ;double it
        add hl,hl       ;4*a
        ld      d,h     ;save 4*a in DE
        ld      e,l
        add hl,hl       ;8*a
        add hl,hl       ;16*a
        add hl,hl       ;32*a
        add hl,de       ;36*a
        ex de,hl                ;put 36*a in DE
        ld hl,fcbt      ;add to base of table
        add hl,de       ;result in HL
        endif
        ld      a,c     ;and return original fd in A
        pop bc
        ret

        if NEDOOS != 0
vsetusr=0
vrstusr=0
        else
;
; The following two subroutines change the current CP/M user area for
; use with file I/O:
;

        IF CPM
vsetusr:
        push bc ;SET user number to upper bits of A, save current:
        push hl
        push de
        push    af      ;save A
        ld      c,gsuser ;get user code
        ld      e,0ffh
        ENDIF

        IF      CPM AND USAREA
        call    bdos
        ENDIF

        IF      CPM AND NOT USAREA
        ld      a,0
        nop
        ENDIF

        IF CPM
        sta     curusr  ;save current user number
        pop     af      ;get new user number byte
        push    af
        rra             ;shift user number down to low bits
        rra
        rra
        and     1fh     ;and mask off high order garbage
setu0:  ld      e,a
        ld      c,gsuser  ;set user code
        ENDIF

        IF      CPM AND USAREA
        call    bdos
        ENDIF

        IF      CPM AND NOT USAREA AND PRESRV
        nop
        nop
        nop
        ENDIF

        IF      CPM
        pop     af
        pop de
        pop hl
        pop bc
        ret

vrstusr:
        push bc
        push hl
        push de
        push    af
        lda     curusr  ;get last saved user number
        jp      setu0   ;and go set current user area to that

        ENDIF           ;end of CP/M-related file I/O routines

        endif

;       IF      NOT CPM
;main:  equ     $       ;where main program resides when not under CP/M
                        ;(under CP/M, the data area comes first)
;       ENDIF


;
; Ram area:
;

        ;IF     CPM     ; Plug this value into BDS.LIB before CASM'ing
ram     equ     $       ; the new library. The "org ram" at the end of this
        ;ENDIF          ; source file should cause the assembler to print
                        ; the value of "ram" at the end of the assembly.

        ;IF     NOT CPM
        ;org    ram     ;if not under CP/M, use custom ram area address
        ;ENDIF

errnum: ds      1       ;error code from file I/O operations
rseed:  ds      8       ;the random generator seed
args:   ds      14      ;"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 storge for use by "sbrk" func
alocmx: ds      2       ;highest location to be made available to the
                        ;storge allocator

                        ;20 bytes of misc. scratch & state variables:
tmp     ds      1
tmp1    ds      1
tmp2    ds      2
tmp2a   ds      2
unused  ds      2

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

                        ;Console I/O control data:
chmode  db      0        ;0: single char mode, 1: line buffered mode
nleft   db      0        ;# of chars left in buffer (if chmode == 1)
ungetl  db      0        ;"ungetch" data byte (0 if no char pushback)
iobrf   db      1       ;check for break on character input/output

spsav   ds      2       ;BDOS's saved SP value upon entry from CCP

        ds      4       ;total of 20 bytes of misc. data area

;
;--------------------------------------------------------------------------
; The following data areas are needed only if running under CP/M:
;

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

        if NEDOOS == 0
fcbt:   ds      36*nfcbs        ;reserve room for fcb's (extra byte for IMDOS)
        endif

;
; The fd table: three bytes per file specifying r/w/open as follows:
;   BYTE 1:
;       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)
;   BYTES 2&3:
;       Highest sector number seen so far during I/O (for cfsize calls)
;

fdt:    ds      3*nfcbs

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

comlin: ds      131     ;copy of the command line pointed to by entries
                        ;in arglst


;
; This is where "init" places the array of argument pointers:
;

arglst: ds      40      ;the "argv" paramater points here ([well,
                        ;actually to 2 bytes before arglst]). Thus,
                        ;up to 20 parameters may be passed to "main"
        ENDIF

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

        ;IF     CPM
main    equ     $       ;where "main" program will be loaded under CP/M
        ;ENDIF

        ;IF NOT M80
        ;org    ram     ;set next pc value back to ram origin, so the value
        ;ENDIF          ;will be displayed by the assembler for convenience