home *** CD-ROM | disk | FTP | other *** search
- ;
- ; 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