home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
CPM
/
ZCPR33
/
A-R
/
FOR-NXT2.LBR
/
FOR.ZZ0
/
FOR.Z80
Wrap
Text File
|
2000-06-30
|
15KB
|
679 lines
; FOR.Z80
;
; Takes a list of (ambiguous) file specifications as parameters and stores
; them in a file (FORFILES.SYS), optionally expanding the ambiguous names.
; Explicit directory specifications are retained in front of the names.
; The output file FORFILES.SYS is set to System status. This is an ordinary
; text file, with one filename (or other list element) on each line.
;
; Alternatively, arbitrary strings, all named directories, or an ascending
; sequence of integers may be written to the file.
;
; Syntax:
;
; FOR <[du:|dir:]fn.ft> [<[du:|dir:]fn.ft>] [/X]
;
; where the 'X' option indicates that all ambiguous filenames are to be
; expanded. If an ambiguous filename is prefaced with a DU: or DIR:
; specification, its expansions will all also contain the directory
; specification.
;
; -or-
; FOR 'one string' "another string" \a third string\ /S
;
; where the 'S' option is REQUIRED to indicate that the list elements are
; delimited strings. Any non-blank character except the virgule (/)
; and comma may be used as a delimiter.
;
; -or-
; FOR /o
;
; where 'o' can be:
; D -- list all named directories
; Rn -- list all integers up to that contained in register 'n',
; one per line. The list is zero-based
; Nn -- list all integers up to 'n', one per line (zero-based).
;
; If the 'Nn' or 'Rn' forms are used and a 1-based list is needed,
; the first element can be removed with 'NEXT' and not used. Any
; parameters preceding one of these option specifications will be
; ignored.
;
; In all circumstances, only one option is appropriate. As presently written,
; program control is transferred directly based upon the option, rather than
; using an array of option flags.
;
; Delimiters BETWEEN list elements (whether filenames or strings) may be
; either spaces or commas.
;
;
; Author: Dreas Nielsen
; History --
; Date Version Comments
; ---- ------- --------
; 7/15/86 0.1 First code
; 1/10/87 0.2 Fixed ambiguous filenames
; 1/11/87 1.0 First complete version
;
;
;================[ Equates and External Routines ]================
;
VERS EQU 10
;
FALSE EQU 0
TRUE EQU NOT FALSE
;
DEBUG EQU FALSE
;
CR EQU 0DH
LF EQU 0AH
BELL EQU 7
SPACE EQU 20H
CTRLZ EQU 1AH
EOF EQU 1AH
BDOS EQU 5
INFERR EQU 1 ;error code for "can't open input file"
OFERR EQU 2 ;error code for "can't open output file"
RDERR EQU 3 ;error code for "can't read input file"
WRTERR EQU 4 ;error code for "can't write output file"
CLZERR EQU 5 ;error code for "can't close output file"
PARMFL EQU '/'
XPARM EQU 'X'
LINLEN EQU 300 ;max # of chars in output line
CMDLIN EQU 080H
SYSFCB EQU 05CH
BUFSIZ EQU 8 ;8 128-byte sectors (1k) for I/O buffers
FCBLEN EQU 36
BSZOFF EQU 0 ;offset of buffer size indicator from I/O ctl block
BADOFF EQU 6 ;offset of buffer addr indic. from I/O ctl block start
FCBOFF EQU 8 ;offset of fcb from I/O ctl block start
;
EXT Z3INIT,QPRINT,SKSP,PRINT,PUTUD,GETUD,LOGUD,DIRF,MFN2
EXT CODEND,PUTER2,FXO$OPEN,FX$PUT,FXO$CLOSE
EXT ZPRSFN,DIRQ,MFN2,FILLB
EXT DNSCAN,FNAME,GETNDR,GETREG,EVAL10,MHLFDC
;
;================[ Beginning of Program ]================
;
DB 'Z3ENV'
DB 1
Z3ENV: DW 00
DB VERS
;
START: LD HL,(Z3ENV)
CALL Z3INIT
;
; Reset error flag
XOR A
CALL PUTER2
;
; Save stack and set a new one
LD (SAVESP),SP
LD HL,STK
LD SP,HL
;
; Print signon message
CALL QPRINT
DB 'FOR v. ',[VERS / 10] + '0','.',[VERS MOD 10] + '0',CR,LF,0
;
; Save currently logged DU
CALL PUTUD
;
; Check for no parameters (help)
LD A,(SYSFCB+1)
CP ' '
JP Z,HELP
;
; Store null at end of cmdline
LD HL,CMDLIN
LD A,(HL)
INC A
LD E,A
XOR A
LD D,A
ADD HL,DE
LD (HL),A
;
; Allocate space for file list and move command line
CALL CODEND
LD (PARAMS),HL
LD DE,CMDLIN+1
MOVCL: LD A,(DE)
LD (HL),A
INC HL
INC DE
OR A
JR NZ,MOVCL
;
; Allocate space for DIR: specification, if needed.
LD (DIRNAM),HL
LD DE,24
ADD HL,DE
;
; Allocate filename buffer used with DIRF
LD (FNBUF),HL
LD DE,13
ADD HL,DE
; Allocate buffer for packed name string
LD (NMDEST),HL
LD DE,LINLEN
ADD HL,DE
;
; Allocate output buffer and initialize it
LD (OUTPLOC),HL
CALL FBINIT ;allocate I/O ctl buffer for output
LD (FREE),HL
LD HL,(OUTPLOC)
LD DE,OFNAM
CALL INITNAM
;
; Examine command line for option specification. If no options are specified,
; the list is presumed to be of filenames which are not to be expanded or
; undelimited strings (without embedded spaces or commas). This routine finds
; the LAST parameter flag on the line, as there may be some embedded in
; delimited strings.
GETOPT:
LD HL,00 ;zero out parameter address
LD (PFADR),HL
LD HL,(PARAMS)
GETO2: LD A,(HL)
INC HL
OR A ;end of list?
JR Z,GETO3
CP PARMFL
JR NZ,GETO2
LD (PFADR),HL
JR GETO2
;
GETO3: LD HL,(PFADR)
LD A,H
OR L ;if this is null...
JR Z,RAWFILES ;...no parameter flag was found
;
; Examine char after '/' and proceed accordingly
CALL SKSP
LD A,(HL)
CP 'X'
JR Z,AMBFILS ;ambiguous filenames
CP 'S'
JP Z,STRINGS ;delimited strings
CP 'D'
JP Z,DIRNAMES ;directory names
CP 'R'
JP Z,REGS ;register value
CP 'N'
JP Z,NUM ;integer value
JP HELP ;because it is an unrecognized option
;
; Parameter list is unambigous filenames or undelimited strings.
RAWFILES:
CALL OPENOUT
LD HL,(PARAMS)
RAW1: LD A,(HL) ;skip to first non-delimiter
INC HL
CALL LISTDEL
JR Z,RAW1
OR A
JR Z,RAW6
DEC HL ;point back 1 to fetch 1st char again
;
RAW2: LD DE,(NMDEST) ;transfer token
RAW3: LD A,(HL)
INC HL
OR A ;end of list?
JR Z,RAW4
CALL LISTDEL ;space or comma?
JR Z,RAW4
LD (DE),A
INC DE
JR RAW3 ;get next char of current token
;
RAW4: ;write current token and look for next
CALL WRTTOK
JR NZ,RAW2 ;next token found -- get and write it
;
RAW6: ;end of list found
CALL CLOSOUT
JP DONE
;
;----------------
; Parameter list is a list of ambiguous filenames.
AMBFILS:
CALL OPENOUT
LD HL,(PARAMS) ;save prefix (DU: or DIR:) if it exists
AMB0: LD A,(HL) ;skip to first non-delimiter
INC HL
CALL LISTDEL ;is (A) a list delimiter?
JR Z,AMB0 ;if so, get next character
OR A
JP Z,AMB3 ;if end of list, quit
DEC HL ;point back 1 to 1st char of token
PUSH HL ;save starting point
CALL NXTDLM ;see if next delimiter is a colon
POP HL ;get starting addr. back
LD DE,(DIRNAM) ;destination buffer; HL points to source
CP ':'
JR NZ,NOMOV
; ;move DU:/DIR: spec into buffer
MOVDU: LD A,(HL)
LD (DE),A
INC HL
INC DE
CP ':'
JR NZ,MOVDU
;
NOMOV: XOR A ;null-terminate DU:/DIR: spec buffer
LD (DE),A
;
; Parse the filename pointed to by HL into FCB format
PUSH HL ;save ptr to filename
LD HL,(DIRNAM)
LD A,(HL)
OR A
JR Z,P2 ;don't scan if no DU/DIR
XOR A ;DU before DIR
CALL DNSCAN
JR Z,P2 ;if invalid, stay here
CALL LOGUD
P2: POP HL ;get filename
LD DE,SYSFCB
CALL FNAME ;parse filename into FCB
JR Z,AMB2
LD (CLPTR),HL ;save pointer to tokens
LD HL,(FREE) ;buffer area for directory load
LD A,10100000B ;non-system files sorted by name
CALL DIRQ ;load directory
CALL GETUD ;return home to write file
;
INC HL ;point to first name
EX DE,HL ;...with DE
WRNAMS: LD A,B ;for all filenames in buffer...
OR C
JR Z,WRNAM3
PUSH DE ;(save ptr to name)
LD DE,(DIRNAM) ;...move directory name to write buffer
LD HL,(NMDEST)
WRNAM1: LD A,(DE)
INC DE
OR A
JR Z,WRNAM2
LD (HL),A
INC HL
JR WRNAM1
WRNAM2: POP DE ;HL = mem buffer, DE = name
;
PUSH BC ;write 13 nulls, so name will be null-term.
LD B,13
XOR A
CALL FILLB
POP BC
;
CALL MFN2 ;convert fname to packed string in wrt buffer
PUSH DE
;
CALL WRTSTR ;write name to file
POP DE
LD HL,16 ;set DE to point to next name
ADD HL,DE
EX DE,HL
DEC BC ;count down number of names written
JR WRNAMS
;
WRNAM3: ;done with this token, look for next
LD HL,(CLPTR)
AMB2: LD A,(HL)
INC HL
OR A
JR Z,AMB3
CP PARMFL
JR Z,AMB3
CALL LISTDEL
JR Z,AMB2
DEC HL ;if another token found, point to 1st char
JP AMB0 ;go back and process it
;
AMB3: CALL CLOSOUT
JP DONE
;
;
;----------------
; Chop parameter list into delimited strings.
;
STRINGS:
CALL OPENOUT
LD HL,(PARAMS)
STR1: LD A,(HL) ;skip to first non-comma, non-space
INC HL
CALL LISTDEL
JR Z,STR1
OR A
JR Z,STR5
DEC HL
;
STR2: LD A,(HL)
LD (DELIM),A ;save delimiter for comparison
INC HL
LD DE,(NMDEST)
STR3: LD A,(HL)
INC HL
OR A
JR Z,STR4
DELIM EQU $+1
CP 00 ;the current string delimiter is used here
JR Z,STR4
LD (DE),A
INC DE
JR STR3
;
STR4:
OR A ;if not null, bump HL by 1 more to account...
JR Z,STR5 ;...for DEC HL in WRTTOK
INC HL
STR5: CALL WRTTOK
JR NZ,STR2
;
STR6:
CALL CLOSOUT
JP DONE
;
;
; List all directory names.
;
DIRNAMES:
CALL GETNDR
JP Z,DONE
LD A,(HL)
JP Z,DONE
; There is a buffer and there is at least one entry in it
CALL OPENOUT
DIRN1: LD A,(HL)
OR A
JR Z,DIRNZ ; end of list reached
INC HL
INC HL ; now pointing to name
PUSH HL ; save this pointer
LD DE,(NMDEST) ; transfer name to output buffer
LD B,8
DIRN2: LD A,(HL)
CP ' '
JR Z,DIRN3
LD (DE),A
INC HL
INC DE
DJNZ DIRN2
;
DIRN3: LD A,':'
LD (DE),A
INC DE
XOR A
LD (DE),A
CALL WRTSTR
;
POP HL ; advance to next directory name
LD DE,16
ADD HL,DE
JR DIRN1
;
DIRNZ: CALL CLOSOUT ; all done with directory names
JP DONE
;
;
; Write all numbers up to the value contained in the register specified by
; the character at (HL+1). The list will be zero-based and will run up to
; the register value - 1.
;
REGS:
INC HL
LD A,(HL)
OR A
JR Z,REGERR ; premature eol
SUB '0'
CP 0
JR C,REGERR ; illegal value
CP 10
JR NC,REGERR
; A register value is specified and it is legal
LD B,A
CALL GETREG
LD E,A
LD D,0
JR WRTNUMS
;
REGERR:
CALL PRINT
DB 'Improper register value.',CR,LF,0
XOR A
DEC A
CALL PUTER2
JP DONE
;
;
; Write a zero-based list of numbers, up to (but not including) the value
; indicated by the string at (HL+1).
;
NUM:
INC HL
LD A,(HL)
OR A
JR Z,NUMERR
CALL EVAL10
JR WRTNUMS
;
NUMERR: CALL PRINT
DB 'Unspecified numeric argument.',CR,LF,0
XOR A
DEC A
CALL PUTER2
JP DONE
;
; Write out numbers up to the value in DE if DE > 0
WRTNUMS:
LD A,E
OR D
JP Z,DONE ; don't write anything if arg is 0
PUSH DE
CALL OPENOUT
POP DE
LD HL,00 ; HL counts up to limit in DE
WRTNUM1:
PUSH DE ; save limit
LD DE,(NMDEST) ; format & write number
CALL MHLFDC
XOR A
LD (DE),A
PUSH HL
CALL WRTSTR
POP HL
POP DE ; get limit back
INC HL ; compute next number to write
PUSH HL ; save it while comparing to limit
OR A ; clear carry flag
SBC HL,DE ; at limit yet?
LD A,H
OR L
POP HL ; get current value back
JR Z,WRTNUMZ ; if at limit, go quit
JR WRTNUM1 ; else go back and write the next number
;
WRTNUMZ:
CALL CLOSOUT
JP DONE
;
;
;
; Print help message and fall through to exit.
HELP:
CALL PRINT
DB 'Syntax is:',CR,LF
DB ' FOR <[du:|dir:]fn.ft> [<[du:|dir:]fn.ft>] [/x]',CR,LF
DB 'or',CR,LF
DB ' FOR ''one string'' "another string" \a third string\ /s',CR,LF
DB 'or',CR,LF
DB ' FOR /o',CR,LF
DB 'Options:'CR,LF
DB ' x -- Expand ambiguous filenames',CR,LF
DB ' s -- List elements are delimited strings',CR,LF
DB ' o -- May be:',CR,LF
DB ' D -- list all named directories',CR,LF
DB ' Rn -- list all integers up to that contained in register ''n'',',CR,LF
DB ' one per line. The list is zero-based.',CR,LF
DB ' Nn -- list all integers up to ''n'', one per line (zero-based).',CR,LF
DB 0
;
;
; Clean up and exit program.
DONE:
CALL GETUD
LD SP,(SAVESP)
RET
;
;
;================[ Subroutines ]================
;
; Initialize file I/O control buffers.
; Enter with HL = first free address in memory
; B = number of 128-byte sectors for the file buffer
; Return: HL = first free address after buffer
;
FBINIT:
PUSH DE
PUSH BC
LD (HL),B
LD DE,BADOFF ;loc of buf addr in I/O ctl block
ADD HL,DE
PUSH HL
LD DE,[FCBLEN + FCBOFF - BADOFF]
ADD HL,DE
EX DE,HL
POP HL
LD (HL),E
INC HL
LD (HL),D
EX DE,HL ;get buf start addr in HL
LD DE,128 ;incr HL by buf len in bytes
FBINI1: ADD HL,DE
DJNZ FBINI1
POP BC
POP DE
RET
;
;----------------
; Move filename into fcb of I/O ctl block. Enter with HL = I/O ctl blk addr,
; DE = addr of string to move. Drive is set to current.
INITNAM:
PUSH BC
PUSH DE ;save while adding fcb offset
LD DE,FCBOFF
ADD HL,DE ;point to input fcb
XOR A ;set current drive
LD (HL),A
INC HL ;point to name field of fcb
POP DE ;get source addr
EX DE,HL ;put dest addr in DE, source in HL
LD BC,11
LDIR
POP BC ;restore original contents
RET
;
;----------------
; Open output file
OPENOUT:
LD DE,(OUTPLOC)
CALL FXO$OPEN
RET
;
;----------------
; Close output file
CLOSOUT:
LD DE,(OUTPLOC)
CALL FXO$CLOSE
RET
;
;----------------
; Find next delimiter in string pointed to by HL. Return with delim. in A,
; HL pointing past char. Delimiters are:
; <NULL> <SPACE> / , :
NXTDLM: LD A,(HL)
INC HL
CP ':'
RET Z
CP ','
RET Z
CP ' '
RET Z
OR A
RET Z
CP '/'
RET Z
JR NXTDLM
;
;----------------
; Is (A) a list-element delimiter (a comma or space?). Return Z if true.
LISTDEL:
CP SPACE
RET Z
CP ','
RET
;
;----------------
; Write the string pointed to by NMDEST to the output file. String will be
; terminated with a CR/LF.
WRTSTR:
LD DE,(OUTPLOC)
LD HL,(NMDEST)
WRT2: LD A,(HL)
INC HL
OR A
JR Z,WRT3
CALL FX$PUT
JR WRT2
WRT3: LD A,CR
CALL FX$PUT
LD A,LF
CALL FX$PUT
RET
;
;----------------
; Null-terminate the current token and write it out, then search for the next.
; Return Z if the end of the input has been reached, NZ otherwise. On return,
; HL points to the next non-blank, non-comma character.
WRTTOK:
XOR A ;store null at end of token
LD (DE),A
PUSH HL
CALL WRTSTR
POP HL
DEC HL ;point to delim again in case it's a null
WRTT: LD A,(HL) ;skip over multiple delimiters
INC HL
OR A ;No blank lines can be generated by multiple
RET Z ;delimiters.
CP PARMFL
RET Z
CALL LISTDEL
JR Z,WRTT
DEC HL ;we'll fetch the non-delimiter again
RET
;
;
;================[ Storage ]================
;
SAVESP: DS 2
PARAMS: ;addr of list of files (command line)
DS 2
FREE: DS 2 ;addr of beginning of free memory
XPAND: DB 0 ;flag: NZ=expand ambiguous names, 0=don't.
DIRNAM: DS 2 ;addr of buffer for directory name
FNBUF: DS 2 ;addr of buffer for file name
NMDEST: DS 2 ;address of destn for packed name string
PFADR: DS 2 ;address following last parameter flag in command line
CLPTR: DS 2 ;temp. storage for pointer to cmd line
OUTPLOC:
DS 2 ;addr of output file buffer
OFNAM: DB 'FORFILESS','Y'+80H,'S'
STKBOT: DS 48
STK: DS 2
;
;
END START