;
; clinka.asm:
;
; BDS C Linker 3/86
;
; Copyright (c) 1980, 1981, 1982, 1986 by Leor Zolman, BD Software, Inc.
;
; Added -f option 4/15/81: forces loading all functions in next crl file
; Added -n option 9/9/82: activates NOBOOT mechandsm in COM file
; Added defdsk/defusr mechandsm to library file searches 9/12/82
; Added -z option to inhibit clearing of externals 11/15/82
;
; MARC-specific features:
; Gets deff.crl, deff2.crl and c.ccall c,from /libC unless -c is given
; Added -i option to produce absolute image under MARC instead of default
; load file formatted output.
; Added -m option for MARC: makes c.ccall c,do a "mexmem" call before setting SP
; Changed -m to cause NON-maxmem. I.e., replaced "call marc" with "nop"s.
;org tpa
jp clink
;
; Configuration block:
;
if not PREREL
defdsk: db 0ffh ;default disk for library files (0=A, etc., FF=current)
defusr: db 0ffh ;default user area for lib files, FF = current
endif
if PREREL
defdsk: db 0ffh
defusr: db 0ffh
endif
defsub: db 0 ;default submit file on A: for distribution version
conpol: db 1 ;true to poll for console interrupts
wboote: db 0 ;true to perform warm-boot on exit
pstrip: db 1 ;(dummy in CLINK:) parity strip
nouser: db 0 ;true to disable usage of set user area calls
;
;end configuration block
;
patch: ds 19 ;reserved for future expansion (adjust when adding
; bytes above)
clink:
;OS_HIDEFROMPARENT
;ld e,6 ;textmode
;OS_SETGFX
call initstdio
;shld zenvad ;save Z environment pointer (if in HL)
;ld hl,0 ;save system SP
;add hl,sp
;shld spsav ;save system SP
ld sp,0;stack ;set up own stack
;call zsetup
lhld errbyt
ld (hl),0 ;no error by default
call copycline
;TODO options before filename? but the example is "clink $1 -s"
ld de,cline
ld hl,fcb+1
;OS_PARSEFNAME
ld b,8
parsefn0
ld a,(de)
ld (hl),a
cp '.'
jr z,parsefn1
cp ' '+1
jr c,parsefn1
inc hl
inc de
djnz parsefn0
jr parsefnq
parsefn1
ld (hl),' '
inc hl
djnz parsefn1
parsefnq
call linit ;initialize linker
ld de,stg0 ;print opening message
call pstg
xor a
sta zsysf ;not zsystems, by default
call comlin ;process immediate command line options
IF CPM
lda defdsk ;set default disk for library files
inc a
sta deffs
sta deff2s
sta deff3s
sta ccc
ENDIF
ld de,tab1 ;set code area pointer to
lhld tb1siz
push hl ;save tab1 size
add hl,de
dec hl
shld tb1end ;save addr of end of tab1
ld de,100 ;leave some space in case of
add hl,de ; tab1 overflow
shld cda
shld cdp
ld hl,tab1
pop bc ;get tab1 size
c4: ld (hl),0 ;clear tab1
inc hl
dec bc
ld a,b
or c
jp nz,c4 ;if not, keep looping
IF TESTING3 ;print out contents of fcbs
push af
call printf
db 'before reading c.ccc, fcbs is: ',0
push hl
ld hl,fcbs
call pfnamu
pop hl
call crlf
pop af
ENDIF
IF CPM
call setdu ;set up default library file user areas
ENDIF
call readc ;read in c.ccc (if not a segment)
IF ZSYS ;had no endif!!!
lhld cda ;check load address for consistency
ld de,0bh ;offset for load addr in header
add hl,de
ld e,(hl)
inc hl
ld d,(hl) ;DE now = load addr from header
lhld runsat
call cmphd
jp z,c400
ld de,stglde
call pstg
jp abort
c400:
ENDIF
; IF CPM
;lda curusr ;go back to current user area
;ld e,a
;ld c,sguser
;lda nouser
;or a
;IF NOT ALPHA
;call z,bdos
;ENDIF
;ENDIF
IF MARC
ld hl,fcbt ;put crl extension on main filename
push hl
call scrl
pop hl
ENDIF
c40:
IF TESTING3 ;print out contents of fcbs
push af
call printf
db 'before reading in main file, fcbs is: ',0
push hl
ld hl,fcbs
call pfnamu
pop hl
call crlf
pop af
ENDIF
call gnfl ;open main file and read in directory
jp c,abort ;abort if can't find it
IF TESTING
call printf
db 'just successfully opened main file',0
ENDIF
IF CPM
ld a,4
sta nr
call reads ;get external data area size and exaddr parameters
ENDIF
IF NOT CPM
ld hl,tbuff
ld de,10
call reads
ENDIF
lhld tbuff+3 ;get external data size.
shld smsf
lda tbuff ;was explicit external area given?
or a
jp z,c4a ;if not, skip setting eaddr
sta eflag ;if so, tell that we have an explicit address
lhld tbuff+1 ;and copy the passed external address into eaddr
shld eaddr
c4a: ld hl,stgm ;read in "main" function
call ft2 ;is it there?
jp nc,link2
ld hl,stgmn ;try long version also
call ft2
jp nc,link2
ld de,stg6 ;no. can't link.
c2: call pstg ;print error message
IF MARC
ld hl,fcbt
ENDIF
call pfnamu ;print file in which error occurred
jp abort ;and abort
link2: ld a,255 ;initialize function number to -1
sta fcnt
ld hl,stgmn
ld a,1
sta gotf
call entt1 ;enter "main" function in table
call pre ;read it in
IF TESTING
call printf
db 'returned from ''pre'' call for main function...',0
ENDIF
link3: call gtfns ;get all we can from current CRL file
link4:
; IF CPM
ld a,1
sta search ;search default path unless otherwise set by getfn
;ld c,sguser ;set user area back to current
;lda curusr
;ld e,a
;lda nouser
;or a
;IF NOT ALPHA
;call z,bdos
;ENDIF
;lda savdrv ;any drive number saved?
;or a
;jp z,link5
;dec a ;if so, change back to it
;ld e,a
;ld c,select
;call bdos
;xor a
;sta savdrv ;and clear saved drive byte
; ENDIF
link5: call fungt ;are there any functions missing?
jp c,linkd ;if not, all done
call getfn ;else get name of new CRL file to search
IF MARC
ld hl,fcbt ;get pointer to the just-gotten crl filename
ENDIF
call gnfl ;open it and read in directory
jp nc,link3 ;if opened OK, go read in some functions...
;
; At this point, all files on the command line and all default
; library files have been loaded...
;
IF MARC ;under MARC, set dflag to indicate that all
ld a,1 ;deff?.crl files have been searched at least once.
sta dflag
ENDIF
jp link4 ;go see if there's more linking to do.
linkd: ld a,1
sta donef ;all done. scan rest of command line
lda mflag ;if it hasn't been scanned through
or a ;already...
call nz,getfn
call reslv ;resolve function references
call getcdf2 ;get default external address
push hl ;save in C.Ccall c,for use by "codend()" function
lhld cda
ld de,codend
add hl,de
pop de
lda segf ;if segment, don't write into code!
or a
jp nz,linkd0
ld (hl),e
inc hl
ld (hl),d
linkd0: ex de,hl
lda eflag ;-e option specified?
or a
jp z,linkd1
lhld eaddr ;yes. get the value given in -e option instead
linkd1: push hl ;save as external starting address in C.CCC
lhld cda ; for run-time use.
ld de,extrns
add hl,de
pop de
lda segf ;if segment, don't write into code!
or a
jp nz,lnkd1a
ld (hl),e
inc hl
ld (hl),d
lnkd1a: ex de,hl
shld extadd
ex de,hl
lhld smsf ;get size of external area
add hl,de ;add to start of external area
push hl ;and store where it'll be available to the
lhld cda ;endext library routine
ld de,freram
add hl,de
pop de
lda segf ;if segment, don't write into code!
or a
jp nz,lnkd1b
ld (hl),e
inc hl
ld (hl),d
lnkd1b:
lda zflag ;-z option given?
or a
jp z,skip1
lhld cda ;if so, disable the external clearing subroutine
ld de,clrex ;by changing the first byte of the appropriate
add hl,de ;jump vector from C3 into C9.
ld (hl),0c9h
skip1:
lda segf ;if segment, don't do rest of this kludgery
or a
jp nz,linkf
lhld cda ;get ptr to startup code in HL
IF ZSYS
ld de,lxiloc
add hl,de
ENDIF
lda taddrf ; -t option given?
or a
jp nz,linke
if 1==0
lda nflag ;noboot option given?
or a
jp z,linkd2 ;if not, go handle normally
; Configure for NOBOOT:
IF ZSYS
push hl
lhld cda
ld de,noboot
add hl,de
ld (hl),1 ;set noboot flag in runtime
pop hl
jp linkf
ENDIF
IF NOT ZSYS
ld (hl),0c3h
inc hl
ld (hl),(snobsp and 255) ;low byte of snobsp address
inc hl
ld (hl),(snobsp / 255) ;high byte of snobsp
ld de,8 ;point HL at nobret jump op
add hl,de
ld (hl),(nobret and 255) ;low byte of nobret address
inc hl
ld (hl),(nobret / 255) ;high byte of nobret address
lhld curtop ;get top of available memory
shld taddr
jp linkf
ENDIF
linkd2: ;no -n given.
endif
;ld (hl),2ah ;no. generate initial "lhld ram+6, ld sp,hl"
;inc hl
;ld de,bdosp ;at run time, ram+6 points to base of bdos
;ld (hl),e
;inc hl
;ld (hl),d
;inc hl
;ld (hl),0f9h ; ld sp,hl to set SP to top of TPA
jp linkf
linke:
ex de,hl ;save code loc in DE
lhld taddr ;if -t option given, leave the "ld sp, stack"
ex de,hl ; instruction there, and insert given value.
inc hl ;pass the ld sp op
ld (hl),e ;store value
inc hl
ld (hl),d
linkf:
IF ZSYS ;handle setup of Z3 Header:
lhld runsat
ex de,hl
ld hl,tpa
call cmphd ;standard load address?
jp z,linkf2 ;if so, no problem
push de ;save runsat address
lhld cda ;make type 3 header
ld (hl),0c7h ;RST 0, so won't crash vandlla CP/M
ld de,8 ;offset to Z type
add hl,de
ld (hl),3 ;make type 3
inc hl
inc hl
inc hl ;point to load addr
pop de ;get back runsat address
ld (hl),e ;store runsat address in header
inc hl
ld (hl),d
ENDIF
linkf2:
call pstat ;print out stats
ld de,stgok ;print completion message
call pstg ;and free-ram diagnostic
ld hl,NEDOOSMEMTOP;lhld bdosp ;protected memory highest available tpa addr
ld l,0
ex de,hl
lhld cdp
call cmh
add hl,de
ld a,h
rra
rra
and 3fh
ld l,a
ld h,0
dec hl
call prhld
ld de,stglo
call pstg
IF TESTING3 ;print out contents of fcbs
push af
call printf
db 'right before calling writf, fcbs is: ',0
push hl
ld hl,fcbs
call pfnamu
pop hl
call crlf
pop af
ENDIF
IF MARC
call crlf
ld a,2
sta consfd ;route write error messages to stderr
ENDIF
call writf ;write out file or execute directly
IF CPM
exit: QUIT ;lda wboote ;need to do warm boot?
;or a
;jp nz,ram ;if so, go do it
;lhld spsav ;put saved CCP stack pointer in SP
;ld sp,hl
;lda ccpok ;CCP still intact?
;or a
;ret nz ;if so, return
;lda oktort ;ok to return despite ccpok being false?
;or a
;ret nz ;if so, return
;jp ram ;otherwise warm-boot
subfile: db 1,'$$$ SUB',0,0,0,0
ENDIF
IF MARC
ld hl,0 ;return code: A OK
exit: ld c,m$exit
jp msys
ferror: ld c,m$error
call msys
ld hl,-1
jp exit
putext: ld a,(hl)
or a
jp z,putxt2
inc hl
jp putext
putxt2: pop de ;get pointer to extension to be put on
putxt3: ld a,(de)
ld (hl),a
inc hl
inc de
or a
jp nz,putxt3 ;copy to (HL) until zero encountered
ex de,hl ;then jump to byte after the zero byte to return
pchl
ENDIF
if 1==0
;
; Set up ZCPR3 environment:
;
zsetup: xor a
sta zenvf
inc a ;ok to return, by default
sta oktort
ld hl,errdum
shld errbyt
lhld zenvad
push hl
ld de,1bh
add hl,de
ld e,(hl)
inc hl
ld d,(hl) ;get reflexive env addr from env
pop hl ;original Z env value
call cmphd ;save as reflexive address?
jp nz,setp2a ;if not Z system, go handle
push hl
ld de,22h ;point to message buffer address
add hl,de
ld a,(hl)
inc hl
ld h,(hl)
ld l,a ;HL -> message buffer
ld de,6 ;get address of error byte
add hl,de
shld errbyt ;save the address
pop hl
ld a,1
sta zenvf ;Z system.
push hl ;save env pointer
ld de,3fh ;get potential ccp address
add hl,de
ld a,(hl)
inc hl
ld h,(hl)
ld l,a
shld ccpad
pop hl ;get env pointer
ld de,8 ;get type
add hl,de
ld a,(hl)
sta envtyp
and 80h ;b7 hi?
lhld ccpad
jp nz,setup3 ;if so, use ccpad as ccp address
setp2a: lhld 0001h ;else calculate the old way
ld de,-1603h
add hl,de
setup3: xor a ;clear 'ccp volatile' flag
sta ccpok
ex de,hl ;put ccp address in DE
ld hl,NEDOOSMEMTOP;lhld bdosp
ld l,0 ;zero out low-order byte
call cmphd ;set Cy if [BASE+6,7] < CCP
jp c,setup4 ;if BASE+6 < CCP, use BASE+6 as end of prot mem
ex de,hl ;else use CCP as end of prot. mem.
ld a,1 ;and set ccp volatile flag
sta ccpok
xor a ;NOT ok to return by default!
sta oktort ; (go by value of ccpok)
setup4: shld curtop
ret
envtyp: ds 1
zenvf: ds 1 ;true if running under ZCPR3
zenvad: ds 2
ccpad: ds 2 ;address of CCP for type 80h ZCPR3
endif
oktort: ds 1 ;ok to return despite ccpok being false?
errbyt: dw errdum ;address of Z3 error byte
errdum: ds 1 ;if CP/M, errbyt points here
IF CPM
fcbt: db 0
db ' '
db ' '
db 0,0,0,0
ENDIF
IF CPM
fcbs: db 0 ;name of output file buffer
db ' ' ;8 filename spots
db 'COM'
db 0,0,0,0
ENDIF
IF NOT ALPHA AND NOT ZSYS
stg0: db 'BD Software C Linker v'
ENDIF
IF NOT ALPHA AND ZSYS
stg0: db 'BD Software C Linker (for ZCPR3) vZ'
ENDIF
IF ALPHA
stg0: db 'BDS Alpha-C Linker v'
ENDIF
IF NOT ZSYS
db '1.'
ENDIF
db version
IF ZSYS
db '.'
ENDIF
db update
IF PREREL
db ' (pre-release)'
ENDIF
IF CPM
db cr,lf,0
ENDIF
IF MARC
db ' for MARC',lf,0
ENDIF
stg2: db 'Error reading: ',0
IF CPM
stgnua: db 'No user area prefix allowed on main filename',0
stg5: db lf,'Dir full; ',cr
ENDIF
IF NOT CPM
stg5: db lf,'Error creating output file: ',0
ENDIF
stg3: db lf,'Error writing: ',0
stg4: db lf,'Can''t close: ',0
stg6: db 'No main function in ',0
stgas: db cr,lf,'Missing function(s):',cr,lf,0
stg7: db lf,'Type the name of a CRL file '
db 'to scan; ',cr,lf
IF CPM
db '<CR> to scan all DEFF files, '
ENDIF
IF NOT CPM
db '<CR> to scan all deff?.crl files, '
ENDIF
IF CPM
db '^Z-<CR> to abort: ',0
ENDIF
IF NOT CPM
db 'or your ''quit'' char to abort: ',0
ENDIF
stgm: db 9dh
stgmn: db 'MAI','N'+80h,0
IF CPM
deffs: db 0,'DEFF CRL',0
deff2s: db 0,'DEFF2 CRL',0
deff3s: db 0,'DEFF3 CRL',0
ccc: db 0,'C CCC',0
ENDIF
IF NOT CPM
deffs: db '/libC/deff0.crl',0
ccc: db '/libC/c.ccc',0
ENDIF
stg1: db 'Can''t find ',0
stglca: db 'Last code address: ',0
stgext: db cr,lf,'Externals start at ',0
stgxt2: db ' occupy ',0
stgxt3: db 'bytes, last byte at ',0
stgtm: db cr,lf, 'Top of memory: ',0
stgds: db cr,lf, 'Stack space: ',0
stgabt: db bell,'Link ABORTED',cr,lf,0
IF CPM
stgdo: db bell,cr,lf,'Warning! Externals extend into the BDOS!',cr,lf,0
ENDIF
IF MARC
stgdo: db lf,'Warning! Externals extend into system memory!',lf,0
ENDIF
IF CPM
stgdo2: db bell,lf,'Warning! Externals overlap code!',cr,lf,0
ENDIF
IF MARC
stgdo2: db lf,'Warning! Externals overlap code!',lf,0
ENDIF
stgom: db 'Out of memory',0
stglo: db 'K link space remaining',cr,lf,0;cr,0
stgok: db 'Writing output...',cr,lf,0
stgserr: db 'Bad symbols',0
stgdeb: db lf,'Executing:',cr,lf,0
stglde: db 'Load Address does not match Z3 Header in Runtime Pkg',cr,lf,0
stgbop: db 'Bad option: -',0
stgt1o: db 'Ref table overflow',0
stgver: db 'Missing arg to -'
stgdps: db 'Symbol re-defined: ',0
stgdpf: db 'Ignoring duplicate function: ',0
stgabo: db '^C',cr,lf,0
IF MARC
stgnof: db 'Usage: '
db 'clink <main_crl_file> [-cmsvw]'
db ' [-e <addr>] [-t <addr>] [-l <addr>]'
db lf
db tab,'[-o <new_name>] [-y <sym_name>]'
db ' [<crl_file> [<crl_file>] ... ]'
db 0
ENDIF
opletr: ds 1
db 0
stgtmf: db 'Sorry; 255 funcs max',0
;
; Initialize linker:
;
linit: ;ld c,sguser ;get current user area
;ld e,0ffh
;lda nouser
;or a
;IF NOT ALPHA
;call z,bdos
;ENDIF
;IF ALPHA
;nop
;nop
;nop
;ENDIF
;sta curusr ;save current user area number
lda defsub
inc a
sta subfile
xor a
sta wrsmf ; "outch" not to write to SYM file
IF MARC ;under marc, initialize message output fd
ld a,1
sta consfd ;route first msgs to stdout (1)
ld hl,0
shld noffst ;search /libC by default for deff*.crl & c.ccc
ld c,m$memory ;get top of memory value before doing maxmem call
call msys
ex de,hl
shld taddr ;taddr before maxmem call
ld c,m$maxmem ;do a maxmem call
call msys
ld a,1
sta maxmd ;note that we've done the maxmem call (once only)
ld c,m$memory ;get top of memory AFTER maxmem call has been done
call msys
ex de,hl
shld curtop ;and as physical top of memory for linkage
ENDIF
IF MARC ;if MARC version, get argc and argv:
sta marcfd ;clear marcfd in case of usage diagnostic
pop af ;skip return address
pop hl ;get argc passed by MARC
ld a,l ;set A = argc
dec a
ld de,stgnof ; complain and abort if no filename given
jp z,stgab
sta argc ;else save argc for later use
pop hl ;get argv passed by MARC
inc hl
inc hl ;point argv to main filename pointer
shld argv ;save pointer to main filename pointer
ld a,(hl) ;indirect to get pointer to main filename
inc hl
ld h,(hl)
ld l,a
push hl ;save it on stack
ld de,fcbt ;copy main filename to fcbt for use in reading
call ldfn ; in main crl file
pop hl ;and also copy to fcbs for use in writing out file
ld de,fcbs
call ldfn
ENDIF
IF TESTING3 ;print out contents of fcbs
push af
call printf
db 'after first setting fcbs, fcbs is: ',0
push hl
ld hl,fcbs
call pfnamu
pop hl
call crlf
pop af
ENDIF
IF CPM
ld de,tbuff ;set DMA address
ld c,sdma ;(helps me debug 4200h version
call bdos ; on 0-based CP/M system)
ld hl,fcb ;save filename argument
ld de,fcbs
call ldfn ;lde main filename to fcbs
ld hl,fcbs+9 ;and give it a COM extension by default
ld (hl),'C'
inc hl
ld (hl),'O'
inc hl
ld (hl),'M'
ENDIF
xor a ;clear some flags:
sta segf ;assume not a segment by default
sta debugf ;don't immediately execute file
sta statf ;default to no stats
sta dflag ;haven't searched DEFF.CRL yet
sta quietf ;report unfound files
sta rdngsm ;not reading in symbols from disk
sta taddrf ;no top of memory address given yet
sta eflag ;no external data addr given yet
sta donef ;all function references not resolved yet
sta wflg ;controls writing of SYM file
IF CPM
sta zflag ;don't inhibit clearing of externals
sta d2flag ;haven't searched DEFF2.CRL either
sta d3flag ;haven't searched DEFF3.CRL either
sta nflag ;no noboot option given yet
sta hflag ;don't force lhld 4206 unless -h given
sta savdrv ;no drive number currently saved
ENDIF
IF MARC
sta dlast ;last DEFF?.CRL searched (0 for none)
sta marcfd ;no file open yet
sta iflag ;no image mode output file unless -i used
sta oflag ;haven't seen -o yet
; sta maxmd ;haven't done maxmem call yet
ENDIF
IF NOT FORCE
sta fflag ;no forced loading of all funcs in crl file
ENDIF
inc a
sta mflag ;more text to process in command line
IF FORCE
sta fflag ;force loading of all funcs in crl file
ENDIF
IF CPM
lda fcb ;default disk to get CRL files from
sta decl ; is disk where source file came from
lhld curtop ;set protected memory address
shld taddr
ENDIF
ld hl,dt1siz ;set default tab1 size
shld tb1siz
ld hl,tpa ;default starting address
shld runsat ; (alterable only if -l option used)
ret
;
; Process immediate command line options:
;
copycline
IF CPM
;ld hl,fcb+1 ;see if user area given as part of filename
;call gdec
;jp c,clink0 ;if not, OK
;ld a,(hl) ;else, followed by slash?
;cp '/'
;jp nz,clink0 ;if not, no problem
;ld de,stgnua ;else abort with "no user number allowed" message
;jp stgab
clink0: ld hl,cline ;copy command line from tbuff to area at cline
shld cptr ;under CP/M
ld hl,tbuff
comlin_fspac:
ld a,(hl)
or a
jr z,comlin_fspac_skip
inc hl
cp ' '
jr nz,comlin_fspac
comlin_fspac_skip
;ld b,(hl)
;inc b
;inc hl
ld de,cline
c0: ;dec b
;jp z,c0a
ld a,(hl)
ld (de),a
or a
inc hl
inc de
jr nz,c0
ENDIF
IF NOT CPM
ld a,2
sta consfd ;future msgs to go stderr
ld hl,cline ;copy all MARC args into area at cline, emulating
shld cptr ;CP/M command line passage
ex de,hl ;DE is destination area
lhld argv ;HL will point to arg text
c00a: lda argc ;get arg count
or a
jp z,c0a ;if done, go process the line
dec a
sta argc ;not done. debump argc and copy current arg text
push hl ;save pointer to text address
ld a,(hl)
inc hl
ld h,(hl)
ld l,a ;HL points to actual arg text
call ldfn ;lde it to (DE)
dec de ;stomp on the trailing null from the last arg text
ld a,' ' ; (replace it with a space)
ld (de),a
inc de
pop hl ;restore arg pointer
inc hl ;bump to next pointer
inc hl
jp c00a ;and go for it
ENDIF
c0a: xor a ;OK, command line has been copied
ld (de),a ;terminate with null byte
ret
comlin:
ld hl,cline ;find first non-space char
call igsp
or a ;if end of line,
jp z,c1 ; don't pass over main filename
c0c: inc hl ;else do.
ld a,(hl)
or a
jp z,c1
call twhite
jp nz,c0c
call igsp ;pass space between this and next arg
c1: shld cptr ;save text pointer for getfn routine
;
; Here process -l and -r and -v; set tb1siz to optional arg of -r,
; set runsat to optional arg of -l, and set segf if -v given:
; also handle new -c option for MARC
; Also handle new -m option to call MEXMEM under MARC...
;
dec hl
prep0: inc hl
prep: ld a,(hl)
or a ;done preprocessing command line?
ret z ;if so, return
cp '"' ;possible option to "-d"?
jp nz,prep3
prep2: inc hl ;if so, skip it totally
ld a,(hl)
or a
ret z ;if null byte, done scanning command line
cp '"'
jp nz,prep2
jp prep0 ;then continue scanning for useful options
prep3: cp '-' ;no. dashed option?
jp nz,prep0 ;if not, ignore it
shld fargb ;else save first arg byte
inc hl
ld a,(hl) ;get option letter
call mapuc
sta opletr ;save for error msg
inc hl
cp 'C' ;set disk to get c.ccc and deff*.crl from
jp z,copt
IF CPM
cp 'H' ;little kludge (for Leo only)
jp z,hopt
ENDIF
IF MARC
cp 'I' ;image mode?
jp z,iopt
ENDIF
cp 'L' ;set load addr?
jp z,lopt
cp 'R' ;set ref table size?
jp z,ropt
dec hl
cp 'V' ;declare a segment?
jp nz,prep
inc hl
sta segf ;this one's easy.
purge: ex de,hl ;put current text addr in DE
purge1: lhld fargb ;get 1st byte of arg
purge2: ld (hl),' ' ;clear it to a space
inc hl
call cmphd ;done?
jp nz,purge2 ;keep blanking till done.
jp prep ;and go pre-process some more
ropt: call gtaddd ;get argument
ex de,hl
ld a,h
or a
jp z,purge1 ;must be at least 100h to be reasonable!
shld tb1siz ;set tab1 size;
jp purge1 ;and go purge text from command line
copt:
IF CPM
call igsp
call cnvtd ;get source disk for C.CCC and DEFF*.CRL
sta defdsk ;(under CP/M only; MARC version assumes
;all this stuff is in /etc)
inc hl ;bump text pointer to possible user area
call gdec ;user area given?
jp c,copt9 ;if not, done with -c option
sta defusr ;else user area given. Store it at defusr
copt9: ex de,hl
jp purge1
;
; Scan text at HL for a decimal number. If found, return in B and clear Cy.
; Return Cy set if no legal decimal number.
; Upon exit, HL is left pointing to the first non-decimal-digit character.
;
gdec: ld b,0
call igsp
call legdd
ld a,0
ret c
gdec1: ld a,(hl)
call legdd
ld a,b
ccf
ret nc
add a ;get A = 10 * B
add a ;(*4)
add a ;(*8)
add b ;(*9)
add b ;(*10)
add c ;now add new digit value in C
ld b,a ;put into B
inc hl
jp gdec1 ;and go for more
;
; Check for legal decimal digit, return Cy set if illegal,
; else the binary value of the digit in A:
;
legdd: call mapuc
sub '0'
ld c,a
ret c
cp 10
ccf
ret
ENDIF
IF NOT CPM
ex de,hl ;put text pointer in DE
ld hl,6 ;set noffst to 6 so current directory is
shld noffst ;searched for deff*.crl & c.ccc instead of /libC
jp purge1
ENDIF
IF CPM
hopt: sta hflag ;kludge for Leo, under CP/M only
ex de,hl
jp purge1
ENDIF
IF MARC
iopt: sta iflag ;set image mode to produce absolute image
ex de,hl
jp purge1
ENDIF
lopt: call gtaddd ;get argument
ex de,hl
shld runsat ;set origin address
jp purge1 ;and purge from command line
;
; Check for user abortion:
;TODO
ckabrt: push af
push hl
push de
push bc
IF CPM
;lda conpol ;are we polling for interrupts?
;or a
;jp z,noabrt ;if not, ignore console...
;ld c,intcon ;interrogate console status
;call bdos
;or a
;jp z,noabrt
;ld c,coninp
;call bdos
;cp 3 ;control-C aborts
;jp nz,noabrt
;ld de,stgabo ;abort.
;jp stgab
ENDIF
IF NOT CPM
;ld c,m$ichec
;call msys
ENDIF
noabrt: pop bc
pop de
pop hl
pop af
ret
;
; Here is a little routine to take an ASCII char in A that
; is either a space or a disk letter, and return the
; appropriate code in A to put in the first byte of an
; fcb accessing the given disk:
;
IF CPM
cnvtd: call twhite
jp nz,cnvtd2
xor a ;if space, return 0
ret
cnvtd2: sub 'A' ;else return 0 for A, 2 for B, etc.
cp 'Z'+1
ret c ;OK if a letter
xor a ;else change to zero
ret
ENDIF
;
; Given the address of a function as stored in memory during
; the linkage process, this function returns the actual address
; that the function will occupy when executing:
;
getcdf: lhld runsat
push de
ex de,hl
lhld cda
call cmh
add hl,de
pop de
ret
getcdf2: call getcdf
ex de,hl
lhld cdp
add hl,de
ret
;
; Print out the contents of register pair HL in ASCII:
; (uses the simple gas-pump algorithm)
;
prhld: push de
push hl
ld hl,' '
shld ascb
ld hl,' 0'
shld ascb+2
pop hl
inc hl
prh0: ld a,h
or l
jp z,prnt
dec hl
push hl
ld hl,ascb+3
prh1: ld a,(hl)
call twhite
jp nz,prh2
ld a,'0'
prh2: inc a
cp '9'+1
jp z,prh4
prh3: ld (hl),a
pop hl
jp prh0
prh4: ld (hl),'0'
dec hl
jp prh1
prnt: ld de,ascb
call pstg
pop de
ret
;
; Print out file name in the fcb, with user number preceding:
;
pfnamu:
lda nouser
or a
jp nz,pfnam ;if user areas disabled, don't even try
ld e,0ffh
ld c,32
call bdos ;get current user number
call prad ;print out value of A in decimal
ld a,'/'
call outch ;follow with slash, then print rest of filename
;
; Routine to print out the name of the file
; in the fcb:
;
IF CPM
pfnam:
push de
push bc
lda fcb
or a ;if no special disk, don't print a letter
jp nz,pfnam1
;push de
;push hl
;ld c,gdisk
;call bdos
;inc a
;pop hl
;pop de
xor a ;TODO getpath
pfnam1: add a,'@' ;make it into the disk letter
call outch
ld a,':'
call outch
pfnam2: ld b,8
ld de,fcb+1
call pnseg ;print filename
ld a,'.'
call outch
ld b,3
call pnseg ;print extension
call crlf
pop bc
pop de
ret
;
; Print out user number in A in decimal:
;
prad: push bc
call prad2
pop bc
ret
prad2: ld c,0 ;compute first digit
prad3: cp 10 ;less than 10?
jp c,prfd ;if so, print first digit
sub 10 ;else subtract 10
inc c ;bump tens digit
jp prad3
prfd: push af ;save last digit
ld a,c ;look at first digit
or a ;zero?
call nz,prhd ;if not, print it
pop af ;get last digit
jp prhd ;print it
;
; print out string at DE, max length B,
; delete spaces:
;
pnseg: ld a,(de)
pns2: call outch
inc de
dec b
ret z
ld a,(de)
call twhite
jp nz,pns2
pns3: inc de
dec b
jp nz,pns3
ret
ENDIF
;
; Print out statistics in response to -s option:
;
pstat: call alphab ;alphabetize symbols
; lda statf ;if printing stats, put out a crlf
; or a
; call nz,crlf
; call crlf
call wrsmb ;write symbols to disk and console
; lda statf ;if stats desired,
; or a ;print them out
; jp nz,pst00
;
; call ovrlap ;check for code/externals overlap
;
; lhld smsf ;and check for external area overflow into system
; ex de,hl
; lhld extadd
; add hl,de
; jp c,exovfl ;if carry, REAL overflow!
; ex de,hl ;DE holds end of external area
; lhld taddr ;get end of TPA address
; call cmphd ;HL better be less than DE....
; ret nc ;if so, no problem
;exovfl:
; ld de,stgdo ;else trouble!
; call pstg
; ret
pst00: ld de,stglca ; "last code address = ..."
call crlf
call pstg
call getcdf2 ;get last code addr. + 1
dec hl
call prhls ;print last code address out
;
; Print external data stats, but DON'T if linking a segment
; and no -e option is given:
;
lda segf
or a
jp z,pst00a ;if not linking a segment, print all stats
lda eflag ;yes, linking a segment. -e option given?
or a
jp z,pst0 ;if not, skip printing external numbers
pst00a: ld de,stgext ;"external data starts at "
call pstg
lhld extadd
push hl
call prhlc
ld de,stgxt2 ;"occupy "
call pstg
lhld smsf
push hl ;save size of external data area
call prhls
ld de,stgxt3 ;" bytes, and and end at"
call pstg
pop de ;get size of externals
pop hl ;get start of externals
add hl,de ;get ending address of externals
dec hl
push hl ;save for local store calc later
ld a,d ;special case of no externals
or e
jp nz,skpfdg
inc hl
skpfdg: call prhls
pop hl
pst0: push hl
ld de,stgtm ;"top of memory=..."
call pstg
lhld taddr
dec hl
push hl ;save top of memory address
call prhls
lda segf
or a
jp z,pst1
pop de
pop de
jp crlf
pst1: ld de,stgds ;print data & stack space
call pstg ; only if not a segment
pop de ;get saved top of memory address in DE
pop hl ;get external ending address in HL
call cmphd ;check for overflow
push af ;save Cy flag for msg later
jp c,pst2 ;externals end before top of memory?
ld a,'-' ;no-- print a negative sign
call outch
ex de,hl ;exchange so it'll come out positive
pst2: call cmh
add hl,de
call prhls ;print out amount of stack space
call crlf
pop af ;check for overflow condition
ld de,stgdo ;data overflow message
call nc,pstg
ovrlap: call getcdf2 ;check for externals/code overlap
ex de,hl ;put end of code addr in DE
lhld extadd ;get external base address
call cmphd ;is external base < end of code + 1?
ld de,stgdo2
call c,pstg
ret
wrsmb: ld a,4
sta gotf ;init symbols-per-line countdown
sta wrsmf ;and make outch write to disk as well as console
lda wflg ; (to disk only if wflg is on)
or a
jp z,wrsm2 ;write symbols to disk?
IF CPM
ld hl,fcbs
ld de,fcb
call ldfn
ld hl,fcb+9
ld (hl),'S'
inc hl
ld (hl),'Y'
inc hl
ld (hl),'M'
ENDIF
IF NOT CPM
ld hl,fcbs
ld de,fcbt
push de
push de
call ldfn
pop hl
call putext
db '.sym',0
pop hl
ENDIF
call crate2 ;if so, create symbols file
ld hl,tbuff ;init buffer pointer
shld bufp
wrsm2: lhld nsmbs ;set BC = countdown of # of symbols
ld b,h
ld c,l
ld de,0 ;while DE will go the other way
wrsm3: call wsmb ;write out a single symbol and address
inc de ;bump pointer to next symbol pointer
inc de
dec bc ;de-bump countdown
ld a,b ;done?
or c
jp nz,wrsm3 ;if not, keep loopin'
call crlf ;done. put out trailing crlf
IF CPM
ld b,1ah ;terminating control-Z for CP/M (cough cough)
lda wflg ;were we writing to a file?
or a
call nz,wrb3 ;(into file only)
ENDIF
xor a
sta wrsmf ;turn off kludge flag
lda wflg
or a ;writing to disk?
ret z ;if not, all done
IF CPM
ld b,1ah ;if so, pad file with control-Z's for CP/M
lhld bufp
ld a,l
and 7fh
jp z,wrsm6
wrsm4: ld a,l
and 7fh
jp z,wrsm5
ld (hl),b
inc hl
jp wrsm4
wrsm5: ld hl,tbuff
call writs
ENDIF
IF NOT CPM ;for MARC, just write out rest of the buffer
lhld bufp
ld a,l
and 7fh
jp z,wrsm6
ld e,a ;put byte count in DE
ld d,0
ld hl,tbuff
call writs ;write out remainder of symbol text buffer
ENDIF
wrsm6: call close
ret
wsmb: push de ;write out symbol #DE and its value
ld hl,tab2 ;first get value
add hl,de
ld a,(hl)
inc hl
ld h,(hl)
ld l,a ;HL = raw value
push hl ;add offset
call getcdf
pop de
add hl,de
call prhls ;print out value in hex
ld hl,wsp ;now get name
pop de
add hl,de
ld a,(hl)
inc hl
ld h,(hl)
ld l,a
call pfnm ;print out name
lda gotf ;see if we trail with tab or crlf
dec a
sta gotf
jp z,wsmbcr
ld a,9 ;tab.
call outch
ret
wsmbcr: call crlf ;crlf
ld a,4 ;reset line count
sta gotf
ret
;
; Alphabetize symbols for SYM file output and stat printout:
;
alphab: call setwsp ;set up swp with pointers to symbols in tab1
ld bc,0 ;initalize outer loop variable
ab1: lhld nsmbs ;done with outer loop?
dec hl
call cmpbh
ret nc ;if so, all done sorting
ld d,b ;else initialize inner loop
ld e,c
inc de
ab2: lhld nsmbs ;done with inner iteration?
dec hl
call cmphd
jp c,ab4 ;if so, iterate outer loop
call cmptx ;else compare two symbols
jp nc,ab3 ;out of order?
ld hl,wsp ;yes. swap pointers.
shld tbase
call swap
ld hl,tab2
shld tbase
call swap
ab3: inc de ;bump inner loop variable
jp ab2
ab4: inc bc ;bump outer loop variable
jp ab1
cmpbh: ld a,b ;return C set if BC < HL
cp h
ret nz
ld a,c
cp l
ret
cmphd: ld a,h ;return C set if HL < DE
cp d
ret nz
ld a,l
cp e
ret
swap: lhld tbase ;switch the 16 bit values at tbase+BC
add hl,bc ; and tbase+DE
add hl,bc
push bc ;save BC
push hl ;save tbase+BC
ld c,(hl) ; BC := (tbase+BC)
inc hl
ld b,(hl)
lhld tbase
add hl,de
add hl,de
push de ;save DE
ld e,(hl) ; DE := (tbase+DE)
inc hl
ld d,(hl)
ld (hl),b ; (tbase+DE) := (tbase+BC)
dec hl
ld (hl),c
pop hl ;get back original DE in HL
ex de,hl ;put into DE, and HL:=(tbase+DE)
ld b,h ; BC := (tbase+DE)
ld c,l
pop hl ;get back tbase+BC
ld (hl),c ; tbase+BC := tbase+DE
inc hl
ld (hl),b
pop bc ;and restore original BC
ret ;oh well, so it isn't documented all that greatly!
setwsp: ld hl,tab1 ;initialize wsp with pointers to entries in tab1
ld bc,0 ;symbol count
ld de,wsp ;destination of pointers
setw2: ld a,(hl) ;end of tab1?
or a
jp nz,setw3
ld h,b ;yes. set nsmbs to # of symbols found
ld l,c
shld nsmbs
ret ;and return.
setw3: push hl ;not done. enter pointer into wsp...
cp 9dh ;"main" is a special code; fudge the pointer
jp nz,setw4
ld hl,stgmn ;"MAIN'"
setw4: ld a,l
ld (de),a
inc de
ld a,h
ld (de),a
inc de
inc bc ;bump symbol count
pop hl ;restore pointer into tab1
setw5: ld a,(hl) ;pass over symbol text
inc hl
or a
jp p,setw5
ld a,(hl) ;and references (if any)
and 7fh
push de
ld d,a
inc hl
ld e,(hl)
inc hl
add hl,de
add hl,de
pop de
jp setw2 ;and go to next symbol
cmptx: push bc ;compare two symbols
push de ;return C set if wsp(BC) > wsp(DE)
ld hl,wsp
add hl,de
add hl,de
ld e,(hl)
inc hl
ld d,(hl) ;DE points to second symbol
ld hl,wsp
add hl,bc
add hl,bc
ld c,(hl)
inc hl
ld b,(hl) ;BC points to first symbol
call cmpt2 ;compare symbols at BC and DE
pop de ;restore registers
pop bc
ret
cmpt2: ld a,(bc) ;get char
and 7fh ;strip end-of-symbol bit
ld h,a ;save
ld a,(de) ;do same with other symbol
and 7fh
cp h ;compare with first one
ret nz ;if not same, all done
ld a,(de) ;else...is 2nd symbol ended?
or a
jp p,cmpt3
ld a,(bc) ;yes..result depends on whether
or a ;1st symbol is ended...
scf
ret p
ccf
ret
cmpt3: ld a,(bc) ;is 1st symbol ended?
or a
ret m ;if so, it must be smaller than second.
inc bc ;else check next character...
inc de
jp cmpt2
;
; Print out the function name pointed to by HL for the SYM file and
; stat report:
;
pfnm: push bc
ld b,0 ;char count
pfnm1: inc b
ld a,(hl)
push af
inc hl
and 7fh
call outch
pop af
or a
jp p,pfnm1
ld a,b
pop bc
cp 3 ;if >= 3 characters, ignore
ret nc
ld a,9 ;else follow with a tab
jp outch
;
; Print out the value in HL in hex and follow by a space:
;
prhls: call prhl
ld a,' '
jp outch
;
; Print out the value in HL in hex and follow by a comma:
;
prhlc: call prhl
ld a,','
jp outch
;
; Print out the value in HL in hex:
;
prhl: ld a,h
call pra
ld a,l
jp pra
;
; Print out the value in A in hex:
;
pra: push af
rrca
rrca
rrca
rrca
call prhd
pop af
;
; Print out the hex digit in A:
;
prhd: and 15
add a,30h
cp 3ah
jp c,outch
add a,7
jp outch
writf:
IF 1==0;CPM ;don't bother with debugging kludge under MARC yet
lda debugf ;debugging before output?
or a
jp z,writf0 ;if not, go write out CRL file
lda nflag ;don't try it if -n given, though...
or a
jp nz,writf0
ld de,stgdeb ;yes. tell about debugging
call pstg
ld b,0 ;first assume no text string
lda debugf ;now, was a text string given?
dec a
jp z,copybt ;if not, just go ahead and do the bootstrap
lhld argptr ;else copy the text line down into tbuff
ex de,hl ;DE points to the text
ld hl,tbuff+1 ;HL points into tbuff
ld (hl),' ' ;stick in a leading space for good measure
inc hl
inc b
cpytxt: ld a,(de) ;get next text character
call mapuc ;map to upper case just like CP/M does
cp '"' ;end of text?
jp z,copybt ;if so, go set line length and copy bootc
ld (hl),a ;else store the character
inc hl ;bump destination ptr
inc de ;bump source ptr
inc b ;bump char count
jp cpytxt ;and loop till done.
copybt: ld a,b ;get text line count
sta tbuff ;set it for the argc&argv processor
ld hl,boots ;the bootstrap
ld de,bootsa ;where it's going
ld b,bbytes ;length of it
bootlp: ld a,(hl)
ld (de),a
inc hl
inc de
dec b
jp nz,bootlp
jp bootsa ;and go copy the program and run it
;
; This is the bootstrap code, to copy the linked COM file down
; into the tpa and run it.
;
bootsa: equ tbuff+90 ;where this boot will reside
boots: lhld cda ;source addr.
ex de,hl ; into DE
lhld cdp ;last addr. of code + 1
ld b,h
ld c,l ;put last addr. in BC
ld hl,tpa ;destination (start of TPA)
boots1: ld a,(de) ;copy a byte
ld (hl),a
inc hl
inc de
ld a,d ;done yet?
cp b
jp nz,bootsa+12 ;jp nz,boots1
ld a,e
cp c
jp nz,bootsa+12
jp tpa ;yes. Go execute code
bbytes: equ $-boots
ENDIF ;end of CP/M-only debugging hack, 4 the time being
writf0:
IF MARC ;under MARC, put an ".out" extension by default
ld hl,fcbs
push hl ;save for create...
push hl ;save for ldfn...
lda oflag ;was -o option given?
or a
jp nz,writf1 ;if so, don't append '.out' to filename
call putext
db '.out',0
writf1:
pop hl
ld de,fcbt ;copy into fcbt for error reporting
call ldfn
pop hl ;create new version
ld de,755q ;protection mode allows execution
call create
ENDIF
IF CPM
call crate ;create an output file under CP/M
ENDIF
lhld cda
IF CPM ;under CP/M, copy and write one sector at a time
writ2: call copys
push af
push hl
ld hl,tbuff
call writs
pop hl
pop af
jp nc,writ2
ENDIF
IF NOT CPM ;under MARC
push hl ;save starting address
call cmh
ex de,hl
lhld cdp ;get ending address
add hl,de ;subtract starting address
inc hl ;add one to get length of file to write
ex de,hl ;put length in DE
pop hl ;get back starting address
;now HL = start, DE = length
lda iflag ;doing image mode?
or a
jp z,writld ;if not, go write MARC load format file
call writs ;write it out
jp close
writld: push hl ;save object code starting address
lhld runsat ;get load address
shld runsav ;save for load address record at end of write
pop hl ;restore code starting addr
wrtld1: call doblck ;set up and write out a block of object file data
jp nz,wrtld1 ;keep going till all data has been written
ld a,1 ;now write out load address record
sta doblck ;use where "doblck" code was for a buffer
lhld runsav ;get load address
shld doblck+1
ld hl,0400h ;this gets stored as "00 04"
shld doblck+3
ld hl,doblck ; as load address.
ld de,5 ;four bytes for load address record, plus EOF byte
call writs ;and write out this final record
ENDIF
jp close
IF MARC
doblck: shld datap ;save object code pointer for later use
dec hl ;HL--> where length byte goes
ld a,d ;more than 255 bytes left to write?
or a
sta endtst ;(save for EOF Test later)
ld c,e ;in case this is the last, put count in c
jp z,sets2 ;and go away if this is the last
push hl ;else subtract 255 from DE
ld hl,-255
add hl,de
ex de,hl
pop hl
ld c,255 ;and set count = 255
sets2: ld (hl),c ;set length count byte for this block
dec hl
push de ;C contains byte count; save countDOWN register on stk
ex de,hl ;save memory pointer in DE
lhld runsat ;get load address for this block
ex de,hl ;put into DE
ld (hl),d ;transfer to memory
dec hl
ld (hl),e
dec hl
ld (hl),1 ;abs record header byte
push hl ;save start of block for writs
ld l,c ;update load address
ld h,0
add hl,de ;by adding byte count to old load address
shld runsat ;and get it ready for the next iteration
push bc ;save C for count total later
lhld datap ;compute checksum. get pointer to start of data
xor a ;clear checksum accumulation
sets3: add m ;add next byte
inc hl ;bump memory pointer
dec c ;de-bump countdown
jp nz,sets3 ;keep going till done
cpl ;negate A to acheive actual checksum byte
inc a
ld b,a ;save checksum in B
ld a,(hl) ;get byte of data AFTER end of block
sta btsav ;save somewhere for later restortion
ld (hl),b ;replace with checksum (kludge, kludge)
pop bc ;get back byte count in C
ld b,0 ;use to compute total size of block to be written
ld hl,5 ;fudge factor because of ld format overhead
add hl,bc ;add to byte count to get total # byte to write
ex de,hl ;put into DE for writs routine
pop hl ;get pointer to start of block
push de ;save this stuff
push hl
call writs ;write the block
pop hl ;restore this stuff
pop de
add hl,de ;get pointer to start of data for NEXT block
dec hl ;point back to checksum byte, which overwrote data
lda btsav ;get back the byte butchered by the checksum byte
ld (hl),a ;restore it to its proper place
pop de ;get back countdown register
lda endtst ;was this the last block? if so, endtst will be zero
or a ;set the Z flag if so, so we don't come here again...
ret
ENDIF
IF CPM ;only need this sector copy kludge under CP/M
copys: ld de,tbuff
ld b,80h
copy1: ld a,(hl)
ld (de),a
push de
ex de,hl
lhld cdp
ld a,h
cp d
jp nz,copy2
ld a,l
cp e
jp z,copy3
copy2: ex de,hl
pop de
inc hl
inc de
dec b
jp nz,copy1
xor a
ret
copy3: pop de
copy4: dec b
jp z,copy5
ld a,1ah
ld (de),a
inc de
jp copy4
copy5: scf
ret
ENDIF ;end of sector copy kludge
;
; Open a file. Under CP/M, the default fcb is assumed to have been
; set up for a file. Under MARC, a name pointer is passed in HL
; and location "marcfd" is set here to the file descriptor returned
; by the MARC system call; register A is 0 for opening for READ, or
; 1 for WRITE.
;
open: push bc ;save registers
push de
push hl
IF TESTING
push af
call printf
db 'trying to open: ',0
push hl
call pfnamu
pop hl
pop af
ENDIF
IF CPM
xor a
sta fcb+_rrn
sta fcb+_rrn+1
ld de,fcb
ld c,openfil
call bdos
ENDIF
IF NOT CPM
ld c,m$open
call msys
ENDIF
IF CPM
cp 255 ;return value of 255 from CP/M's 'open' means error
jp nz,op2
ENDIF
IF NOT CPM
jp z,op2 ;Z flag under MARC indicates success
ENDIF
ld de,stg1 ;spew an error.
op1: lda quietf ;be quiet about it?
or a
call z,pstg
ld a,0 ;clear quietf.
sta quietf
IF MARC
pop hl
push hl ;get filename string for MARC pfnam routine
ENDIF
call z,pfnamu ;tell name of file that can't be opened
scf ;set carry to indicate error to calling routine
jp op3
op2:
IF CPM
xor a
sta nr
ENDIF
IF NOT CPM
sta marcfd ;store fd for file only if it opened correctly
ENDIF
IF TESTING
call printf
db '....opened OK',0
ENDIF
op3: pop hl
pop de
pop bc
ret
;
; Close a file. Under CP/M, also zero out the extent field so the
; next routine to use the default fcb doesn't go apeshit opening
; the wrong extent.
;
close:
IF TESTING
call printf
db 'closing...',0
ENDIF
IF CPM
push bc
push de
push hl
ld de,fcb
ld c,closefil
call bdos
ld hl,fcb+12
ld (hl),0
pop hl
pop de
pop bc
cp 255
ret nz
ld de,stg4
jp c2
ENDIF
IF NOT CPM
lda marcfd
ld c,m$close
call msys
jp nz,ferror
ld a,0
sta marcfd ;clear fd byte for error recovery
ret
ENDIF
;
; Delete a file. Name is in default fcb for CP/M, or passed in HL
; for MARC:
;
delfil:
IF CPM
ld de,fcb
ld hl,fcb+12
ld (hl),0
ld c,delete
jp bdos
ENDIF
IF NOT CPM
ld c,m$unlink
call msys
jp nz,ferror
ret
ENDIF
;
; Create a file and open it, first deleting any old version.
; Filename is set up in default fcb under CP/M, or pointed to by
; HL under MARC:
;
crate:
IF CPM
ld hl,fcbs
ld de,fcb
call ldfn
crate2: call delfil
call create
; call open ;don't need to call open, since "create" does it for us
ret
ENDIF
IF NOT CPM
crate2: ld de,644q ;protection mode
jp create
ENDIF
;
; Create a new file. Default fcb is set up under CP/M; name pointer
; is passed under MARC along with a protection mode in DE; marcfd
; is set to the fd of the file (since the creat call opens it for writing):
;
create:
IF CPM
ld de,fcb
ld hl,fcb+12
ld (hl),0
ld hl,fcb+32
ld (hl),0
inc hl
ld (hl),0 ;_rrn
inc hl
ld (hl),0 ;_rrn+1
ld c,makfil
call bdos
cp 255
ret nz
ld de,stg5
jp c2
ENDIF
IF NOT CPM
ld c,m$creat
call msys
jp nz,ferror
sta marcfd ;save the fd if it got created OK
ret
ENDIF
;
; Under CP/M, reads in a sector of data from the default fcb,
; setting the Carry flag on end of file,
; and prints something appropriately nasty on error. Under MARC,
; reads in DE bytes to memory at HL from the currently open file:
;
reads:
IF CPM
push hl ;under CP/M
push de
ld de,fcb
ld c,CMD_RNDRD;rsequen
call bdos ;read a sector
ld hl,(fcb+_rrn) ;ok
inc hl
ld (fcb+_rrn),hl ;ok
pop de
pop hl
or a
ret z ;error?
;dec a ;maybe.
scf
ret ;z ;return carry if EOF
ENDIF ;else fall through to error reporting routine
IF MARC ;under MARC:
lda marcfd
ld c,m$read
push de ;save byte count
call msys ;read data
pop bc ;get back byte count in BC
jp nz,ferror
ld a,d
cp b
jp nz,reads1
ld a,e
cp c
ret z
; ld a,d
; or e ;is DE zero? if so, EOF: an error here
; ret nz
ENDIF
reads1: ld de,stg2 ;read error: barfsville
jp c2
;
; Write a sector of data to the file in the default fcb under CP/M;
; write DE bytes from memory at HL to the "marcfd" file under MARC:
;
writs:
IF CPM
push de
push hl
ld c,wsequen
ld de,fcb
call bdos
pop hl
pop de
or a
ret z
ENDIF
IF NOT CPM
ld c,m$write
lda marcfd
call msys
ret z
jp ferror
ENDIF
ld de,stg3 ;write error: complain
jp c2
;
; Read a character from the standard input (console only under CP/M):
;
inch:
IF CPM
push bc
push hl
;ld c,coninp
;call bdos
call yieldgetkeyloop ;YIELDGETKEYLOOP
pop hl
pop bc
ENDIF
IF NOT CPM
xor a ;standard input under MARC
ld c,m$getcf
call msys
jp nz,ferror
ENDIF
IF CPM
call mapuc
ENDIF
cp key_esc;3
jp z,abort
ret
;
; Print a CR-LF onto standard output (console only under CP/M):
;
crlf: IF CPM
ld a,cr
call outch
ENDIF
ld a,lf ;and fall through to outch
;
; Write a character to standard output, and to the symbols file
; if wrsmf flag is active:
;
outch:
IF MARC
cp cr ;ignore CR's under MARC
ret z
ENDIF
push hl
push bc
push de
push af
ld b,a
lda wrsmf ;if wrsmf true,
or a
jp z,outc1
ld a,b ;do it all in wrb
call wrb
jp outc1a
outc1: ld a,b ;otherwise just put out to the console
call outch2
outc1a: pop af
pop de
pop bc
pop hl
ret
;
; Write the character in A to the standard output (console only under CP/M):
;
outch2:
IF CPM
push bc
;ld c,conout
;ld e,a
;call bdos
PRCHAR_
pop bc
ret
ENDIF
IF NOT CPM ; for MARC:
ld b,a ;put character in B
lda consfd ;stdout or stderr under MARC
ld c,m$putcf
call msys
jp nz,ferror
ret
ENDIF
wrb: ld b,a ;write out a byte of symbol table text
lda statf ;displaying symbol values on console?
or a
jp z,wrb2
ld a,b ;yes. do it.
call outch2
wrb2: lda wflg ;writing symbols to disk?
or a
ret z
wrb3: push hl
lhld bufp
ld (hl),b
inc hl
ld a,l
and 7fh
jp nz,wrb4
IF MARC
ld de,128
ENDIF
ld hl,tbuff
call writs ;if buffer full, dump to disk
wrb4: shld bufp
pop hl
ret
IF MARC
pfnam: ex de,hl ;for MARC, put name pointer in DE
call pstg
call crlf
ret
ENDIF
pstg: push af
pstg1: ld a,(de)
or a
jp nz,pstg2
pop af
ret
pstg2: call outch
inc de
jp pstg1
gnfl:
IF CPM
call scrl ;set CRL extension
lda quietf
ld b,a
ld a,1
sta quietf ;don't complain yet under CP/M
ENDIF
xor a
call open ;try to open for reading
IF CPM
ld a,b
sta quietf
ENDIF
IF MARC
ret c ;don't read in directory if not there
ENDIF
; IF CPM
jp nc,gnflok ;found in first path? if so, go process
lda search ;no. should we search default area also?
or a
jp z,cmpln ;if not, go complain
;lda defusr ;now try default disk and user area
;ld e,a
;inc a ;default user area is current user area?
;jp z,gnfl2 ;if so, don't change
;ld c,sguser
;lda nouser
;or a
;IF NOT ALPHA
;call z,bdos
;ENDIF
gnfl2: lda defdsk ;default disk current disk?
ld e,a
cp 0ffh ;if so, don't switch
jp z,gnfl3
;push de
;ld c,gdisk ;first get and save currently logged drive
;call bdos
;inc a ;add 1 so A == 1, and 0 can mean "unused"
xor a ;TODO getpath
sta savdrv
;pop de ;get back drive to switch to in E
;ld c,select
;call bdos
gnfl3: xor a ;now try to open in new directory
call open
jp nc,gnflok ;and go on processing if we finally found it
ret ;else return, since this time "open" printed an error
cmpln: lda quietf ;do we bitch?
or a
scf
ret nz ;if quietf set, don't bitch, just set Cy and return
ld de,stg1 ;can't find:
call pstg
call pfnamu ;print filename
scf ;and return Cy set to indicate failure
ret
gnflok:
; ENDIF
ld hl,direc
IF CPM ;read in directory under CP/M one sector at a time
call reads
call cpys
call reads
call cpys
call reads
call cpys
call reads
call cpys
ENDIF
IF NOT CPM ;under MARC just read in 512 bytes
ld de,512
call reads
ENDIF
xor a ;clear carry
ret
scrl:
IF CPM
ld hl,fcb+9
ld (hl),'C'
inc hl
ld (hl),'R'
inc hl
ld (hl),'L'
ret
ENDIF
IF NOT CPM
call putext
db '.crl',0
ret
ENDIF
IF CPM
cpys: ld de,tbuff
ld b,80h
cps2: ld a,(de)
ld (hl),a
inc hl
inc de
dec b
jp nz,cps2
ret
ENDIF ;end of CP/M-only stuff
;
; Get any functions out of the currently open CRL file
; as may be needed, until the supply is exhausted:
;
gtfns: lda fflag ;force loading of all function in this crl file?
or a
jp z,gtfn0 ;if not, go scan normally for needed functions
;
; Load in EVERY function in the currently open CRL file. Once this works,
; it should also refrain from loading any functions which have already been
; loaded...
;
ld hl,direc ;and try to get every function we can...
gtfn00: ld a,(hl)
cp 80h ;end of directory?
jp z,gtfn03 ;if so, done with this crl file
push hl
push hl
shld savnam ;save a pointer to the name for entt1 to bitch with
call pb7hi ;pass name (we don't care about it yet)
call ft23a ;else set function parameters for rdfun
pop hl
ld a,1 ;say that we got it
sta gotf
sta rdngsm ;set this so symbol routine does duplicate checking
call entt1 ;enter into tab1 as gotten
lda gotf ;was it a duplicate?
cp 81h
call nz,pre ;read it in and process if not a duplicate
gtfn02: pop hl ;get back pointer to directory
call pb7hi ;pass over name of the function we just read in
inc hl ;and its address
inc hl
jp gtfn00 ;and go for the next one.
gtfn03:
IF NOT FORCE
xor a
sta fflag ;turn off forcing after this file.
ENDIF
sta rdngsm ;and reset this also
jp close ;and go close the current one
;
; Scan the current CRL file for NEEDED functions only (restarting scan
; every time one is loaded, so any local backward-references are
; resolved):
;
gtfn0: ld hl,tab1 ;init needed-function table pointer
shld fngtt
gtfn1: call fung2 ;any more ungotten functions in the n-f table?
jp c,close ;if not, all done with this crl file
push hl
call ft2 ;else see if the next needed function is in the
pop hl ; current CRL file
jp c,gtfn1 ;is it?
ld a,1 ;yes.
sta gotf ;say that we got it
call entt1 ;enter the fact in tab1
call pre ;and actually read it in
jp gtfn1 ;and go for more
;
; This routine scans through the entire needed-function table for
; any non-loaded needed function entries. As soon as one is found,
; HL is returned with a pointer to the loaded byte for that entry, and
; Z is set. Z is returned NOT set if there aren't any more unloaded functions:
;
fungt: ld hl,tab1 ;start at the beginning
shld fngtt
;
; This routine scans the needed-function table from the current position
; of the table pointer (fngtt) to the end, looking for unloaded needed
; functions. See above for return values.
;
fung2: lhld fngtt ;get pointer into tab1
fng21: push hl
call past1e
shld fngtt
pop hl
ld a,(hl)
or a
scf
ret z
push hl
fng22: call pb7hi ;pass function name
ld a,(hl) ;next byte a zero?
or a
pop hl
jp m,fung2
ret ;no...so
past1e: call pb7hi
push de
ld a,(hl)
and 7fh
ld d,a
inc hl
ld e,(hl)
inc hl
ex de,hl
add hl,hl
add hl,de
pop de
ret
pb7hi: ld a,(hl)
inc hl
or a
jp p,pb7hi
ret
mapuc: cp 61h
ret c
cp 7bh
ret nc
sub 32
ret
;
; This routine scans the current CRL file directory for an occurence of
; the function whose name is pointed to by HL. If found, Cy is returned not
; set. Cy is returned set if not found, of course:
;
ft2: push hl ;save the name pointer
ex de,hl ;and also put in DE
ld hl,direc ;start at the beginning of directory
ft21: ld a,(hl) ;end of directory?
cp 80h
jp nz,ft22
pop hl ;yes. no match found, so set carry and return
scf
ret
ft22: call stcmp ;not end of directory. current entry match?
jp nz,ft24
ft23: call ft23a
pop hl ;all done. Note carry isn't set because of pb7hi
ret
ft23a: ld a,(hl) ;yes--next two bytes after name are file address
inc hl ;put the file address in HL
push hl
ld h,(hl)
ld l,a
shld enst ;save for rdfun to use in loading it later
pop hl ;find out what the address after the subsequent
inc hl ;entry is, to get ending address in file...
call pb7hi
ld a,(hl) ;here it is. load into HL
inc hl
ld h,(hl)
ld l,a
shld enend ;and save for rdfun
ret
ft24: call pb7hi ;no match. go on to next entry
inc hl
inc hl
jp ft21
;IF LASM
;link clinkb
;ENDIF