You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

1287 lines
26 KiB

title 'console command processor (CCP), ver 2.2'
;
; assembly language version of the cpm console command processor
;
; version 2.2 February, 1980
;
; copyright (c) 1976, 1977, 1978, 1979, 1980
;
; Digital Research
; Box 579, Pacific Grove,
; California, 93950
;
false equ 0000h
true equ not false
testing equ false ;true if testing
;
;
if testing
org 3400h
bdosl equ $+800h ;bdos location
else
org 000h
bdosl equ $+800h ;bdos location
endif
tran equ 100h
tranm equ $
ccploc equ $
;
; *************************************************************
; * base of ccp contains the following code/data *
; * ccp: jmp ccpstart (start with command) *
; * jmp ccpclear (start, clear command) *
; * ccp+6 127 (max command length) *
; * ccp+7 comlen (command length = 00) *
; * ccp+8 ' ... ' (16 blanks) *
; *************************************************************
; * Normal entry is at ccp, where the command line given *
; * at ccp+8 is executed automatically (normally a null *
; * command with comlen = 00). An initializing program *
; * can be automatically loaded by storing the command at *
; * ccp+8, with the command length at ccp+7. In this *
; * case, the ccp executes the command before prompting *
; * console for input. Note that the command is exe- *
; * cuted on both warm and cold starts. When the command *
; * line is initialized, a jump to "jmp ccpclear" dis- *
; * ables the automatic command execution. *
; *************************************************************
;
jmp ccpstart ;start ccp with possible initial command
jmp ccpclear ;clear the command buffer
maxlen: db 127 ;max buffer length
comlen: db 0 ;command length (filled in by dos)
; ;command executed initially in comlen non zero
combuf:
db ' ' ;8 character fill
db ' ' ;8 character fill
db 'copyright (c) 1979, digital research '; 38
ds 128-($-combuf)
;
; ;total buffer length is 128 characters
comaddr:dw combuf ;address of next character to scan
staddr: ds 2 ;starting address of current fillfcb request
;
diska equ 0004h ;disk address for current disk
bdos equ 0005h ;primary bdos entry point
buff equ 0080h ;default buffer
fcb equ 005ch ;default file control block
;
rcharf equ 1 ;read character function
pcharf equ 2 ;print character function
pbuff equ 9 ;print buffer function
rbuff equ 10 ;read buffer function
breakf equ 11 ;break key function
liftf equ 12 ;lift head function (no operation)
initf equ 13 ;initialize bdos function
self equ 14 ;select disk function
openf equ 15 ;open file function
closef equ 16 ;close file function
searf equ 17 ;search for file function
searnf equ 18 ;search for next file function
delf equ 19 ;delete file function
dreadf equ 20 ;disk read function
dwritf equ 21 ;disk write function
makef equ 22 ;file make function
renf equ 23 ;rename file function
logf equ 24 ;return login vector
cself equ 25 ;return current selected drive number
dmaf equ 26 ;set dma address
userf equ 32 ;set user number
;
;special fcb flags
;
rofile equ 9 ;read only file
sysfile equ 10 ;system file flag
;
;special characters
;
cr equ 13 ;carriage return
lf equ 10 ;line feed
la equ 5fh ;left arrow
eofile equ 1ah ;end of file
;
;utility procedures
;
printchar:
mov e,a
mvi c,pcharf
jmp bdos
;
printbc: ;print character but save bc registers
push b
call printchar
pop b
ret
;
crlf: mvi a,cr
call printbc
mvi a,lf
jmp printbc
;
blank: mvi a,' '
jmp printbc
;
print: ;print string starting at bc until next 00
push b ; entry
call crlf
pop h ;now print the string
prin0: mov a,m
ora a
rz ;stop on 00
inx h
push h ;ready for next
call printchar ;charcter printed
pop h
jmp prin0 ;for another character
;
initialize:
mvi c,initf
jmp bdos
;
select: mov e,a
mvi c,self
jmp bdos
;
bdos$inr:
call bdos
sta dcnt
inr a
ret
;
open: ;open the file given by d,e
mvi c,openf
jmp bdos$inr
;
openc: ;open comfcb
xra a
sta comrec ;clear next record to read
lxi d,comfcb
jmp open
;
close: ;close the file given by d,e
mvi c,closef
jmp bdos$inr
;
search: ;search for the file given by d,e
mvi c,searf
jmp bdos$inr
;
searchn: ;search for the next occurance of the file
mvi c,searnf ; given by d,e
jmp bdos$inr
;
searchcom: ;search for comfcb file
lxi d,comfcb
jmp search
;
delete: ;delete the fle given by d,e
mvi c,delf
jmp bdos
;
bdos$cond:
call bdos
ora a
ret
;
diskread: ;read the next record from the file given
mvi c,dreadf ; by d,e
jmp bdos$cond
;
diskreadc: ;read the comfcb file
lxi d,comfcb
jmp diskread
;
diskwrite: ;write the next record to the file given
mvi c,dwritf ; by d,e
jmp bdos$cond
;
make: ;create the file given by d,e
mvi c,makef
jmp bdos$inr
;
renam: ;rename the file given by d,e
mvi c,renf
jmp bdos
;
getuser: ;return current user code in a
mvi e,0ffh ;drop through to setuser
;
setuser:
mvi c,userf
jmp bdos ;sets user number
;
saveuser: ;save eser#/disk# before possible ^C or
call getuser ; transient; code to a
add a
add a
add a
add a ;rotate left
lxi h,cdisk
ora m ;4b = user, 4b = disk
sta diska ;stored away in memory for later
ret
;
setdiska:
lda cdisk
sta diska ;user/disk
ret
;
translate: ;translate character in register a to upper
cpi 61h ; case; return if below lower case a
rc
cpi 7bh ;return if above lower case z
rnc
ani 5fh ;translated to upper case
ret
;
readcom: ;read the next command into the command buffer
; check for submit file
lda submit
ora a
jz nosub
; ;scanning a submit file
;change drives to open and read the file
lda cdisk
ora a
mvi a,0
cnz select ;have to open again in case xsub present
;
lxi d,subfcb
call open
jz nosub ;skip if nosub
;
lda subrc
dcr a ;read last record(s) first
sta subcr ;current record to read
lxi d,subfcb
call diskread ;end of file if last record
jnz nosub
;
;disk read is ok, transfer to combuf
lxi d,comlen
lxi h,buff
mvi b,128
call move0 ;line is transfered, close the file with
; a deleted record
lxi h,submod
mvi m,0 ;clear fwflag
inx h
dcr m ;one less record
lxi d,subfcb
call close
jz nosub ;close went ok, return to original drive
;
lda cdisk
ora a
cnz select ;print to the 00
lxi h,combuf
call prin0
call break$key
jz noread
call del$sub
jmp ccp ;break key depressed
;
nosub: call delsub ;translate to upper case, store zero at end
call saveuser ;user number save in case ^C
mvi c,rbuff
lxi d,maxlen
call bdos
call setdiska ;no control-C do restore diska
;
noread: ;enter here from submit file
lxi h,comlen ;set the last character to zero for later scans
mov b,m ;length is in b
;
readcom0:
inx h
mov a,b
ora a ;end of scan
jz readcom1
mov a,m ;get character and translate
call translate
mov m,a
dcr b
jmp readcom0
;
readcom1: ;end of scan, h,l address end of command
mov m,a ;store a zero
lxi h,combuf
shld comaddr ;ready to scan to zero
ret
;
break$key: ;check for a character ready at console
mvi c,breakf
call bdos
ora a
rz
mvi c,rcharf
call bdos ;character cleared
ora a
ret
;
cselect: ;get currently selected drive number to reg a
mvi c,cself
jmp bdos
;
setdmabuff: ;set default buffer dma address
lxi d,buff ; (drop through)
;
setdma: ;set dma address to d,e
mvi c,dmaf
jmp bdos
;
del$sub: ;delete the submit file, and set submit flag
lxi h,submit
mov a,m
ora a
rz ;return if no submit file
mvi m,0 ;submit flag is set to false
xra a
call select ;on drive a to erase file
lxi d,subfcb
call delete
lda cdisk
jmp select ;back to original drive
;
serialize: ;check serialization
lxi d,serial
lxi h,bdosl
mvi b,6 ;check 6 bytes
;
ser0: ldax d
cmp m
jnz badserial
inx d
inx h
dcr b
jnz ser0
ret ;serial number is ok
;
comerr: ;error in command string starting at
call crlf ; position 'staddr' and ending with first
lhld staddr ; delimeter, h,l address first to print
;
comerr0: ;print characters until blank or zero
mov a,m
cpi ' '
jz comerr1 ;not blank
ora a
jz comerr1 ;not 0, so print it
push h
call printchar
pop h
inx h
jmp comerr0 ;for another character
;
comerr1: ;print question mark and delete sub file
mvi a,'?'
call printchar
call crlf
call del$sub
jmp ccp ;restart with next command
;
;FCB scan and fill subroutine (entry is at
; fillfcb below)
;fill the comfcb, indexed by a (0 or 16)
;subroutines
;
delim: ;look for a delimeter
ldax d
ora a
rz ;not the last element
cpi ' '
jc comerr ;non graphic
rz ;treat blank as delimeter
cpi '='
rz
cpi la ;left arrow
rz
cpi '.' ;period
rz
cpi ':' ;colon
rz
cpi ';' ;semicolon
rz
cpi '<' ;left angle bracket
rz
cpi '>' ;right angle bracket
rz
ret ;delimeter not found
;
deblank: ;deblank the input line
ldax d
ora a
rz ;treat end of line as blank
cpi ' '
rnz
inx d
jmp deblank
;
addh: ;add a to h,l
add l
mov l,a
rnc
inr h
ret
;
fillfcb0: ;equivalent to fillfcb(0)
mvi a,0
;
fillfcb:
lxi h,comfcb
call addh
push h
push h ;fcb rescanned at [?]-
xra a
sta sdisk ;clear selected disk (in case a:...)
lhld comaddr
xchg ;command address in d,e
call deblank ;to first non blank character
xchg
shld staddr
xchg
pop h ;d,e has command, h,l has fcb address
;look for preceding file name a: b: ...
ldax d
ora a
jz setcur0 ;use current disk of empty command
;
sbi 'A'-1
mov b,a ;disk name held in b if ':' follows
inx d
ldax d
cpi ':'
jz setdsk ;set disk name if :
;
setcur: ;set current disk
dcx d ;back to first character of command
;
setcur0:
lda cdisk
mov m,a
jmp setname
;
setdsk: ;set disk to name in register b
mov a,b
sta sdisk ;mark as disk selected
mov m,b
inx d ;past the :
;
setname: ;set the file name field
mvi b,8 ;file name length, (max)
;
setnam0:
call delim
jz padname ;not a delimeter
inx h
cpi '*'
jnz setnam1 ;must be ?'s
mvi m,'?'
jmp setnam2 ;to dec count
;
setnam1:
mov m,a ;store character in fcb
inx d
;
setnam2:
dcr b ;coutn down length
jnz setnam0
;
;end of name, truncate remainder
tryname:
call delim
jz setty ;set type field if delimeter
inx d
jmp tryname
;
padname:
inx h
mvi m,' '
dcr b
jnz padname
;
setty: ;set the type field
mvi b,3
cpi '.'
jnz padty ;skip the field if not there
inx d ;past the '.', to the type field
;
setty0: ;set the field from the command buffer
call delim
jz padty
inx h
cpi '*'
jnz setty1 ;[only 'se' on listing]-
mvi m,'?' ;since * specified
jmp setty2
;
setty1: ;not a * so copy to type field
mov m,a
inx d
;
setty2: dcr b
jnz setty0
;
;end of type field, truncate
trtyp: ;truncate type field
call delim
jz efill
inx d
jmp trtyp
;
padty: ;pad the type field with blanks
inx h
mvi m,' '
dcr b
jnz padty
;
efill: ;end of filename/filetype fill, save command
; address, fill the remaining fields for the
; fcb
mvi b,3
;
efill0:
inx h
mvi m,0
dcr b
jnz efill0
xchg
shld comaddr ;set new starting point
;
;recover the start address of the fcb and
;count ?'s
pop h
lxi b,11 ;b=0, c=8+3
;
scnq: inx h
mov a,m
cpi '?'
jnz scnq0 ;? found, count it in b
inr b
;
scnq0: dcr c
jnz scnq
;
;number of ?'s in c [sic], move to a and
mov a,b ;return with flags set
ora a
ret
;
intvec: ;intrinsic function names (all are four
db 'DIR ' ; characters)
db 'ERA '
db 'TYPE'
db 'SAVE'
db 'REN '
db 'USER'
;
intlen equ ($-intvec)/4 ;intrinsic function length
;
serial: db 0,0,0,0,0,0
;
intrinsic: ;look for intrinsic functions (comfcb has
; been filled
lxi h,intvec
mvi c,0 ;c counts intrinsics as scanned
;
intrin0:
mov a,c
cpi intlen ;done with scan?
rnc
lxi d,comfcb+1 ;beginning of name
mvi b,4 ;length of match is in b
;
intrin1:
ldax d
cmp m ;match
jnz intrin2 ;skip if no match
inx d
inx h
dcr b
jnz intrin1 ;loop while matching
;
;complete match on name, check for blank in fcb
ldax d
cpi ' '
jnz intrin3 ;otherwise matched
mov a,c
ret ;with intrinsic number in a
;
intrin2: ;mismatch, move to end of intrinsic
inx h
dcr b
jnz intrin2
;
intrin3: ;try next intrinsic
inr c ;to next intrinsic number
jmp intrin0 ;for another round
;
ccpclear: ;clear the command buffer
xra a
sta comlen ;drop through to start ccp
;
ccpstart: ;enter here from boot loader
lxi sp,stack
push b ;save initial disk number
;(high order 4 bits = user code, low order
;4 bits = disk #)
mov a,c
rar
rar
rar
rar
ani 0fh ;user code
mov e,a
call setuser ;user code selected
;initialize for this user, get $ flag
call initialize ;0ffh in accum if $ present
sta submit ;submit flag set if $ file present
pop b ;recall user code and disk number
mov a,c
ani 0fh ;disk number in accumulator
sta cdisk ;clears user code nibble
call select ;proper disk is selected, now check sub file
;check for initial command
lda comlen
ora a
jnz ccp0 ;assumed typed already
;
ccp: ;enter here on each command or error condition
lxi sp,stack
call crlf ;print D> where d is disk number
call cselect
adi 'A'
call printchar
mvi a,'>'
call printchar
call readcom ;command buffer filled
;
ccp0: ;(enter here from initialization with command
; filled)
lxi d,buff
call setdma ;default dma address at buff
call cselect
sta cdisk ;current disk number saved
call fillfcb0 ;command fcb filled
cnz comerr ;the name cannot be an ambiguous reference
lda sdisk
ora a
jnz userfunc ;check for an intrinsic function
;
call intrinsic
lxi h,jmptab ;index is in the accumulator
mov e,a
mvi d,0
dad d
dad d ;index in d,e
mov a,m
inx h
mov h,m
mov l,a
pchl ;pc changes to the proper intrinsic or user
;function
jmptab:
dw direct ;directory search
dw erase ;file erase
dw type ;type
dw save ;save memory
dw rename ;file rename
dw user ;user number
dw userfunc ;user-defined function
;
badserial:
lxi h,di or (hlt shl 8)
shld ccploc
lxi h,ccploc
pchl
;
;utility subroutines for intrinsic handlers
;
readerr: ;print the read error message
lxi b,rdmsg
jmp print
;
rdmsg: db 'read error',0
;
nofile: ;print no file message
lxi b,nofmsg
jmp print
;
nofmsg: db 'no file',0
;
getnumber: ;read a number from the command line
call fillfcb0 ;should be a number
lda sdisk
ora a
jnz comerr ;cannot be prefixed
;convert the byte value in comfcb to binary
lxi h,comfcb+1
lxi b,11 ;(b = 0, c = 11)
;value accumulated in b, c counts name length
; to zero
conv0: mov a,m
cpi ' '
jz conv1 ;more to scan
;
inx h
sui '0'
cpi 10
jnc comerr ;valid?
mov d,a
mov a,b ;multiply by ten
ani 1110$0000b
jnz comerr
mov a,b
rlc
rlc
rlc ;*8
add b
jc comerr
add b
jc comerr ;*8 + *2 = *10
add d
jc comerr ;+digit
mov b,a
dcr c
jnz conv0 ;for another digit
ret
;
conv1: ;end of digits, check for all blanks
mov a,m
cpi ' '
jnz comerr ;blanks?
inx h
dcr c
jnz conv1
mov a,b ;recover value
ret
;
movename: ;move 3 characters from h,l to d,e addresses
;
mvi b,3
;
move0: mov a,m
stax d
inx h
inx d
dcr b
jnz move0
ret
;
addhcf: ;buff + a + c to h,l followed by fetch
lxi h,buff
add c
call addh
mov a,m
ret
;
setdisk:
;change disks for this command, if requested
xra a
sta comfcb ;clear disk name from fcb
lda sdisk
ora a
rz ;no action if not specified
dcr a
lxi h,cdisk
cmp m
rz ;already selected
jmp select
;
resetdisk:
;return to original disk after command
lda sdisk
ora a
rz ;no action if not selected
dcr a
lxi h,cdisk
cmp m
rz ;same disk
lda cdisk
jmp select
;
;individual intrinsics follow
direct:
;directory search
call fillfcb0 ;comfcb gets file name
call setdisk ;change disk drives if requested
lxi h,comfcb+1
mov a,m ;may be empty request
cpi ' '
jnz dir1 ;skip fill of ??? if not blank
;set comfcb to all ??? for current disk
mvi b,11 ;length of fill ????????.???
dir0:
mvi m,'?'
inx h
dcr b
jnz dir0
;not a blank request, must be in comfcb
dir1:
mvi e,0
push d ;e counts directory entries
call searchcom ;first one has been found
cz nofile ;not found message
dir2:
jz endir
;found, but may be system file
lda dcnt ;get the location of the element
rrc
rrc
rrc
ani 110$0000b
mov c,a ;c contains base index into buff for dir entry
mvi a,sysfile
call addhcf ;value to a
ral
jc dir6 ;skip if system file
;c holds index into buffer
;another fcb found, new line?
pop d
mov a,e
inr e
push d
;e=0,1,2,3,...new line if mod 4 = 0
ani 11b
push psw ;and save the test
jnz dirhdr0 ;header on current line
call crlf
push b
call cselect
pop b
;current disk in a
adi 'A'
call printbc
mvi a,':'
call printbc
jmp dirhdr1 ;skip current line hdr
;
dirhdr0:
call blank ;after last one
mvi a,':'
call printbc
;
dirhdr1:
call blank ;compute position of name in buffer
mvi b,1 ;start with first character of name
;
dir3:
mov a,b
call addhcf ;buff+a+c fetched
ani 7FH ;mask flags
;may delete trailing blanks
cpi ' '
jnz dir4 ;check for blank type
pop psw
push psw ;may be 3rd item
cpi 3
jnz dirb ;place blank at end if not
mvi a,9
call addhcf ;first char of type
ani 7fh
cpi ' '
jz dir5 ;not a blank in the file type field
;
dirb: mvi a,' ' ;restore trailing filename chr
dir4:
call printbc ;char printed
inr b
mov a,b
cpi 12
jnc dir5 ;check for break between names
cpi 9
jnz dir3 ;for another char
;print a blank between names
call blank
jmp dir3
;
dir5: ;end of current entry
pop psw ;discard the directory counter (mod 4)
dir6: call break$key
;check for interrupt at keyboard
jnz endir ;abort directory search
call searchn
jmp dir2 ;for another entry
;
endir: ;end of directory scan
pop d ;discard directory counter
jmp retcom
;
;
erase:
call fillfcb0 ;cannot be all ???'s
cpi 11
jnz erasefile
;erasing all of the disk
lxi b,ermsg
call print
call readcom
lxi h,comlen
dcr m
jnz ccp ;pad input
inx h
mov a,m
cpi 'Y'
jnz ccp
;ok, erase the entire diskette
inx h
shld comaddr ;otherwise error at retcom
;
erasefile:
call setdisk
lxi d,comfcb
call delete
inr a ;255 returned in not found
cz nofile ;no file message if so
jmp retcom
;
;
ermsg: db 'All (Y/N)?',0
;
type:
call fillfcb0
jnz comerr ;don't allow ?'s in file name
call setdisk
call openc ;open the file
jz typerr ;zero flag indicates not found
;file opened, real 'til eof
call crlf
lxi h,bptr
mvi m,255 ;read first buffer
;
type0: ;loop on bptr
lxi h,bptr
mov a,m
cpi 128 ;end buffer
jc type1
push h ;carry 1f 0,1,...,127
;read another buffer full
call diskreadc
pop h ;recover address of bp
jnz typeof ;hard end of file
xra a
mov m,a ;bptr = 0
;
type1: ;read character at bptr and print
inr m ;bptr = bptr + 1
lxi h,buff
call addh ;h,l addresses char
mov a,m
cpi eofile
jz retcom
call printchar
call break$key
jnz retcom ;abort if break
jmp type0 ;for another character
;
typeof: ;end of file, check for errors
dcr a
jz retcom
call readerr
;
typerr: call resetdisk
jmp comerr
;
save:
call getnumber ;value to register a push
push psw ;save it for later
;should be followed by a flip
;to save the memory ima
call fillfcb0
jnz comerr ;cannot be ambiguous
call setdisk ;may be a disk change
lxi d,comfcb
push d
call delete ;existing file rem
pop d
call make ;create a new file on disk
jz saverr ;no directory space
xra a
sta comrec ;clear next record field
pop psw ;#pages to write is in a, change to #sectors
mov l,a
mvi h,0
dad h
lxi d,tran ;h,l is sector count, d,e is load address
;
save0: ;check for sector count zero
mov a,h
ora l
jz save1 ;may be completed
dcx h ;sector count = sector count - 1
push h ;save it for next time around
lxi h,128
dad d
push h ;next dma address saved
call setdma ;current dma address set
lxi d,comfcb
call diskwrite
pop d
pop h ;dma address, sector count
jnz saverr ;may be disk full case
jmp save0 ;for another sector
;
save1: ;end of dump, close the file
lxi d,comfcb
call close
inr a ;255 becomes 00 if error
jnz retsave ;for another command
;
saverr: ;must be full or head only disk
lxi b,fullmsg
call print
;
retsave:
;reset dma buffer
call setdmabuff
jmp retcom
;
fullmsg:
db 'no space',0
;
;
rename: ;rename a file on a specific disk
call fillfcb0
jnz comerr ;must be unambiguous
lda sdisk
push psw ;save for later compare
call setdisk ;disk selected
call searchcom ;is new name already there?
jnz renerr3 ;file doesn't exist, move to second half of fcb
lxi h,comfcb
lxi d,comfcb+16
mvi b,16
call move0 ;check for = or left arrow
lhld comaddr
xchg
call deblank
cpi '='
jz ren1
cpi la
jnz renerr2
;
ren1: xchg
inx h
shld comaddr ;past delimiter
;proper delimiter found
call fillfcb0
jnz renerr2
;check for dirve conflict
pop psw
mov b,a ;previous drive number
lxi h,sdisk
mov a,m
ora a
jz ren2
;drive name was specified. same one?
cmp b
mov m,b
jnz renerr2
;
ren2: mov m,b ;store the name in case drives switched
xra a
sta comfcb
call searchcom
;is old file there
jz renerr1
;everything is ok, rename the file
lxi d,comfcb
call renam
jmp retcom
;
renerr1: ;no file on disk
call nofile
jmp retcom
;
renerr2: ;ambigous reference/name conflict
call resetdisk
jmp comerr
;
renerr3: ;file already exists
lxi b,renmsg
call print
jmp retcom
;
renmsg: db 'file exists',0
;
user:
;set user number
call getnumber ;leaves the value in the accumulator
cpi 16
jnc comerr ;must be between 0 and 15
mov e,a ;save for setuser call
lda comfcb+1
cpi ' '
jz comerr
call setuser ;new user number set
jmp endcom
;
userfunc:
call serialize
;check serialization
;load user function and set up for execution
lda comfcb+1
cpi ' '
jnz user0
;no file name, but may be disk switch
lda sdisk
ora a
jz endcom ;no disk name if 0
dcr a
sta cdisk
call setdiska ;set user/disk
call select
jmp endcom
;
user0: ;file name is present
lxi d,comfcb+9
ldax d
cpi ' '
jnz comerr ;type '
push d
call setdisk
pop d
lxi h,comtype ;.com
call movename
;file type is set to .com
call openc
jz userer
;file opened properly, read it into memory
lxi h,tran ;transient program base
;
load0:
push h ;save dma address
xchg
call setdma
lxi d,comfcb
call diskread
jnz load1
;sector loaded, set new dma address and com
pop h
lxi d,128
dad d
lxi d,tranm ;has the load overflowed?
mov a,l
sub e
mov a,h
sbb d
jnc loaderr
jmp load0 ;for another sector
;
load1: pop h
dcr a
jnz loaderr ;end file is 1
call resetdisk ;back to original disk
call fillfcb0
lxi h,sdisk
push h
mov a,m
sta comfcb ;drive number set
mvi a,16
call fillfcb ;move entire fct to
pop h
mov a,m
sta comfcb+16
xra a
sta comrec ;record number set to zero
lxi d,fcb
lxi h,comfcb
mvi b,33
call move0 ;move command line to buff
lxi h,combuf
;
bmove0: mov a,m
ora a
jz bmove1
cpi ' '
jz bmove1 ;[text was truncated, I made it 1] -
inx h
jmp bmove0 ;for another scan
;first blank position found
bmove1: mvi b,0
lxi d,buff+1
;ready for the move
bmove2: mov a,m
stax d
ora a
jz bmove3 ;more to move
inr b
inx h
inx d
jmp bmove2
;
bmove3: ;b has character count
mov a,b
sta buff
call crlf
;now go to the loaded program
call setdmabuff
;default dma
call saveuser
;user code saved
;low memory diska contains user code
call tran ;gone to the loaded program
lxi sp,stack
;may come back here
call setdiska
call select
jmp ccp
;
userer: ;arrive here on command error
call resetdisk
jmp comerr
;
loaderr: ;cannot load the program
lxi b,loadmsg
call print
jmp retcom
;
loadmsg:
db 'bad load',0
;
comtype:
db 'com' ;for com files
;
;
retcom: ;reset disk before end of command check
call resetdisk
;
endcom: ;end of intrinsic command
call fillfcb0
;to check for garbage at end of line
lda comfcb+1
sui ' '
lxi h,sdisk
ora m ;0 in accumulator if no disk selected,
;and blank fcb
jnz comerr
jmp ccp
;
;
; data areas
;
ds 16 ;8 level stack
stack:
;
; 'submit' fiel control block
;
submit: db 0 ;00 if no submit file, ff if submitting
subfcb: db 0,'$$$ ' ;file name is $$$
db 'sub',0,0 ;file name is sub
submod: db 0 ;module number
subrc: ds 1 ;record count filed
ds 16 ;disk map
subcr: ds 1 ;current record to read
;
; command file control block
;
comfcb: ds 32 ;fields filled in later
comrec: ds 1 ;current record to read/write
dcnt: ds 1 ;disk directory count (used for error codes)
cdisk: ds 1 ;current disk
sdisk: ds 1 ;selected disk for current operation
;none=0, a=1, b=2 ...
bptr: ds 1 ;buffer pointer
;
end ccploc