;**********************************************************
; TEXT2DB
; Copyright (c) 1989  C.W. Cotrill, A.E. Hawley, J.W. Wright
;
; Convert text file to db statements suitable for most
; z80 (and other) assemblers.  MSB of incoming bytes is
; masked so WordStar document files may be used as input.
; Several control characters are intercepted by TEXT2DB
; and a user-configurable string emitted instead.  A
; trigger character may be used to mark locations in the
; text file where a label is required in the output file.
; This simplifies screen creation for programs like ZCNFG.
;
; This program was inspired in large part by Joe Wright's
; ZTEXT V2.1.  The coding, however, is totally original
; and is designed to demonstrate the use of SYSLIB, Z3LIB,
; ZCNFG, and TEXT2DB itself in making Z System utilities.
; We have refained from using coding "tricks" to shorten
; the code so it will be less confusing and better serve
; as an example.

; CODING & CHANGE CONVENTIONS
; Note that CODE is Upper Case, Comments are mixed (mostly
; lower) case.
; When making changes to the source, MAKE CODE CHANGES IN
; LOWER CASE, so that the changes are readily apparent.
; Return the modified source file to the Author(s), who
; will review the changes and then restore the format to
; Upper Case Code, comments mixed case. This strategy was
; an outstanding success during the development of TEXT2DB
; by the authors.
; Naturally, if you prefer, you can make all code in
; lower case with changes in UPPER case. The same benefits
; are obtained. The changes stand out!

; Comments, questions, and update coordination can be
; addressed to the authors (by modem) at:
;	Al Hawley  or Cameron W. Cotrill
;	The Ladera Z-Node, (213) 670-9465

; Development and change history is in a separate file,
; TEXT2DB.HST

; ASSEMBLE WITH:
;	ZMAC TEXT2DB
;	Z80ASM TEXT2DB
;	SLR180 TEXT2DB
;	M80 =TEXT2DB.Z80/Z
;
;  Note: Set assembler for 6 character labels in rel stream!

; LINK COMMANDS:  (Generate TEXT2DB.SYM)
;	ZMACLNK TEXT2DB /M
;	SLRNKP TEXT2DB/N,/A:100/J,TEXT2DB,TEXT2DB/M,/E
;	LINK TEXT2DB
;
;***********************************************************

VERS	EQU	10		; Version number in decimal
				; 10 = Version 1, Revision 0

	MACLIB	SYSDEF.LIB	; The usual defines...

; To simplify linking of the final program, all librarys required
; by the program are requested here.  The routines required from
; each library are also declared here.
;
; NOTE:  Z3LIB is declared first, then SYSLIB because
;	 of references in z3lib to syslib routines.
;.....
; Z3LIB ROUTINES:

	.REQUEST Z3LIB
	EXT	GETMDISK,GETMUSER,GZMTOP
	EXT	WHRENV,ZFNAME
	EXT	Z3INIT

;.....
; SYSLIB ROUTINES:

	.REQUEST SYSLIB
	EXT	@B2HH,@B2HL,CODEND,EVAL10,FILLB
	EXT	F$DELETE
	EXT	FX$GET,FX$PUT,FXI$OPEN,FXO$OPEN
	EXT	FXI$CLOSE,FXO$CLOSE
	EXT	ISCTRL,ISDIGIT,ISSP
	EXT	LOGUD,MA3DC,RETUD,SKSP
	EXT	PRINT

;.....
; Definitions unique to this program
QUOT	EQU	''''		; Single quote defines strings
;quot	equ	'"'		; (a possible alternate choice)
	PAGE
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; PROGRAM ENTRY POINT
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

TEXT2DB:
	JP	START		; Skip around ZCPR header and config

;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; ZCPR HEADER
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

	DB	'Z3ENV'
	DB	1		; Type 1 utility
ENVADR:	DW	0001H		; Force whrenv to search
	DW	0		; Reserved for type 3,4

;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; CONFIGURATION AREA
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

; The data in this area is configurable with ZCNFG which uses
; a configuration file named <FT>.CFG, where FT is the string
; at cnfgid: below.
; ZCNFG is available in the Public Domain, with documentation.

CNFGID:	DB	'TEXT2DB',0	; Name of configuration file
	DS	15-($-CNFGID)	; Space reserved for version id

LINELN:	DB	60		; Nominal output line length

; Mnemonics sent to the output file to represent common control
;  characters in the input file.
; 6 chars for each string, left justified in a 7 char field of spaces

CRSTR:	DB	'CR     '	; 0Dh
LFSTR:	DB	'LF     '	; 0Ah
DELIMT:	DB	'0      '	; End of data delimiter
TABSTR:	DB	'TAB    '	; 09h
RVON:	DB	'DIM    '	; 01
RVOFF:	DB	'BRIGHT '	; 02
BELSTR:	DB	'BELL   '	; 07h
ESCSTR:	DB	'ESC    '	; 1Bh

; Field lengths as shown
SLABEL:	DB	'SCR000'	; First synthetic label
SLTERM:	DB	':'		; Label terminator
LABWS:	DB	TRUE		; White space around the 'DB'
				; True=tab, false=space
; Up to 6 char in a field of 7 spaces
DBSTR:	DB	'DB     '	; DB | DEFB | .BYTE | <etc>

; Field lengths as shown
SLCODE:	DB	'`'		; Trigger char for synthetic lbl
OUTTYP:	DB	'DB '		; Default type for output file
INPTYP:	DB	'TXT'

; Other configurable program parameters
TSPACE:	DB	FALSE		; True = allow spaces at end of DB string
MAXLIN:	DB	128		; Absolute maximum output line length
QCHAR:	DB	QUOT		; Character TEXT2DB uses to quote strings
	PAGE
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; PROGRAM START
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

START:	XOR	A		; Test for z80 cpu
	DEC	A
	JP	PE,NOTZ80	; 8080, 8085 set parity flag Even

	LD	(STACK),SP
	LD	SP,STACK	; Swap to local stack
	CALL	INITENV		; Init z3env, terminal, say hello
	CALL	PARSE		; Command tail
	JR	C,ABORT		; On unrecoverable cmd tail error
	CALL	PGMINIT		; Allocate buffers, complete dcb's
				; Open i/o files
	CALL	PROC		; Main work is done here
				; Filter input to output files
	CALL	WRAPUP		; Finish up, close files
	JP	EXIT
	PAGE
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; EXIT AND ERROR EXIT ROUTINES
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

NOTZ80:	LD	DE,NZ80MSG
	LD	C,9		; Bdos print function
	JP	BDOS		; Exit with a return to ccp from dos

NZ80MSG:
	DB	'This program requires a Z80/Z180 cpu$'

ABORT:
ABORT1:	CALL	PRINT
	DB	BELL,'*** FATAL ERROR - ABORTING',CR,LF,0

EXIT:	LD	BC,(DFLTDU)
	CALL	LOGUD		; Restore default du
	LD	SP,(STACK)
	RET
	PAGE
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; SIGN ON, SET ENV ADDRESS, SET DEFAULT DRIVE/USER
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

INITENV:
	CALL	RETUD		; Find current du
	LD	(DFLTDU),BC	; Remember default du
	LD	HL,(ENVADR)
	CALL	WHRENV		; Locate and confirm z3env
	LD	(ENVADR),HL	; Save actual address
	LD	A,H
	OR	L
	JP	Z,ABORT1	; If no env
	CALL	Z3INIT
	CALL	PRINT
	DB	'TEXT2DB'	; Name of program
	DB	' V'
	DB	VERS/10+'0','.',VERS MOD 10+'0'
	DB	CR,LF
	DB	' Copyright (C)'
	DB	'1989'
	DB	' C.W. Cotrill, A.E. Hawley, J.W. Wright'
	DB	CR,LF,LF
	DB	0
	RET
	PAGE
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; COMMAND PROCESSOR
;  Parse tail, do options, put fn,ft in dcb's
;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

PARSE:

; Convert space terminated strings in configuration
;  block to null terminated strings

	LD	HL,CRSTR
	LD	B,SLABEL-CRSTR
	CALL	REFORM		; Change spaces to nulls
	LD	HL,DBSTR
	LD	B,SLCODE-DBSTR
	CALL	REFORM		; Change spaces to nulls

; Initialize working synthetic label in work area
;  so it can be modified by command line /S option.

	LD	HL,SLABEL	; Copy config default to
	LD	DE,WSLABEL	; Working synthetic label
	LD	BC,7
	LDIR
	LD	HL,DBSTR
	LD	DE,HEADER+1
	CALL	CPYSTR		; Include configured header

; LABWS is a true/false value - true=tab, false=space

	LD	A,(LABWS)	; Get label field white space switch
	OR	A		; Tab, or space?
	LD	A,SPC		; Assume space
	JR	Z,..P1		; And jump if so
	LD	A,TAB		; Else its a tab
..P1:	LD	(HEADER),A	; Install before the 'DB' string
	LD	(DE),A		; Insert after data mnemonic (DB)
	INC	DE
	XOR	A
	LD	(DE),A		; Insert terminating null

; Initialize output FCB FN.FT field. FNAME does
;  this ONLY if there is a name present!

	LD	HL,OUTFCB+1	; ->FN field
	LD	A,SPC
	LD	B,11		; Length of FN.FT field
	CALL	FILLB

; The parse starts here and includes HELP function,
;  which is provided on ANY unresolvable token.

	LD	HL,TBUF	+ 1	; ->command tail in tbuf
	CALL	GETOKEN		; ->process options, ->next FS
	JP	C,DOHELP	; Give help if bad option
	JP	Z,DOHELP	; Or empty command.

; Possible input file spec

	LD	DE,INPFCB	; Parse token to inpfcb
	LD	A,1		; Tell zfname DU first
	CALL	ZFNAME

; If error, HELP & abort

	JP	NZ,DOHELP	; Wildcards not allowed
	CALL	DU2BC		; Get DU returned by zfname
	JP	C,DOHELP	; Do HELP if out of range
	LD	(SRCDU),BC	; Either current or declared du

	CALL	GETOKEN		; ->process options, ->next FS
	JP	C,DOHELP	; Give help if bad option
	JR	Z,CMDONE	; No more to get

; Possible output file spec

	LD	DE,OUTFCB	; Parse token to outfcb
	LD	A,1		; Tell zfname DU first
	CALL	ZFNAME

; If error, HELP & abort

	JP	NZ,DOHELP	; Wildcards not allowed
	CALL	DU2BC		; Get DU returned by zfname
	JP	C,DOHELP	; Do HELP if out of range
	LD	(DSTDU),BC	; Not used currently, but....

	CALL	GETOKEN		; Process trailing options
	JP	C,DOHELP	; HELP & abort on error

; A file name is present in inpfcb, and any options are set.
;  A file spec may be present in outfcb.

CMDONE:

; Provide default input FT if needed from config
; (The default FT can be configured to '   ' or
; any other string of your choice. The blank FT
; permits use of input files which have no FT.)

	LD	DE,INPFCB+9	; Input file type field
	LD	HL,INPTYP	; From config area
	CALL	DEFTYP

; Provide default output FT from config if needed

	LD	DE,OUTFCB+9	; Output FT field
	LD	HL,OUTTYP	; From config area
	CALL	DEFTYP

; Provide default FN from inpfcb if needed

	LD	DE,OUTFCB+1	; Filename field
	LD	HL,INPFCB+1	; Default is input FN
	CALL	DEFNFT

; Exit.  FCB's and options are defined

	RET

;.....
; Get the next command tail character and process
;  if it's an option. Else return pointing to FS.
; Entry: hl -> next command tail loc.
; Exit: hl -> FS token or EOL
;	flags:	CY = bad option
;		NZ = hl-> cmd tail token
;		 Z = End of Command encountered

GETOKEN:
	CALL	SKSP		; Skip white space, get next char
	LD	A,(HL)
	CALL	ISCTRL		; Control character?
	RET	Z		; Must be EOC
	CP	'/'		; Option?
	JR	NZ,FSTOKEN	; No, possible FS
	CALL	DOOPT		; Attempt to interpret option
	RET	C		; Return CY set if not recognized
	JR	GETOKEN		; Try again for a FS

FSTOKEN:
	OR	A		; Reset carry
	RET			; Ret nz,nc

;.....
; Entry: hl -> char before possible option char
; Exit: hl -> next char after option char
;	flags:	NC = option processed
;		C  = Bad or no option char

DOOPT:	INC	HL		; -> option char
	LD	A,(HL)		; Get it
	INC	HL		; -> next char
	CP	'S'		; Synthetic label preset?
	JR	Z,FIRSTLBL	; Do if it is

; Other options could get selected here

	SCF			; Unrecognized option
	RET

;.....
; Generate the first synthetic label based on
;  user input like /Saaannn, /Snnnnn, or /Saaa
;  aaa = alphanumeric starting with alpha. n=digit
;  The first 3 chars of input are copied if they start
;  with a non-numeric. Spaces are converted to '.'.
;  Characters unacceptable to the assembler are otherwise
;  NOT filtered. The assembler will tell you about them!
;  The balance of the token is interpreted as a decimal
;  number. Both parts over write the configuration default.
;  if there is no number following the 3 char part, then
;  eval10 will return a 0. In that case, the default
;  number from configuration will be used for the first label.

; Entry: hl -> string
; Exit: hl -> terminator
;	AF,BC,DE used

FIRSTLBL:
	LD	A,(HL)		; If it starts with a number,
	CALL	ISDIGIT
	JR	Z,LBLNUM	; Then use the default prefix

	LD	DE,WSLABEL	; Working Synthetic label
	LD	B,3		; Get 3 char prefix
FIRST1:	CP	SPC		; Over-write the default
	RET	C		; Control char is end of string!
	JR	NZ,FIRST2	; Continue if >space
	LD	A,'.'		; Substitute period for space
FIRST2:	LD	(DE),A		; Transfer to prototype label
	INC	DE
	INC	HL
	LD	A,(HL)		; Get next character
	DJNZ	FIRST1
;
; EVAL10 returns the number in DE, and A=E
;
LBLNUM:	CALL	EVAL10		; Get the users first number
	OR	A		; Test for no number
	RET	Z		; And use the configured default
	LD	DE,LABELV	; ->numeric part of working label
	CALL	MA3DC		; Low byte to dec ascii in synthetic label
	OR	A		; No error, so be sure CY is reset
	RET

;.....
; Extract the Drive & User placed in the FCB
;  by ZFNAME or ZPRSFN and test for > Maximum
;
; exit: BC = DU from the FCB
;	DE, HL preserved
;	CY set = DU out of range

DU2BC:	PUSH	HL		; Cmd tail pointer
	PUSH	DE		; ->fcb
	EX	DE,HL
	LD	A,(HL)		; Drive byte from fcb
	OR	A
	JR	NZ,DU2BC1	; If other than default
	LD	A,(DFLTDU+1)	; Default, get actual drive
	INC	A
DU2BC1:	DEC	A		; A=0, b=1, ...
	LD	B,A
	LD	DE,0DH
	ADD	HL,DE		; ->user number from fcb
	LD	C,(HL)

; BC contains requested DU. Test against maxima in ENV

	CALL	GETMDISK	; Max disk from env
	CP	B		; Is requested drv larger?
	JR	C,DU2BCX
	CALL	GETMUSER	; Max user from env
	CP	C
DU2BCX:	POP	DE
	POP	HL
	RET

;.....
; Install the string at HL in the same length
;  field at DE if the 1st field byte is blank.
; Entry:
;	DE -> destination field
;	HL -> replacement string
; Exit:
;	A,C are undefined
;	B=0
;	HL -> next replacement string start
;	DE -> next field start
;	FLAGS: NZ=NO replacement
;		Z=field filled with (HL)

; Enter here with HL -> FNFT model in FCB format.

DEFNFT:	LD	BC,8		; Do both fn and ft
	CALL	REPMTY

; For this entry, HL -> FT model (3 bytes)

DEFTYP:	LD	BC,3		; Do ft only

; Replace an empty field at DE with the
;  formatted string at HL
;	BC = field length

REPMTY:	LD	A,(DE)
	CP	SPC
	JR	Z,REPMT1

; Skip the source, dest fields if no replace

	ADD	HL,BC		; ->next field
	EX	DE,HL
	ADD	HL,BC		; ->next dest
	EX	DE,HL
	RET

; Dest field marked empty, so replace it

REPMT1:	LDIR
	RET

;.....
; Print built in help message

DOHELP:
	CALL	PRINT
	INCLUDE	T2DBHELP.LIB	; Include the HELP screen file
	JP	EXIT
	PAGE
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; SIZE and ALLOCATE INPUT and OUTPUT BUFFERS
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

; Find the program end and the highest free memory,
;  then allocate two equal size buffers for input & output.
;  Making the actual buffer sizes an integral power of two
;  records in length minimizes the number of disc read/write
;  accesses because deblocking buffers are similarly designed.

PGMINIT:
	CALL	CODEND		; Start of free mem
	EX	DE,HL		; In de
	CALL	GZMTOP		; Get top of tpa in hl
	AND	A
	SBC	HL,DE		; Size in bytes

; Shortcut: the minimum size necessary is 1 page for
;  two 128 byte buffers. This will certainly be available,
;  in which case H > 0 and L can be set to 0 when buffer size
;  is a power of 2 bytes.

	LD	A,H
	CALL	TPOWR		; Ret highest power in A
	JP	Z,ABORT		; H was zero.. something wrong!
	LD	L,0
	RRCA			; /2 for size per buffer
	LD	H,A		; HL = buffer size, nearest power of 2

; DE contains the first page boundary address in free
;  memory, and is the start of the first buffer.

	EX	DE,HL		; Preserve buffer size in de
	LD	(DCBINB),HL	; Input buf address
	ADD	HL,DE
	LD	(DCBOTB),HL	; Output buf address
	EX	DE,HL		; Recover buffer size in hl

; Divide by 128 to return record size of buffers

	ADD	HL,HL		; X2
	LD	L,H		; /256
	LD	H,0
	RL	H		; Include carry from the add
	LD	(DCBINP),HL	; Set up dcb's
	LD	(DCBOUT),HL

; Initialize synthetic label counter

	LD	HL,LABELV	; ->3 ascii number field
	CALL	EVAL10		; 16 bits allowed, but
	LD	(LBLCNT),A	; Only use low 8 bits

; Open input and output files

	LD	BC,(SRCDU)	; Where the files are
	CALL	LOGUD		; Go there
	LD	DE,DCBINP
	CALL	FXI$OPEN
	JP	Z,OPNERR	; Problem opening the file

; Input file now open, get first char to test for 0 length file.

	CALL	FX$GET		; Get the first character
	LD	(CURCHR),A	; Save it
	JP	Z,ZEROLEN	; Zero length file, Forget it

	LD	DE,OUTFCB
	CALL	F$DELETE	; Erase any existing file of same name

	LD	DE,DCBOUT
	CALL	FXO$OPEN	; Make new output file
	RET	NZ		; Main exit from prginit

	CALL	PRINT
	DB	'Can''t make the Output file!',CR,LF,0
	JP	EXIT

OPNERR:
	CALL	PRINT
	DB	'Can''t Open Input File!',CR,LF,0
	JP	EXIT

ZEROLEN:
	CALL	PRINT
	DB	'Input File is Zero-Length!',CR,LF,0
	JP	EXIT
	PAGE
;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; CLOSE FILES
;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

WRAPUP:	LD	DE,DCBINP
	CALL	FXI$CLOSE
	LD	DE,DCBOUT
	CALL	FXO$CLOSE	; Th..th..that's all folks!
	RET
	PAGE
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; SPECIAL CHARACTER TABLES
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

; Tables used by PROC to identify characters to filter
;  and the corresponding strings (by address) used to
;  replace them.  The tables are paired and MUST be
;  maintained in order.  CTLTB1 is paired with CTLTB1A,
;  and CTLTB2 is paired with CTLTB2A.

;.....
; Special chars that always result in new line in output file

CTLTB1:	DB	LF
	DB	FF		; Issue delimiter
	DB	1AH		; Issue delimiter
CTLTB1E:

; Special chars that don't result in new line in output file

CTLTB2:	DB	CR
	DB	TAB
	DB	DIM
	DB	BRIGHT
	DB	BELL
	DB	ESC
CTLTB2E:

;.....
; Address of output strings (in config area)

CTLTB1A:			;corresponds to CTLTB1
	DW	LFSTR
	DW	DELIMT
	DW	DELIMT

CTLTB2A:			;corresponds to CTLTB2
	DW	CRSTR
	DW	TABSTR
	DW	RVON
	DW	RVOFF
	DW	BELSTR
	DW	ESCSTR
	PAGE
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; MAIN PROCESSING ROUTINE
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

PROC:

; Initialize (first char already read in in PGMINIT)

	XOR	A
	LD	(LSTCHR),A	; Previous character
	LD	(QUOTON),A	; Set quote to false
	LD	(LCHCNT),A	; Clear output char counter
	LD	(FSLBOT),A	; No output of synthetic label
	LD	(NEWLIN),A	; Already at Col. 1. No crlf needed
	LD	(LSTSPF),A	; Set last char special flag to false
	DEC	A
	LD	(FDOHDR),A	; Indicate header needed
	LD	A,(CURCHR)	; First character from Input file
	JR	PROC0A		; We have the first character
				; Jump around PROC0: this time

;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
;  INPUT CHARACTER PROCESSING LOOP
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

PROC0:
	LD	A,(CURCHR)
	CP	1AH
	JP	Z,OUTCRLF	; Final CRLF and quit on file end

	LD	(LSTCHR),A	; Remember the previous character
	LD	A,(FSPECL)
	LD	(LSTSPF),A	; Save special char flag for prev char also

; Get a char from the input stream

	LD	DE,DCBINP	; Point to input control block
	CALL	FX$GET		; Read a char
	JR	NZ,PROC0A	; No error

	LD	A,1AH		; Phony End of File  JWW

PROC0A:
	LD	HL,PROC0	; Beginning of Main loop
	PUSH	HL		; All routines return to PROC0:

	AND	7FH		; Clear high bit
	LD	(CURCHR),A	; And save for future use
	CALL	CLASSIFY	; Set FSPECL and FSLBL appropriately

	CALL	TRIGGER		; Set up for synthetic label if needed

	CALL	TSTNL		; Set up to fold line if needed.

; Emit the synthetic label and db header
;  if needed prior to processing char

	CALL	OUTHDR		; Fold line & send header if required

	CALL	QUOTE		; Change state of quote as needed

; Test if char is output "as is"

	LD	A,(FSPECL)
	AND	A		; Test special char flag
	JR	NZ,PROC0B

	LD	A,(CURCHR)
	CP	QUOT		; Quote?
	CALL	Z,CHRPUT	; Two of them if so
	JP	CHRPUT		; Return to PROC0:

;......
PROC0B:

; This is a special one, write a comma if needed

	CALL	COMMA		; Issue a comma if needed

; See if this char is one that doesn't cause a new line

	LD	A,(CURCHR)
	LD	BC,CTLTB2E-CTLTB2
	LD	HL,CTLTB2E-1
	CPDR
	JR	NZ,PROC2	; If not in ctl table 2

; Send output for char that does not cause newline

	LD	HL,CTLTB2A
PROC1:
	ADD	HL,BC
	ADD	HL,BC		; Point to token address
	LD	A,(HL)
	INC	HL
	LD	H,(HL)
	LD	L,A
	JP	OUTHL		; Copy token to output stream

; Check for control table 1 char (string, new line)

PROC2:	LD	A,(CURCHR)
	LD	BC,CTLTB1E-CTLTB1
	LD	HL,CTLTB1E-1
	CPDR
	JP	NZ,OUTHA	; If not control table one char
	LD	HL,CTLTB1A
	CALL	PROC1		; Copy token to output stream
	OR	0FFH
	LD	(NEWLIN),A
	LD	(FDOHDR),A
	RET

;.....
;If the current character is a 'trigger'
; then force a new line, set flag requesting
; synthetic label header, and exit to PROC0
; to get the next character. This routine
; simply returns to where it was called if
; the character is not a trigger (SLCODE)

TRIGGER:
	LD	A,(FSLBL)	; Synthetic label requested?
	OR	A		; If not, ..
	RET	NZ		; Return to caller
	CPL			; Make 0ffh
	LD	(FSLBOT),A	; Flag synthetic label output before next char
	LD	HL,LCHCNT	; Column counter for output line
	AND	(HL)		; 0 = at the beginning of a line
				; Or no synthetic label
	POP	HL		; Remove the return to the tstnl call
	RET	Z		; No newline required
	OR	0FFH
	LD	(NEWLIN),A	; Force newline before next character
	RET			; Exit by returning to proc0 to get
				; The next character.

;.....
; See if it's time to fold the line
;  line fold is required if:
;  a) absolute line length is exceded
;  b) formatted line length is exceded
;
; This routine sets a flag (newlin) if line fold
; is needed. Actual folding of the line (with a crlf)
; is done in OUTHDR where the flag is tested.

TSTNL:	PUSH	HL		; Save because it's used locally
	LD	HL,LINELN	; Point to formatted line length
	LD	A,(LCHCNT)
	CP	(HL)		; Time to consider wrapping line?
	POP	HL
	RET	C		; Return if not yet

	PUSH	HL
	PUSH	DE
	LD	HL,MAXLIN	; Absolute maximum line length
	CP	(HL)		; Absolute Max chars per line
	CCF			; Set Carry if too long
	SBC	A,A		; A=0ffh, NZ and Cy if too long
	JR	NZ,TSTNL0	; Quit now; force a new line

	LD	A,(TSPACE)	; Get space at eol flag
	AND	A		; ..and see if set
	LD	DE,CURCHR	; If so, test current character
	LD	HL,FSPECL
	JR	Z,TSTNL1
	LD	DE,LSTCHR	; Else test prior char
	LD	HL,LSTSPF
TSTNL1:	LD	A,(DE)		; Get char to test
	CALL	ISSP		; Is it a space?
	CALL	SETTFZ		; Returns Z if white space
	CPL			; ..now 0ffh if white space, 0 if not
	OR	(HL)		; Is it a space or a control char?
TSTNL0:
	POP	DE
	POP	HL
	RET	Z		; No, delay line fold
	LD	(NEWLIN),A	; .. a = 0ffh
	LD	(FDOHDR),A
	RET

;.....
; Force a new line

FORCENL:
	PUSH	HL
	LD	HL,QUOTON
	LD	A,(HL)
	AND	A		; Is quote on right now?
	JR	Z,FORCN1	; Skip if off
	INC	A		; Ff -> 0
	LD	(HL),A		; Turn quote off
	LD	A,QUOT		; Emit a quote
	CALL	CHRPUT
FORCN1:	CALL	OUTCRLF		; Send newline
	POP	HL
	RET

;......
; Send crlf and header to output stream

OUTCRLF:
	LD	A,CR
	CALL	CHRPU2		; Write a real cr
	LD	A,LF
	CALL	CHRPU2		; And a real lf
	XOR	A
	LD	(LCHCNT),A	; Clear output char counter
	LD	(NEWLIN),A	; And newline required flag
	DEC	A
	LD	(FDOHDR),A	; Mark header needed before writing more
	RET

;.....
; Output db header - including synthetic label
; if requested.

OUTHDR:	LD	HL,(FDOHDR)	; If either normal header
	LD	A,H		; Or synthetic label needed
	OR	L		; Then this will be nz
	RET	Z		; Z = no header required

	LD	A,(NEWLIN)
	OR	A		; CRLF needed?
	CALL	NZ,FORCENL	; Close old line, start a new one

	LD	HL,HEADER	; Prepare to output header string
	LD	A,(FSLBOT)
	OR	A		; Synthetic label needed?
	JR	Z,OUTH0		; Z = no
	LD	HL,WSLABEL	; For synthetic label + hdr str
OUTH0:	PUSH	AF
	CALL	OUTHL
	POP	AF
	CALL	NZ,BLDLBL
	OR	0FFH
	LD	(FCHAR1),A	; Set first char in a line flag
	INC	A
	LD	(FDOHDR),A	; Clear header send needed flag
	LD	(FSLBOT),A	; And synthetic label output flag
	RET

;......
; Increment the synthetic label
; Install incremented counter in ascii in the
;  three character field with leading zeros

BLDLBL:
	LD	A,(LBLCNT)	; The label number to use
	INC	A		; Number
	LD	(LBLCNT),A
	LD	DE,LABELV	; Ascii destination
	CALL	MA3DC		; From syslib
	RET

;......
; Send the terminated string at HL to the output stream
;  The terminator is not sent
; Entry: C = char which terminates the string
; Exit: HL -> terminator character

OUTHL:	LD	A,(HL)
	AND	A		; Terminator?
	RET	Z		; Exit if done
	CALL	CHRPUT		; Write it out
	INC	HL		; Bump pointer
	JR	OUTHL		; And continue

;.....
; Output value in a as a hex value

OUTHA:	LD	A,(CURCHR)
	CALL	@B2HH		; Convert high nibble to ascii
	CALL	CHRPUT
	LD	A,(CURCHR)
	CALL	@B2HL		; Convert low nibble to ascii
	CALL	CHRPUT
	LD	A,'H'		; Output 'h' suffix
				; Fall thru to chrput

;.....
; Output literal character in a and count chars

CHRPUT:	PUSH	HL
	LD	HL,LCHCNT	; -> character counter
	INC	(HL)		; Bump character count
	CP	TAB		; Check for TAB
	JR	NZ,CHRPU1	; Not TAB

	PUSH	AF
	LD	A,(HL)		; Character count
	ADD	A,7		; To or past TAB stop
	AND	-8		; Put on even 8 byte boundry
	LD	(HL),A		; Put it back
	POP	AF

CHRPU1:	POP	HL

CHRPU2:	PUSH	DE
	PUSH	HL
	LD	DE,DCBOUT
	CALL	FX$PUT		; Write char to output stream
	LD	HL,FCHAR1
	LD	(HL),0		; Clear first char flag
	POP	HL
	POP	DE
	RET

;.....
; Output a quote if needed

QUOTE:	PUSH	AF
	PUSH	HL
	LD	HL,QUOTON	; Point to quote flag
	LD	A,(FSPECL)	; And current char type
	CPL			; Nz if this char needs quoting
	XOR	(HL)
	JR	Z,QUOTEX	; If no quote needs to be sent
	XOR	(HL)
	LD	(HL),A		; Toggle quote flag
	CALL	NZ,COMMA	; If quote wasn't on, might need comma
	LD	A,QUOT
	CALL	CHRPUT		; And send a quote to the output stream
QUOTEX:	POP	HL
	POP	AF
	RET

;.....
; Output a comma if needed

COMMA:	PUSH	AF
	LD	A,(FCHAR1)
	AND	A		; Is this the first char in a line?
	LD	A,','
	CALL	Z,CHRPUT	; Output comma if it isn't
	POP	AF
	RET

;.....
; Classify the character in A.	Set FSLBL and FSPECL accordingly.
; Return FSPECL in AF.

CLASSIFY:
	PUSH	HL
	PUSH	AF		; Save the character
	LD	HL,SLCODE	; Point to synthetic label code
	CP	(HL)		; Is it a Syn Label request
	CALL	Z,TSTDBL	; Check doubled trigger
	CALL	SETTFZ		; Zero if single trigger
	LD	H,A		; FSLBL value to H (0=true)
	POP	AF		; Get the character again
	CALL	ISCTRL		; Test if control char
	CALL	SETTFZ		; A=0 if control, else ff
	AND	H		; Negative Or (0 or 0 = 0)
	XOR	-1		; Positive result (Z flag set)
	LD	L,A		; FSPECL value to L
	LD	(FSPECL),HL	; Save 'em both
	POP	HL
	RET

;.....
; Test for trigger character quoting
; itself. In such case, mark the character
; normal and remove flags set by the first
; occurrence to generate a label & header

TSTDBL:
	LD	H,A		; Char being tested
	LD	A,(LSTCHR)
	SUB	H		; Second occurrence?
	JR	Z,DBLD		; Jump if yes
	XOR	A		; Make Z flag
	RET			; To treat as normal trigger

DBLD:	LD	(FSLBOT),A	; Don't output synthetic label
	LD	(NEWLIN),A	; Or new line
	OR	H		; Recover char, and make NZ
	RET			; Return char classified as normal

	PAGE
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
;	Utility Subroutines
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

; Set a register value according to state of z flag

SETTFZ:	LD	A,0		; Don't alter flags
	RET	Z		; Done if z flag set
	DEC	A		; Else set a=0ffh
	RET

;.....
; TPOWR returns the highest power of 2
;  less than or equal to the entry value.
;  Note: a singularity occurs for value = 0,
;  for which the mathematical result is
;  minus infinity, which is identified by
;  the Zero Flag.

; Entry: A = any value
; Exit: A = one bit set corresponding to the
;	highest position bit set in value
;	FLAGS = z,nc for zero value, else nz,c
; Uses AF, all other registers preserved

TPOWR:	OR	A
	RET	Z
	PUSH	BC
	LD	C,1		; Prime the result register
TPOWR0:	RRC	C		; C/2, (always makes nc)
	RLCA			; A*2, (zflag unaffected)
	JR	NC,TPOWR0

; When the highest set bit is shifted out,
;  reg c contains the result.

	LD	A,C
	POP	BC
	RET

;.....
; Reformat space terminated to null
;  terminated string. The string may not
;  contain embedded spaces.

; Entry: HL -> block of bytes
;	b = number of bytes
; Exit: HL -> next byte
; All space bytes are replaced by null

REFORM:	LD	A,(HL)
	CP	SPC
	CALL	Z,CNVT0
	INC	HL
	DJNZ	REFORM
	RET
CNVT0:	LD	(HL),0
	RET

;......
; Copy a null terminated string
; Entry: HL -> source string
;	DE -> destination
; Exit: HL -> null terminator
;	DE -> next destination loc.

CPYSTR:	LD	A,(HL)
	OR	A
	RET	Z
	LD	(DE),A
	INC	HL
	INC	DE
	JR	CPYSTR

	PAGE
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; RAM
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

	DSEG			; All uninitialized data

DCBINP:	DS	1		; Use 8 128-Byte Pages (1K)
	DS	1		; Filled in by FXIO
	DS	2		; Filled in by FXIO
	DS	2		; Filled in by FXIO
DCBINB:	DS	2		; Address of Working Buffer
INPFCB:	DS	1		; Filled in by FXIO to 0
	DS	8		; File Name
	DS	3		; File Type
	DS	24		; Filled in by FXIO

DCBOUT:	DS	1		; Use 8 128-Byte Pages (1K)
	DS	1		; Filled in by FXIO
	DS	2		; Filled in by FXIO
	DS	2		; Filled in by FXIO
DCBOTB:	DS	2		; Address of Working Buffer
OUTFCB:	DS	1		; Filled in by FXIO to 0
	DS	8		; File Name
	DS	3		; File Type
	DS	24		; Filled in by FXIO

; Working copy of synthetic label and header
;  from configuration area. Initialized in PARSE:

WSLABEL:			; Synthetic label + ':'
	DS	3		; Alpha + AN part of label
LABELV:	DS	3		; Numeric field of synthetic label
	DS	1		; Room for ':'

HEADER:	DS	1		; Leading white space char
	DS	6		; Up to 6 char data mnemonic
	DS	2		; Plus room for trailing white space
				; And null terminator

LBLCNT:	DS	1		; Synthetic label count
CURCHR:	DS	1		; Current character from input stream
LSTCHR:	DS	1		; Last character read from stream
LCHCNT:	DS	1		; Output line char counter
;------
;		--- FLAGS ---
;  The following 2 bytes are accessed as a word in PROC0:
FDOHDR:	DS	1		; Db header needed
FSLBOT:	DS	1		; Synthetic label rdy for output

;  The following 2 bytes are accessed as a word in CLASSIFY:
FSPECL:	DS	1		; Special character detected
FSLBL:	DS	1		; Synthetic label requested

QUOTON:	DS	1		; Quoted sequence being output
FCHAR1:	DS	1		; First non-white character after db
LSTSPF:	DS	1		; Value of FSPECL for previous character
NEWLIN:	DS	1		; TRUE forces new line before next char
;------

DFLTDU:	DS	2		; Default drive/user
SRCDU:	DS	2		; Source drive/user
DSTDU:	DS	2		; Destination drive/user

	DS	64		; Program stack
STACK:	DS	2		; Stack pointer storage

	END
;
; End of TEXT0A.Z80