;
; Environment Definition
;
if z3env ne 0
;
; External ZCPR3 Environment Descriptor
;
jmp start
db 'Z3ENV' ;This is a ZCPR3 Utility
db 1 ;External Environment Descriptor
z3eadr:
dw z3env
start:
lhld z3eadr ;pt to ZCPR3 environment
;
else
;
; Internal ZCPR3 Environment Descriptor
;
MACLIB Z3BASE.LIB
MACLIB SYSENV.LIB
z3eadr:
jmp start
SYSENV
start:
lxi h,z3eadr ;pt to ZCPR3 environment
endif
;
; Start of Program -- Initialize ZCPR3 Environment
;
call z3init ;initialize the ZCPR3 Env and the VLIB Env
;
; Print Banner
;
call print ;check quiet flag
db 'MKDIR, Version '
db (version/10)+'0','.',(version mod 10)+'0'
db cr,lf,0
;
; Check for Wheel Powers
;
call getwhl ;get wheel byte
jnz ndir0
call print
db ' Permission to Run MKDIR Denied - Not Wheel',0
ret
;
; Check for Availability of Named Directory
;
ndir0:
call getndr ;get location of directory
jnz ndir1
call print
db ' Named Directory Buffer Not Available',0
ret
ndir1:
xra a ; A=0
sta chflag ; set no changes
sta flflag ; set no file loaded
sta ecount ; set no entries
lda fcb+1 ; check for help
cpi '/'
jnz start1
call print ; print help message
db cr,lf,' MKDIR is used to read and edit named directory files.'
db cr,lf,'It is invoked by the following forms --'
db cr,lf
db cr,lf,' MKDIR <-- Enter System'
db cr,lf,' MKDIR dir:filename.typ <-- Define File First'
db cr,lf,' MKDIR // <-- Print this Help'
db cr,lf,0
ret
start1:
call putud ; save current dir for quick return
lxi h,dnfile ; set default file name
lxi d,dfcb+1 ; copy into fcb
mvi b,11 ; 11 chars
call hmovb
lxi h,fcb+1 ; pt to fcb
mov a,m ; get name
cpi ' ' ; no entry?
jz mkdir ; enter system
dcx h ; pt to name
lxi d,dfcb ; store name in DFCB
mvi b,16 ; copy 16 chars
call hmovb
jmp loadf0 ; enter load file
;
; Main Entry Point for Loading a File
;
loadfile:
lxi d,dfcb ; set up default file name
call zfname ; extract info
loadf0:
call retud ; get UD in CB
lda dfcb ; get disk
ora a ; current?
jz loadf1
dcr a ; A=0
mov b,a ; disk in B
loadf1:
lda dfcb+13 ; get user
mov c,a ; in C
call logud ; log into UD to begin search
;
; Entry Point for Loading File in DFCB
;
ffile:
lxi d,dfcb ; pt to FCB
call initfcb ; init it
call f$open ; try to open file
jz ffile1
call print
db cr,lf,'File ',0
lxi d,dfcb+1 ; print name
call pfn1
call print
db ' Not Found',0
jmp mkdir
ffile1:
call getnd ; get max size of file
mov b,a ; ... in B
inr b ; add 1 for overflow
call codend ; pt to scratch buffer
readf:
lxi d,dfcb ; pt to FCB
call f$read ; read next block
jnz readd ; done if EOF
push b ; save count
mvi b,128 ; copy 128 bytes
lxi d,tbuff ; ... from TBUFF
xchg
call hmovb
xchg ; HL pts to next block to copy into
pop b ; get count
dcr b ; count down
jnz readf
call print
db cr,lf,'Named Directory File too Large for System',0
call getud ; return home
jmp mkdir ; reset parameters
readd:
call f$close ; close file
call getud ; return home
;
; Fill in empty space at end of buffer
;
readd1:
mov a,b ; get count
cpi 1 ; done?
jz readd2
push b ; save count
mvi b,128 ; fill 128 bytes with 0
xra a
call hfilb
pop b ; get count
dcr b ; count down
jmp readd1
readd2:
mvi a,0ffh
mov m,a ; set EOF mark
sta flflag ; set file loaded flag
;
; Determine Entry Count
;
call codend ; pt to first entry
mvi b,0 ; set entry count
lxi d,18 ; size of entry
readd3:
mov a,m ; get first char of next entry
ora a ; done?
jz readd4
inr b ; increment count
dad d ; pt to next
jmp readd3
readd4:
mov a,b ; set entry count
sta ecount
jmp mkdir1 ; enter MKDIR
;
; Enter MKDIR System and Init Environ
; Enter at MKDIR if no file loaded, enter at MKDIR1 if file loaded
;
mkdir:
call dinit0 ; init directory
xra a ; A=0
sta ecount ; set no entries present
sta flflag ; set no file loaded
sta chflag ; set no changes
mkdir1:
call print
db cr,lf,'MKDIR Command (? for Help)? ',0
call capine ; get command
lxi d,mkdir1 ; set ret address
push d
lxi h,ctable ; scan command table for it
mov c,a ; command in C
mkdir2:
mov a,m ; get command letter
ora a ; end of table?
jz mkdirh
cmp c ; match?
jz mkdir3
inx h ; skip over address
inx h
inx h
jmp mkdir2
mkdir3:
inx h ; get address in HL
mov a,m ; low
inx h
mov h,m
mov l,a ; HL is address of routine
pchl ; "call" routine
;
; Print MKDIR Command Help
;
mkdirh:
call print
db cr,lf,'MKDIR Commands are --'
db cr,lf,' C -- Change Directory (Add/Rename/Delete Entries)'
db cr,lf,' I -- Initialize Directory'
db cr,lf,' P -- Print Directory'
db cr,lf,' R -- Read Directory File'
db cr,lf,' S -- Status of MKDIR Environment'
db cr,lf,' W -- Write Directory File'
db cr,lf,' X -- Exit Program'
db cr,lf,0
ret
;
; Command Table
;
ctable:
db 'C' ; change directory
dw change
db 'I' ; init directory
dw dinit
db 'P' ; print directory
dw pwd
db 'R' ; read file
dw read
db 'S' ; status
dw status
db 'W' ; write file
dw write
db 'X' ; exit
dw exit
db 0 ; end of table
;
; Status
;
status:
call print
db cr,lf,'** MKDIR Status **',cr,lf,cr,lf,0
call prec ; print entry count
call print
db cr,lf,'Working File Name: ',0
lxi d,dfcb+1
call pfn1
call crlf ; new line
call crlf
lda chflag ; changes made?
ora a
jnz stat1
call print
db 'No ',0
stat1:
call print
db 'Changes made to Directory since Startup'
db cr,lf,0
lda flflag ; file loaded?
ora a ; 0=no
jnz stat2
call print
db 'No ',0
stat2:
call print
db 'File has been loaded',cr,lf,0
ret
;
; Init Directory
;
dinit:
call print
db cr,lf,' Are you sure you want to Initialize the Directory '
db '(Y/N/<CR>=N)? ',0
call capine ; get response
call crlf
cpi 'Y' ; Yes is only valid reply
rnz
dinit0:
xra a ; A=0
sta ecount
cma
sta chflag ; set change flag
call getnd ; get directory size
mov b,a ; ... in B
call codend ; pt to directory
dinit1:
push b ; save counter
xra a ; zero fill
mvi b,128 ; 128 bytes
call hfilb
pop b ; get counter
dcr b ; count down
jnz dinit1
mvi m,0ffh ; store ending mark
ret
;
; Read File
;
read:
pop psw ; clear stack
call getfname ; get file name
ora a ; none?
jz ffile ; just find default file and load it
jmp loadfile ; parse entry and load file
;
; Get File Name from User
;
getfname:
call print
db cr,lf,'Name of File (<RETURN> = ',0
call retud ; get current DU
mov a,b ; print disk
adi 'A'
call cout
mov a,c ; print user
call padc
call print
db ': ',0
lxi d,dfcb+1 ; print default name
call pfn1
call print
db ')? ',0
mvi a,0ffh ; capitalize
call bbline ; get user input
call sksp ; skip to non-blank
mov a,m
ora a ; default?
ret
;
; Write File
;
write:
call getfname ; get file name
jz write1
lxi d,dfcb ; parse into DFCB
call zfname ; parse file name
call retud ; get current DU
lda dfcb ; get disk
ora a ; current?
jz write0
dcr a ; adjust for A=0
mov b,a ; ... in B
write0:
lda dfcb+13 ; get user
mov c,a ; ... in C
call logud ; log into new dir
write1:
lxi d,dfcb ; open file for output
call initfcb
call f$exist ; does file exist?
jz wf0
call gfa ; get file attributes
ani 1 ; R/O?
jz wf0
call print
db cr,lf,'File is R/O',0
jmp getud ; go home
wf0:
call f$make ; open file
inr a ; a was 0ffh if error
jz werr ; write error and abort
call print
db cr,lf,'Writing Directory to Disk ... ',0
call getnd ; get size of file
mov b,a ; count in B
call codend ; pt to start of buffer
wf1:
push b ; save counter
lxi d,tbuff ; copy into buffer
mvi b,128 ; 128 bytes
call hmovb
lxi d,dfcb ; pt to FCB
call f$write ; write block
pop b ; get ptr
jnz werr
dcr b ; count down
jnz wf1
lxi d,dfcb ; pt to FCB
call f$close ; close file
call getud ; go home
xra a ; A=0
sta chflag ; set no changes flag
call print
db 'Done',0
ret
werr:
call print
db cr,lf,'Error in Disk Write',0
jmp getud ; go home
;
; Exit from MKDIR
;
exit:
pop psw ; clear stack
lda chflag ; check for any changes
ora a ; 0=No
rz
call print
db cr,lf
db cr,lf,'Directory has changed since last Write'
db cr,lf,'Do you want to write Directory to Disk '
db '(Y/N)? ',0
call capine ; get response
call crlf ; new line
cpi 'N' ; no?
cnz write ; write if not No
ret
;
; Change Directory Contents
;
change:
call setduok ; save old DUOK flag and set new one
call print
db cr,lf,'** MKDIR Change Mode **',0
ch0:
call print
db cr,lf,'Directory Entry (?<RETURN> for Help)? ',0
mvi a,0ffh ; caps
call bbline ; get user input
call sksp ; skip to non-blank
mov a,m ; get char
ora a ; no input?
jz chprint ; done, so print directory
mov a,m ; get first char
cpi 'X' ; Exit?
jz chexit ; if so, sort and then exit
cpi '/' ; help?
jz chhelp
cpi '?' ; help?
jnz ch1
chhelp:
call print
db cr,lf
db cr,lf,'MKDIR Change Mode --'
db cr,lf,' You may issue the following commands at this point:'
db cr,lf
db cr,lf,' DU:dirname <-- Create/Rename Dir Entry'
db cr,lf,' DU: <-- Delete Dir Entry'
db cr,lf,' <RETURN> <-- Print Directory'
db cr,lf,' X <-- Exit'
db cr,lf,' ? <-- Print this Help'
db cr,lf,0
jmp ch0
chprint:
call dsort ; use dsort routine
call pwd ; use pwd routine
jmp ch0 ; continue
ch1:
lxi d,tfcb ; extract user and disk info as well as name
call zfname ; get info
call retud ; get DU
lda tfcb ; get disk
ora a ; default?
jz ch2
dcr a
mov b,a ; A=0
ch2:
inr b ; A=1
lda tfcb+13 ; get user
mov c,a ; ... in C
mov a,b ; save as temp disk and user
sta tdisk
mov a,c
sta tuser
;
; Scan Directory for Temp Disk and User
;
call codend ; pt to first entry
scanud:
mov a,m ; done?
ora a
jz scanud2
inx h ; pt to name
inx h
mov a,m ; get first char of name
dcx h
dcx h ; pt to disk
cpi ' ' ; deleted entry?
jz scanud1
mov a,m ; get disk
cmp b
jnz scanud1
inx h ; pt to user
mov a,m ; get user
dcx h ; pt back
cmp c ; compare it
jz udfound
scanud1:
lxi d,18 ; pt to next
dad d
jmp scanud
;
; DU not found
;
scanud2:
lda tfcb+1 ; delete?
cpi ' ' ; space if so
jnz addname
call print
db cr,lf,' DU not Found',0
jmp ch0
;
; Found Possible Directory Entry
;
udfound:
inx h ; found existing entry
inx h ; pt to name
lda tfcb+1 ; delete?
cpi ' ' ; space if so
jz delname
;
; Rename Function
;
call print
db cr,lf,' Renaming ',0
mvi b,8 ; 8 chars
call prhlb ; print name
push h ; save ptr to name
call etest ; check for duplicate name
pop d ; restore ptr to name
jz ch0 ; abort since duplicate
lxi h,tfcb+1 ; pt to new name
mvi b,8 ; 8 chars
call hmovb ; copy
mvi a,0ffh ; set change
sta chflag
jmp ch0
;
; Add Function
;
addname:
call print
db cr,lf,' Adding ',0
lxi h,tfcb+1 ; print name of entry to add
mvi b,8
call prhlb
;
; Test for Duplicate Name
;
putname:
call etest ; test for duplicate name
jz ch0 ; abort if duplicate
;
; Test to see if there is room for another entry
;
putn1:
mvi b,18 ; 18 bytes required for entry
push h ; save ptr
putn2:
mov a,m ; check for 0FFH
cpi 0ffh
jz putn3
inx h ; pt to next
dcr b
jnz putn2
pop h ; get ptr to entry
jmp putn4 ; make entry
putn3:
pop psw ; clear stack
call print
db cr,lf,'** Directory Full **',0
jmp ch0
;
; Make Directory Entry
;
putn4:
mvi a,0ffh ; set change flag
sta chflag
lda tdisk ; set disk and user
mov m,a
inx h
lda tuser
mov m,a
inx h
lxi d,tfcb+1 ; pt to new name
xchg
mvi b,8 ; 8 chars
call hmovb ; set new name
call password ; enter password into buffer at DE
lda ecount ; print count
inr a ; increment entry count
sta ecount
jmp precount ; print count
;
; Test for Duplicate Directory Name
;
etest:
call codend ; pt to first entry
etest0:
mov a,m ; done?
ora a
jz etest2
inx h ; pt to name
inx h
lxi d,tfcb+1 ; pt to new name
mvi b,8 ; 8 chars
call compb ; compare
jnz etest1
call crlf
lxi h,tfcb+1
mvi b,8 ; 8 chars
call prhlb ; print dir name
call print
db ' is a Duplicate Name',0
xra a ; return Z
ret
;
; Last Entry was OK - Pt to Next
;
etest1:
lxi d,16 ; pt to next entry
dad d
jmp etest0
;
; No Duplicate Entries - Return NZ and HL pts to after last entry
;
etest2:
dcr a ; set NZ
ret
;
; Enter 8-char password into memory pted to by HL
;
password:
push d ; save ptr
call print
db ' -- Password? ',0
mvi a,0ffh ; caps
call bbline ; get line from user
call crlf ; new line
mvi b,8 ; 8 chars max
pop d ; pt to destination
pword1:
mov a,m ; get char
ora a ; done?
jz pword2
stax d ; put char
inx h ; pt to next
inx d
dcr b ; count down
jnz pword1
ret
pword2:
mvi a,' ' ; rest are spaces
stax d ; store space
inx d ; pt to next
dcr b ; count down
jnz pword2
ret
;
; Delete Function
;
delname:
mvi a,0ffh ; change made
sta chflag
call print
db cr,lf,' Deleting ',0
mvi b,8 ; 8 chars
call prhlb
mvi m,' ' ; space fill
call dirpack ; pack directory
call print
db ' -- ',0
lda ecount ; decrement entry count
dcr a
sta ecount
;
; Print Number of Remaining Entries in Directory
;
precount:
call prec ; print count
jmp ch0
prec:
lda ecount ; print remaining count
call padc
call print
db ' Entries in Directory',0
ret
;
; Pack Memory-Based Directory -- One Entry has been Deleted
;
dirpack:
call codend ; get address of first entry
mov d,h ; DE pts to it also
mov e,l
dirp0:
mov a,m ; get first byte
ora a ; done if zero
jz dirp2
push b ; save counts
inx h ; pt to name
inx h
mov a,m ; get char
dcx h ; pt back to disk
dcx h
cpi ' ' ; no entry if space
jz dirp1
mvi b,18 ; copy 18 bytes
call hmovb
pop b ; get counts
jmp dirp0
dirp1:
lxi b,18 ; pt to next entry
dad b
pop b ; get counts
jmp dirp0
dirp2:
mvi b,18 ; fill last entry with zeroes
xra a
xchg ; HL pts to last entry
jmp hfilb
;
; Exit Change Routine
;
chexit:
call resduok ; restore DUOK flag and fall thru to DSORT
;
; Sort Directory
;
dsort:
lda ecount ; number of elements
ora a ; any?
rz ; done if none
sta ssbcnt ; set count
call codend ; pt to first element
shld ssbstrt ; set starting address
lxi d,ssb ; pt to sort specifiction block
jmp sort ; sort
;
; Sort Compare Routine
;
compare:
push h ; don't change regs
push d
ldax d ; compare disk
cmp m
jnz comp1
inx h ; pt to user
inx d
ldax d ; compare user
cmp m
comp1:
pop d ; restore regs
pop h
ret
;
; SETDUOK - Save Old DUOK Flag and Set Flag to TRUE
; RESDUOK - Restore Old DUOK Flag
;
setduok:
push h ;save regs
push d
call getenv ;get ptr to environment descriptor
lxi d,2EH ;offset to DUOK Flag
dad d
mov a,m ;get flag
sta duoksav ;save flag
mvi m,1 ;turn flag on
pop d ;restore regs
pop h
ret
resduok:
push h ;save regs
push d
call getenv ;get ptr to environment descriptor
lxi d,2EH ;offset to DUOK Flag
dad d
lda duoksav ;get save flag
mov m,a ;set flag
pop d ;restore regs
pop h
ret
;
; Print Names of Directory Elements
;
pwd:
call crlf ; new line
lda ecount ;check count first
ora a ;no entries?
jnz pwd01
call print
db ' No Entries in Directory',0
ret
;
; Print Header for Password Entries
;
pwd01:
mvi b,2 ;2 times
pwd0a:
call print
db
' DU : DIR Name - Password ',0
dcr b ;count down
jnz pwd0a
call crlf
mvi b,2
pwd0b:
call print
db '---- -------- -------- ',0
dcr b ;count down
jnz pwd0b
call crlf
;
; Begin Output Processing
;
mvi c,0 ;set entry count
mvi b,1 ;set disk 1
call codend ;pt to buffer containing new directory
;
; Print Each Resident Command Name
;
pwd1:
mov a,m ;get table entry
ora a ;end of table?
rz ;exit
cmp b ;same disk?
jz pwd2
;
; Advance to Next Set of Entries for New Disk
;
mov b,a ;set new disk
mov a,c ;get count
ani 3 ;see if newline already given
cnz crlf ;complete current line
call crlf ;1 additional line
mvi c,0 ;reset count
pwd2:
push b ;save counters
;
; Print DU:
;
mov a,m ;get disk
adi '@' ;convert to letter (A to P)
call cout
inx h ;pt to user
mov a,m ;get user
call padc ;print user number
call print ;print separator
db ': ',0
inx h ;pt to name
;
; Print DIR
;
call prname ;print name of directory
call print
db ' - ',0
call prname ;print name of password
pop b ;get counters
inr c ;another entry
push b ;save counters
;
; Print Separator
;
call print ;print separator
db ' ',0
pop b ;get counters
;
; New Line Counter
;
inr c ;increment entry counter
mov a,c ;check for done
ani 3 ;every 4
cz crlf ;new line
jmp pwd1
;
; Print 8-char name (directory or password) and advance ptr
;
prname:
mvi b,8 ;print name
prn1:
mov a,m ;get char
call cout
inx h ;pt to next
dcr b ;count down
jnz prn1
ret
;
; Utilities
;
;
; Print chars pted to by HL for B bytes
;
prhlb:
push h ; save HL
prhlb1:
mov a,m ; print chars
inx h ; pt to next
call cout
dcr b ; count down
jnz prhlb1
pop h ; get HL
ret
;
; Compute Number of 128-byte blocks in Named Dir
; Return with Number in A and HL pting to it
;
getnd:
call getndr ; get ptr to NDR and number of entries in A
push h ; save ptr
mvi h,0 ; HL = value
mov l,a
dad h ; *2
mov d,h ; DE = value * 2
mov e,l
dad h ; *4
dad h ; *8
dad h ; *16
dad d ; *18
mov a,h ; /128
rlc
ani 0feh
mov h,a
mov a,l
rlc
ani 1
ora h ; A = value * 18 / 128
inr a ; +1
pop h ; get ptr
ret
;
; Default File Name
;
dnfile:
db 'NAMES '
db 'NDR'
;
; Sort Specification Block
;
ssb:
ssbstrt:
ds 2 ; start address of dir
ssbcnt:
dw 0 ; number of records to sort
dw 18 ; 18 bytes/record
dw compare ; compare routine
dw 0 ; no ptr table
db 0,0 ; don't use ptrs
;
; Buffers
;
duoksav:
ds 1 ; save value for DUOK flag
tdisk:
ds 1 ; temp disk
tuser:
ds 1 ; temp user
flflag:
ds 1 ; file loaded flag
chflag:
ds 1 ; dir changed flag
ecount:
ds 1 ; entry count
crcnt:
ds 1 ; new line count
tfcb:
ds 36 ; temp FCB
dfcb:
ds 36 ; Default FCB
