Files
RomWBW/Source/Images/d_bp/u15/SHVAR.MAC
2020-01-03 20:42:06 -08:00

656 lines
11 KiB
Plaintext
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.
;
; Program: SHVAR
; Author: Richard Conn
; Version: 1.0
; Date: 5 Mar 84
;
version equ 10
;
; SHVAR is used to define a shell variable for the Shell SH.
; It makes entries into the file SH.VAR in the ROOT directory. The
; syntax of its use is:
; SHVAR variable text <-- define/redefine variable
; SHVAR variable <-- delete variable
; SHVAR <-- list variables
;
;
; Equates for Key Values
;
z3env SET 0f400h ;address of ZCPR3 environment
backup equ 0 ;backup old file? 1 for yes, 0 for no
ctrlz equ 'Z'-'@' ;^Z for EOF
fcb equ 5ch
tbuff equ 80h
cr equ 0dh
lf equ 0ah
;
; External Z3LIB and SYSLIB Routines
;
ext cout,qcout,getquiet,sort,crlf
ext sksp,fillb,moveb
ext initfcb,f$open,f$read,f$close,f$make,f$delete,f$write,f$rename
ext z3init,qprint,codend,hmovb,root,logud,getwhl,print
ext getfn1,pfn1,cline
;
; 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 Environment
call banner ;print banner
;
; Check for Wheel
;
call getwhl ;get wheel byte
jnz start0
call print
db cr,lf,' Not Wheel - Aborting',0
ret
;
; Try to Load Variables
;
start0:
;
; Check for Help
;
lda fcb+1 ;get first char of FCB
cpi '/' ;also help?
jnz start0x
;
; Print Help Message
;
call print
db cr,lf,'SHVAR - Define/Redefine/Delete a Shell Variable'
db cr,lf,'Syntax:'
db cr,lf,' SHVAR variable text <-- to Define/Redefine'
db cr,lf,' SHVAR variable <-- to Delete'
db cr,lf,' SHVAR <-- to List Variable Names'
db 0
ret
;
; Define File to Work With
;
start0x:
call getfn1 ;get name of shell
lxi d,shvfcb+1 ;variable FCB
mvi b,11 ;11 chars
mov a,m ;any name given?
cpi ' ' ;space if none
cnz moveb ;set name
;
; Define $$$ and BAK Files
;
lxi h,shvfcb+1
lxi d,shvtmp+1 ;set $$$ name
mvi b,8 ;8 chars
call moveb
;
if backup
lxi d,shvbak+1 ;set BAK name
call moveb
endif
;
;
; Save Command Line
;
lxi h,tbuff ;save line
call cline
shld lineptr ;set ptr to line
;
; Load Variables
;
call varload
jnz start1
;
; Initialize Shell Variables if File Not Found
;
call print
db cr,lf,' Shell Variable File ',0
lxi d,shvfcb+1
call pfn1
call print
db ' Not Found',0
ret
;
; Process User Command
;
start1:
lda fcb+1 ;check for list option
cpi ' ' ;no args = list
jz list
call doit ;process command
call varsave ;save new shell variables
ret
;
; Print Names of Variables
;
list:
call lpack ;pack just names
xchg ;set ptr to ptr table
inx h
shld ptrbuf ;ptr buffer for sort
lhld vcount ;run sort?
mov a,h
ora l
cnz lsort ;sort names
call print
db cr,lf,' Shell Variables --',cr,lf,0
mvi c,0 ;set counter
call codend ;pt to first variable
mov a,m ;empty?
cpi ctrlz
jnz list1
call print
db ' -- No Variables Defined --',0
ret
;
; Print Next Variable
;
list1:
mov a,m ;end of list?
cpi ctrlz
jz list3
call print
db ' ',0
mvi b,8 ;print 8 chars
list2:
mov a,m ;get char
inx h ;pt to next
call cout ;print it
dcr b ;count down
jnz list2
inr c ;increment count
mov a,c ;new line?
ani 3
cz crlf
jmp list1
list3:
mov a,c ;new line to end?
ani 3
cnz crlf
ret
;
; Sort Variables
;
lsort:
call codend ;pt to first variable
shld ssb ;set ptr
lxi d,ssb ;pt to SSB
jmp sort ;perform sort
;
; Compare Routine
;
compare:
push h ;save regs
push d
push b
mvi b,8 ;8 chars
comp1:
ldax d ;get char
cmp m ;compare
jnz comp2
inx h ;pt to next
inx d
dcr b ;count down
jnz comp1
comp2:
pop b ;restore regs
pop d
pop h
ret
;
; Pack Variables Down to a Minimum (Just 8-char Names)
;
lpack:
lxi h,0 ;set count
shld vcount
call codend ;pt to first variable
mov d,h ;DE=HL
mov e,l
lpack1:
mov a,m ;get next char
stax d ;set possible EOF
cpi ctrlz ;done?
rz
push h ;increment variable count
lhld vcount
inx h
shld vcount
pop h
mvi b,8 ;save 8 chars
lpack2:
mov a,m ;get next char
stax d ;store it
inx h ;pt to next
inx d
dcr b ;count down
jnz lpack2
lpack3:
mov a,m ;skip to next variable
inx h
ora a ;done?
jnz lpack3
jmp lpack1 ;resume
;
; Input and Process User Commands
;
doit:
call nadd ;add/delete/redefine variable
;
; Pack Names
;
pack:
call codend ;pack entries in table
mov d,h ;HL=DE
mov e,l
;
; Check Next Entry
;
pack1:
mov a,m ;get next char
stax d ;put it
cpi ctrlz ;done?
rz
cpi ' ' ;deleted?
jz pack3
;
; Copy Entry
;
pack2:
mov a,m ;get char
stax d ;put it
inx h ;pt to next
inx d
ora a ;done?
jnz pack2
jmp pack1 ;resume
;
; Skip Entry
;
pack3:
mov a,m ;get char
inx h ;pt to next
ora a ;done?
jnz pack3
jmp pack1 ;resume
;
; Add Names to Table
;
nadd:
lhld lineptr ;pt to user line
call sksp ;skip to first non-blank
ora a ;done?
rz ;exit if no change
call qprint
db cr,lf,' Shell Variable ',0
;
; Copy Input Name into Shell Buffer SHVAR
;
push h ;save ptr to name
lxi h,shvar ;init name buffer
mvi a,' ' ;space fill
mvi b,8 ;8 chars
call fillb
xchg ;pt to buffer in DE
pop h ;pt to name
mvi b,8 ;8 chars max
nadd1:
mov a,m ;get name char
call delck ;check for delimiter
jz nadd3
stax d ;store char
call qcout ;print chars of variable name
inx h ;pt to next
inx d
dcr b ;count down
jnz nadd1
nadd2:
mov a,m ;flush to delimiter
inx h
call delck ;check for delimiter
jnz nadd2
dcx h ;pt to delimiter
;
; Search for Name
;
nadd3:
shld lineptr ;set ptr to rest of line
call codend ;pt to first element
;
; Check for End of Entries
;
nadd4:
mov a,m ;get first char of next string
cpi ctrlz
jz addit ;add name at HL
;
; Compare Names
;
lxi d,shvar ;pt to variable
mvi b,8 ;compare
shld curname ;save ptr to current name in case of delete
nadd5:
ldax d ;check for duplicate
cmp m
jnz nadd6
inx h ;pt to next
inx d
dcr b ;count down
jnz nadd5
jmp nadd7
;
; No Match, so Skip Rest of String
;
nadd6:
mov a,m ;skip to end of string
inx h ;pt to next
ora a ;done?
jnz nadd6
jmp nadd4 ;resume
;
; Match - Determine What User Wants to Do
;
nadd7:
lhld lineptr ;see if any text follows name
call sksp ;skip to text
ora a ;EOL?
jz delete ;delete name
;
; Redefine Name
;
lhld curname ;pt to name in buffer
mvi b,8 ;space fill it
mvi a,' '
call fillb
jmp nadd6 ;resume in case another duplicate
;
; Delete Name
;
delete:
call qprint
db ' Deleted',0
lhld curname ;pt to name in buffer
mvi b,8 ;space fill it
mvi a,' '
call fillb
ret
;
; Add Name
;
addit:
call qprint
db ' = ',0
shld curname ;save ptr to new name
xchg ;dest in DE
lxi h,shvar ;pt to name
mvi b,8 ;8 chars
call hmovb ;copy name into buffer
xchg ;pt to after name with HL
push h ;save ptr
mvi m,0 ;store ending 0 and ^Z in case of abort
inx h
mvi m,ctrlz ;store ^Z
lhld lineptr ;point to user text
call sksp ;skip to non-space
pop d ;pt to destination
;
; Copy User Input into Buffer
;
addit1:
mov a,m ;get char
stax d ;put char
ani 7FH ;done?
cnz qcout ;print chars of definition
inx h ;pt to next
inx d
ora a ;done?
jnz addit1
mvi a,ctrlz ;mark end
stax d
ret
;
; Print Banner
;
banner:
call qprint
db 'SHVAR, Version '
db (version/10)+'0','.',(version mod 10)+'0'
db 0
ret
;
; Check to see if char in A is a delimiter
; Return with Z if so
;
delck:
push h ;pt to table
push b ;save BC
mov b,a ;char in B
lxi h,dtable ;pt to delimiter table
delck1:
mov a,m ;get delimiter
ora a ;done?
jz notdel
cmp b ;compare
jz yesdel
inx h ;pt to next
jmp delck1
notdel:
mov a,b ;get char
ora a ;set Z if null, else NZ
yesdel:
mov a,b ;restore char
pop b ;restore regs
pop h
ret
;
; Delimiter Table
;
dtable:
db '<>;:,.=-_ ',0
;
; Save Shell Variable List
; Return with Z if Error
;
varsave:
call getquiet ;get quiet flag
jnz vars0
call print
db cr,lf,' Writing Shell Variable File ',0
lxi d,shvfcb+1
call pfn1 ;print file name
vars0:
lxi d,shvtmp ;open temp
call initfcb
call f$delete ;delete if any exists
call f$make ;create new file
inr a ;error?
rz
call codend ;pt to scratch area
;
; Save Loop
;
vars1:
lxi d,tbuff ;copy into buffer
mvi b,128 ;128 bytes
call hmovb
lxi d,shvtmp ;write block
call f$write
jnz werr ;write error
lxi d,tbuff ;check for done
mvi b,128 ;128 bytes
;
; Check for Done
;
vars2:
ldax d ;look for ^Z
cpi ctrlz
jz varsx
inx d ;pt to next
dcr b ;count down
jnz vars2
jmp vars1
;
; Done
;
varsx:
lxi d,shvtmp ;close temp file
call f$close
;
; Delete Old Backup File SH.BAK
;
if backup
;
lxi d,shvbak ;delete any old backups
call initfcb
call f$delete
;
; Create New Backup File SH.BAK=SH.VAR
;
lxi h,shvbak ;new name
lxi d,shvfcb ;old name
call f$rename ;create backup file
;
else
;
; Delete Original File
;
lxi d,shvfcb ;pt to FCB
call initfcb
call f$delete
;
endif ;backup
;
; Create New Shell Variable File SH.VAR=SH.$$$
;
lxi h,shvfcb ;new name
lxi d,shvtmp ;old name
call f$rename ;create new file
xra a ;return OK
dcr a ;NZ
ret
;
; File Write Error
;
werr:
call print
db cr,lf,'Error in Writing File - Aborting',0
xra a ;error code
ret
;
; Load Shell Variable List
; Return with Z if Error
;
varload:
;
; Look for Variable File
;
call root ;determine DU of root
call logud ;goto root
call codend ;pt to scratch area
mvi m,ctrlz ;prep for no file
lxi d,shvfcb ;try to open file
call initfcb ;init FCB
call f$open
rnz ;file not found
;
; Read in Variable File
;
varl1:
lxi d,shvfcb ;read in file
call f$read
jnz varl2
lxi d,tbuff ;pt to data
xchg ;copy into memory
mvi b,128 ;128 bytes
call hmovb
xchg
jmp varl1
varl2:
lxi d,shvfcb ;close file
call f$close
;
; Say List is Already Loaded
;
xra a ;return NZ for OK
dcr a
ret
;
; Buffers
;
lineptr:
ds 2 ;ptr to next char in line
curname:
ds 2 ;ptr to current variable name
shvar:
ds 8 ;shell variable name
;
if backup
shvbak:
db 0
db 'SH ' ;name of shell variable file
db 'BAK'
ds 24 ;36 bytes total
endif ;backup
;
shvtmp:
db 0
db 'SH ' ;name of shell variable file
db '$$$'
ds 24 ;36 bytes total
shvfcb:
db 0
db 'SH ' ;name of shell variable file
db 'VAR'
ds 24 ;36 bytes total
;
; Sort Specification Block
;
ssb:
ds 2 ;address of first record
vcount:
ds 2 ;number of records to sort
dw 8 ;size of each record in bytes
dw compare ;compare routine
ptrbuf:
ds 2 ;address of pointer buffer
dw 0ffh ;use pointers
end