Subversion Repositories NedoOS

;
; clinkb.asm:
;
; This routine finds, somehow, the name of the next CRL file to search.
; It also processes any command line options that weren't taken care
; of back at the start of the link. This routine has grown into a real
; bitch of kludginess, and I'm sorry about that...but it's so CUTE in
; the way it does so damned much "on the fly" zipping down the command
; line. Anyway, once the command line runs out, deff.crl and deff2.crl
;       (or deff0.crl, deff1.crl, deff2.crl, etc., under MARC)
; are spit back, and if those have been scanned already then a list of
; unresolved function references is printed (because this routine wouldn't
; be CALLED if all the functions had been resolved...) and the user is
; prompted for another file name, or a special command like abort (control-Q)
; or search all deff*.crl files again (a carriage-return.)
;

getfn:  lda mflag       ; has command line been fully processed?
        or a
        jp z,gfnzz2     ;if so, go do something else...

        lhld cptr       ;no.
gfn0:   ld a,(hl)
        call twhite     ;skip leading white space at the current position
        jp nz,gfna      ;of scanning
        inc hl
        jp gfn0

gfna:   or a            ;have we reached the end of the line (so to speak)?
        jp nz,gfnb
gfnzz:  sta mflag       ;yes. set this flag to tell us so next time

        lda donef       ;If link has been completed already, and we were
        or a            ;just scanning for more possible command line options,
        ret nz          ;then return right here.

gfnzz2: lda dflag       ;if haven't searched DEFF.CRL yet,
        or a
        jp z,gfldf      ;go do it.

        IF CPM
        lda d2flag      ;if haven't searched DEFF2.CRL yet,
        or a
        jp z,gfld2f     ;go do it.

        lda d3flag      ;if haven't scanned DEFF3.CRL yet,
        or a
        jp z,gfld3f     ;go do it.
        ENDIF

        jp gtfnz        ;else go get file name from user.

gfnb:   cp '-'          ;is the next thing an option?
        jp nz,gfnc      ;if not, go get filename
gfnb0:  inc hl          ;yes.
gfnb1:  ld a,(hl)               ;put in A and convert to upper case
        call mapuc
        sta opletr      ;save for possible error reports later

        cp 'S'          ;print stats?
        jp z,sets

        IF MARC
        cp 'M'          ;do maxmem call in c.ccc?
        jp z,setm
        ENDIF

        cp 'T'          ;set top of memory?
        jp z,sett

        cp 'O'          ;set output filename?
        jp z,seto

        cp 'W'          ;write symbol table?
        jp z,setw

        cp 'E'          ;set external data starting addr?
        jp z,setext

        IF CPM          ;TEMPorRILY UNIMPLEMENETED UNDER MARC
        cp 'Z'          ;inhibit clearing of external data?
        jp z,setz

        cp 'Y'          ;read in symbol table file from disk
        jp z,gsyms

        cp 'D'          ;debug mode?
        jp z,setd

        cp 'N'
        jp z,setn
        ENDIF

        cp 'F'          ;switch to scanning of functions (from loading)?
        jp z,setf

        call twhite
        jp z,gfn0
        or a
        jp z,gfn0

        push af
        ld de,stgbop    ;bad option
        call pstg
        pop af          ;print the option char used
        call outch
        call crlf
        jp abort

sets:   sta statf
        jp gfnb0

        IF MARC
setm:   push hl         ;insert a "call marc" instruction at mhackl in c.ccc:
        lhld cda        ;get start of code area
        ld de,mhackl    ;get displacement for mhackl in DE
        add hl,de               ;HL --> where "call marc" will go
        ld (hl),0cdh    ;"call" op
        inc hl
        ld (hl),msys&0ffh
        inc hl
        ld (hl),msys/256
        
        lda taddrf      ;if -t option used, don't change taddr
        or a
        jp nz,setm2

        lhld curtop     ;make physical top of memory logical top 
        shld taddr      ;at run-time

setm2:  pop hl          ;restore text pointer

        jp gfnb0
        ENDIF


setw:   sta wflg        ;write symbols out
        jp gfnb0

        IF CPM
setz:   sta zflag       ;inhibit clearing external flag
        jp gfnb0

setn:   sta nflag       ;activate NOBOOT option
        jp gfnb0
        ENDIF

setf:
        IF FORCE
        xor a
        ENDIF

        IF NOT FORCE
        ld a,1
        ENDIF

        sta fflag
        inc hl
        jp gfn0

        IF CPM          ;temp. unimplemented under MARC
setd:   ld a,1          ;for starters, no text list
        sta debugf      ;causes file to be executed
        inc hl          ;pass over the `D'
        call igsp       ;test for arg list text
        cp '"'
        jp nz,gfna      ;if not, all done
        sta debugf      ;set debugf to > 1 to indicate a text list      
        inc hl
        shld argptr     ;and set a pointer to the arg list
setd1:  ld a,(hl)               ;find the trailing quote
        inc hl
        cp '"'
        jp nz,setd1
        jp gfnb1        ;instead of written to disk
        ENDIF

sett:   inc hl
        call gtaddd
        ex de,hl
        shld taddr
        ld a,1
        sta taddrf
        ex de,hl
        jp gfn0

;
; Scan a hex address at text at HL and return
; with the value in DE, and HL pointing past the text:
; Complain and abort if no legal value given.   
;

gtaddd: ld de,0
gtad1:  call igsp
        call tsthd
        jp nc,gtad3
        ld de,stgver
stgab:  call pstg

        IF CPM
        call crlf
        ENDIF

        jp abort

gtad2:  ld a,(hl)
        call tsthd
        ret c
gtad3:  call addda
        inc hl
        jp gtad2

addda:  push hl
        ex de,hl
        add hl,hl
        add hl,hl
        add hl,hl
        add hl,hl
        ld e,a
        ld d,0
        add hl,de
        ex de,hl
        pop hl
        ret

tsthd:  call mapuc
        sub '0'
        ret c
        cp 10
        ccf
        ret nc
        cp 11h
        ret c
        cp 17h
        ccf
        ret c
        sub 7
        ret

seto:
        IF MARC
        ld a,1
        sta oflag
        ENDIF

        inc hl          ;point HL to filename
        ld de,fcbs      ;this is where the fcb for it will be set up

        IF CPM
        lda decl        ;save default crl disk 'cause we're gonna clobber it
        push af
        lda fcbs        ;get default output disk
        sta decl        ;put it here for gfncp2
        ENDIF

        call igsp       ;ignore leading space of filename text
        call gfncp2     ;set up fcb

        IF CPM
        pop af
        sta decl        ;restore decl
        ENDIF

        jp gfn0

setext: inc hl
        call gtaddd
        ex de,hl
        shld eaddr
        ld a,1
        sta eflag
        ex de,hl
        jp gfn0

        IF CPM
gsyms:  inc hl          ;read in a symbol table file
        call igsp       ;ignore spaces
        push hl         ;assume "sym" extension by default
        ld hl,fcb+9
        ld (hl),'S'
        inc hl
        ld (hl),'Y'
        inc hl
        ld (hl),'M'
        pop hl

        call gfncp      ;set up the default FCB w/file name
        xor a
        call open       ;try to open the symbols file for reading
        jp c,gsym2      ;if can't, don't read in symbols
        ld hl,tbuff
        shld buffp      ;init buffer pointer

        lhld cdp
        push hl         ;save code pointer
gsymlp: ld a,1          ;set "reading symbol" flag
        sta rdngsm
        call dosym      ;process a symbol
        jp nc,gsymlp    ;until we run out
        pop hl          ;get back
        shld cdp
        xor a           ;clear "reading symbols" flag
        sta rdngsm

        call close      ;close symbol file
gsym2:  lhld cptr       ;get back text pointer
        jp gfn0 ;and go process more commands



dosym:  call igsht      ;ignore garbage
        ret c           ;return if EOF
        call tsthd      ;legal value character?
        jp c,serror
        call getval     ;get value in hex from file

        push hl         ;this gets added later, 
        call getcdf
        call cmh        ;so subtract it now!    
        ex de,hl
        pop hl

        add hl,de               ;subtracting...
        shld cdp        ;set up for call to entt1
        call getname    ;get symbol name at sname buffer
        ld hl,sname     ;get pointer to name
        ld de,stgmn     ;is it the "MAIN" entry?
        call stcmp
        ret z           ;if so, don't yank it!
        ld a,1          
        sta gotf        ;this is so that entt1 defines the symbol here
        call entt1
        xor a           ;no error
        ret             ;and done with the symbol

serror: ld de,stgserr   ;"illegal symbol in file"
        jp stgab

getname: ld hl,sname
        call igsht
        jp c,serror     ;if no legal 1st char of symbol name, error
getn2:  ld (hl),a
        inc hl
        call getcc      ;get next char
        jp c,getn3      ;if EOF, also end-of-symbol!
        call tstsht     ;is it "whitespace" character?
        jp nz,getn2     ;if not, store and get next char
getn3:  dec hl          ;turn on bit 7 of last char
        ld a,(hl)
        or 80h
        ld (hl),a
        ret


getval: ld hl,0         ;clear sum
getv2:  add hl,hl               ;shift sum left 4 bits
        add hl,hl
        add hl,hl
        add hl,hl
        ld e,a          ;add new hex digit to sum
        ld d,0
        add hl,de
        call getcc      ;any more chars?
        call tsthd
        jp nc,getv2     ;if so, go do them
        ret             ;else done


igsht:  call getcc      ;get character from file
        call tstsht     ;if no more, return C set
        ret c
        jp z,igsht      ;and ignore junk
        ret
        ENDIF

tstsht: call twhite
        ret z
        cp 0dh          ;cr?
        ret z
        cp 0ah          ;lf?
        ret z
        cp 1ah          ;EOF?
        scf
        ret z           ;if so, set C
        ccf             ;else not EOF
        ret             ;else good character

        IF CPM
getcc:  push hl         ;save HL
        lhld buffp      ;get buffer pointer
        ld a,l
        and 7fh         ;start of buffer?
        jp nz,getc2
        call reads      ;yes. read in a sector
        ret c           ;return C if EOF
getc2:  ld a,(hl)               ;get char from buffer
        push af ;save character
        inc hl          ;bump pointer
        ld a,l          ;end of sector?
        and 7fh
        jp nz,getc3
        ld hl,tbuff
getc3:  pop af
        shld buffp      ;and save for next time
        pop hl          ;restore HL
        or a            ;clear Carry
        ret
        ENDIF

igsp:   ld a,(hl)               ;ignore spaces at text at HL
        call twhite
        ret nz
        inc hl
        jp igsp

;
; At this point, we have a filename on the command line. It will
; be interpreted as the name of a CRL file, and scanned for needed
; functions:
;

gfnc:   call gfncp      ;collect up the name
        jp afterg

;
; This routine, given a pointer to the ascii text of a CP/M filename,
; sets up the default fcb with the given name. The disk to stick in the
; the disk byte by default is loaded from decl, but that is overridable
; if an explicit disk designator is given.
;
; The filename may also be preceded by a user number code of form "#/",
; causing a switch to that user area for the duration of the file scan,
; and then a reversion back to the current user area.
;

gfncp:
;       IF CPM          ;put a CP/M filename into the default fcb:
        ld de,fcb
gfncp2: push de         ;save pointer to working fcb
        push hl         ;save text pointer
        call gdec       ;user area prefix? If so, starts with number...
        jp c,gfncp4     ;if not, don't assume a user number is there
        ld a,(hl)               ;if we saw a number, check for trailing slash
        cp '/'
        jp nz,gfncp4    ;if no slash, it wasn't a user number

        ex (sp),hl              ;pop old text pointer off stack
        pop hl

        ;push de                ;save DE
        ;ld e,b         ;set the user number to the given value
        ;ld c,sguser
        ;lda nouser
        ;or a
        ;push hl                ;save pointer to slash in text
        ;IF NOT ALPHA
        ;call z,bdos
        ;ENDIF
        ;pop hl         ;get back text pointer

        ;pop de         ;restore DE
        inc hl          ;bump text ptr past the slash
        push hl         ;push back so we can fall through to next section
        xor a           ;disable default disk searching
        sta search

gfncp4: pop hl          ;restore text pointer to start of filename
gfncp5: inc hl
        ld a,(hl)               ;is an explicit disk designator given?
        dec hl
        cp ':'
        lda decl
        ld (de),a               ;in case not, set it up with the default disk
        jp nz,gfnc0
        xor a           ;disable default disk searching
        sta search
        ld a,(hl)               ;else get the actual disk letter
        call mapuc      ;in upper case, of course
        sub '@'         ;subtract offset to put into proper range
        inc hl
        inc hl
        ld (de),a               ;save at start of target fcb
        ld a,(hl)               ;space or null follow designator?
        or a
        jp z,gfncp9
        cp ' '
        jp nz,gfnc0     ;if not, go parse filename
gfncp9: pop de          ;else don't, having only modified disk designator.
        ret
        
gfnc0:  inc de
gfnc1:  ld b,8
        call gfnc3      ;load the principle filename
        ld a,(hl)
        or a
        jp z,gfnca      ;end of command line?
        cp ' '          ;if not, was filename terminated by a space?
        jp z,gfnca      ;if so, don't touch the COM extension
        inc hl          ;else either clear the extension (if a lone "." given)
        ld b,3          ;or set up the new exntension.
        call gfnc3
gfnca:  shld cptr       ;save command line pointer
        ex (sp),hl              ;exchage command line pointer with fcb address on stack
        ld de,12        ;clear the extent field of the fcb
        add hl,de
        ld (hl),0
        pop hl          ;get back the command line pointer and return
        ret

;
; This routine copies up to B ascii letters from text at HL to the fcb
; filename or extension field at DE, padding with spaces on the right:
;

gfnc3:  ld a,(hl)
        or a
        jp z,padsp
        call twhite
        jp z,padsp
        cp '.'
        jp z,padsp
        call mapuc
        ld (de),a       
        inc de
        inc hl
        dec b
        jp nz,gfnc3
padsp:  ld a,b
        or a
        ret z
        ld a,' '
        ld (de),a
        inc de
        dec b
        jp padsp
;       ENDIF

        IF NOT CPM      ;for MARC, copy the filename to fcbt:
        ld de,fcbt
gfncp2: ld a,(hl)
        or a
        jp z,gfncp3
        call tstsht     ;end of name?
        jp z,gfncp3
        ld (de),a
        inc hl
        inc de
        jp gfncp2       

gfncp3: shld cptr
        xor a
        ld (de),a
        ret
        ENDIF

afterg: lda donef               ;if all done, we don't need to load the file
        or a
        jp nz,getfn

        IF CPM
          call scrl
;         inc a
;         sta search            ;search current, then default disk/user area
        ENDIF

        IF NOT CPM
          push hl
          ld hl,fcbt
          call scrl
          pop hl
        ENDIF   

        ret

;
; Announce missing functions after all given CRL files have been
; read in and there are still unresolved function references:
;

gtfnz:  ld de,stgas
        call pstg       ;"missing functions:"
        call list       ;list out function names

        IF MARC
        xor a
        sta dlast       ;reset deff?.crl counter whenever going into
        ENDIF           ;interactive mode under MARC

getfn2: call crlf
        ld de,stg7      ;ask for input
        call pstg

gfl1:   ld hl,tbuff     ;get a line of user input at tbuff

        IF CPM          ;under CP/M, use the bdos call to get a line of input
        ld (hl),120
        ex de,hl
        ld c,readbuf
        call bdos       ;get line of input
        call crlf
        ld hl,tbuff+2   ;get length byte
        push hl
        dec hl  
        ld a,(hl)
        inc a
        add l
        ld l,a
        ld (hl),0
        pop de
        ENDIF

        IF NOT CPM              ;get a line of input under MARC:
        push hl         ;save pointer to start of text line buffer area
gfl1a:  call inch       ;get a character from console
        ld (hl),a               ;save it
        inc hl          ;bump pointer
        cp newlin       ;newline?
        jp nz,gfl1a
        dec hl
        ld (hl),0               ;if so, change it to a null
        pop de          ;and restore pointer to accumulated line into DE
        ENDIF

gfl1b:  ld a,(de)
        inc de
        call twhite
        jp z,gfl1b

        IF CPM
        cp 1ah          ;control-Z?
        jp nz,gfl1c     ;if so, abort the linkage
        ENDIF

        IF NOT CPM
        jp gfl1c        ;don't bother checking for ^Q under MARC, since
        ENDIF           ;^C's are handled by the OS.

abort:
        lhld errbyt
        ld (hl),0ffh

        IF NOT ALPHA
        ;ld e,0         ;switch to user 0 to erase submit file under ZSYSTEM
        ;ld c,sguser
        ;lda nouser
        ;or a
        ;jp nz,abort2

        ;lda zenvf      ;zsystems?
        ;or a
        ;call nz,bdos   ;if so, change to user 0
abort2:
        ENDIF

        ld de,subfile   ;if so, erase submit file on user 0
        ld c,delete
        call bdos

        ;lda curusr     ;restore to current user area
        ;ld e,a
        ;ld c,sguser
        ;lda nouser
        ;or a
        ;IF NOT ALPHA
        ;call z,bdos
        ;ENDIF

        ld de,stgabt    ;abort message
        call pstg
        jp exit

        IF NOT CPM
        lda marcfd      ;any file open?
        or a
        call nz,close   ;if so, close it
        call crlf       ;put out extra CR-LF under MARC
        ld hl,-1
        jp exit
        ENDIF

gfl1c:  or a            ;null input line?
        jp nz,gfl2

        IF MARC
        xor a           ;if so, cause all deff*.crl files to be searched
        sta dflag       ;under MARC
        ENDIF

gfldf:
        IF FORCE
        xor a
        sta fflag       ;turn off forced loading while scanning libraries
        ENDIF

        ld hl,deffs     ; search deff.crl (or current deff?.crl under MARC)

        IF MARC         ;now--go through all deff?.crl files under MARC
        push hl
        lda dlast       ;has the cycle been started yet?
        or a            ;if so, go on to next iteration
        jp nz,gfldfn
        ld a,'0' ;else start it up with deff0.crl
        sta dlast
        dec a           ;make it so it gets bumped to '0' and used

gfldfn: ld de,10        ;point to variable location
        add hl,de

        inc a           ;bump dlast to next value
        cp ':'          ;if up past the digits, turn it into an 'a'
        jp nz,gfldfo
        ld a,'a'

gfldfo: sta dlast       ;save for looping
        ld (hl),a               ;and put into filename as next deff?.crl to search
        cp '4'
        jp c,gfldfp

        sta quietf      ;be quiet if past deff3.crl

gfldfp: pop hl  

        ex de,hl
        lhld noffst     ;add either 0 (to search /libC) or 6 (current direct)
        add hl,de
        ENDIF

        IF CPM
        ld de,fcb
        ENDIF

        IF NOT CPM
        ld de,fcbt
        ENDIF

        call ldfn

        IF CPM
        call setdu      ;make library user area the current user area
        xor a
        sta d2flag      ;cause deff2.crl and deff3.crl to be re-scanned
        sta d3flag
        sta search      ;don't search anywhere but default
        inc a
        sta dflag       ;and say that deff.crl has now been scanned
        ENDIF

        ret


;       IF CPM          ;only search DEFF2.CRL and DEFF3.CRL explicitly
gfld2f: ld hl,deff2s    ;under CP/M
        ld de,fcb
        call ldfn
        xor a
        sta search      ;only search default
        inc a
        sta d2flag
        call setdu      ;set library user area to be current
        ret

gfld3f: ld hl,deff3s
        ld de,fcb
        call ldfn
        xor a
        sta search      ;only search default
        inc a
        sta quietf      ;don't complain if can't open file
        sta d3flag
        call setdu      ;set library user area to be current
        ret

setdu:  ;lda defusr
        ;ld e,a
        ;ld c,sguser
        ;lda nouser
        ;or a
        ;IF NOT ALPHA
        ;call z,bdos
        ;ENDIF
        ret
;       ENDIF

gfl2:   ex de,hl                ;put text address in HL
        dec hl
        call gfncp      ;set up fcb with name of file

        IF MARC
        ld hl,fcbt
        ENDIF
;
;       IF CPM
;       ld a,1
;       sta search      ;search current, then default disk/user area
;       ENDIF

        call scrl
        ret

;
; List out names of missing functions:
;

list:   ld hl,tab1
        shld fngtt
        ld b,7
lst1:   call fung2
        ret c

lst2:   ld a,(hl)
        push af
        and 7fh

        IF CPM
        call mapuc
        ENDIF

        call outch
        pop af
        or a
        inc hl
        jp p,lst2
        dec b
        jp nz,lst3
        call crlf
        ld b,7
lst3:   ld a,' '
        call outch
        call outch
        jp lst1

readc:  lda segf        ;if segment, don't read in C.CCC
        or a
        ret nz

        IF CPM
        call savfn      ;else do...if CP/M, save main filename for later use
        ENDIF

        ld hl,ccc       ;get name of c.ccc

        IF MARC
        ex de,hl
        lhld noffst     ;add either 0 (to search /libC) or 6 (current direct)
        add hl,de
        ENDIF

        IF CPM
        ld de,fcb       ;set up fcb under CP/M
        call ldfn
        ENDIF

        xor a
        call open       ;open c.ccc for reading
        jp c,abort      ;abort if can't find it

        IF CPM          ;read in c.ccc under CP/M
        lhld cda
rdc1:   call reads
        jp c,rdc2
        call cpys
        jp rdc1
        ENDIF

        IF NOT CPM
        lda marcfd      ;figure out how big c.ccc really is
        ld c,m$fsize
        call msys
        ex de,hl                ;put length into DE (from HL)
        lhld cda        ;get load address into HL
        call reads      ;under MARC, call read to get entire file in
        ENDIF



rdc2:   lhld cda
        ld a,(hl)               ;test if ZSYSTEMS c.ccc
        cp 0ebh
        jp z,rdc2a
        xor a           ;if not, reset zsysf, else set it
rdc2a:  sta zsysf

        ld de,cccsiz
        add hl,de
        ld e,(hl)
        inc hl
        ld d,(hl)       
        lhld cda
        add hl,de
        shld cdp
        call close
        
        IF CPM
        call resfn      ;restore main filename to default fcb under CP/M
        ENDIF

        IF TESTING
        call printf
           db 'c.ccc loaded correctly',0
        ENDIF

        ret             ;end of readc routine

        IF CPM
savfn:  ld hl,fcb
        ld de,fcbt
        jp ldfn

resfn:  ld hl,fcbt
        ld de,fcb
        jp ldfn
        ENDIF

        IF CPM
ldfn:   ld b,13
ldf1:   ld a,(hl)
        ld (de),a
        inc hl
        inc de
        dec b
        jp nz,ldf1
        ret
        ENDIF

        IF NOT CPM
ldfn:   ld a,(hl)
        ld (de),a
        inc hl
        inc de
        or a
        jp nz,ldfn
        ret
        ENDIF


;
; Read a function in to memory from the currently open CRL file:
;

rdfun:  call ckabrt
        lda fcnt        ;bump function count
        inc a
        sta fcnt
        cp 255          ;reached functional limit of clink?
        jp nz,rdf0
        ld de,stgtmf    ;yes. complain and abort.
        jp stgab
                        ;else proceed reading in the function:
rdf0:   lhld enst       ;get starting position of function in the file
        ld b,h
        ld c,l          ;put into BC
        call cmh        ;negate it
        ex de,hl
        lhld enend      ;get ending position (actually start of next one)
        add hl,de               ;subtract starting position to get length
        push hl         ;save length
        ex de,hl                ;put into DE
        lhld cdp        ;and add to current load address
        add hl,de

rdf0a:  lda curtop+1    ;to see if it overflows memory
        dec a           ;** possible bug fix ***
        ld l,a
        ld a,h
        cp l
        jp c,rdf1               ;no overflow
                        ;yes.... overflow

        IF CPM
        lda ccpok       ;CCP intact?
        or a
        jp nz,rdf00a    ;if so, try making it go away
        ENDIF

rdf0b:  ld de,stgom     ;if so, print message and abort
        jp stgab        ;just abort under CP/M

rdf00a:
        IF CPM
        push hl         ;save HL
        ld hl,NEDOOSMEMTOP;lhld bdosp   ;get protected memory address
        ld l,0
        shld curtop     ;make it new top of memory
        pop hl          ;restore HL
        xor a
        sta ccpok       ;clear CCP intact flag
        jp rdf0a        ;go try again
        ENDIF

rdf1:
        IF CPM
        ld de,fcb       ;OK, function will fit into memory.
        call setdat
        ld a,c
        or 80h
        ld l,a
        ld h,ram/256
        shld tbp
        call reads
        ENDIF

        IF NOT CPM
        lhld enst       ;get starting position of function in CRL file
        ld b,0          ;absolute seek
        ld c,m$seek
        lda marcfd
        call msys       ;seek to correct position in file
        jp nz,ferror
        ENDIF

        lhld cdp        ;get code pointer
        ex de,hl                ;put into DE: this is where the data will go
        pop hl          ;get length of function module
        push hl
        add hl,de               ;add to base address
        shld cdn        ;save this for some other routine to futz with

        IF CPM
        pop hl
rdf2:   call rdbt
        ld (de),a
        inc de
        dec hl
        ld a,h
        or l
        jp nz,rdf2
        ret
        ENDIF

        IF NOT CPM
        pop de          ;get length of function module
        lhld cdp        ;get load address for function module
        call reads      ;read in the module
        ret
        ENDIF

        IF CPM          ;all this kludgery only for CP/M
rdbt:   push hl
        lhld tbp
        ld a,l
        or a
        jp z,rdb2
        ld a,(hl)
        inc hl
        shld tbp
        pop hl
        ret

rdb2:   call reads
        ld hl,tbuff
        ld a,(hl)
        inc hl
        shld tbp
        pop hl
        ret

;
; Routine used under CP/M to set the extent and record fields
; of the default fcb to the first sector of the function to be read in:
;
;bc=
;de=fcb
setdat: ld h,b
        ld l,c
        add hl,hl
        ld a,h
        and 7fh
        ld hl,32
        add hl,de
        ld (hl),a
        sta tmpnr
        ld a,b
        rlca
        rlca
        and 3
        ;ld hl,12
        ;add hl,de
        ;cp (hl)
        ;ret z
        ;push af
        ;push hl
        ;call close
        ;pop hl
        ;pop af
        ;ld (hl),a
        ;call open
        ;jp c,abort
        lda tmpnr
        sta fcb+_rrn;32
        ret
        ENDIF           ;end of this section of CP/M-only kludgery

pre:
        IF TESTING
        call printf
          db 'calling rdfun:',0
        ENDIF

        call rdfun      ;read in the function

        IF TESTING
        call printf
          db 'returned from rdfun.',0
        ENDIF
        
        lhld cdp

        push hl         ;find start of code, so on-the-fly
pre0:   ld a,(hl)               ;reference fixing can be done for
        inc hl          ;those references to functions
        or a            ;already processed and in their
        jp nz,pre0      ;fixed positions.
        inc hl          ;found end of name list.
        inc hl          ;now HL -> start of actual func code
        shld fncodb     ;save function code begin addr
        pop hl
        
        lda fcnt2
        ld b,a
        ld c,0
pre1:   ld a,(hl)
        or a
        jp z,pre2
        push hl
        inc c
        ld h,b
        ld l,c
        shld refv
        xor a
        sta gotf
        pop hl
        push hl
        push bc
        call entt1
        pop bc
        pop hl
        call pb7hi
        jp pre1

pre2:   inc hl
        ld c,(hl)
        inc hl
        ld b,(hl)
        inc hl
        ex de,hl
        lhld cdp
        push hl
        push hl
        call cmh
        add hl,de
        ex de,hl
        pop hl
        call sqish
        pop hl
        add hl,bc
        push hl
        ld c,(hl)
        inc hl
        ld b,(hl)
        inc hl
        push hl
        call getcdf2
        shld fadr
        pop hl
pre3:   ld a,b
        or c
        jp z,pre4
        ld e,(hl)
        inc hl
        ld d,(hl)
        inc hl
        push hl
        lhld cdp
        add hl,de
        ld e,(hl)
        inc hl
        ld d,(hl)
        push hl
        lhld fadr
        add hl,de
        ex de,hl
        pop hl
        ld (hl),d
        dec hl
        ld (hl),e
        pop hl
        dec bc
        jp pre3

pre4:   pop hl
        shld cdp
        ret

cmh:    push af
        ld a,h
        cpl
        ld h,a
        ld a,l
        cpl
        ld l,a
        inc hl
        pop af
        ret


sqish:  push bc
        ld b,h
        ld c,l
        add hl,de
        ex de,hl
        lhld cdn
sq2:    ld a,(de)
        ld (bc),a
        ld a,d
        cp h
        jp nz,sq3
        ld a,e
        cp l
        jp nz,sq3
        pop bc
        ret
sq3:    inc de
        inc bc
        jp sq2


reslv:  ld hl,tab1
        ld d,0
rlv2:   ld a,(hl)
        or a
        ret z
        inc hl
        jp p,rlv2
        ld a,(hl)
        and 7fh
        ld b,a
        inc hl
        ld c,(hl)
        inc hl
        push hl
        push de
        ld l,d
        ld h,0
        add hl,hl
        ld de,tab2
        add hl,de
        ld e,(hl)
        inc hl
        ld d,(hl)
        call getcdf
        add hl,de
        shld doresv
        pop de
        pop hl

rlv3:   ld a,b
        or c
        jp nz,rlv4
        inc d
        jp rlv2

rlv4:   push de
        push hl
        inc hl
        ld l,(hl)
        ld h,0
        add hl,hl
        ld de,tab2
        add hl,de
        ld e,(hl)
        inc hl
        ld d,(hl)
        pop hl
        ld a,(hl)
        inc hl
        inc hl
        call dores
        pop de
        dec bc
        jp rlv3


dores:  push hl
        push bc
        ld c,a
        ld b,0
        ld hl,0
        add hl,bc
        add hl,bc
        add hl,bc
        inc hl
        add hl,de
        ex de,hl
        lhld doresv
        ex de,hl
        ld (hl),e
        inc hl
        ld (hl),d
        pop bc
        pop hl
        ret


entt1:  ex de,hl
        ld hl,tab1
        ld bc,0
        xor a
        sta fcnt2
et1a:   ld a,(hl)
        or a
        jp z,et1c
        push bc
        call stcmp
        pop bc
        jp z,et1d
        lda fcnt2
        inc a
        sta fcnt2
et1b:   call past1e
        inc bc
        jp et1a

et1c:   ld a,(de)

        IF CPM
        call mapuc2
        ENDIF

        ld (hl),a
        inc de
        inc hl
        or a
        jp p,et1c
        ld (hl),0
        inc hl
        ld (hl),0
        inc hl
        ld (hl),0
        dec hl
        dec hl

        xor a           ;allow this symbol entry
        sta rdngsm
        
        push de
        call ckov2      ;check for table 1 overflow
        pop de

et1d:   lda gotf
        or a
        ld a,(hl)
        inc hl          ;has the function just been read in?
        jp nz,et1e
        or a            ;no. has it been read in previously?
        jp p,et1d2


        lda fcnt2       ;yes. fix reference immediately. first
        ld l,a          ; compute where referenced function will
        ld h,0          ; reside at run time...
        add hl,hl               ;now HL is offset into tab2.
        ld de,tab2      ;get HL pointing to location of address
        add hl,de               ; of referenced function.
        ld a,(hl)               ;and get the address.
        inc hl
        ld h,(hl)
        ld l,a          ;now HL points to the function code in RAM
        ex de,hl                ;need to add offset to get actual
        call getcdf     ; load address
        add hl,de               ;now HL = load address of the referenced func
        shld doresv     ;save it for use by dores.

        lhld fncodb     ;now compute location of reference within
        ex de,hl                ; the new function...DE -> start of code
        lda refv        ;A tells position # of jump vector
        jp dores        ;let dores figure out the rest and do

et1d2:  push de
        ld e,(hl)
        dec hl
        ld d,(hl)
        inc de
        ld (hl),d
        inc hl
        ld (hl),e
        pop de
        inc hl
        call tb1ex

        call ckfng
        ex de,hl
        lhld refv
        ex de,hl
        ld (hl),e
        inc hl
        ld (hl),d
        ret

et1e:   lda rdngsm      ;has new symbol been previously defined?
        or a
        jp z,et1e2

        dec hl          ;perhaps. test if table entry is defined...
        ld a,(hl)
        or a
        inc hl
        jp p,et1e2      ;if bit 7 was set on that byte, it was defined...
                        ; so was it?
        ld de,stgdps    ;yes...complain
        ld hl,sname
        lda fflag       ;forcing all functions from a crl file?
        or a
        jp z,et1e0

        ld a,81h        ;set this so function doesn't get loaded later
        sta gotf
        ld de,stgdpf    ;if so, use special message for duplicate entry
        lhld savnam     ;get pointer to function name
        
        IF FORCE
        push hl
        ld a,(hl)
        cp 'M'
        jp nz,et1e00
        inc hl
        ld a,(hl)
        cp 'A'
        jp nz,et1e00
        inc hl
        ld a,(hl)
        cp 'I'
        jp nz,et1e00
        inc hl
        ld a,(hl)
        cp 'N'+80h
        jp nz,et1e00
        pop hl
        ret

et1e00: pop hl
        ENDIF

et1e0:  call pstg
et1e1:  call pfnm
        call crlf       ;follow with CR-LF combo
        ret             ;and ignore the symbol name this time...


et1e2:  dec hl
        ld a,(hl)
        or 80h
        ld (hl),a
        ld hl,tab2
        add hl,bc
        add hl,bc
        ex de,hl
        lhld cdp
        ex de,hl
        ld (hl),e
        inc hl
        ld (hl),d
        ret

ckfng:  push de
        push hl
        ex de,hl
        lhld fngtt
        ld a,h
        sub d
        jp c,ckfd
        jp nz,ckfng1
        ld a,l
        sub e
        jp c,ckfd
ckfng1: inc hl
        inc hl
        shld fngtt
ckfd:   pop hl
        pop de
        ret

;
; Expand tab1 from the current position of HL by 2 bytes:
;

tb1ex:  push hl
        push bc

        push hl
        lhld tb1end
        ld b,h
        ld c,l
        dec bc
        dec bc
        pop hl

        call cmh
        add hl,bc
        inc hl
        push bc
        ld b,h          ;set BC to the count
        ld c,l

        lhld tb1end
        ex de,hl
        pop hl          ;HL is source addr

        ld a,2          ;if on 8080, do it the hard way
        inc a
        jp po,z80exp

ex8080: ld a,(hl)
        ld (de),a
        dec hl
        dec de
        dec bc
        ld a,b
        or c
        jp nz,ex8080
        jp ckov

z80exp: db 0edh,0b8h    ;LDDR on Z80.

ckov:   lhld tb1end     ;check last byte of tab1 (initialized to zero)
        ld de,-10
        add hl,de
        ld a,(hl)
        or a            ;if still zero, ok
        jp z,ckovok
        ld de,stgt1o    ;else overflow
        jp stgab

ckov2:  push hl
        push bc
        jp ckov
        
ckovok: pop bc
        pop hl
        ret

;
; Test the strings at DE (b7 high on last char) and
; at HL for equality:
;

stcmp:  push bc
        push de
        push hl
stcm1:  ld a,(hl)

        IF CPM
        call mapuc2
        ENDIF

        ld b,a
        ld a,(de)

        IF CPM
        call mapuc2
        ENDIF

        cp b
        jp nz,stcm3
        or a
        jp m,stcm2
        inc de
        inc hl
        jp stcm1
stcm2:  pop de
        pop de
        pop bc
        xor a
        inc hl
        ret
stcm3:  pop hl
        pop de
        pop bc
        ret

;
; Map character in A to upper case, preserving
; the parity bit:
;

mapuc2: push bc
        or a
        push af
        and 7fh
        call mapuc
        ld b,a
        pop af
        ld a,b
        pop bc
        ret p
        or 80h
        ret

;
; Test routine for debugging MARC version under CP/M:
;
        IF TESTING2
test:   ld hl,argvtt    ;test argv
        push hl
        ld hl,2         ;test argc
        push hl
        ld hl,0         ;dummy return address
        push hl
        jp  tpa

argvtt: dw argv0
        dw argv1
        dw argv2

argv0:  db 'clink',0
argv1:  db 't',0
argv2:  db '-s',0
        ENDIF

        IF TESTING OR TESTING3
printf: ex (sp),hl              ;save HL on stack, get string pointer into HL
        push de         ;save DE
        ex de,hl                ;put string pointer into DE
        call pstg       ; print the string
        ex de,hl                ;put return address from DE into HL
        push hl
        call crlf       ; and follow with cr-lf
        pop hl          ;get back return address
        pop de          ; restore DE
        ex (sp),hl              ;put return address back on stack, get back HL  
        ret             
        ENDIF           ;end of test sequence


;
; Return Z true if char is space or tab:
;

twhite: cp ' '
        ret z
        cp tab
        ret

wsp:    equ getfn

ascb:   ds 4    ;ascii buffer used for hex-to-decimal conversion
        db 0

curtop: ds 2    ;pointer to top of user memory

zsysf:  ds 2    ;z systems flag

donef:  ds 1    ;tells if all linked up yet
decl:   ds 1    ;disk from which to get deff and deff2
cdp:    ds 2    ;points to next free space in code
cdn:    ds 2
enst:   ds 2    ;used to pass disk addr of function to "rdfun"
enend:  ds 2    ;used to pass last disk addr of function + 1 to "rdfun"
smsf:   ds 2    ;external data block size
quietf: ds 1    ;true if we don't want to complain if can't open file


fcnt:   ds 1    ;function count...holds current function number
fcnt2:  ds 1
gotf:   ds 1    ;set true when calling "entt1" w/ just-loaded function
statf:  ds 1    ;true if -s option given
wflg:   ds 1    ;true if -w option given
segf:   ds 1    ;true if segment being linked
zflag:  ds 1    ;true if -z option given
tmpnr:  ds 1    ;workspace used by "setdat" routine
fngtt:  ds 2
refv:   ds 2
fadr:   ds 2
bufp:   ds 2
buffp:  ds 2    ;used by gsyms routine as buffer pointer

cline:  ds 140  ;elongated for v1.32
sname:  ds 15
cptr:   ds 2
mflag:  ds 1
dflag:  ds 1    ;true if we've scanned DEFF.CRL under CP/M, or if we've
                ;scanned all deff?.crl files under MARC

taddr:  ds 2    ;address of top of memory available to running program
taddrf: ds 1
eflag:  ds 1    ;if external address supplied
eaddr:  ds 2    ;if eflag true: extern. addr.
extadd: ds 2    ; final external address.
wrsmf:  ds 1    ;true if writing symbols to disk during outch calls
rdngsm: ds 1    ;true if reading a symbol from a file
nsmbs:  ds 2
tbase:  ds 2
fflag:  ds 1    ;true when loading all functions; else scanning for needed ones
runsat: ds 2    ;load address
savcdp: ds 2    ;save cdp here while reading in symbols
debugf: ds 1    ;true if running file instead of writing to disk
argptr: ds 2    ;points to arg list text if used with -d option
fncodb: ds 2    ;used in new mod to do reference fixing on the fly
doresv: ds 2
fargb:  ds 2
savnam: ds 2    ;used to save function name pointers for error printout
tb1siz: ds 2
cda:    ds 2
tb1end: ds 2
tab2:   ds 512
direc:  ds 512

        IF CPM
d2flag: ds 1    ;true if we've scanned DEFF2.CRL
d3flag: ds 1    ;true if we've scanned DEFF3.CRL
hflag:  ds 1    ;true if Leo want's lhld 4206 instead of 0006
tbp:    ds 2
ccpok:  ds 1
spsav:  ds 2
nflag:  ds 1    ;true if "-n" for noboot given
curusr: ds 1    ;current user area number
savdrv: ds 1    ;saved drive number when temporrily gone elsewhere
search: ds 1    ;true to search current drive/user area for file, then default
        ENDIF

        IF MARC
argc:   ds 1
argv:   ds 2
marcfd: ds 1
maxmd:  ds 1    ;true if maxmem call done yet
iflag:  ds 1    ;true if image mode output file wanted; else load format file
btsav:  ds 1    ;scratch used by writld routine
endtst: ds 1
datap:  ds 2
runsav: ds 2
oflag:  ds 1    ;true if -o given
noffst: ds 2    ;either 0 or 6, depending on whether -c option used
fcbs:   ds 40
fcbt:   ds 40
consfd: ds 1    ;1 if console output going to stdout, or 2 for stderr
dlast:  ds 1    ;last deff?.crl file searched ('1', '2', ...), or 0 if none
        ENDIF

        ds 75
stack:  equ $

tab1:   equ $           ;reference table begins here

        ;IF LASM
        ;end
        ;ENDIF