mirror of
https://github.com/wwarthen/RomWBW.git
synced 2026-02-06 22:43:15 -06:00
1287 lines
26 KiB
NASM
1287 lines
26 KiB
NASM
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 0d000h
|
||
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
|
||
|