mirror of https://github.com/wwarthen/RomWBW.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
460 lines
8.6 KiB
460 lines
8.6 KiB
;
|
|
; PROGRAM: PATH
|
|
; VERSION: 3.0
|
|
; AUTHOR: RICHARD CONN
|
|
; DATE: 12 Apr 84
|
|
; PREVIOUS VERSIONS: NONE
|
|
; DERIVATION: PATH, Version 1.0 (for ZCPR2) of 12 Jan 83
|
|
;
|
|
VERS EQU 30
|
|
z3env SET 0f400h
|
|
|
|
;
|
|
; PATH allows the user to do two things -- display the current path
|
|
; and set a new path. Named directories may be used in the definition of
|
|
; the new path.
|
|
;
|
|
; PATH is invoked by the following forms:
|
|
; PATH <-- Display Path
|
|
; PATH path-expression <-- Set Path
|
|
; PATH // <-- Print Help
|
|
;
|
|
|
|
;
|
|
; CP/M Constants
|
|
;
|
|
cpm equ 0 ;base
|
|
fcb equ cpm+5ch
|
|
tbuff equ cpm+80h
|
|
cr equ 0dh
|
|
lf equ 0ah
|
|
|
|
;
|
|
; SYSLIB Routines
|
|
;
|
|
ext z3init,eprint,codend,dirtdu,dutdir
|
|
ext cout,epstr,pafdc,retud
|
|
ext getpath,getmdisk,getmuser,getwhl
|
|
|
|
;
|
|
; 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
|
|
lxi h,0 ;save stack ptr
|
|
dad sp
|
|
shld strtstack ; save ptr to original stack
|
|
lxi h,tbuff+1 ; pt to command line input
|
|
shld cmdline ; save ptr to command line
|
|
call retud ; get current disk and user
|
|
;
|
|
; Print Banner
|
|
;
|
|
call eprint
|
|
db 'PATH Version '
|
|
db vers/10+'0','.',(vers mod 10)+'0',0
|
|
|
|
;
|
|
; Check for Help
|
|
;
|
|
lda fcb+1 ; get first char
|
|
cpi '/' ; help?
|
|
jnz start1
|
|
call eprint
|
|
db cr,lf,'Syntax:'
|
|
db cr,lf,' PATH <-- Display Path'
|
|
db cr,lf,' PATH expr <-- Set Path'
|
|
db 0
|
|
ret
|
|
|
|
;
|
|
; Check for Error and Continue if not
|
|
;
|
|
start1:
|
|
call getpath ; external path available?
|
|
mov a,h ; HL=0 if none
|
|
ora l
|
|
jnz start2
|
|
call eprint
|
|
db ' - Abort: No Path',0
|
|
ret
|
|
start2:
|
|
call getwhl ; check for wheel
|
|
jnz start3
|
|
call eprint
|
|
db ' - Abort: No Wheel',0
|
|
ret
|
|
start3:
|
|
lhld cmdline ; check command line for text
|
|
call sblank ; skip to non-blank
|
|
shld cmdline ; set ptr to next element
|
|
ora a ; EOL=display function
|
|
jz pdisp
|
|
call codend ; set temporary path
|
|
shld pathptr ; point to it
|
|
|
|
;
|
|
; **** Set New Path ****
|
|
; CMDLINE pts to next element
|
|
;
|
|
pbuild:
|
|
lhld cmdline ; pt to next element
|
|
call sblank ; skip to non-blank
|
|
mov a,m ; get first char of next element
|
|
ora a ; EOL?
|
|
jz pbdone ; done if so, store path and display
|
|
shld token ; save ptr to first byte
|
|
mov a,m ; get first char
|
|
cpi '$' ; is it current?
|
|
jz pbdu ; DU: form
|
|
sui 'A' ; convert to number
|
|
jc pbdir ; DIR: form
|
|
mov b,a ; save number
|
|
call getmdisk ; get max disk number
|
|
mov c,a
|
|
mov a,b
|
|
cmp c ; in range?
|
|
jnc pbdir ; DIR: form if not
|
|
inx h ; pt to next char -- may be DU or DIR
|
|
mov a,m ; get next part of element
|
|
cpi '$' ; current?
|
|
jz pbdu ; is a DU: form
|
|
digtst:
|
|
cpi ':' ; colon ends it
|
|
jz pbdu ; is a DU: form
|
|
cpi ' ' ; space ends it
|
|
jz pbdu
|
|
ora a ; EOL ends it
|
|
jz pbdu
|
|
cpi '0' ; must be a digit
|
|
jc pbdir ; DIR: form if not in range
|
|
cpi '9'+1
|
|
jnc pbdir
|
|
inx h ; pt to next
|
|
mov a,m ; get it
|
|
jmp digtst
|
|
;
|
|
; It is a DU: form
|
|
;
|
|
pbdu:
|
|
lhld pathptr ; pt to path entry
|
|
xchg ; ... in DE
|
|
lhld token ; pt to token
|
|
mov a,m ; current?
|
|
cpi '$'
|
|
jz pbdu1
|
|
sui 'A'-1 ; convert to number from 1 to n
|
|
pbdu1:
|
|
stax d ; save disk element
|
|
inx h ; pt to next
|
|
inx d
|
|
mov a,m ; current user?
|
|
inx h ; pt to after user in case of match to current
|
|
cpi '$' ; current?
|
|
jz pbdu2
|
|
dcx h ; pt to first digit
|
|
push d ; save ptr to path
|
|
call eval10 ; convert to number in C
|
|
jc rangerr
|
|
call getmuser ; check for max user
|
|
inr a
|
|
mov b,a ; place max in B
|
|
mov a,c ; value in A
|
|
cmp b
|
|
jnc rangerr
|
|
pop d ; get ptr to path
|
|
pbdu2:
|
|
stax d ; store user number
|
|
inx d
|
|
mov a,m ; ending with colon?
|
|
cpi ':'
|
|
jnz pbdu3
|
|
inx h ; skip over colon
|
|
pbdu3:
|
|
shld cmdline ; save ptr to next command line entry
|
|
xchg
|
|
shld pathptr ; save ptr to next path entry
|
|
jmp pbuild ; continue processing
|
|
;
|
|
; Build DIR: form
|
|
;
|
|
pbdir:
|
|
lhld token ; pt to name
|
|
call dirtdu ; convert to DU in BC
|
|
jnz gotud ; process new DU
|
|
;
|
|
; Entry not found
|
|
;
|
|
rangerr:
|
|
call eprint
|
|
db cr,lf,'Bad Expression at ',0
|
|
lhld token ; print string starting at token
|
|
call epstr
|
|
lhld strtstack ; get original stack
|
|
sphl ; set stack ptr
|
|
ret
|
|
;
|
|
; Got User and Disk -- Store in Path
|
|
;
|
|
gotud:
|
|
lhld pathptr ; get ptr to path
|
|
inr b ; disk A = 1
|
|
mov m,b ; store disk
|
|
inx h
|
|
mov m,c ; store user
|
|
inx h ; pt to next
|
|
shld pathptr
|
|
lhld token ; skip over token
|
|
gotud1:
|
|
mov a,m ; skip to space or EOL
|
|
inx h ; pt to next
|
|
ora a ; EOL?
|
|
jz gotud2
|
|
cpi ' ' ; space?
|
|
jnz gotud1
|
|
gotud2:
|
|
dcx h ; pt to EOL or space
|
|
shld cmdline ; set ptr to next element
|
|
jmp pbuild ; continue building
|
|
;
|
|
; Path Building is Done -- CODEND contains new path
|
|
;
|
|
pbdone:
|
|
lhld pathptr ; store ending zero in path
|
|
mvi m,0
|
|
call getpath ; pt to path
|
|
xchg ; ... in DE
|
|
call codend ; copy temp path into external path
|
|
pcopy:
|
|
mov a,m ; get disk
|
|
stax d ; put disk
|
|
ora a ; end of path?
|
|
jz pdisp ; done if so and display
|
|
inx h ; pt to user
|
|
inx d
|
|
mov a,m ; get user
|
|
stax d ; put user
|
|
inx h ; pt to next disk
|
|
inx d
|
|
jmp pcopy
|
|
|
|
;
|
|
; **** Display Path Function ****
|
|
;
|
|
pdisp:
|
|
call eprint
|
|
db cr,lf,' Symbolic Form: ',0
|
|
call getpath ; pt to external path
|
|
pdisp1:
|
|
mov a,m ; get disk
|
|
ora a ; done?
|
|
jz adisp
|
|
cpi '$' ; current?
|
|
jz pdisp2
|
|
adi '@' ; convert to letter
|
|
pdisp2:
|
|
call cout ; print disk letter
|
|
inx h ; pt to user
|
|
mov a,m ; get user number
|
|
cpi '$' ; current?
|
|
jnz pdisp3
|
|
call cout ; print current indicator
|
|
jmp pdisp4
|
|
pdisp3:
|
|
call pafdc ; print user number
|
|
pdisp4:
|
|
call colon
|
|
inx h ; pt to next element
|
|
mov a,m ; done?
|
|
ora a ; 0=yes
|
|
cnz arrow
|
|
jmp pdisp1
|
|
;
|
|
; Print Absolute Path
|
|
;
|
|
adisp:
|
|
call eprint
|
|
db cr,lf,' DU Form: ',0
|
|
call retud ; get current user/disk
|
|
call getpath ; pt to path
|
|
adisp1:
|
|
mov a,m ; get disk
|
|
ora a ; done?
|
|
jz ndisp
|
|
cpi '$' ; current?
|
|
jnz adisp2
|
|
mov a,b ; get current disk
|
|
inr a ; adjust to 1 to n
|
|
adisp2:
|
|
adi '@' ; convert to letter
|
|
call cout ; print disk letter
|
|
inx h ; pt to user
|
|
mov a,m ; get user
|
|
cpi '$' ; current?
|
|
jnz adisp3
|
|
mov a,c ; get current user
|
|
adisp3:
|
|
call pafdc ; print user
|
|
call colon
|
|
inx h ; pt to next
|
|
mov a,m ; done?
|
|
ora a
|
|
cnz arrow
|
|
jmp adisp1
|
|
;
|
|
; Print Named Path
|
|
;
|
|
ndisp:
|
|
call eprint
|
|
db cr,lf,' DIR Form: ',0
|
|
call getpath ; pt to external path
|
|
ndisp1:
|
|
call retud ; get current user and disk in C and B
|
|
mov a,m ; get disk
|
|
ora a ; done?
|
|
rz
|
|
cpi '$' ; current?
|
|
jz ndisp2
|
|
mov b,a ; disk in B
|
|
dcr b ; adjust to 0 to n-1
|
|
ndisp2:
|
|
inx h ; pt to user
|
|
mov a,m ; get it
|
|
cpi '$' ; current?
|
|
jz ndisp3
|
|
mov c,a ; user in C
|
|
ndisp3:
|
|
inx h ; pt to next
|
|
push h ; save ptr
|
|
call udscan ; scan dirs for user/disk and print its name
|
|
pop h ; get ptr
|
|
call colon
|
|
mov a,m ; done?
|
|
ora a
|
|
cnz arrow
|
|
jmp ndisp1
|
|
|
|
;
|
|
; **** Utilities ****
|
|
;
|
|
|
|
;
|
|
; Convert Chars pted to by HL to Number in C
|
|
; Return with Carry Set if Overflow
|
|
; If OK, Value in C and HL pts to character after last digit
|
|
;
|
|
eval10:
|
|
mvi c,0 ; set value
|
|
eval1:
|
|
mov a,m ; get first digit
|
|
sui '0' ; convert to binary
|
|
jc evalx ; done with value in C
|
|
cpi 10 ; range?
|
|
jnc evalx ; done with value in C
|
|
mov b,a ; digit in B
|
|
mov a,c ; multiply by 10
|
|
add a ; *2
|
|
rc ; error abort
|
|
add a ; *4
|
|
rc
|
|
add c ; *5
|
|
rc
|
|
add a ; *10
|
|
rc
|
|
add b ; add value
|
|
rc
|
|
mov c,a ; value in C
|
|
inx h ; pt to next
|
|
jmp eval1
|
|
evalx:
|
|
ora a ; clear carry flag
|
|
ret
|
|
|
|
;
|
|
; Print Colon
|
|
;
|
|
colon:
|
|
mvi a,':' ; print colon
|
|
jmp cout
|
|
|
|
;
|
|
; Print Arrow
|
|
;
|
|
arrow:
|
|
call eprint
|
|
db ' --> ',0
|
|
ret
|
|
|
|
;
|
|
; Skip to non-blank
|
|
;
|
|
sblank:
|
|
mov a,m ; get char
|
|
inx h ; pt to next
|
|
cpi ' ' ; space?
|
|
jz sblank
|
|
dcx h ; pt to non-blank
|
|
ret
|
|
;
|
|
; Scan directories for user and disk in C and B
|
|
; Print name if found or "Noname" if not
|
|
;
|
|
udscan:
|
|
call dutdir ; convert to name
|
|
jz udscan1 ; error return if no name
|
|
mvi b,8 ; 8 chars max
|
|
udsprn:
|
|
mov a,m ; get name char
|
|
cpi ' ' ; done?
|
|
rz
|
|
call cout ; print char
|
|
inx h ; pt to next
|
|
dcr b ; count down
|
|
jnz udsprn
|
|
ret
|
|
udscan1:
|
|
call eprint
|
|
db 'Noname',0
|
|
ret
|
|
|
|
;
|
|
; Buffers
|
|
;
|
|
cmdline:
|
|
ds 2 ; ptr to next char in command line
|
|
token:
|
|
ds 2 ; ptr to current token
|
|
pathptr:
|
|
ds 2 ; ptr to next path entry
|
|
strtstack:
|
|
ds 2 ; ptr to original stack
|
|
|
|
end
|
|
|