; 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