seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-23 16:34:07 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity
Files
31738079c43b1cd3eae2815a0dfb36f71505257a
Digital-Research-Source-Code/CPM OPERATING SYSTEMS/CPM 3.X/CPM 3.0/DEVDIR SOURCE/CCP3ORG.ASM
Sepp J Morris 31738079c4 Upload 
Digital Research
2020-11-06 18:50:37 +01:00

2807 lines
60 KiB
NASM
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

title 'CP/M 3 - Console Command Processor - November 1982'
; version 3.00 Nov 30 1982 - Doug Huskey
; Copyright (C) 1982
; Digital Research
; P.O. Box 579
; Pacific Grove, CA 93950
; Revised: (date/name of person modifying this source)
; ****************************************************
; ***** The following equates must be set to 100H ***
; ***** + the addresses specified in LOADER.PRN ***
; ***** ***
equ1 equ rsxstart ;does this adr match loader's?
equ2 equ fixchain ;does this adr match loader's?
equ3 equ fixchain1 ;does this adr match loader's?
equ4 equ fixchain2 ;does this adr match loader's?
equ5 equ rsx$chain ;does this adr match loader's?
equ6 equ reloc ;does this adr match loader's?
equ7 equ calcdest ;does this adr match loader's?
equ8 equ scbaddr ;does this adr match loader's?
equ9 equ banked ;does this adr match loader's?
equ10 equ rsxend ;does this adr match loader's?
equ11 equ ccporg ;does this adr match loader's?
equ12 equ ccpend ;This should be 0D80h
rsxstart equ 0100h
fixchain equ 01D0h
fixchain1 equ 01EBh
fixchain2 equ 01F0h
rsx$chain equ 0200h
reloc equ 02CAh
calcdest equ 030Fh
scbaddr equ 038Dh
banked equ 038Fh
rsxend equ 0394h
ccporg equ 041Ah
; ****************************************************
; NOTE: THE ABOVE EQUATES MUST BE CORRECTED IF NECESSARY
; AND THE JUMP TO START AT THE BEGINNING OF THE LOADER
; MUST BE SET TO THE ORIGIN ADDRESS BELOW:
org ccporg ;LOADER is at 100H to 3??H
; (BE SURE THAT THIS LEAVES ENOUGH ROOM FOR THE LOADER BIT MAP)
; Conditional Assembly toggles:
true equ 0ffffh
false equ 0h
newdir equ true
newera equ true ;confirm any ambiguous file name
dayfile equ true
prompts equ false
func152 equ true
multi equ true ;multiple command lines
;also shares code with loader (100-2??h)
;
;************************************************************************
;
; GLOBAL EQUATES
;
;************************************************************************
;
;
; CP/M BASE PAGE
;
wstart equ 0 ;warm start entry point
defdrv equ 4 ;default user & disk
bdos equ 5 ;CP/M BDOS entry point
osbase equ bdos+1 ;base of CP/M BDOS
cmdrv equ 050h ;command drive
dfcb equ 05ch ;1st default fcb
dufcb equ dfcb-1 ;1st default fcb user number
pass0 equ 051h ;1st default fcb password addr
len0 equ 053h ;1st default fcb password length
dfcb1 equ 06ch ;2nd default fcb
dufcb1 equ dfcb1-1 ;2nd default fcb user number
pass1 equ 054h ;2nd default fcb password addr
len1 equ 056h ;2nd default fcb password length
buf equ 80h ;default buffer
tpa equ 100h ;transient program area
if multi
comlen equ 100h-19h ;maximum size of multiple command
;RSX buffer with 16 byte header &
;terminating zero
else
comlen equ tpa-buf
endif
;
; BDOS FUNCTIONS
;
vers equ 31h ;BDOS vers 3.1
cinf equ 1 ;console input
coutf equ 2 ;console output
crawf equ 6 ;raw console input
pbuff equ 9 ;print buffer to console
rbuff equ 10 ;read buffer from console
cstatf equ 11 ;console status
resetf equ 13 ;disk system reset
self equ 14 ;select drive
openf equ 15 ;open file
closef equ 16 ;close file
searf equ 17 ;search first
searnf equ 18 ;search next
delf equ 19 ;delete file
readf equ 20 ;read file
makef equ 22 ;make file
renf equ 23 ;rename file
dmaf equ 26 ;set DMA address
userf equ 32 ;set/get user number
rreadf equ 33 ;read file
flushf equ 48 ;flush buffers
scbf equ 49 ;set/get SCB value
loadf equ 59 ;program load
allocf equ 98 ;reset allocation vector
trunf equ 99 ;read file
parsef equ 152 ;parse file
;
; ASCII characters
;
ctrlc: equ 'C'-40h
cr: equ 'M'-40h
lf: equ 'J'-40h
tab: equ 'I'-40h
eof: equ 'Z'-40h
;
;
; RSX MEMORY MANAGEMENT EQUATES
;
; RSX header equates
;
entry equ 06h ;RSX contain jump to start
nextadd equ 0bh ;address of next RXS in chain
prevadd equ 0ch ;address of previous RSX in chain
warmflg equ 0eh ;remove on wboot flag
endchain equ 18h ;end of RSX chain flag
;
; LOADER.RSX equates
;
module equ 100h ;module address
;
; COM file header equates
;
comsize equ tpa+1h ;size of the COM file
rsxoff equ tpa+10h ;offset of the RSX in COM file
rsxlen equ tpa+12h ;length of the RSX
;
;
; SYSTEM CONTROL BLOCK OFFSETS
;
pag$off equ 09ch
;
olog equ pag$off-0ch ; removeable media open vector
rlog equ pag$off-0ah ; removeable media login vector
bdosbase equ pag$off-004h ; real BDOS entry point
hashl equ pag$off+000h ; system variable
hash equ pag$off+001h ; hash code
bdos$version equ pag$off+005h ; BDOS version number
util$flgs equ pag$off+006h ; utility flags
dspl$flgs equ pag$off+00ah ; display flags
clp$flgs equ pag$off+00eh ; CLP flags
clp$drv equ pag$off+00fh ; submit file drive
prog$ret$code equ pag$off+010h ; program return code
multi$rsx$pg equ pag$off+012h ; multiple command buffer page
ccpdrv equ pag$off+013h ; ccp default drive
ccpusr equ pag$off+014h ; ccp default user number
ccpconbuf equ pag$off+015h ; ccp console buffer address
ccpflag1 equ pag$off+017h ; ccp flags byte 1
ccpflag2 equ pag$off+018h ; ccp flags byte 2
ccpflag3 equ pag$off+019h ; ccp flags byte 3
conwidth equ pag$off+01ah ; console width
concolumn equ pag$off+01bh ; console column position
conpage equ pag$off+01ch ; console page length (lines)
conline equ pag$off+01dh ; current console line number
conbuffer equ pag$off+01eh ; console input buffer address
conbuffl equ pag$off+020h ; console input buffer length
conin$rflg equ pag$off+022h ; console input redirection flag
conout$rflg equ pag$off+024h ; console output redirection flag
auxin$rflg equ pag$off+026h ; auxillary input redirection flag
auxout$rflg equ pag$off+028h ; auxillary output redirection flag
listout$rflg equ pag$off+02ah ; list output redirection flag
page$mode equ pag$off+02ch ; page mode flag 0=on, 0ffH=off
page$def equ pag$off+02dh ; page mode default
ctlh$act equ pag$off+02eh ; ctl-h active
rubout$act equ pag$off+02fh ; rubout active (boolean)
type$ahead equ pag$off+030h ; type ahead active
contran equ pag$off+031h ; console translation subroutine
con$mode equ pag$off+033h ; console mode (raw/cooked)
ten$buffer equ pag$off+035h ; 128 byte buffer available
; to banked BIOS
outdelim equ pag$off+037h ; output delimiter
listcp equ pag$off+038h ; list output flag (ctl-p)
q$flag equ pag$off+039h ; queue flag for type ahead
scbad equ pag$off+03ah ; system control block address
dmaad equ pag$off+03ch ; dma address
seldsk equ pag$off+03eh ; current disk
info equ pag$off+03fh ; BDOS variable "info"
resel equ pag$off+041h ; disk reselect flag
relog equ pag$off+042h ; relog flag
fx equ pag$off+043h ; function number
usrcode equ pag$off+044h ; current user number
dcnt equ pag$off+045h ; directory record number
searcha equ pag$off+047h ; fcb address for searchn function
searchl equ pag$off+049h ; scan length for search functions
multcnt equ pag$off+04ah ; multi-sector I/O count
errormode equ pag$off+04bh ; BDOS error mode
drv0 equ pag$off+04ch ; search chain - 1st drive
drv1 equ pag$off+04dh ; search chain - 2nd drive
drv2 equ pag$off+04eh ; search chain - 3rd drive
drv3 equ pag$off+04fh ; search chain - 4th drive
tempdrv equ pag$off+050h ; temporary file drive
patch$flag equ pag$off+051h ; patch flags
date equ pag$off+058h ; date stamp
com$base equ pag$off+05dh ; common memory base address
error equ pag$off+05fh ; error jump...all BDOS errors
top$tpa equ pag$off+062h ; top of user TPA (address at 6,7)
;
; CCP FLAG 1 BIT MASKS
; (used with getflg, setflg and resetflg routines)
;
chainflg equ 080h ; program chain (funct 49)
not$chainflg equ 03fh ; mask to reset chain flags
chainenv equ 040h ; preserve usr/drv for chained prog
comredirect equ 0b320h ; command line redirection active
menu equ 0b310h ; execute ccp.ovl for menu systems
echo equ 0b308h ; echo commands in batch mode
userparse equ 0b304h ; parse user numbers in commands
subfile equ 0b301h ; $$$.SUB file found or active
subfilemask equ subfile-0b300h
rsx$only$set equ 02h ; RSX only load (null COM file)
rsx$only$clr equ 0FDh ; reset RSX only flag
;
; CCP FLAG 2 BIT MASKS
; (used with getflg, setflg and resetflg routines)
;
ccp10 equ 0b4a0h ; CCP function 10 call (2 bits)
ccpsub equ 0b420h ; CCP present (for SUBMIT, PUT, GET)
ccpbdos equ 0b480h ; CCP present (for BDOS buffer save)
dskreset equ 20h ; CCP does disk reset on ^C from prompt
submit equ 0b440h ; input redirection active
submitflg equ 40h ; input redirection flag value
order equ 0b418h ; command order
; 0 - COM only
; 1 - COM,SUB
; 2 - SUB,COM
; 3 - reserved
datetime equ 0b404h ; display date & time of load
display equ 0b403h ; display filename & user/drive
filename equ 02h ; display filename loaded
location equ 01h ; display user & drive loaded from
;
; CCP FLAG 3 BIT MASKS
; (used with getflg, setflg and resetflg routines)
;
rsxload equ 1h ; load RSX, don't fix chain
coldboot equ 2h ; try to exec profile.sub
;
; CONMODE BIT MASKS
;
ctlc$stat equ 0cf01h ;conmode CTL-C status
;
;
;************************************************************************
;
; Console Command Processor - Main Program
;
;************************************************************************
;
;
;
start:
;
lxi sp,stack
lxi h,ccpret ;push CCPRET on stack, in case of
push h ; profile error we will go there
lxi d,scbadd
mvi c,scbf
call bdos
shld scbaddr ;save SCB address
mvi l,com$base+1
mov a,m ;high byte of commonbase
sta banked ;save in loader
mvi l,bdosbase+1 ;HL addresses real BDOS page
mov a,m ;BDOS base in H
sta realdos ;save it for use in XCOM routine
;
lda osbase+1 ;is the LOADER in memory?
sub m ;compare link at 6 with real BDOS
jnz reset$alloc ;skip move if loader already present
;
;
movldr:
lxi b,rsxend-rsxstart ;length of loader RSX
call calcdest ;calculate destination and (bias+200h)
mov h,e ;set to zero
mov l,e
; lxi h,module-100h ;base of loader RSX (less 100h)
call reloc ;relocate loader
lhld osbase ;HL = BDOS entry, DE = LOADER base
mov l,e ;set L=0
mvi c,6
call move ;move the serial number down
mvi e,nextadd
call fixchain1
;
;
reset$alloc:
mvi c,allocf
call bdos
;
;
;
;************************************************************************
;
; INITIALIZE SYSTEM CONTROL BLOCK
;
;************************************************************************
;
;
scbinit:
;
; # dir columns, page size & function 9 delimiter
;
mvi b,conwidth
call getbyte
inr a ;get console width (rel 1)
rrc
rrc
rrc
rrc
ani 0fh ;divide by 16
lxi d,dircols
stax d ;dircols = conwidth/16
mvi l,conpage
mov a,m
dcr a ;subtract 1 for space before prompt
inx d
stax d ;pgsize = conpage
xra a
inx d
stax d ;line=0
mvi a,'$'
inx d
stax d ;pgmode = nopage (>0)
mvi l,outdelim
mov m,a ;set function 9 delimiter
;
; multisector count, error mode, console mode
; & BDOS version no.
;
mvi l,multcnt
mvi m,1 ;set multisector I/O count = 1
inx h ;.errormode
xra a
mov m,a ;set return error mode = 0
mvi l,con$mode
mvi m,1 ;set ^C status mode
inx h
mov m,a ;zero 2nd conmode byte
mvi l,bdos$version
mvi m,vers ;set BDOS version no.
;
; disk reset check
;
mvi l,ccpflag2
mov a,m
ani dskreset ;^C at CCP prompt?
mvi c,resetf
push h
cnz bdos ;perform disk reset if so
pop h
;
; remove temporary RSXs (those with remove flag on)
;
rsxck:
mvi l,ccpflag1 ;check CCP flag for RSX only load
mov a,m
ani rsx$only$set ;bit = 1 if only RSX has been loaded
push h
cz rsx$chain ;don't fix-up RSX chain if so
pop h
mov a,m
ani rsx$only$clr ;clear RSX only loader flag
mov m,a ;replace it
;
; chaining environment
;
ani chain$env ;non-zero if we preserve programs
push h ;user & drive for next transient
;
; user number
;
mvi l,ccpusr ; HL = .CCP USER (saved in SCB)
lxi b,usernum ; BC = .CCP'S DEFAULT USER
mov d,h
mvi e,usrcode ; DE = .BDOS USER CODE
ldax d
stax b ; usernum = bdos user number
mov a,m ; ccp user
jnz scb1 ; jump if chaining env preserved
stax b ; usernum = ccp default user
scb1: stax d ; bdos user = ccp default user
;
; transient program's current disk
;
inx b ;.CHAINDSK
mvi e,seldsk ;.BDOS CURRENT DISK
ldax d
jnz scb2 ; jump if chaining env preserved
mvi a,0ffh
; cma ; make an invalid disk
scb2: stax b ; chaindsk = bdos disk (or invalid)
;
; current disk
;
dcx h ;.CCP's DISK (saved in SCB)
inx b ;.CCP's CURRENT DISK
mov a,m
stax b
stax d ; BDOS current disk
;
; $$$.SUB drive
;
mvi l,tempdrv
inx b ;.SUBFCB
mov a,m
stax b ; $$$.SUB drive = temporary drive
;
; check for program chain
;
pop h ;HL =.ccpflag1
mov a,m
ani chainflg ;is it a chain function (47)
jz ckboot ;jump if not
lxi h,buf
chain: lxi d,cbufl
mvi c,tpa-buf-1
mov a,c
stax d
inx d
call move ;hl = source, de = dest, c = count
jmp ccpparse
;
; execute profile.sub ?
;
ckboot: mvi l,ccpflag3
mov a,m
ani coldboot ;is this a cold start
jnz ccpcr ;jump if not
mov a,m
ori coldboot ;set flag for next time
mov m,a
sta errflg ;set to ignore errors
lxi h,profile
jmp chain ;attempt to exec profile.sub
profile:
db 'PROFILE.S',0
;
;
;
;************************************************************************
;
; BUILT-IN COMMANDS (and errors) RETURN HERE
;
;************************************************************************
;
;
ccpcr:
; enter here on each command or error condition
call setccpflg
call crlf
ccpret:
lxi h,stack-2 ;reset stack in case of error
sphl ;preserve CCPRET on stack
xra a
sta line
lxi h,ccpret ;return for next builtin
push h
call setccpflg
dcx h ;.CCPFLAG1
mov a,m
ani subfilemask ;check for $$$.SUB submit
jz prompt
;
;
;
;************************************************************************
;
; $$$.SUB file processing
;
;************************************************************************
;
;
lxi d,cbufl ;set DMA to command buffer
call setbuf
mvi c,openf
call sudos ;open it if flag on
mvi c,cstatf ;check for break if successful open
cz sudos ;^C typed?
jnz subclose ;delete $$$.SUB if break or open failed
lxi h,subrr2
mov m,a ;zero high random record #
dcx h
mov m,a ;zero middle random record #
dcx h
push h
lda subrc
dcr a
mov m,a ;set to read last record of file
mvi c,rreadf
cp sudos
pop h
dcr m ;record count (truncate last record)
mvi c,delf
cm sudos
ora a ;error on read?
;
;
subclose:
push psw
mvi c,trunf ;truncate file (& close it)
call sudos
pop psw ;any errors ?
jz ccpparse ;parse command if not
;
;
subkill:
lxi b,subfile
call resetflg ;turn off submit flag
mvi c,delf
call sudos ;kill submit
;
;
;
;************************************************************************
;
; GET NEXT COMMAND
;
;************************************************************************
;
;
;
; prompt user
;
prompt:
lda usernum
ora a
cnz pdb ;print user # if non-zero
call dirdrv1
mvi a,'>'
call putc
;
if multi
;move ccpconbuf addr to conbuffer addr
lxi d,ccpconbuf*256+conbuffer
call wordmov ;process multiple command, unless in submit
ora a ;non-zero => multiple commands active
push psw ;save A=high byte of ccpconbuf
lxi b,ccpbdos
cnz resetflg ;turn off BDOS flag if multiple commands
endif
call rcln ;get command line from console
call resetccpflg ;turn off BDOS, SUBMIT & GET ccp flags
if multi
pop psw ;D=high byte of ccpconbuf
cnz multisave ;save multiple command buffer
endif
;
;
;
;************************************************************************
;
; PARSE COMMAND
;
;************************************************************************
;
;
ccpparse:
;
; reset default page mode
; (in case submit terminated)
;
call subtest ;non-zero if submit is active
jnz get$pg$mode ;skip, if so
set$pg$mode:
mvi l,page$def
mov a,m ;pick up default
dcx h
mov m,a ;place in mode
get$pg$mode:
mvi l,page$mode
mov a,m
sta pgmode
;
;check for multiple commands
;convert to upper case
;reset ccp flag, in case entered from a CHAIN (or profile)
;
call uc ;convert to upper case, ck if multiple command
rz ;get another line if null or comment
;
;transient or built-in command?
;
lxi d,ufcb ;include user number byte in front of FCB
call gcmd ;parse command name
lda fcb+9 ;file type specified?
cpi ' '
jnz ccpdisk2 ;execute from disk, if so
lxi h,ufcb ;user or drive specified?
mov a,m ;user number
inx h
ora m ;drive
inx h
mov a,m ;get 1st character of filename
jnz ccpdisk3 ;jump if so
;
;BUILT-IN HANDLER
;
ccpbuiltin:
lxi h,ctbl ;search table of internal commands
lxi d,fcb+1
lda fcb+3
cpi ' '+1 ;is it shorter that 3 characters?
cnc tbls ;is it a built-in?
jnz ccpdisk0 ;load from disk if not
lda option ;[ in command line?
ora a ;options specified?
mov a,b ;built-in index from tbls
lhld parsep
shld errsav ;save beginning of command tail
lxi h,ptbl ;jump to processor if options not
jz tblj ;specified
cpi 4
jc trycom
lxi h,fcb+4
jnz ccpdisk0 ;if DIRS then look for DIR.COM
mvi m,' '
;
;LOAD TRANSIENT (file type unspecified)
;
ccpdisk0:
lxi b,order
call getflg ;0=COM 8=COM,SUB 16=SUB,COM
jz ccpdisk2 ;search for COM file only
mvi b,8 ;=> 2nd choice is SUB
sub b ;now a=0 (COM first) or 8 (SUB first)
jz ccpdisk1 ;search for COM first then SUB
mvi b,0 ;search for SUB first then COM
ccpdisk1:
push b ;save 2nd type to try
call settype ; A = offset of type in type table
call exec ;try to execute, return if unsuccessful
pop psw ;try 2nd type
call settype
;
;LOAD TRANSIENT (file type specified)
;
ccpdisk2:
call exec
jmp perror ;error if can't find it
;
;DRIVE SPECIFIED (check for change drives/users command)
;
ccpdisk3:
cpi ' ' ;check for filename
jnz ccpdisk0 ;execute from disk if specified
call eoc ;error if not end of command
lda ufcb ;user specified?
sui 1
jc ccpdrive
ccpuser:
sta usernum ;CCP's user number
mvi b,ccpusr
call setbyte ;save it in SCB
call setuser ;set current user
ccpdrive:
lda fcb ;drive specified?
dcr a
rm ;return if not
push psw
call select
pop psw
sta disk ;CCP's drive
mvi b,ccpdrv
jmp setbyte ;save it in SCB
;;
;
;************************************************************************
;
; BUILT-IN COMMANDS
;
;************************************************************************
;
;
; Table of internal ccp commands
;
;
ctbl: db 'DIR '
db 'TYPE '
db 'ERASE '
db 'RENAME '
db 'DIRSYS '
db 'USER '
db 0
;
ptbl: dw dir
dw type
dw era
dw ren
dw dirs
dw user
;;
;;-----------------------------------------------------------------------
;;
;; DIR Command
;;
;; DIR list directory of current default user/drive
;; DIR <X>: list directory of user/drive <X>
;; DIR <AFN> list all files on the current default user/drive
;; with names that match <AFN>
;; DIR <X>:<AFN> list all files on user/drive <X> with names that
;; match <AFN>
;;
;;-----------------------------------------------------------------------
;;
;
if newdir
dirdrv:
lda dfcb ;get disk number
endif
dirdrv0:
dcr a
jp dirdrv2
dirdrv1:
lda disk ;get current disk
dirdrv2:
adi 'A'
jmp pfc ;print it (save BC,DE)
;
;
if newdir
dir:
mvi c,0 ;flag for DIR (normal)
lxi d,sysfiles
jmp dirs1
;
;
dirs:
mvi c,080h ;flag for DIRS (system)
lxi d,dirfiles
dirs1: push d
call direct
pop d ;de = .system files message
jz nofile ;jump if no files found
mov a,l ;A = number of columns
cmp b ;did we print any files?
cnc crlf ;print crlf if so
lxi h,anyfiles
dcr m
inr m
rz ;return if no files
;except those requested
dcr m ;set to zero
jmp pmsgnl ;tell the operator other files exist
;
;
direct:
push b ;save DIR/DIRS flag
call sbuf80 ;set DMA = 80h
call gfn ;parse file name
lxi d,dfcb+1
ldax d
cpi ' '
mvi b,11
cz setmatch ;use "????????.???" if none
call eoc ;make sure there's nothing else
call srchf ;search for first directory entry
pop b
rz ;if no files found
dir0:
lda dircols ;number of columns for dir
mov l,a
mov b,a
inr b ;set # names to print per line (+1)
dir1:
push h ;L=#cols, B=curent col, C=dir/dirs
lxi h,10 ;get byte with SYS bit
dad d
mov a,m
pop h
ani 80h ;look at SYS bit
cmp c ;DIR/DIRS flag in C
jz dir2 ;display, if modes agree
mvi a,1 ;set anyfiles true
sta anyfiles
jmp dir3 ;don't print anything
;
; display the filename
;
dir2:
dcr b
cz dirln ;sets no. of columns, puts crlf
mov a,b ;number left to print on line
cmp l ;is current col = number of cols
cz dirdrv ;display the drive, if so
mvi a,':'
call pfc ;print colon
call space
call pfn ;print file name
call space ;pad with space
dir3:
push b ;save current col(B), DIR/DIRS(C)
push h ;save number of columns(L)
call break ;drop out if keyboard struck
call srchn ;search for another match
pop h
pop b
jnz dir1
direx:
inr a ;clear zero flag
ret
else
dirs: ; display system files only
mvi a,0d2h ; JNC instruction
sta dir11 ; skip on non-system files
;
dir: ; display non-system files only
lxi h,ccpcr
push h ; push return address
call gfn ;parse file name
inx d
ldax d
cpi ' '
mvi b,11
cz setmatch ;use "????????.???" if none
call eoc ;make sure there's nothing else
call findone ;search for first directory entry
jz dir4
mvi b,5 ;set # names to print per line
dir1: lxi h,10 ;get byte with SYS bit
dad d
mov a,m
ral ;look at SYS bit
dir11: jc dir3 ;don't print it if SYS bit set
mov a,b
push b
dir2: lxi h,9 ;get byte with R/O bit
dad d
mov a,m
ral ;look at R/O bit
mvi a,' ' ;print space if not R/O
jnc dir21 ;jump if not R/O
mvi a,'*' ;print star if R/O
dir21: call pfc ;print character
call pfn ;print file name
mvi a,13 ;figure out how much padding is needed
sub c
dir25: push psw
call space ;pad it out with spaces
pop psw
dcr a
jnz dir25 ;loop if more required
pop b
dcr b ;decrement # names left on line
jnz dir3
call crlf ;go to new line
mvi b,5 ;set # names to print on new line
dir3: push b
call break ;drop out if keyboard struck
call srchn ;search for another match
pop b
jnz dir1
dir4: mvi a,0dah ;JC instruction
sta dir11 ;restore normal dir mode (skip system files)
jmp ccpcr
endif
;;
;;-----------------------------------------------------------------------
;;
;; TYPE command
;;
;; TYPE <UFN> Print the contents of text file <UFN> on
;; the console.
;;
;;-----------------------------------------------------------------------
;;
type: lxi h,ccpcr
push h ;push return address
call getfn ;get and parse filename
mvi a,127 ;initialize buffer pointer
sta bufp
mvi c,openf
call sbdosf ;open file if a filename was typed
type1: call break ;exit if keyboard struck
call getb ;read byte from file
rnz ;exit if physical eof or read error
cpi eof ;check for eof character
rz ;exit if so
call putc ;print character on console
jmp type1 ;loop
;
;;-----------------------------------------------------------------------
;;
;; USER command
;;
;; USER <NN> Set the user number
;;
;;-----------------------------------------------------------------------
;;
user:
lxi d,unmsg ;Enter User #:
call getprm
call gdn ;convert to binary
rz ;return if nothing typed
jmp ccpuser ;set user number
;
;;-----------------------------------------------------------------------
;;
;; ERA command
;;
;; ERA <AFN> Erase all file on the current user/drive
;; which match <AFN>.
;; ERA <X>:<AFN> Erase all files on user/drive <X> which
;; match <AFN>.
;;
;;-----------------------------------------------------------------------
;;
era: call getfn ;get and parse filename
jz era1
call ckafn ;is it ambiguous?
jnz era1
lxi d,eramsg
call pmsg
lhld errorp
mvi c,' ' ;stop at exclamation mark or 0
call pstrg ;echo command
lxi d,confirm
call getc
call crlf
mov a,l ;character in L after CRLF routine
ani 5fh ;convert to U/C
cpi 'Y' ;Y (yes) typed?
rnz ;return, if not
ora a ;reset zero flag
era1: mvi c,delf
jmp sbdosf
;;-----------------------------------------------------------------------
;;
;;
;; REN command
;;
;;-----------------------------------------------------------------------
;;
ren: call gfn ;zero flag set if nothing entered
push psw
lxi h,16
dad d
xchg
push d ;DE = .dfcb+16
push h ;HL = .dfcb
mvi c,16
call move ;DE = dest, HL = source
call gfn
pop h ;HL=.dfcb
pop d ;DE=.dfcb+16
call drvok
mvi c,renf ;make rename call
pop psw ;zero flag set if nothing entered
;
;;-----------------------------------------------------------------------
;;
;; BUILT-IN COMMAND BDOS CALL & ERROR HANDLERS
;;
;;-----------------------------------------------------------------------
;
sbdosf:
push psw
cnz eoc ;make sure there's nothing else
pop psw
lxi d,dfcb
mvi b,0ffh
mvi h,1 ;execute disk command if we don't call
cnz bdosf ;call if something was entered
rnz ;return if successful
ferror:
dcr h ;was it an extended error?
jm nofile
lhld errsav
shld parsep
trycom: call exec
call pfn
lxi d,required
jmp builtin$err
;
;;-----------------------------------------------------------------------
;
;
; check for drive conflict
; HL = FCB
; DE = FCB+16
;
drvok: ldax d ;get byte from 2nd fcb
cmp m ;ok if they match
rz
ora a ;ok if 2nd is 0
rz
inr m ;error if the 1st one's not 0
dcr m
jnz perror
mov m,a ;copy from 2nd to 1st
ret
;;-----------------------------------------------------------------------
;;
;; check for ambiguous reference in file name/type
;;
;; entry: b = length of string to check (ckafn0)
;; de = fcb area to check (ckafn0) - 1
;; exit: z = set if any ? in file reference (ambiguous)
;; z = clear if unambiguous file reference
;;
ckafn:
mvi b,11 ;check entire name and type
ckafn0: inx d
ldax d
cpi '?' ;is it an ambiguous file name
if newera
rz ;return true if any afn
else
rnz ;return true only if *.*
endif
dcr b
jnz ckafn0
if newera
dcr b ;clear zero flag to return false
endif
ret ;remove above DCR to return true
;;
;;-----------------------------------------------------------------------
;;
;; get parameter (generally used to get a missing one)
;;
getprm:
call skps ;see if already there
rnz ;return if so
getp0:
if prompts
push d
lxi d,enter
call pmsg
pop d
endif
call pmsg ;print prompt
call rcln ;get response
jmp uc ;convert to upper case
;
;;
;;-----------------------------------------------------------------------
if not newdir
;;
;; search for first file, print "No File" if none
;;
findone:
call srchf
rnz ;found
endif
;;-----------------------------------------------------------------------
nofile:
lxi d,nomsg ;tell user no file found
builtin$err:
call pmsgnl
jmp ccpret
;
;
;************************************************************************
;
; EXECUTE DISK RESIDENT COMMAND
;
;************************************************************************
;
;
xfcb: db 0,'SUBMIT COM' ;processor fcb
;
;
; execute submit file (or any other processor)
;
xsub: ;DE = .fcb
ldax d
mvi b,clp$drv
call setbyte ;save submit file drive
lxi h,xfcb
mvi c,12
call move ;copy processor into fcb
lxi h,cbufl ;set parser pointer back to beginning
mvi m,' '
inx h ;move past blank
shld parsep
; execute SUBMIT.COM
;
;
; execute disk resident command (return if not found or error)
;
exec:
;try to open and execute fcb
lxi d,fcb+9
lxi h,typtbl
call tbls ;search for type in type table
rnz ;return if no match
lxi d,ufcb
ldax d ;check to see if user specified
ora a
rnz ;return if so
inx d
ldax d ;check if drive specified
mov c,a
push b ;save type (B) and drive (C)
mvi c,0 ;try only 1 open if drive specified
ora a
jnz exec1 ;try to open as specified
lxi b,(drv0-1)*256+4;try upto four opens from drv chain
lda disk
inr a
mov h,a ;save default disk in H
mvi l,1 ;allow only 1 match to default disk
exec0: inr b ;next drive to try in SCB drv chain
dcr c ;any more tries?
mov a,c
push h
cp getbyte
pop h
ora a
jm exec3
jz exec01 ;jump if drive is 0 (default drive)
cmp h ;is it the default drive
jnz exec02 ;jump if not
exec01: mov a,h ;set drive explicitly
dcr l ;is it the 2nd reference
jm exec0 ;skip, if so
exec02: stax d ;put drive in FCB
exec1: push b ;save drive offset(B) & count(C)
push h
call opencom ;on default drive & user
pop h
pop b
jz exec0 ;try next if open unsuccessful
;
; successful open, now jump to processor
;
exec2:
if dayfile
lxi b,display
call getflg
jz exec21
ldax d
call dirdrv0
mvi a,':'
call pfc
push d
call pfn
pop d
push d
lxi h,8
dad d
mov a,m
ani 80h
lxi d,userzero
cnz pmsg
call crlf
pop d
endif
exec21: pop psw ;recover saved command type
lxi h,xptbl
;
; table jump
;
; entry: hl = address of table of addresses
; a = entry # (0 thru n-1)
;
tblj: add a ;adjust for two byte entries
call addhla ;compute address of entry
push d
mov e,m ;fetch entry
inx h
mov d,m
xchg
pop d
pchl ;jump to it
;
typtbl: db 'COM '
db 'SUB '
db 'PRL '
db 0
;
xptbl: dw xcom
dw xsub
dw xcom
;
; unsuccessful attempt to open command file
;
exec3: pop b ;recover drive
mov a,c
stax d ;replace in fcb
ret
;
;
settype:
;set file type specified from type table
;a = offset (x2) of desired type (in bytes)
rrc
lxi h,typtbl
call addhla ;hl = type in type table
lxi d,fcb+9
mvi c,3
jmp move ;move type into fcb
;
;
;
; EXECUTE COM FILE
;
xcom: ;DE = .fcb
;
; set up FCB for loader to use
;
lxi h,tpa
shld fcbrr ;set load address to 100h
lhld realdos-1 ;put fcb in the loader's stack
dcr h ;page below LOADER (or bottom RSX)
mvi l,0C0h ;offset for FCB in page below the BDOS
push h ;save for LOADER call
ldax d ;get drive from fcb(0)
sta cmdrv ;set command drive field in base page
xchg
mvi c,35
call move ;now move FCB to the top of the TPA
;
; set up base page
;
lxi h,errflg ;tell parser to ignore errors
inr m
xcom3: lhld parsep
dcx h ;backup over delimiter
lxi d,buf+1
xchg
shld parsep ;set parser to 81h
call copy0 ;copy command tail to 81h with
;terminating 0 (returns A=length)
sta buf ;put command tail length at 80h
xcom5: call gfn ;parse off first argument
shld pass0
mov a,b
sta len0
lxi d,dfcb1
call gfn0 ;parse off second argument
shld pass1
mov a,b
sta len1
xcom7: lxi h,chaindsk ;.CHAINDSK
mov a,m
ora a
cp select
lda usernum
call setuser ;set default user, returns H=SCB
add a ;shift user to high nibble
add a
add a
add a
mvi l,seldsk
ora m ;put disk in low nibble
sta defdrv ;set location 4
;
; initialize stack
;
xcom8: pop d ;DE = .fcb
lhld realdos-1 ;base page of BDOS
xra a
mov l,a ;top of stack below BDOS
sphl ;change the stack pointer for CCP
mov h,a ;push warm start address on stack
push h ;for programs returning to the CCP
inr h ;Loader will return to TPA
push h ;after loading a transient program
;
; initialize fcb0(CR), console mode, program return code
; & removable media open and login vectors
;
xcom9: sta 7ch ;clear next record to read
mvi b,con$mode
call setbyte ;set to zero (turn off ^C status)
mvi l,olog
mov m,a ;zero removable open login vector
inx h
mov m,a
inx h
mov m,a ;zero removable media login vector
inx h
mov m,a
mvi l,ccpflag1
mov a,m
ani chain$flg ;chaining?
jnz loader ;load program without clearing
mvi l,prog$ret$code ;the program return code
mov m,a ;A=0
inx h
mov m,a ;set program return = 0000h
;
; call loader
;
loader:
mov a,m ;reset chain flag if set,
ani not$chainflg ;has no effect if we fell through
mov m,a
mvi c,loadf ;use load RSX to load file
jmp bdos ;now load it
;
;
;
;
;************************************************************************
;
; BDOS FUNCTION INTERFACE - Non FCB functions
;
;************************************************************************
;
;
;
;;-----------------------------------------------------------------------
;;
;;
;;
;; print character on terminal
;; pause if screen is full
;; (BDOS function #2)
;;
;; entry: a = character (putc entry)
;; e = character (putc2 entry)
;;
putc: cpi lf ;end of line?
jnz putc1 ;jump if not
lxi h,pgsize ;.pgsize
mov a,m ;check page size
inx h ;.line
inr m ;line=line+1
sub m ;line=page?
jnz putc0
mov m,a ;reset line=0 if so
inx h ;.pgmode
mov a,m ;is page mode off?
ora a ;page=0 if so
lxi d,more
cz getc ;wait for input if page mode on
cpi ctrlc
jz ccpcr
mvi e,cr
call putc2 ;print a cr
putc0: mvi a,lf ;print the end of line char
putc1: mov e,a
putc2: mvi c,coutf
jmp bdos
;;
;;-----------------------------------------------------------------------
;;
;; get character from console
;; (BDOS function #1)
;;
getc: call pmsg
getc1: mvi c,cinf
jmp bdos
;;
;;-----------------------------------------------------------------------
;;
;; print message string on terminal
;; (BDOS function #9)
;;
pmsg: mvi c,pbuff
jmp bdos
;;
;;-----------------------------------------------------------------------
;;
;; read line from console
;; (calls BDOS function #10)
;;
;; exit: z = set if null line
;;
;; This function uses the buffer "cbuf" (see definition of
;; function 10 for a description of the buffer). All input
;; is converted to upper case after reading and the pointer
;; "parsep" is set to the begining of the first non-white
;; character string.
;;
rcln: lxi h,cbufmx ;get line from terminal
mvi m,comlen ;set maximum buffer size
xchg
mvi c,rbuff
call bdos
lxi h,cbufl ;terminate line with zero byte
mov a,m
inx h
call addhla
mvi m,0 ;put zero at the end
jmp crlf ;advance to next line
;
;;
;;-----------------------------------------------------------------------
;;
;; exit routine if keyboard struck
;; (calls BDOS function #11)
;;
;; Control is returned to the caller unless the console
;; keyboard has a character ready, in which case control
;; is transfer to the main program of the CCP.
;;
break: call break1
rz
jmp ccpcr
break1: mvi c,cstatf
call rw
rz
mvi c,cinf
jmp rw
;;
;;-----------------------------------------------------------------------
;;
;; set disk buffer address
;; (BDOS function #26)
;;
;; entry: de -> buffer ("setbuf" only)
;;
sbuf80: lxi d,buf
setbuf: mvi c,dmaf
jmp bdos
;;
;;-----------------------------------------------------------------------
;;
;; select disk
;; (BDOS function #14)
;;
;; entry: a = drive
;;
select:
mov e,a
mvi c,self
jmp bdos
;
;;
;;-----------------------------------------------------------------------
;;
;; set user number
;; (BDOS function #32)
;;
;; entry: a = user #
;; exit: H = SCB page
;;
setuser:
mvi b,usrcode
jmp set$byte
;
;
;
;************************************************************************
;
; BDOS FUNCTION INTERFACE - Functions with a FCB Parameter
;
;************************************************************************
;
;
;;
;; open file
;; (BDOS function #15)
;;
;; exit: z = set if file not found
;;
;;
opencom: ;open command file (SUB, COM or PRL)
lxi b,openf ;b=0 => return error mode of 0
lxi d,fcb ;use internal FCB
;; BDOS CALL ENTRY POINT (used by built-ins)
;;
;; entry: b = return error mode (must be 0 or 0ffh)
;; c = function no.
;; de = .fcb
;; exit: z = set if error
;; de = .fcb
;;
bdosf: lxi h,32 ;offset to current record
dad d ;HL = .current record
mvi m,0 ;set to zero for read/write
push b ;save function(C) & error mode(B)
push d ;save .fcb
ldax d ;was a disk specified?
ana b ;and with 0 or 0ffh
dcr a ;if so, select it in case
cp select ;of permanent error (if errmode = 0ffh)
lxi d,passwd
call setbuf ;set dma to password
pop d ;restore .fcb
pop b ;restore function(C) & error mode(B)
push d
lhld scbaddr
mvi l,errormode
mov m,b ;set error mode
push h ;save .errormode
call bdos
pop d ;.errormode
xra a
stax d ;reset error mode to 0
lda disk
mvi e,seldsk
stax d ;reset current disk to default
push h ;save bdos return values
call sbuf80
pop h ;bdos return
inr l ;set z flag if error
pop d ;restore .fcb
ret
;;
;;-----------------------------------------------------------------------
;;
;; close file
;; (BDOS function #16)
;;
;; exit: z = set if close error
;;
;;close: mvi c,closef
;; jmp oc
;;
;;-----------------------------------------------------------------------
;;
;; delete file
;;
;; exit: z = set if file not found
;;
;; The match any character "?" may be used without restriction
;; for this function. All matched files will be deleted.
;;
;;
;;delete:
;; mvi c,delf
;; jmp oc
;;
;;-----------------------------------------------------------------------
;;
;; create file
;; (BDOS function #22)
;;
;; exit: z = set if create error
;;
;;make: mvi c,makef
;; jmp oc
;;-----------------------------------------------------------------------
;;
;; search for first filename match (using "DFCB" and "BUF")
;; (BDOS function #17)
;;
;; exit: z = set if no match found
;; z = clear if match found
;; de -> directory entry in buffer
;;
srchf: mvi c,searf ;set search first function
jmp srch
;;
;;-----------------------------------------------------------------------
;;
;; search for next filename match (using "DFCB" and "BUF")
;; (BDOS function #18)
;;
;; exit: z = set if no match found
;; z = clear if match found
;; de -> directory entry in buffer
;;
srchn: mvi c,searnf ;set search next function
srch: lxi d,dfcb ;use default fcb
call bdos
inr a ;return if not found
rz
dcr a ;restore original return value
add a ;shift to compute buffer pos'n
add a
add a
add a
add a
lxi h,buf ;add to buffer start address
call addhla
xchg ;de -> entry in buffer
xra a ;may be needed to clear z flag
dcr a ;depending of value of "buf"
ret
;;
;;-----------------------------------------------------------------------
;;
;; read file
;; (BDOS function #20)
;;
;; entry: hl = buffer address (readb only)
;; exit z = set if read ok
;;
read: xra a ;clear getc pointer
sta bufp
mvi c,readf
lxi d,dfcb
rw: call bdos
ora a
ret
;
;;
;;-----------------------------------------------------------------------
;;
;; $$$.SUB interface
;;
;; entry: c = bdos function number
;; exit z = set if successful
sudos: lxi d,subfcb
jmp rw
;
;
;
;************************************************************************
;
; COMMAND LINE PARSING SUBROUTINES
;
;************************************************************************
;
;------------------------------------------------------------------------
;
; COMMAND LINE PREPARSER
; reset function 10 flag
; set up parser
; convert to upper case
;
; All input is converted to upper case and the pointer
; "parsep" is set to the begining of the first non-blank
; character string. If the line begins with a ; or :, it
; is treated specially:
;
; ; comment the line is ignored
; : conditional the line is ignored if a fatal
; error occured during the previous
; command, otherwise the : is
; ignored
;
; An exclamation point is used to separate multiple commands on a
; a line. Two adjacent exclaimation points translates into a single
; exclaimation point in the command tail for compatibility.
;------------------------------------------------------------------------
;
;
uc:
call resetccpflg
xchg ;DE = .SCB
xra a
sta option ;zero option flag
lxi h,cbuf
call skps1 ;skip leading spaces/tabs
xchg
cpi ';' ;HL = .scb
rz
cpi '!'
jz uc0
cpi ':'
jnz uc1
mvi l,prog$ret$code
inr m
inr m ;was ^C typed? (low byte 0FEh)
jz uc0 ;successful, if so
inx h
inr m ;is high byte 0FFh?
rz ;skip command, if so
uc0: inx d ;skip over 1st character
uc1: xchg ;HL=.command line
shld parsep ;set parse pointer to beginning of line
uc3: mov a,m ;convert lower case to upper
cpi '['
jnz uc4
sta option ;'[' is the option delimiter => command option
uc4: cpi 'a'
jc uc5
cpi 'z'+1
jnc uc5
sui 'a'-'A'
mov m,a
uc5:
if multi
cpi '!'
cz multistart ;HL=.char, A=char
endif
inx h ;advance to next character
ora a ;loop if not end of line
jnz uc3
;
; skip spaces
; return with zero flag set if end of line
;
skps: lhld parsep ;get current position
skps1: shld parsep ;save position
shld errorp ;save position for error message
mov a,m
ora a ;return if end of command
rz
cpi ' '
jz skps2
cpi tab ;skip spaces & tabs
rnz
skps2: inx h ;advance past space/tab
jmp skps1 ;loop
;
;-----------------------------------------------------------------------
;
; MULTIPLE COMMANDS PER LINE HANDLER
;
;-----------------------------------------------------------------------
if multi
multistart:
;
; A = current character in command line
; HL = address of current character in command line
;
;double exclaimation points become one
mov e,l
mov d,h
inx d
ldax d
cpi '!' ;double exclaimation points
push psw
push h
cz copy0 ;convert to one, if so
pop h
pop psw
rz
;we have a valid multiple command line
mvi m,0 ;terminate command line here
xchg
;multiple commands not allowed in submits
;NOTE: submit unravels multiple commands making the
;following test unnecessary. However, with GET[system]
;or CP/M 2.2 SUBMIT multiple commands will be posponed
;until the entire submit completes...
; call subtest ;submit active
; mvi a,0
; rnz ;return with A=0, if so
;set up the RSX buffer
lhld osbase ;get high byte of TPA address
dcr h ;subtract 1 page for buffer
mvi l,endchain ;HL = RSX buffer base-1
mov m,a ;set end of chain flag to 0
push h ;save it
multi0: inx h
inx d
ldax d ;get character from cbuf
mov m,a ;place in RSX
cpi '!'
jnz multi1
mvi m,cr ;change exclaimation point to cr
multi1: ora a
jnz multi0
mvi m,cr ;end last command with cr
inx h
mov m,a ;terminate with a zero
;set up RSX prefix
mvi l,6 ;entry point
mvi m,jmp ;put a jump instruction there
inx h
mvi m,9 ;make it a jump to base+9 (RSX exit)
inx h
mov m,h
inx h ;HL = RSX exit point
mvi m,jmp ;put a jump instruction there
mvi l,warmflg ;HL = remove on warm start flag
mov m,a ;set (0) for RSX to remain resident
mov l,a ;set low byte to 0 for fixchain
xchg ;DE = RSX base
call fixchain ;add the RSX to the chain
;save buffer address
lhld scbaddr
mvi l,ccpconbuf ;save buffer address in CCP conbuf field
pop d ;DE = RSX base
inx d
mov m,e
inx h
mov m,d
mvi l,multi$rsx$pg
mov m,d ;save the RSX base
xra a ;zero in a to fall out of uc
ret
;
;
; save the BDOS conbuffer address and
; terminate RSX if necessary.
;
multisave:
lxi d,conbuffer*256+ccpconbuf
call wordmov ;first copy conbuffer in case SUBMIT
ora a ;and/or GET are active
lxi d,conbuffl*256+ccpconbuf
cz wordmov ;if conbuff is zero then conbufl has the
push h ;next address
call break1
pop h ;H = SCB page
mvi l,ccpconbuf
jnz multiend
mov e,m
inx h
mov d,m ;DE = next conbuffer address
inr m
dcr m ;is high byte zero?
dcx h ;HL = .ccpconbuf
jz multiend ;remove multicmd RSX if so
ldax d ;check for terminating zero
ora a
rnz ;return if not
;
; we have exhausted all the commands
multiend:
; HL = .ccpconbuf
xra a
mov m,a ;set buffer to zero
inx h
mov m,a
mvi l,multi$rsx$pg
mov h,m
mvi l,0eh ;HL=RSX remove on warmstart flag
dcr m ;set to true for removal
jmp rsx$chain ;remove the multicmd rsx buffer
endif
;;
;************************************************************************
;
; FILE NAME PARSER
;
;************************************************************************
;
;
;
; get file name (read in if none present)
;
;
;; The file-name parser in this CCP implements
;; a user/drive specification as an extension of the normal
;; CP/M drive selection feature. The syntax of the
;; user/drive specification is given below. Note that a
;; colon must follow the user/drive specification.
;;
;; <a>: <a> is an alphabetic character A-P specifing one
;; of the CP/M disk drives.
;;
;; <n>: <n> is a decimal number 0-15 specifying one of the
;; user areas.
;;
;; <n><a>: A specification of both user area and drive.
;;
;; <a><n>: Synonymous with above.
;;
;; Note that the user specification cannot be included
;; in the parameters of transient programs or precede a file
;; name. The above syntax is parsed by gcmd (get command).
;;
;; ************************************************************
getfn:
if prompts
lxi d,fnmsg
getfn0:
call getprm
endif
gfn: lxi d,dfcb
gfn0: call skps ;sets zero flag if eol
push psw
call gfn2
pop psw
ret
;
; BDOS FUNCTION 152 INTERFACE
;
;entry: DE = .FCB
; HL = .buffer
;flags/A reg preserved
;exit: DE = .FCB
;
;
gfn2: shld parsep
shld errorp
push d ;save .fcb
lxi d,pfncb
mvi c,parsef
if func152
call bdos
else
call parse
endif
pop d ;.fcb
mov a,h
ora l ;end of command? (HL = 0)
mov b,m ;get delimiter
inx h ;move past delimiter
jnz gfn3
lxi h,zero+2 ;set HL = .0
gfn3: mov a,h
ora l ;parse error? (HL = 0ffffh)
jnz gfn4
lxi h,zero+2
call perror
gfn4: mov a,b
cpi '.'
jnz gfn6
dcx h
gfn6: shld parsep ;update parse pointer
gfnpwd: mvi c,16
lxi h,pfcb
push d
call move
lxi d,passwd ;HL = .disk map in pfcb
mvi c,10
call move ;copy to passwd
pop d ;HL = .password len
mov a,m
zero: lxi h,0 ;must be an "lxi h,0"
ora a ;is there a password?
mov b,a
jz gfn8
lhld errorp ;HL = .filename
gfn7: mov a,m
cpi ';'
inx h
jnz gfn7
gfn8: ret ;B = len, HL = .password
;
; PARSE CP/M 3 COMMAND
; entry: DE = .UFCB (user no. byte in front of FCB)
; PARSEP = .command line
gcmd:
push d
xra a
stax d ;clear user byte
inx d
stax d ;clear drive byte
inx d
call skps ;skip leading spaces
;
; Begin by looking for user/drive-spec. If none if found,
; fall through to main file-name parsing section. If one is found
; then branch to the section that handles them. If an error occurs
; in the user/drive spec; treat it as a filename for compatibility
; with CP/M 2.2. (e.g. STAT VAL: etc.)
;
lhld parsep ;get pointer to current parser position
pop d
push d ;DE = .UFCB
mvi b,4 ;maximum length of user/drive spec
gcmd1: mov a,m ;get byte
cpi ':' ;end of user/drive-spec?
jz gcmd2 ;parse user/drive if so
ora a ;end of command?
jz gcmd8 ;parse filename (Func 152), if so
dcr b ;maximum user/drive spec length exceeded?
inx h
jnz gcmd1 ;loop if not
;
; Parse filename, type and password
;
gcmd8:
pop d
xra a
stax d ;set user = default
lhld parsep
gcmd9: inx d ;past user number byte
ldax d ;A=drive
push psw
call gfn2 ;BDOS function 152 interface
pop psw
stax d
ret
;
; Parse the user/drive-spec
;
gcmd2:
lhld parsep ;get pointer to beginning of spec
mov a,m ;get character
gcmd3: cpi '0' ;check for user number
jc gcmd4 ;jump if not numeric
cpi '9'+1
jnc gcmd4
call gdns ;get the user # (returned in B)
pop d
push d
ldax d ;see if we already have a user #
ora a
jnz gcmd8 ;skip if we do
mov a,b ;A = specified user number
inr a ;save it as the user-spec
stax d
jmp gcmd5
gcmd4: cpi 'A' ;check for drive-spec
jc gcmd8 ;skip if not a valid drive character
cpi 'P'+1
jnc gcmd8
pop d
push d
inx d
ldax d ;see if we already have a drive
ora a
jnz gcmd8 ;skip if so
mov a,m
sui '@' ;convert to a drive-spec
stax d
inx h
gcmd5: mov a,m ;get next character
cpi ':' ;end of user/drive-spec?
jnz gcmd3 ;loop if not
inx h
pop d ;.ufcb
jmp gcmd9 ;parse the file name
;
;************************************************************************
;
; TEMPORARY PARSE CODE
;
;************************************************************************
;
if not func152
; version 3.0b Oct 08 1982 - Doug Huskey
;
;
passwords equ true
parse: ; DE->.(.filename,.fcb)
;
; filename = [d:]file[.type][;password]
;
; fcb assignments
;
; 0 => drive, 0 = default, 1 = A, 2 = B, ...
; 1-8 => file, converted to upper case,
; padded with blanks (left justified)
; 9-11 => type, converted to upper case,
; padded with blanks (left justified)
; 12-15 => set to zero
; 16-23 => password, converted to upper case,
; padded with blanks
; 26 => length of password (0 - 8)
;
; Upon return, HL is set to FFFFH if DE locates
; an invalid file name;
; otherwise, HL is set to 0000H if the delimiter
; following the file name is a 00H (NULL)
; or a 0DH (CR);
; otherwise, HL is set to the address of the delimiter
; following the file name.
;
xchg
mov e,m ;get first parameter
inx h
mov d,m
push d ;save .filename
inx h
mov e,m ;get second parameter
inx h
mov d,m
pop h ;DE=.fcb HL=.filename
xchg
parse0:
push h ;save .fcb
xra a
mov m,a ;clear drive byte
inx h
lxi b,20h*256+11
call pad ;pad name and type w/ blanks
lxi b,4
call pad ;EXT, S1, S2, RC = 0
lxi b,20h*256+8
call pad ;pad password field w/ blanks
lxi b,12
call pad
call skip
;
; check for drive
;
ldax d
cpi ':' ;is this a drive?
dcx d
pop h
push h ;HL = .fcb
jnz parse$name
;
; Parse the drive-spec
;
parsedrv:
ldax d ;get character
ani 5fh ;convert to upper case
sui 'A'
jc perr1
cpi 16
jnc perr1
inx d
inx d ;past the ':'
inr a ;set drive relative to 1
mov m,a ;store the drive in FCB(0)
;
; Parse the file-name
;
parse$name:
inx h ;HL = .fcb(1)
call delim
jz parse$ok
if passwords
lxi b,7*256
else
mvi b,7
endif
parse6: ldax d ;get a character
cpi '.' ;file-type next?
jz parse$type ;branch to file-type processing
cpi ';'
jz parsepw
call gfc ;process one character
jnz parse6 ;loop if not end of name
jmp parse$ok
;
; Parse the file-type
;
parse$type:
inx d ;advance past dot
pop h
push h ;HL =.fcb
lxi b,9
dad b ;HL =.fcb(9)
if passwords
lxi b,2*256
else
mvi b,2
endif
parse8: ldax d
cpi ';'
jz parsepw
call gfc ;process one character
jnz parse8 ;loop if not end of type
;
parse$ok:
pop b
push d
call skip
call delim
pop h
rnz
lxi h,0
ora a
rz
cpi cr
rz
xchg
ret
;
; handle parser error
;
perr:
pop b ;throw away return addr
perr1:
pop b
lxi h,0ffffh
ret
;
if passwords
;
; Parse the password
;
parsepw:
inx d
pop h
push h
lxi b,16
dad b
lxi b,7*256+1
parsepw1:
call gfc
jnz parsepw1
mvi a,7
sub b
pop h
push h
lxi b,26
dad b
mov m,a
ldax d ;delimiter in A
jmp parse$ok
else
;
; skip over password
;
parsepw:
inx d
call delim
jnz parsepw
jmp parse$ok
endif
;
; get next character of name, type or password
;
gfc: call delim ;check for end of filename
rz ;return if so
cpi ' ' ;check for control characters
inx d
jc perr ;error if control characters encountered
inr b ;error if too big for field
dcr b
jm perr
if passwords
inr c
dcr c
jnz gfc1
endif
cpi '*' ;trap "match rest of field" character
jz setwild
gfc1: mov m,a ;put character in fcb
inx h
dcr b ;decrement field size counter
ora a ;clear zero flag
ret
;;
setwild:
mvi m,'?' ;set match one character
inx h
dcr b
jp setwild
ret
;
; skip spaces
;
skip0: inx d
skip: ldax d
cpi ' ' ;skip spaces & tabs
jz skip0
cpi tab
jz skip0
ret
;
; check for delimiter
;
; entry: A = character
; exit: z = set if char is a delimiter
;
delimiters: db cr,tab,' .,:;[]=<>|',0
delim: ldax d ;get character
push h
lxi h,delimiters
delim1: cmp m ;is char in table
jz delim2
inr m
dcr m ;end of table? (0)
inx h
jnz delim1
ora a ;reset zero flag
delim2: pop h
rz
;
; not a delimiter, convert to upper case
;
cpi 'a'
rc
cpi 'z'+1
jnc delim3
ani 05fh
delim3: ani 07fh
ret ;return with zero set if so
;
; pad with blanks
;
pad: mov m,b
inx h
dcr c
jnz pad
ret
;
endif
;
;
;************************************************************************
;
; SUBROUTINES
;
;************************************************************************
;
if multi
;
; copy SCB memory word
; d = source offset e = destination offset
;
wordmov:
lhld scbaddr
mov l,d
mov d,h
mvi c,2
;
endif
;
; copy memory bytes
; de = destination hl = source c = count
;
move:
mov a,m
stax d ;move byte to destination
inx h
inx d ;advance pointers
dcr c ;loop if non-zero
jnz move
ret
;
; copy memory bytes with terminating zero
; hl = destination de = source
; returns c=length
copy0: mvi c,0
copy1: ldax d
mov m,a
ora a
mov a,c
rz
inx h
inx d
inx b
jmp copy1
;;
;;-----------------------------------------------------------------------
;;
;; get byte from file
;;
;; exit: z = set if byte gotten
;; a = byte read
;; z = clear if error or eof
;; a = return value of bdos read call
;;
getb: xra a ;clear accumulator
lxi h,bufp ;advance buffer pointer
inr m
cm read ;read sector if buffer empty
ora a
rnz ;return if read error or eof
lda bufp ;compute pointer into buffer
lxi h,buf
call addhla
xra a ;set zero flag
mov a,m ;get byte
ret
;;
;;-----------------------------------------------------------------------
;;
;;
;; system control block flag routines
;;
;; entry: c = bit mask (1 bit on)
;; b = scb byte offset
;;
subtest:
lxi b,submit
getflg:
; return flag value
; exit: zero flag set if flag reset
; c = bit mask
; hl = flag byte address
;
lhld scbaddr
mov l,b
mov a,m
ana c ; a = bit
ret
;
setccpflg:
lxi b,ccp10
;
setflg:
; set flag on (bit = 1)
;
call getflg
mov a,c
ora m
mov m,a
ret
;
resetccpflg:
lxi b,ccp10
;
resetflg:
; reset flag off (bit = 0)
;
call getflg
mov a,c
cma
ana m
mov m,a
ret
;;
;;
;; SET/GET SCB BYTE
;;
;; entry: A = byte ("setbyte" only)
;; B = SCB byte offset from page
;;
;; exit: A = byte ("getbyte" only)
;;
setbyte:
lhld scbaddr
mov l,b
mov m,a
ret
;
getbyte:
lhld scbaddr
mov l,b
mov a,m
ret
;
;;-----------------------------------------------------------------------
;;
;;
;; print message followed by newline
;;
;; entry: de -> message string
;;
pmsgnl: call pmsg
;
; print crlf
;
dirln: mov b,l ;number of columns for DIR
crlf: mvi a,cr
call pfc
mvi a,lf
jmp pfc
;;
;;-----------------------------------------------------------------------
;;
;; print decimal byte
;;
pdb: sui 10
jc pdb2
mvi e,'0'
pdb1: inr e
sui 10
jnc pdb1
push psw
call putc2
pop psw
pdb2: adi 10+'0'
jmp putc
;;-----------------------------------------------------------------------
;;
;;
;; print string terminated by 0 or char in c
;;
pstrg: mov a,m ;get character
ora a
rz
cmp c
rz
call pfc ;print character
inx h ;advance pointer
jmp pstrg ;loop
;;
;;-----------------------------------------------------------------------
;;
;; check for end of command (error if extraneous parameters)
;;
eoc: call skps
rz
;
; handle parser error
;
perror:
lxi h,errflg
mov a,m
ora a ;ignore error????
mvi m,0 ;clear error flag
rnz ;yes...just return to CCPRET
lhld errorp ;get pointer to what we're parsing
mvi c,' '
call pstrg
perr2: mvi a,'?' ;print question mark
call putc
jmp ccpcr
;
;;-----------------------------------------------------------------------
;;
;;
;; print error message and exit processor
;;
;; entry: bc -> error message
;;
;;msgerr: push b
;; call crlf
;; pop d
;; jmp pmsgnl
;;
;;-----------------------------------------------------------------------
;;
;; get decimal number (0 <= N <= 255)
;;
;; exit: a = number
;;
gdn: call skps ;skip initial spaces
lhld parsep ;get pointer to current character
shld errorp ;save in case of parsing error
rz ;return if end of command
mov a,m ;get it
cpi '0' ;error if non-numeric
jc perror
cpi '9'+1
jnc perror
call gdns ;convert number
shld parsep ;save new position
ori 1 ;clear zero and carry flags
mov a,b
ret
;
gdns: mvi b,0
gdns1: mov a,m
sui '0'
rc
cpi 10
rnc
push psw
mov a,b ;multiply current accumulator by 10
add a
add a
add b
add a
mov b,a
pop psw
inx h ;advance to next character
add b ;add it in to the current accumulation
mov b,a
cpi 16
jc gdns1 ;loop unless >=16
jmp perror ;error if invalid user number
;;
;;-----------------------------------------------------------------------
;;
;; print file name
;;
if newdir
pfn: inx d ;point to file name
mvi h,8 ;set # characters to print, clear # printed
call pfn1 ;print name field
call space
mvi h,3 ;set # characters to print
pfn1: ldax d ;get character
ani 7fh
call pfc ;print it if not
inx d ;advance pointer
dcr h ;loop if more to print
jnz pfn1
ret
;
space: mvi a,' '
;
pfc: push b
push d
push h
call putc
pop h
pop d
pop b
ret
else
pfn: inx d ;point to file name
lxi b,8*256 ;set # characters to print, clear # printed
call pfn1 ;print name field
ldax d ;see if there's a type
ani 7fh
cpi ' '
rz ;return if not
mvi a,'.' ;print dot
call pfc
mvi b,3 ;set # characters to print
pfn1: ldax d ;get character
ani 7fh
cpi ' ' ;is it a space?
cnz pfc ;print it if not
inx d ;advance pointer
dcr b ;loop if more to print
jnz pfn1
ret
;
space: mvi a,' '
;
pfc: inr c ;increment # characters printed
push b
push d
call putc
pop d
pop b
ret
endif
;;
;;-----------------------------------------------------------------------
;;
;; add a to hl
;;
addhla: add l
mov l,a
rnc
inr h
ret
;;
;;-----------------------------------------------------------------------
;;
;; set match-any string into fcb
;;
;; entry: de -> fcb area
;; b = # bytes to set
;;
setmatch:
mvi a,'?' ;set match one character
setm1: stax d ;fill rest of field with match one
inx d
dcr b ;loop if more to fill
jnz setm1
ora a
ret
;;
;;-----------------------------------------------------------------------
;;
;; table search
;;
;; Search table of strings separated by spaces and terminated
;; by 0. Accept abbreviations, but set string = matched string
;; on exit so that we don't try to execute abbreviation.
;;
;; entry: de -> string to search for
;; hl -> table of strings to match (terminate table with 0)
;; exit: z = set if match found
;; a = entry # (0 thru n-1)
;; z = not set if no match found
;;
tbls: lxi b,0ffh ;clear entry & entry length counters
tbls0: push d ;save match string addr
push h ;save table string addr
tbls1: ldax d ;compare bytes
ani 7fh ;kill upper bit (so SYS + R/O match)
cpi ' '+1 ;end of search string?
jc tbls2 ;skip compare, if so
cmp m
jnz tbls3 ;jump if no match
tbls2: inx d ;advance string pointer
inr c ;increment entry length counter
mvi a,' '
cmp m
inx h ;advance table pointer
jnz tbls1 ;continue with this entry if more
pop h ;HL = matched string in table
pop d ;DE = string address
call move ; C = length of string in table
mov a,b ;return current entry counter value
ret
;
tbls3: mvi a,' ' ;advance hl past current string
tbls4: cmp m
inx h
jnz tbls4
pop d ;throw away last table address
pop d ;DE = string address
inr b ;increment entry counter
mvi c,0ffh
mov a,m ;check for end of table
sui 1
jnc tbls0 ;loop if more entries to test
ret
;
;************************************************************************
;************************************************************************
;
;************************************************************************
;
; DATA AREA
;
;************************************************************************
; ;Note uninitialized data placed at the end (DS)
;
;
if prompts
enter: db 'Enter $'
unmsg: db 'User #: $'
fnmsg: db 'File: $'
else
unmsg: db 'Enter User #: $'
endif
nomsg: db 'No File$'
required:
db ' required$'
eramsg:
db 'ERASE $'
confirm:
db ' (Y/N)? $'
more: db cr,lf,cr,lf,'Press RETURN to Continue $'
if dayfile
userzero db ' (User 0)$'
endif
;
;
;
if newdir
anyfiles: db 0 ;flag for SYS or DIR files exist
dirfiles: db 'NON-'
sysfiles: db 'SYSTEM FILE(S) EXIST$'
endif
errflg: db 0 ;parse error flag
if multi
multibufl:
dw 0 ;multiple commands buffer length
endif
scbadd: db scbad-pag$off,0
;********** CAUTION FOLLOWING DATA MUST BE IN THIS ORDER *********
pfncb: ;BDOS func 152 (parse filename)
parsep: dw 0 ;pointer to current position in command
pfnfcb: dw pfcb ;.fcb for func 152
usernum: ;CCP current user
db 0
chaindsk:
db 0 ;transient's current disk
disk: db 0 ;CCP current disk
subfcb: db 1,'$$$ SUB',0
ccpend: ;end of file (on disk)
ds 1
submod: ds 1
subrc: ds 1
ds 16
subcr: ds 1
subrr: ds 2
subrr2: ds 1
dircols:
ds 1 ;number of columns for DIR/DIRS
pgsize: ds 1 ;console page size
line: ds 1 ;console line #
pgmode: ds 1 ;console page mode
;*****************************************************************
errorp: ds 2 ;pointer to beginning of current param.
errsav: ds 2 ;pointer to built-in command tail
bufp: ds 1 ;buffer pointer for getb
realdos:
ds 1 ;base page of BDOS
;
option: ds 1 ;'[' in line?
passwd: ds 10 ;password
ufcb: ds 1 ;user number (must procede fcb)
FCB:
ds 1 ; drive code
ds 8 ; file name
ds 3 ; file type
ds 4 ; control info
ds 16 ; disk map
fcbcr: ds 1 ; current record
fcbrr: ds 2 ; random record
pfcb: ds 36 ; fcb for parsing
;
;
;
;
; command line buffer
;
cbufmx: ds 1
cbufl: ds 1
cbuf: ds comlen
ds 50h
stack:
ccptop: ;top page of CCP
end

Reference in New Issue View Git Blame Copy Permalink