mirror of
https://github.com/wwarthen/RomWBW.git
synced 2026-02-06 14:11:48 -06:00
460 lines
8.6 KiB
Plaintext
460 lines
8.6 KiB
Plaintext
;
|
||
; 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
|
||
|