; SRT.ASM  -  01-MAR-86
;
THSVER	EQU	12
REVISE	EQU	'a'
;
;------------------------------------------------------------------
;
;			   SRT.ASM
;
;	     DO ALL THE STUFF WE'VE BEEN WANTING TO....
;	    --- --- --- --- --- --- --- --- --- --- ---
;	    ENABLE REDIRECTED INPUT VIA '<' CONVENTION
;	      (THIS ALLOWS LOWER-CASE SKIP-STRINGS)
;
; This is the sort  routine  that I've been  looking for, I hope...
; Invoke it with no parameters	and it will output the clear-screen
; string as described below followed by full on-line documentation.
; Note that  its default  is to re-read the  source  file in random
; mode after sorting, so if you want to perform an in-core display-
; save, use  A>SRT out=in ;()K,132 which will produce a maximum key
; length of 132 characters, beginning  from the start  of the input
; line and skipping no characters  with the output = the keys.	The
; program  will tell you  if you run out of core and close any par-
; tial output file  on the way out.  To sort a bigger file,  simply
; shorten  the key length  parameter.  The max on my system (end of
; TPA = 0E000h) and an array base of 0B00h will allow approximately
; 1800+ lines with a key length of 22 characters.  (The node length
; is fixed  at 8 bytes).  If you set the key  length to 6, say, for
; sorting  labels  in a .ASM file, you can sort  about 4200+ lines.
;
;
;     Please call me with any beefs/suggestions/comments!
;
;	days: (703)922-5600 Eaton Corporation switchboard.
;	eves: (301)277-6621 (occasionally...)
;
;------------------------------------------------------------------
;
	$-MACRO
	$-PRINT
;
;	MACLIB	ABORT
	MACLIB	EQU
	MACLIB	EXOPCODE
	MACLIB	FILIO
	MACLIB	G80
	MACLIB	MACRO
;	MACLIB	PARSER
;	MACLIB	RELOC	;SEE ALSO XTRAN.LIB
;	MACLIB	SCR2PRTR
;	MACLIB	SCHBUF
	MACLIB	SIMPIO
	MACLIB	START
	MACLIB	TEST
;
;
; *** NOTE: ONLY ONE OF THE BELOW TWO LIBRARIES MAY BE USED AT A TIME
;
;	USE TRAN FOR FINISHED ROUTINES, TRTST FOR DEBUGGING
	MACLIB	TRAN
;	MACLIB	TRTST
;
;
; *** END OF TRAN SERIES ***
;
;	MACLIB	TXTST
;	MACLIB	VIDEO
;	MACLIB	XTRAN		; RELOCATING 'TRAN' & 'BR'
	MACLIB	Z80
;
;SBTTL LOCAL MACRO AREA -----------------------------------
;
;SBTTL	OUTPRT- SEND BUFFER TO OUTPUT ROUTINE
;**********************************************************
;ASSUMPTIONS:
;	NOCRT HAS BEEN SET FOR ALL CASES WHERE CRT NOT
;	  DESIRED AS PART OF THE DESTINATION GROUP
;
OUTPRT	 MACRO	BUFFER,STPCHR
	 IF	NOT NUL	BUFFER
	LXI	D,BUFFER	; ; point to source buffer
	 ENDIF
	 IF	NOT NUL	STPCHR
	MVI	B,STPCHR
	 ELSE
	MVI	B,0		; ;default stop char for us
	 ENDIF
	CALL	OUTPUT		; ;call the routine
	 ENDM


PAGE:
;;$+PRINT	< < ?? DISK SPACE PROBLEM...
;;SBTTL EQUATES AREA --------------------------------------

DEBUG	EQU	FALSE
SHWPRC	EQU	TRUE		; Show current process if true

SWTCHR	EQU	'/'		; Switch character

	 IF	DEBUG
BITKEY	EQU	0		; Show key & pointer if set
BITLIN	EQU	1		; Show lines on output if set
BITLN1	EQU	2		; Show lines on input if set
	 ELSE
BITLN1	EQU	2		; Show lines on input if set
				; Key code disabled, lines always
				; - displayed on output
	 ENDIF

BITK06	EQU	6		; Non-default offset request
BITK80	EQU	7		; Send key only to output
;
;
;SBTTL	BEGIN EXECUTABLE CODE
;==========================================================
;
	SIZ	20,,START
SHWFLG:	DB	6		; \ what information to show -	 140h
				; / default is bitlin & bitln1
PRCSHW:	DB	SHWPRC		;				 141h
DESCND:	DB	FALSE		; \ set true if descending	 142h
				; /  - sort required
SWITCH:	DB	SWTCHR		; Switch character storage
CLSSTR:	DB	1,0CH,0,0,0,0,0,0,0 ; Clear string stuff
	XIT
;
ERXIT:	 IF	DEBUG
	SAVE
	 ENDIF

	CALL	EOTERX		; Move long routine to end of task

	 IF	DEBUG
	UNSAVE
	RST	7
	 ENDIF

EXIT:	LDA	IGNFLG ! ANA A	; Did we ignore any lines?
	TRAN	Z,EXIT9		; No - branch
	PRINTM	IGNMSG		; Yes - tell the user

EXIT9:	 IF	DEBUG
	RST	7
	 ELSE
	RST	0
	 ENDIF
;
;
;SBTTL	START- MAIN LINE CODE LOOP
;==========================================================
;
START:	CALL	GETCMD		; Get & parse command line
	CALL	MAKARY		; Form the array we'll sort
	CALL	SORT		; Sort it
	CALL	SHOW		; Output the results
	CALL	CLOSER		; Close any output file
START9:	CALL	EXIT		; Exit with trace

PAGE:
;SBTTL	MAKARY- MAKE ARRAY FROM INPUT FILE
;==========================================================
;
MAKARY:	LDA	PRCSHW		; Show processes?
	ANA	A
	TRAN	Z,MAKAR0	; No - branch
	QPRINT	SRCMSG		; 'getting source file information'

MAKAR0:	 IF	DEBUG
	LXI	H,0		; \
	SHLD	MEMVAL		; / init # nodes to 0
	SHLD	CURLIN		; Init current input line #
	LXI	H,MYDMA		; \
	SHLD	REDLIN+2	; / init offset to 0
	 ENDIF

	CALL	OPNFIL		; Open input & output files
	CALL	REDREC		; Read a record (random mode)
	ERROR	NULMSG,C	; Error if null file
	LHLD	BDOS+1		; Point to top of memory
	DCX	H		; Point to even page & leave space
	MVI	L,0
	SHLD	NODTOP		; Save as marker to end of nodes
	PUSH	H
	POPIX			; Initialize pointer to nodes

MAKAR1:	LHLD	MEMVAL		; Update # of nodes value
	INX	H
	SHLD	MEMVAL		; - and resave it
	LXI	D,-NODLEN	; Length of nodes
	DADX	D		; Point to first/next node

MAKAR2:	CALL	CLRNOD		; Clear out the new node
	LHLD	ARYPTR		; Point to base of current key
	STX	ND$STR,L	; \
	STX	ND$STR+1,H	; / save it in current node
	PUSHIX			; ^ \
	POP	H		; ^ | get the node pointer
	LXI	D,2		; ^ | into nd$ptr
	DAD	D
	STX	ND$PTR,L	; ^ |
	STX	ND$PTR+1,H	; ^ /
	LHLD	CURLIN		; Get input line number

	 IF	DEBUG
	STX	ND$LIN,L	; \
	STX	ND$LIN+1,H	; / save it in current node
	 ENDIF

	INX	H		; Update & resave it
	SHLD	CURLIN
	LHLD	SRCFCB+33	; Get next record number
	DCX	H		; - and point back to current
	STX	ND$REC,L	; \
	STX	ND$REC+1,H	; / save it in current node
	LHLD	REDLIN+2	; Get the offset word
	LXI	D,-MYDMA	; Make it a relative offset
	DAD	D		; - by subtracting the base address
	STX	ND$OFS,L	; - save it in current node

PAGE:
	CALL	REDLIN		; Get current line to intbuf
	JRC	MAKAR9		; Branch on eof
	LDA	SHWFLG		; Get flag
	BIT	BITLN1,A	; Show the line?
	JRZ	MAKAR3		; No - branch
	CALL	SHWINT		; Yes - show intbuf

MAKAR3:	CALL	SUBSTR		; Save selected substring
	ANA	A		; Nul length?
	TRAN	NZ,MAKAR4	; No - branch
	DCR	A		; \ yes - ignore this line
	STA	IGNFLG
	TRAN	MAKAR2		; /  - and loop for next

MAKAR4:	STX	ND$LEN,A	; No - save length
	TRAN	MAKAR1		; - then loop for next

MAKAR9:	PUSH	PSW		; Save flags
	LXI	D,NODLEN	; Last read fails
	DADX	D		; - so point to good node
	LHLD	MEMVAL		; Decrement # nodes
	DCX	H
	SHLD	MEMVAL		; - and resave it
	SIXD	NODPTR		; Save pointer to base of nodes
	LHLD	NODPTR		; \ get top of non-node memory
	MVI	L,0
	SHLD	OUTEND		; / - and save as top of write buffer
	POP	PSW		; Restore flags
	RET			; To calling

;SBTTL	SHWINT- SHOW INTBUF'S CONTENTS
;==========================================================
;
SHWINT:	PRINTM	INTBUF+2,,,0	; Print til trailing nul
	RET			; To calling

;SBTTL	CLRNOD- CLEAR OUT CURRENT NODE
;==========================================================
;
CLRNOD:	PUSHS	B,H		; Save registers
	MVI	B,NODLEN	; Length to clear out
	PUSHIX			; \
	POP	H		; / put pointer in HL

CLRNO1:	MVI	M,0		; Clear a byte
	INX	H		; Point to next
	DJNZ	CLRNO1		; - and loop through node
	POPS	H,B
	RET			; To calling

PAGE:
;SBTTL	SUBSTR- SAVE SELECTED SUBSTRING TO ARRAY
;==========================================================
;
;ON ENTRANCE:
;
;	INTBUF	CONTAINS VALID LINE TO PROCESS
;	ARYPTR	CONTAINS VALID POINTER TO SUBSTRING ARRAY
;
;	IF (SKPSTR) <> 0
;	  SKPSTR CONTAINS SKIP CHARACTERS WITH NULL TERM.
;	 ELSE
;	  OFFSET CONTAINS VALID OFFSET TO BASE OF KEY
;	 ENDIF
;
;	KEYLEN	CONTAINS VALID KEY LENGTH (22 IS DEFAULT)
;
;ON EXIT:
;
;	DESIRED KEY HAS BEEN MOVED TO ARRAY
;	ARYPTR HAS BEEN UPDATED
;	'A' CONTAINS LENGTH OF THIS STRING
;	B,D,H,IX,IY PRESERVED
;NOTE:
;	THE ARRAY ENTRY MAY BE OF NULL LENGTH IF SKPSTR <> 0
;	 - AND THE SKIP CHARACTERS WERE NOT FOUND IN THE
;	 - CURRENT INTBUF LINE OR THE OFFSET LENGTH WAS LONGER
;	 - THAN THE INTBUF LINE.
;
PAGE:
SUBSTR:	PUSHS	B,D,H
	LDA	SKPSTR		; Any characters to skip?
	ANA	A
	LDA	OFFSET		; (get offset vector)
	CNZ	SKPSKP		; Yes - skip them & return offset
	INR	A		; Offset found?
	TRAN	Z,SUBST9	; No - split with zero length
	DCR	A		; Yes - restore length byte
	MOV	E,A		; - and put it in DE
	MVI	D,0
	LXI	H,INTBUF+1	; Point to source's length
	MOV	B,M		; Get it & point to first ASCII
	INX	H
	CMP	B		; Line long enough?
	JRC	SUBST0		; Yes - branch
	XRA	A		; No - return zero as length
	TRAN	SUBST9		; - and goto common exit
;
SUBST0:	DAD	D		; Yes - form absolute offset
	LDED	ARYPTR		; Get current array pointer
	LDA	KEYLEN		; Get key length
	MOV	B,A
	MVI	C,0		; Init length of this string

SUBST1:	ANA	A		; End of line found?
	JRZ	SUBST3		; Yes - split
	MOV	A,M		; No - get a character
	STAX	D		; - and move it
	INX	D		; Point to next source, dest
	INX	H
	INR	C		; Increment length counter
	DJNZ	SUBST1		; - and loop

SUBST3:	XCHG
	MVI	M,0		; Form trailing null
	INX	H		; Claim space for null
	SHLD	ARYPTR		; Save array pointer
	MOV	A,C		; Return string length in a
	PUSHIX			; \
	POP	D		; / get current node pointer
	CMPHD			; Out of space yet?
	ERROR	'+++ Out of node space',NC

SUBST9:	POPS	H,D,B
	RET			; To calling

PAGE:
;SBTTL	REDREC- READ A RECORD IN RANDOM MODE
;==========================================================
;
REDREC:	CONSOLCHR BREAK,CLSABT	; Goto close&abort if user desires
	READR	SRCFCB,MYDMA	; Read a record to mydma
	JRC	REDRE9		; Branch on eof
	CALL	RESDMA		; Reset high bits in buffer
	PNTNXT	SRCFCB		; Point to next record
	XRA	A		; Clear carry

REDRE9:	RET			; - with status

;SBTTL	RESDMA- RESET HIGH BITS IN DMA BUFFER
;==========================================================
;
RESDMA:	LXI	H,MYDMA		; Point to base of buffer
	MVI	B,80H		; Buffer length
RESDM1:	RES	7,M		; Reset the high bit
	INX	H		; Point to next
	DJNZ	RESDM1		; - and loop through buffer
	RET			; To calling

;SBTTL	REDLIN- READ A LINE FROM MYDMA
;==========================================================
;
REDLIN:	GETLIN	REDREC,MYDMA,INTBUF ; Get a line to intbuf
	JRC	REDLI9		; Split if error
	LXI	D,INTBUF+2	; Point to ascii
REDLI9:	RET			; - with status

;SBTTL	CLSABT-, CLOSER- CLOSE ANY OUTPUT FILE
;==========================================================
;
CLSABT:	LXI	H,DSTFCB
	LXI	D,NEWNAM	; 'filename.$$$' fcb
	LXI	B,9		; Don't include .typ field
	LDIR	0		; Make rename fcb
	CALL	CLOSER		; Close any output file
	RENAME1	DSTFCB,NEWNAM	; Rename the file
	ERROR	'+++ Aborting at user request.'

CLOSER:	LDA	DSTFCB+1 ! CPI SPACE ; Valid file name?
	TRAN	Z,CLOSE9	; No - split
	CALL	WRITER		; Yes - flush buffer
	CLOSE	DSTFCB		; - and close file
	ERROR	CLSERR,C	; Report any error

CLOSE9:	RET			; To calling

PAGE:
;SBTTL	SKPSKP- SKIP THE SKIP_CHARACTER STRING
;==========================================================
;RETURN -1 IF END OF STRING REACHED BEFORE END OF SKIP_CHAR STRING
; ELSE RETURN LENGTH OF SKIP STRING IN 'A'
;
SKPSKP:	PUSHS	B,D,H		; Save other registers
	LXI	H,INTBUF+1	; Yes - point to length byte
	MOV	C,M		; Make length word of it
	MVI	B,0
	INX	H		; - and point to first char
	LXI	D,SKPSTR	; Point to buffer
	LDA	CTGSWI		; Contiguous string request?
	ANA	A
	JRZ	SKPSK1		; No - split
	LDAX	D		; Yes - get a character
	CCIR			; Look for it
	JPO	SKPSK8		; Not found - split
	LDA	SKPLEN		; Get length of skip string
	MOV	B,A
	DCX	H		; Point back to first character
	CALL	CMPSTR		; - and compare the strings
	JRNZ	SKPSK8		; Split if no match
	JR	SKPSK6		; - else pick up skip length

SKPSK1:	LDAX	D		; Get a character

SKPSK5:	CCIR			; Look for it
	JPO	SKPSK8		; Not found - split
	INX	D		; Get next skip character
	LDAX	D
	ANA	A		; Null?
	JRNZ	SKPSK5		; No - loop for next

SKPSK6:	LXI	D,-(INTBUF+2)	; Negated base of ascii line
	LDA	SHWFLG		; Get sense of switch
	BIT	BITK06,A	; Special offset request?
	JRZ	SKPSK7		; No - branch
	LDA	OFFSET		; Yes - get offset value
	JR	SKPSK9		; - and split to common exit

SKPSK7:	DAD	D		; Get offset in hl
	MOV	A,L		; - (actual length is in l)
	JR	SKPSK9		; All done - declare success

SKPSK8:	MVI	A,-1		; Declare failure

SKPSK9:	POPS	H,D,B		; Restore registers
	RET			; To calling

PAGE:
;SBTTL	SORT- SORT THE ARRAY
;==============================================================
;
; *** NOTE THAT THE ORIGINAL CODE FOR THIS ROUTINE MAY BE FOUND
; *** AS PART OF BACKUP.ASM
;
SORT:	LDA	DESCND		; Descending order sort request?
	ANA	A
	JRZ	SORT0		; No
	MVI	A,JC		; Yes - 0dah = 'jc dest'
	STA	NEQ		;

SORT0:	LDA	PRCSHW		; Show processes?
	ANA	A
	TRAN	Z,SORT1		; No - branch
	QWRITE	<SORTING THE FILE>

SORT1:	LHLD	MEMVAL		; Get record count
	SHLD	N1		; - and initialize
	SHLD	M1		; - values
	LXI	H,NODLEN	; Get node size
	SHLD	K1		; - and save it for sort
	LHLD	NODPTR		; Point to base of array
	SHLD	J1		; - for sort
	CALL	SHELLM		; Call the routine
	LDA	PRCSHW ! ANA A	; Show processes?
	TRAN	Z,SORT9		; No - branch
	QWRITE	<DONE SORTING>

SORT9:	RET			; Finished sorting

;SBTTL	SHELLM- from KILOBAUD april 1981 p164
;==============================================================
;
; Remark 'For fixed length records stored in memory put noumber
; of records in N1 and M1.  The length of each record is stored
; at K1, and the starting address at J1.  Start sort by calling
; location  "SHELLM".  To change to descending sort, change the
; byte at NEQ: to DAH. - instruction = "JC NSW"'
;
N1:	DW	0		; Number of records
M1:	DW	0		; Same here
K1:	DW	0		; Length of records
J1:	DW	0		; Starting address of strings
I1:	DW	0		; Ptr
ML1:	DW	0		; Ptr
DJ1:	DW	0		; Ptr
DI1:	DW	0		; Ptr
;
SHELLM:	LHLD	J1		; Get start address
;	$-PRINT

PAGE:
	PUSH	H		; Save
	LHLD	K1		; Get length
	PUSH	H		; It too

DIV:	XRA	A		; M1=m1/2
	LHLD	M1
	MOV	A,H
	RAR
	MOV	H,A
	MOV	A,L
	RAR
	MOV	L,A
	SHLD	M1		; Save new m1
;
	ORA	H		; Check if done
;;	JNZ	NDON		;*Original instruction
	JRNZ	NDON		; *
	POP	B		; Finished
	POP	D		; So return
	RET			; Now

PAGE:
;SBTTL	NDON- set k1=n1-m1
;==========================================================

NDON:	XCHG			; M1 to DE
	LHLD	N1
	MOV	A,L
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	SHLD	K1
	LXI	H,1		; Set and save i=j=1
	SHLD	J1
	SHLD	I1
;
; Calculate and save address offset = M1*I1
;
	DCR	L
	POP	B		; Length of str=i1
	PUSH	B		; Put it back

LP1:	DAD	D
	DCX	B
	MOV	A,B
	ORA	C
;;	JNZ	LP1
	JRNZ	LP1
	SHLD	ML1
;
	XCHG			; Calc & save d(j), d(i), d(i+m)
	POP	B
	POP	H
	PUSH	H
	PUSH	B

LP2:	SHLD	DJ1
	SHLD	DI1
	XCHG
	DAD	D
	XCHG			; Hl has d(i), de has d(i+m)

PAGE:
;SBTTL	CP1- compare strings and switch
;==========================================================
;
CP1:	POP	BC		; Put valid length in bc (for shellm's use)
	PUSH	BC
	CALL	COMPAR		; Perform actual comparison routine
	JZ	NSW		; If done, don't switch
;
;
; Change next instruction to JC for descending
;
NEQ:	JNC	NSW		; If d(i)<d(i+m) don't switch
SW:	MVI	B,2		; Only swapping one word
SW1:	MOV	C,M
	LDAX	D
	MOV	M,A
	MOV	A,C
	STAX	D
	INX	H
	INX	D
	DJNZ	SW1
;
;
; Strings switched, chk if I1-M1 < 1
;
; * NOTE THAT BY COMMENTING THE INSTRUCTIONS WITH TRAILING ';*''S
; * AND UNCOMMENTING THOSE THAT ARE CURRENTLY COMMENTED WITH ';*'
; * THE DSBC CODE MAY BE TESTED FOR POSSIBLE REPLACEMENT.
; * - BE SURE TO CHECK THE TIMING, TOO...
; *
	LHLD	M1		; *
	MOV	A,H		; *
	CMA			; *
	MOV	D,A		; *
	MOV	A,L		; *
	CMA			; *
	MOV	E,A		; *
;;*	LDED	M1	; GET POINTER
;;*	XRA	A	; CLEAR CARRY
	LHLD	I1
;;*	DSBC	D	;GET THE REMAINDER
;
	DAD	D		; If i1-m1<1 then jump to same as
				; No switch
	JNC	NSW

PAGE:
;SBTTL	calc new d(i), d(i+m)
;==========================================================
;
	INX	H		; Save	new i1=i1-m
	SHLD	I1
	LHLD	DI1		; Old d(i)=new d(i+m)
	XCHG
	LHLD	ML1		; Address offset
	MOV	A,E		; New d(i)=old d(i)-offset
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	DI1		; Save new d(i)
	JMP	CP1		; Goto compare strings

;SBTTL	NSW- check for j>k
;==========================================================
;
NSW:	LHLD	J1
	INX	H		; Save new j=old j+1
	SHLD	J1
	SHLD	I1
	XCHG
	LHLD	K1
	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D
	JC	DIV		; If j>k goto beginning and
				; Divide M1

;SBTTL	calc new d(j), d(i)
;==========================================================
;
	LHLD	DJ1
	POP	D
	PUSH	D
	DAD	D		; New d(j)=old d(j+1)
	XCHG
	LHLD	ML1
	XCHG
	JMP	LP2

;;	$+PRINT
PAGE:
;SBTTL	COMPAR- COMPARISON ROUTINE
;==========================================================
;
COMPAR:	PUSHS	B,D,H
	MOV	A,M		; ^\ get hl's node pointer -
	INX	H
	MOV	H,M		; ^/ - into HL
	MOV	L,A
	XCHG			; ^
	MOV	A,M		; ^\ get de's node pointer -
	INX	H
	MOV	H,M		; ^/ - into -
	MOV	L,A
	XCHG			; ^  - de
	PUSHS	D,H
	LXI	D,ND$LEN-2	; Point to length byte of node
	DAD	D
	MOV	B,M		; Get hl(string)'s length
	POPS	H,D
	PUSHS	D,H
	LXI	H,ND$LEN-2
	DAD	D
	MOV	A,M		; Get de(string)'s length
	POPS	H,D		; Restore pointer registers
	CMP	B		; Which is longer?
	JRC	COMPA1		; Already have longer - branch
	MOV	B,A		; Put longer length in 'b'

COMPA1:	MOV	A,M
	INX	H
	MOV	H,M		; HL = (HL)
	MOV L,A
	XCHG
	MOV	A,M
	INX	H
	MOV	H,M		; DE = (DE)
	MOV	L,A
	XCHG
	CALL	CMPSTR		; Compare the strings
	JRNZ	COMPA8		; - branch if unequal
	MOV	A,D		; - else ensure original
	CMP	H		; - address order
	JRNZ	COMPA8
	MOV	A,E
	CMP	L

COMPA8:	POPS	H,D,B		; Preserve flag information
	RET			; To calling

;SBTTL	CMPSTR- COMPARE STRINGS @ HL, DE FOR LENGTH 'B'
;==========================================================
;
CMPSTR:	LDAX	D		; Get a character
	CMP	M		; - and compare
	JRNZ	CMPST9		; Branch on first failure
	INX	D		; Point to next char
	INX	H		; Point to next char
	DJNZ	CMPSTR

CMPST9:	RET			; To calling

PAGE:
;SBTTL	SHOW- DISPLAY THE ARRAY CONTENTS TO CRT
;==========================================================
;
SHOW:	 IF	DEBUG
	LXI	H,0
	SHLD	CURLON		; Init current output line #
	 ENDIF
	CALL	MAKEOF		; Init the write buffer
	CALL	QQCRLF		; Fresh line to start
	LIXD	NODPTR		; Point to base of array
	LXI	D,NODLEN	; Element length
	LBCD	MEMVAL		; Number of elements
	JR	SHOW2		; Skip first increment

SHOW1:	DADX	D		; Point to next element

SHOW2:	CALL	SHWVAL		; Show a value & write it to output
	DCX	B		; Account for usage
	MOV	A,B		; Done?
	ORZ	C
	JRNZ	SHOW1		; No - loop
	RET			; Yes - return to calling

PAGE:
;SBTTL	SHWVAL- SHOW A VALUE TO THE USER
;==========================================================
;
;ON ENTRANCE:
;
;	IX POINTS TO CURRENT NODE
;
SHWVAL:	 IF	DEBUG
	SAVE			; Save all 8080 registers
	LDX	L,ND$PTR	; \
	LDX	H,ND$PTR+1	; / point to node in hl
	DCX	H		; Offset the pointer to account for nd$ptr
	DCX	H
	PUSH	H		; \
	POPIY			; / put adjusted pointer in iy
	LDA	SHWFLG		; Get flag
	BIT	BITKEY,A	; Show the key?
	TRAN	Z,SHWVA9	; No - branch
	PRINTM	KEYMSG		; Print key string address msg
	LDY	L,ND$STR	; \
	LDY	H,ND$STR+1	; / get the key string address
	PUSH	H		; - and save it
	HEXOUT			; Output it
	PRINTM	INLMSG		; Print input line number message
	LDY	L,ND$LIN	; \
	LDY	H,ND$LIN+1	; / get input line number
	HEXOUT			; Output it
	PRINTM	SPCMSG		; Output a space or two
	POP	D		; Restore pointer to key

SHWVA1:	LDAX	D		; Get a character
	ANA	A		; Done?
	JRZ	SHWVA9		; Yes - split
	PUSH	D		; No - save pointer & move char
	MOV	E,A
	MVI	C,CONOUT	; - and output it to crt
	CALL	BDOS
	POP	D		; Retrieve & point to next
	INX	D
	JR	SHWVA1		; - and loop for next

SHWVA9:	CALL	QQCRLF		; To separate lines
	UNSAVE			; Restore all registers
	LDA	SHWFLG		; Get flag
	BIT	BITLIN,A	; Show the line?
	JRZ	SHWVAZ		; No - branch
	 ENDIF

	CALL	SHWLIN		; Show input line

SHWVAZ:	RET			; To calling

PAGE:
;SBTTL	SHWLIN- SHOW SOURCE FILE LINE OR KEY
;==========================================================
;
SHWLIN:	SAVE			; Save all 8080 registers
	LDX	L,ND$PTR	; \
	LDX	H,ND$PTR+1	; / point to node in hl
	DCX	H		; Offset the pointer to account for nd$ptr
	DCX	H
	PUSH	H		; \
	POPIY			; / put adjusted pointer in iy

	 IF	DEBUG
	LDY	L,ND$LIN	; \
	LDY	H,ND$LIN+1	; / get source file line #
	PUSH	H		; - and save it
	PRINTM	OUTMSG		; - print source file line # message
	POP	H		; Retrieve line #
	DECOUT	,<SUPPRESS OR CON> ; - and send to crt
	 ENDIF

	LDA	SHWFLG		; Get contents
	BIT	BITK80,A	; Display keys only?
	TRAN	Z,SHWLI5	; No - branch
	LDY	E,ND$STR	; \ yes -
	LDY	D,ND$STR+1	; / get the key string address
	LDY	L,ND$LEN	; Get length of current line
	MVI	H,0		; Point to end of line
	DAD	D

SHWLI0:	DCX	H		; Get last character
	MOV	A,M
	ANA	A		; Null term character?
	JRZ	SHWLI0		; Yes - loop for previous
	CPI	LF		; Crlf in place?
	JRZ	SHWLI0		; Yes - loop for previous
	CPI	CR		; Half a crlf?
	JRNZ	SHWLI2		; No - send line as is
	MVI	M,0		; Yes - truncate it

SHWLI2:	OUTPRT			; - and output line

SHWLI3:	OUTPRT	CRBUF		; Yes - output it
	TRAN	SHWLI9		; - and split

SHWLI5:	LDY	L,ND$REC	; \
	LDY	H,ND$REC+1	; / get record number
	SHLD	SRCFCB+33	; - set it
	LDY	E,ND$OFS	; Get offset within record
	MVI	D,0		; Form word offset
	LXI	H,MYDMA		; Base of dma buffer
	DAD	D		; Form absolute offset
	SHLD	REDLIN+2	; Save it for getlin's use
	CALL	REDREC		; Read the record
	ERROR	'+++ bad read - aborting.',C
	CALL	REDLIN		; Read the line
	OUTPRT	INTBUF+2	; Send line to output devices

SHWLI9:	UNSAVE			; Restore all 8080 registers
	RET			; To calling

;SBTTL	MAKEOF- INITIALIZE OUTPUT BUFFER & POINTERS
;**********************************************************
;
MAKEOF:	LDA	DSTFCB+1
	CPI	SPACE
	TRAN	Z,MAKEO9	; No file - split immediatly

	 IF	DEBUG
	LDA	SHWFLG		; \
	RES	BITKEY,A	; | make sure we don't try
	STA	SHWFLG		; /  - to show keys...
	 ENDIF

	PUSHS	B,D,H
	LXI	H,SHWFLG
	BIT	BITK80,M	; Save the keys to the output file?
	JRZ	MAKEO3		; No - branch
	CALL	MAKALT		; Yes - make alternate arrangements
	TRAN	MAKEO8		; - then branch to common exit

MAKEO3:	LHLD	OUTEND		; Get pointer to end of buffer
	LXI	B,-ARRAY	; Base of buffer
	DAD	B
	PUSH	H		; Form length in BC
	POP	B
	DCX	B		; - and avoid off-by-one error
	LXI	H,ARRAY		; Point to base of buffer
	SHLD	OUTBAS		; - and save it as base output buffer
	SHLD	OUTPTR		; - init output pointer, too
	MVI	M,1AH		; Character with which to fill
	LXI	D,ARRAY+1	; Prepare for fill operation
	LDIR	0		; Fill the buffer

MAKEO8:	POPS	H,D,B

MAKEO9:	RET			; To calling

;SBTTL	MAKALT- MAKE ALTERNATE OUTPUT FILE BUFFER ARRANGEMENTS
;==========================================================
;
MAKALT:	LHLD	ARYPTR		; Get pointer to end of key array
	INR	H		; Form safe xx00h value
	MVI	L,0
	SHLD	OUTBAS		; - and save it as base output buffer
	SHLD	OUTPTR		; - init output pointer, too
	LDED	NODPTR		; Get base of node array
	CMPHD			; - and test
	ERROR	MAKMSG,NC	;
	PUSHS	H,H		; Save pointer for restoration, replication
	LDED	OUTEND		; Get end of output buffer pointer
	XCHG			; Set up for subtraction
	XRA	A
	DSBC	D		; Form remainder
	PUSH	H		; - and put it in bc
	POPS	B,D,H		; - and restore pointers
	INX	D		; Point to next
	MVI	M,CTLZ		; Initialize fill byte
	LDIR	0		; - and the rest of the buffer
	RET			; To calling

PAGE:
;SBTTL	OUTPUT- ALL 'OUTPRT' REQUESTS COME HERE
;**********************************************************
;
OUTPUT:	LDA	DSTFLG		; Set destination
	MOV	C,A

OUTPU1:	PUSHS	B,D		; Save registers
	CALL	@PRINTM		; Print the line
	POPS	D,B		; Restore registers
	LDA	DSTFCB+1	; Test for file
	CPI	SPACE		; Valid file name?
	JRZ	OUTPU9		; No - branch to common exit
	CALL	PUTIT		; Yes - send line to file

OUTPU9:	RET			; To calling

;SBTTL	WRITER- WRITE A BLOCK
;**********************************************************
;
WRITER:	SAVE			; Save all 8080 registers
	LHLD	OUTBAS		; Get base of output
	LXI	D,-80H		; \
	DAD	D		; / - and predecrement it
	PUSH	H		; Prepare to pop

WRITE1:	POP	H		; Retrieve pointer
	LXI	D,80H		; Offset to first/next buffer
	DAD	D		; Form current pointer in hl
	XCHG			; - and swap it to de
	LHLD	OUTPTR		; Retrieve e_o_buffer pointer
	CMPHD			; Are we done?
	TRAN	C,WRITE9	; Yes - split
	PUSH	D		; No - save pointer
	WRITES	DSTFCB,,WRITEX	; Write a 128. byte buffer
	TRAN	WRITE1		; - and loop for possible next

WRITE9:	CALL	MAKEOF		; Fill the buffer with eof markers
	UNSAVE			; Restore all 8080 registers
	LHLD	OUTBAS		; Reset output pointer to base of buffer

WRITEZ:	RET			; To calling

WRITEX:	ERROR	'+++ disk full'	; Error exit for write

PAGE:
;SBTTL	PUTIT- WRITE A LINE TO OUTPUT FILE
;**********************************************************
;	PUTTMP	WRITER,ARRAY,OUTEND,OUTPTR
; THE CODE BELOW USES THE PUTTMP MACRO (ABOVE) AS ITS
; SOURCE - THE UNALTERED MACRO IS FOUND IN FILIO.LIB
;
PUTIT:	LHLD	OUTPTR		; Get current outbuf pointer

PUTIT1:	LDAX	D		; Get a char & point to next
	INX	D
	ANA	A		; End of buffer?
	JRZ	PUTIT9		; Yes - split
	MOV	M,A		; No - move the character in
	INX	H		; Point to next destination
	PUSH	D		; Save input pointer
	LDED	OUTEND		; Get end of our buffer
	CMPHD			; Full buffer?
	JRC	PUTIT2		; No - branch
	CALL	WRITER		; Yes - write to disk &
	LHLD	OUTBAS		; - reset output pointer

PUTIT2:	POP	D		; Restore input pointer
	JR	PUTIT1		; - then loop for next char

PUTIT9:	SHLD	OUTPTR		; Save pointer for next
	RET			; To calling

;SBTTL	QQCRLF- CRLF TO CRT - ALL REGISTERS PRESERVED
;==========================================================
;
QQCRLF:	SAVE
	CALL	QQCRL0
	UNSAVE
	RET			; To calling

QQCRL0:	MVI	E,CR
	CALL	QQCRL1
	MVI	E,LF
QQCRL1:	MVI	C,CONOUT
	CALL	BDOS
	RET			; To qqcrlf/calling

PAGE:
;SBTTL	EOTERX- CLEAR SCREEN ROUTINE FOR ERXIT
;==========================================================
;
EOTERX:	LXI	H,MENU		; Get known address
	CMPHD			; Menu request?
	JRNZ	ERXIT2		; No - branch
	LXI	H,CLSSTR	; Yes - point to cls buffer
	MOV	B,M		; Get length byte
	MOV	A,B		; Null string?
	ANA	A
	JRZ	ERXIT1		; Yes - split

ERXIT0:	INX	H		; No - get a character
	MOV	E,M
	PUSHS	B,H		; Save the counter & pointer
	MVI	C,CONOUT	; Output the character
	CALL	BDOS
	POPS	H,B		; Restore pointer & counter
	DJNZ	ERXIT0		; - and loop for next char

ERXIT1:	LXI	D,MENU		; Point to the original msg

ERXIT2:	LDAX	D		; Follow the exit status convention
	STA	MAGICSTATUS
	MVI	C,PRTSTR	; Print the message

	 IF	DEBUG
	CALL	BDOS		; For tracing
	RET
	 ELSE
	JMP	BDOS		; For task size & execution speed
	 ENDIF
PAGE:
;SBTTL	DATA & BUFFER AREAS
;==========================================================
;
DSTFLG:	DB	CON		; Console only destination
OUTPTR:	DW	0		; Output pointer
OUTBAS:	DW	0		; Base of output buffer
OUTEND:	DW	0		; Top of write buffer pointer (xx00h)

	 IF	DEBUG
FCBFLG:	DB	0		; Fcb move/no request flag
	 ENDIF

CRBUF:	DB	CR,LF,0		; Buffer for outprt's use
MYDMA:	DS	80H		; Input dma buffer
INTBUF:	DB	255		; Maximum length of line
	DB	0		; Length of current line
	DS	256		; + trailing null
;
;
; ------ KEY RELATED STUFF ---------------
;
IGNFLG:	DB	0		; If set, tell user we ignored some lines
CURLIN:	DW	0		; Current input line number
CURLON:	DW	0		; Current output line counter

;BITKEY EQU	0		;SHOW KEY & POINTER IF SET
;BITLIN EQU	1		;SHOW SOURCE LINE IF SET
;BITLN1 EQU	2		;SHOW LINES IN MAKARY IF SET
CTGSWI:	DB	0		; Contiguous skipstring request flag
OFFSET:	DB	0		; Offset to skip
KEYLEN:	DB	22		; Default (from j.m.c.jr.)
SKPLEN:	DB	0		; Length of skip string
SKPSTR:	DB	0		; Serves as flag byte
	DS	20		; Maximum length of skip string

PAGE:
; ------ NODE POINTERS -------------------
;
NODPTR:	DW	0		; Pointer to base of nodes
NODTOP:	DW	0		; Address after last node
ARYPTR:	DW	ARRAY		; Pointer to next available substring
MEMVAL:	DW	0		; Number of nodes constructed
;
;
; ------ ERROR & OTHER MESSAGES ----------
;
OPNPTR:	DW	OPNERR		; Error pointer

	 IF	DEBUG
SPCMSG:	DB	'  $'		; Space message
INLMSG:	DB	' line #> $'	; Input line number
OUTMSG:	DB	' olin #> $'	; Output line number
KEYMSG:	DB	'  key #> $'	; Key pointer value
	 ENDIF

CLSERR:	DB	CR,LF,'+++ Error - can''t close output file!$'
MAKMSG:	DB	CR,LF,'+++ No space for output file.$'
OH$OH:	DB	CR,LF,'File exists - erase it? $'
USRABT:	DB	CR,LF,'+++ Aborting at user request.$'
FCBMSG:	DB	CR,LF,'+++ Bad source or destination FCB$'
BADDST:	DB	CR,LF,'+++ Bad characters in destination FCB$'
IGNMSG:	DB	CR,LF,'Some lines ignored - null or no key'
	DB	' or too short.',CR,LF,'$'

PAGE:
PARM1:	DW	0		; Pointer to first command line parameter
PARM2:	DW	0		; Pointer to second command line parameter

DLMBUF:	DB	'<([{''"'	; Left delimiters
	DB	'>)]}''"'	; Matching right delimiters
DELLEN	EQU	$-DLMBUF	; Length of buffer

;;		  'FILENAMETYP'
SRCFCB:	DB	0,'           ',0,0,0,0,0,0,0,0
	DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

;;		  'FILENAMETYP'
DSTFCB:	DB	0,'           ',0,0,0,0,0,0,0,0
	DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

NEWNAM:	DB	0,'        $$$',0,0,0,0,0,0,0,0
	DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

	NEXTPAGE
ARRAY	EQU	$		; Base of key array
SRCMSG:	DB	CR,LF,LF,'Getting source file information.'
	DB	CR,LF,'$'
NULMSG:	DB	CR,LF,'+++ Null File - can''t read first record!$'
OPNERR:	DB	CR,LF,'+++ Error - can''t open input file!$'
OPNORR:	DB	CR,LF,'+++ Error - can''t open output file!$'
;
;
; --------- NODE EXPLANATION -------------
;
; ND$PTR POINTS TO ITS ASSOCIATED NODE (ALL NODE-RELATIVE
;	VALUES ARE THEN DECREMENTED BY 2)
; ONLY THE ND$PTR WORDS ARE SWAPPED - THE OTHER 6 OR 8 BYTES
;	ARE LEFT IN PLACE
;
; --------- NODE DEFINITIONS -------------
;
ND$BAS	EQU	$		; Base of node
ND$PTR	EQU	$-ND$BAS	; Pointer to this node
	DW	0
ND$STR	EQU	$-ND$BAS	; String offset
	DW	0
ND$REC	EQU	$-ND$BAS	; Record number
	DW	0
ND$OFS	EQU	$-ND$BAS	; Offset to current line
	DB	0
ND$LEN	EQU	$-ND$BAS	; Length of current line
	DB	0

	 IF	DEBUG
ND$LIN	EQU	$-ND$BAS	; Input line number (0->n)
	DW	0
NODLEN	EQU	$-ND$BAS	; Account for length
	 ELSE
NODLEN	EQU	$-ND$BAS
	 ENDIF
;
;
; ------ END OF NODE DEFINITIONS ---------
;
PAGE:
MENU:	DB	'                            '
	DB	'SRT.COM Version '
;
;
; MENU & ORIGINAL TEXT FOLLOWS IN SOURCE LISTING
;
	$-PRINT
	VERSION	THSVER,REVISE
	DB	CR,LF
	DB	'Usage: ',CR,LF
	DB	'A>SRT OUTFIL.TYP=INFIL.TYP [/switches] ',CR,LF
	DB	'Switches take one of two forms:',CR,LF
	DB	'                             /[offs'
	DB	'et],[keylen] ',CR,LF
	DB	'     where  offset and keylen are n'
	DB	'umeric  and represent  the  offset   from ',CR,LF
	DB	'the beginning of  the line and the '
	DB	'length of the  key, respectively; and ',CR,LF
	DB	'                /<skip string>[swit'
	DB	'ches][,keylen][switches] ',CR,LF
	DB	'     where  the "<" character can b'
	DB	'e any one of <,(,",'',{ or [.   A matching ',CR,LF
	DB	'right  delimiter is required as sho'
	DB	'wn in the example.   A switch  may  occur ',CR,LF
	DB	'after  the skip string either befor'
	DB	'e or after the keylen parameter.   "C" in ',CR,LF
	DB	'either position produces a contiguo'
	DB	'us skip_string request,  "K" says to save ',CR,LF
	DB	'the  keys as output,  and "O" sets '
	DB	'the offset value manually.   The  default ',CR,LF
	DB	'offset is the character following t'
	DB	'he last skip string character.  Delimiter ',CR,LF
	DB	'nesting  is  not allowed.   Note th'
	DB	'at in both cases the keylen  argument  is ',CR,LF
	DB	'optional and defaults to 22 decimal'
	DB	'. ',CR,LF
	DB	'     SRT also takes three special o'
	DB	'utput devices;  LST:, CON: and PUN:. They ',CR,LF
	DB	'perform  as in PIP and STAT.   Rese'
	DB	't 140h,  141h to disable source  display, ',CR,LF
	DB	'process  messages.   Set 142h for d'
	DB	'escending sort.   143h = switch character ',CR,LF
	DB	'storage  location.  Byte  144h begi'
	DB	'ns the clear screen  sequence,  which  is ',CR,LF
	DB	'stored in the format: db len,ch1,ch'
	DB	'2...ch8. ',CR,LF
	DB	'     To use lower case or other dif'
	DB	'ficult/impossible characters in the  skip ',CR,LF
	DB	'string,  use  the command format "S'
	DB	'RT <CMDLIN.FIL",  where the first line of ',CR,LF
	DB	'CMDLIN.FIL consists of the desired '
	DB	'command tail term. by carriage return.'
	DB	'$'
;
;		     SRT.COM Version 1.2x
; Usage:
; A>SRT OUTFIL.TYP=INFIL.TYP [/switches]
; Switches take one of two forms:
;
;		      /[offset],[keylen]
;
; where offset and keylen are numeric and represent  the offset from
; the beginning of the line and the length of the key, respectively;
; and:
;		 /<skip string>[switches][,keylen][switches]
;
; where the "<" char. can be any one of <,(,",',{ or [.  A matching
; right delimiter is required as shown in the example. A switch may
; occur after  the skip-string, either	before or after  the keylen
; parameter.  "C" in either position  produces	a contiguous  skip-
; string request, "K" says to save the keys as output, and "O" sets
; the offset value  manually.  The default offset  is the character
; following  the last skip-string character.  Delimiter  nesting is
; not allowed.	Note that in both cases  the keylen argument is op-
; tional and defaults  to 22 decimal.  SRT also takes three special
; output devices:  LST:, CON: and PUN:	They perform  as in PIP and
; STAT.  Reset 140h, 141h to disable  source  display, process mes-
; sages.   Set 142h for  descending sort.   143h = switch character
; storage location.  Byte  144h begins	the clear  screen  sequence,
; which is stored in the format:  DB LEN,CH1,CH2..CH8.	To use lower
; case or other difficult/impossible  characters in the skip-string,
; use the command format "SRT <CMDLIN.FIL",  where the first line of
; CMDLIN.FIL consists of the desired command tail terminated by car-
; riage return.
;
	$+PRINT
PAGE:
;SBTTL	GTTCM0- DEBUGGING FLAG PART OF GETCMD
;==========================================================
;
	 IF	DEBUG
GTTCM0:	QWRITE	<SHOW THE KEYS?	>
	PAUSE
	CPI	'Y'
	JRNZ	GTTCM1
	LDA	SHWFLG
	SETB	BITKEY,A
	STA	SHWFLG

GTTCM1:	QWRITE	<SHOW THE SOURCE LINES?	>
	PAUSE
	CPI	'Y'
	JRNZ	GTTCM2
	LDA	SHWFLG
	SETB	BITLIN,A
	STA	SHWFLG

GTTCM2:	QWRITE	<SHOW THE SOURCE LINES ON INPUT? >
	PAUSE
	CPI	'Y'
	JRNZ	GTTCM3
	LDA	SHWFLG
	SETB	BITLN1,A
	STA	SHWFLG

GTTCM3:	CALL	QQCRLF		; New line
	RET			; To calling
	 ENDIF

PAGE:
;SBTTL	GETCMD- GET ALL PARAMETERS FROM COMMAND LINE
;==========================================================
;
GETCMD:	LXI	H,80H		; Point to command line
	MOV	A,M
	ANA	A		; Null command line?
	ERROR	MENU,Z		; Split with menu if so
	MOV	B,A		; No - move length into ctr
	INX	H		; Point to first ascii

GETCM1:	MOV	A,M		; Get a character
	CPI	SPACE		; Space?
	JRNZ	GETCM2		; No - branch for next test
	INX	H		; Yes - point to next ascii
	DJNZ	GETCM1		; - and loop for next
	ERROR	MENU		; Nul buffer - split
;
;
; -- NON-SPACE FOUND - GET OTHER POINTERS AS PRESENT/REQUIRED
;
GETCM2:	SHLD	PARM1		; Save pointer to it
	CPI	'<'		; Redirection switch?
	JRNZ	GETCM2A		; No - branch
	CALL	REGET		; Yes - get input line from file
	TRAN	GETCMD		; - and loop for fresh effort

GETCM2A:LDA	SWITCH		; Get switch character
	MOV	C,A

GETCM3:	MOV	A,M		; Get character
	CPI	'='		; Found source fcb?
	JRNZ	GETCM4		; No - branch
	SHLD	PARM2		; Yes - save as second parameter

GETCM4:	CMP	C		; Found switch character?
	JRZ	GETCM5		; Yes - branch
	INX	H		; - and point to next
	DJNZ	GETCM3		; No - loop for next
	TRAN	GETC5A		; End of buffer - branch
;
;
; -- ALL PARAMETER BLOCKS FOUND AT THIS POINT
;
GETCM5:	CALL	GETSWI		; Get any switches
	MVI	M,0		; Form delimiter for rightmost filespec

GETC5A:	LHLD	PARM2		; Get potential source fcb
	MOV	A,H		; Do we have one?
	ORA	L
	JRZ	GETCM6		; Not here - branch
	MVI	M,0		; Form delimiter (for parm1)
	INX	H		; - point to filespec
	CALL	MAKSRC		; - and make source fcb
	LHLD	PARM1		; Point to destination filespec
	CALL	MAKDST		; - and make destination fcb
	TRAN	GETCM9		; Goto common exit point

GETCM6:	LHLD	PARM1		; Get pointer
	CALL	MAKSRC		; - and make fcb

GETCM9:	 IF	DEBUG
	CALL	GTTCM0		; Get debugging flags
	 ENDIF

	LXI	D,SRCFCB
	LXI	H,DSTFCB
	MVI	B,12		; Length of fcb
	CALL	CMPSTR		; Compare them
	ERROR	'+++ Source & destination must be different',Z
	RET			; To calling

PAGE:
;SBTTL	REGET- GET COMMAND LINE FROM FILE @HL+1
;==========================================================
;
REGET:	INX	H		; Point to filename
	XCHG
	FILFCB	,5CH		; - and make fcb
	OPEN	'I',5CH,REGRET	; Get it?
	READS	5CH,81H,REGRET	; Read first record offset by one
	LXI	H,81H		; - and point to base of record
	LXI	B,80H		; Length of buffer
	MVI	A,CR		; Search character
	CCIR	0		; Look for it
	JRNZ	REGRET		; Split if no line
	DCX	H		; Form null terminator
	MVI	M,0
	MVI	A,80H		; Length of original counter
	SUB	C		; Form length used
	STA	80H		; - and save as length byte
	RET			; To calling
REGRET:	ERROR	'+++ Null or missing command line file'

PAGE:
;SBTTL	GETSWI- GET ALL SWITCHES
;==========================================================
;
; ON ENTRANCE:
;
;	HL,B SET UP AS POINTER, COUNTER
;	 - WITH HL POINTING TO SWITCH CHARACTER
; PDL:
; GETSWI:
; DO UNTIL (SWITCH CHARACTER FOUND)
;   POINT TO NEXT CHARACTER
;
;   IF (END OF BUFFER FOUND) THEN
;     GOTO [GETSW9]
;   ENDIF
;
; ENDDO
; GETSW1:
; DO WHILE (WHITE SPACE FOUND)
;   POINT TO NEXT CHARACTER
;
;   IF (END OF BUFFER FOUND) THEN
;     GOTO [GETSW9]
;   ENDIF
;
; ENDDO
; GETSW5:
;
; IF (CHARACTER IS NUMERIC) THEN
;   MAKE VALUE [MAKVAL]
;   SAVE VALUE AS OFFSET VALUE
;   SKIP OVER POTENTIAL COMMA CHARACTER
;   MAKE VALUE [MAKVAL]

;   IF (VALUE <> 0) THEN
;     SAVE VALUE AS KEY LENGTH
;   ENDIF
;
;   GOTO [GETSW9] TO EXIT
; ELSE
;   GET SKIP CHARACTERS [GETSKP]
; ENDIF
;
; GETSW9:
;   RETURN TO CALLING
; END PDL:
;
; * FIND SWITCH CHARACTER
;
GETSWI:	LDA	SWITCH		; Get switch character
	MOV	C,A
	SAVE			; Save all 8080 registers
	MOV	A,M		; Get next character
	CMP	C		; Switch character?
	JRZ	GETSW1		; Yes - split
	INX	H		; No - point to next
	DJNZ	GETSWI		; - and loop
	TRAN	GETSW9		; Eobuf - split altogether

GETSW1:	INX	H		; Point to next
	DCR	B		; Account for usage
	TRAN	Z,GETSW9	; - and split if eobuf
;
;
; * POINT PAST ANY WHITE SPACE
;
GETSW2:	MOV	A,M		; Get next character
	CPI	'K'		; Save keys as output?
	CZ	SETKEY		; Yes - set the switch
	CPI	'O'		; Set if offset '0' request
	CZ	SETO
	CPI	SPACE		; Space found?
	JRNZ	GETSW5		; No - split
	INX	H		; Yes - point to next
	DJNZ	GETSW2		; - and loop for next char
	TRAN	GETSW9		; Eobuf - split altogether
;
;
; * IF FIRST PARAMETER IS NUMERIC, GET IT & TRY FOR SECOND
;
GETSW5:	SUI	30H		; Test for numeric range
	JM	GETSW8		; Must be skip characters or illegal
	CPI	10		; Test for numeric range
	JRNC	GETSW8		; Must be skip characters or illegal
	CALL	MAKVAL		; Get value of block
	MOV	A,E		; Save as line offset
	STA	OFFSET
	MOV	A,B		; End of buffer?
	ANA	A
	JRZ	GETSW9		; Yes - split
	INX	H		; No - point to next character
	DCR	B		; - account for usage
	JRZ	GETSW9		; - and branch on end of buffer
	CALL	MAKVAL		; Make value if one is available
	MOV	A,E		; Nul length?
	ANA	A
	JRZ	GETSW9		; Yes - goto to common exit
	STA	KEYLEN		; No - save key length
	JR	GETSW9		; - then goto common exit
;
;
; * ELSE TRY FOR SKIP_CHARACTER BUFFER
;
GETSW8:	MOV	A,B		; End of buffer? (this should be unnecessary)
	ANA	A
	JRZ	GETSW9		; Yes - split
	CALL	MAKSKP		; Get skip characters & length

GETSW9:	MOV	A,M		; Get character
	CPI	'O'		; Set if offset '0' request
	CZ	SETO
	CPI	'K'		; Save key as output?
	CZ	SETKEY		; Yes
	UNSAVE			; Restore all 8080 registers
	RET			; To calling

PAGE:
;SBTTL	MAKVAL- MAKE BINARY VALUE FROM BUFFER @HL
;==========================================================
;
; ON ENTRANCE:

;	HL POINTS TO BUFFER
;	B  = REMAINING LENGTH OF BUFFER
; ON EXIT:
;
;	HL, B DEFINE REMAINING BUFFER & LENGTH
;	VALUE IN DE
;
MAKVAL:	MOV	A,B		; End of buffer?
	ANA	A
	TRAN	Z,MAKVA9	; Yes - split
	LXI	D,0		; Init value

MAKVA1:	MOV	A,M		; Get a character
	SUI	30H		; Make it binary
	JM	MAKVA9		; Split if out of range
	CPI	10		; Test high side
	JRNC	MAKVA9		; Split if out of range
	CALL	SUMMER		; Sum the value in a to de
	INX	H		; - and point to next
	DJNZ	MAKVA1		; Loop through buffer

MAKVA9:	RET			; To calling

;PAGE
;SBTTL	SUMMER- SUM 'A' TO DE - PRESERVE ALL OTHER REGISTERS
;==========================================================
;
SUMMER:	PUSH	H		; Save pointer
	XCHG			; *2
	DAD	H
	MOV	E,L		; Replicate for later use
	MOV	D,H
	DAD	H		; *4
	DAD	H		; *8
	DAD	D		; *10
	MOV	E,A		; Form word from current 'a'
	MVI	D,0
	DAD	D		; Sum new value
	XCHG			; Restore registers
	POP	H
	RET			; To calling

PAGE:
;SBTTL	MAKSRC- MAKE SOURCE FCB FROM FILESPEC AT HL
;==========================================================
;
; ON ENTRANCE:
;
;	HL POINTS TO SOURCE FILESPEC
; ON EXIT:
;
;	SRCFCB MADE & VALIDATED OR FATAL ERROR DECLARED
;
MAKSRC:	LXI	D,SRCFCB
	CALL	MAKFCB
	VALIDATE SRCFCB,SRCERR	; Make sure valid fcb
	RET			; To calling

SRCERR:	ERROR	'+++ Bad characters in source FCB'

;PAGE
;SBTTL	MAKDST- MAKE DESTINATION FCB FROM @HL
;==========================================================
;
; ON ENTRANCE:
;
;	HL POINTS TO DESTINATION FCB
; PROCESSING:
;
;	RECOGNISE CON:,PUN:,LST: AS SPECIAL CASES (ONLY THE
;		- FIRST CHARACTER NEEDS TO BE TESTED)
; ON EXIT:
;
;	DESTINATION FCB SET UP OR OUTPUT BYTE = OUTPUT DEVICE
;	 - OR FATAL ERROR DECLARED
;
MAKDST:	SAVE

MAKDS1:	PUSHS	D,H
	LXI	D,3		; Point to potential ':'
	DAD	D		; - in HL
	MOV	A,M		; Found special case?
	CPI	':'
	POPS	H,D		; (restore registers)
	TRAN	NZ,MAKDS2	; No - branch
	MOV	A,M		; Yes - get first character
	CPI	'C'		; Console request?
	TRAN	Z,MAKCON	; Yes - set switch
	CPI	'P'		; Punch request?
	TRAN	Z,MAKPUN	; Yes - set switch
	CPI	'L'		; List request?
	TRAN	Z,MAKLST	; Yes  - set switch
	ERROR	'+++ Special destination error'	; No - report error & abort

MAKDS2:	LXI	D,DSTFCB	; Point to destination fcb
	CALL	MAKFCB		; Make fcb from buffer @hl
	VALIDATE DSTFCB,DSTERR	; Make sure valid fcb
	TRAN	MAKDS9		; - and branch to common exit
;
;
; -- NOTE THAT MAKCON IS ONLY INCLUDED FOR COMPLETENESS, AS THE CONSOLE
;    ON SWITCH IS SET BY DEFAULT AT ASSEMBLY TIME.
;
MAKCON:	LDA	DSTFLG		; Get current sense of switch
	SETB	CON,A		; Set con: output flag
	JR	MAKCMN		; - and branch to common code

MAKPUN:	LDA	DSTFLG		; Get current sense of switch
	SETB	PUNOUT,A	; Set pun: output flag
	JR	MAKCMN		; - and branch to common code

MAKLST:	LDA	DSTFLG		; Get current sense of switch
	SETB	LSTOUT,A	; Set lst: output flag

MAKCMN:	STA	DSTFLG		; Save output device switch
	MVI	A,SPACE		; \
	STA	DSTFCB+1	; / - and ensure bad file name

MAKDS9:	UNSAVE			; Restore all 8080 registers
	RET			; To calling

DSTERR:	ERROR	BADDST

PAGE:
;SBTTL	MAKSKP- GET SKIP CHARACTERS FROM COMMAND LINE
;==========================================================
;
; ON ENTRANCE:
;
;	HL POINTS TO COMMAND LINE
;	B  = REMAINING LENGTH
; ON EXIT:
;
;	SKIP CHARACTERS HAVE BEEN PLACED IN SKIP STRING BUFFER
;	HL, B DEFINE REMAINING BUFFER & LENGTH
;
MAKSKP:	XCHG			; Set up for us

MAKSK1:	PUSH	B		; Save counter
	LXI	B,DELLEN/2	; Look at left delimiters
	LDAX	D		; Get a character
	LXI	H,DLMBUF	; Point to delimiter buffer
	CCIR			; Match on current char?
	JRZ	MAKSK5		; Yes - branch
	POP	B		; No - try again
	INX	D		; Point to next source
	DJNZ	MAKSK1		; - and loop for next try
	XCHG			; Restore buffer pointer
	TRAN	MAKSK9		; - and goto common exit
;
;
; -- AT THIS POINT WE HAVE A MATCH ON THE LEFT DELIMITER
; -- NOW MOVE CHARACTERS UNTIL MATCHING RIGHT DEL FOUND.
;
; --	 IF (END OF STRING FOUND BEFORE END OF COMMAND BUFFER) THEN
; --	  TRY FOR KEY LENGTH REQUEST
; --	 ENDIF
;
MAKSK5:	POP	B		; Restore counter register
	PUSH	D		; Save command line pointer
	LXI	D,(DELLEN/2)-1	; Offset to matching right delimiter
	DAD	D		; Point to it
	MOV	C,M		; - and get it for us
	POP	H		; Restore command line pointer
	INX	H		; Point past left delimiter
	DCR	B		; \  account for usage
	MOV	A,B
	ANA	A		; | end of command line buffer?
	JRZ	MAKSKZ		; /  yes - split
	LXI	D,SKPSTR	; No - point to skip string buffer

MAKSK6:	MOV	A,M		; End of buffer reached?
	CMP	C
	JRZ	MAKSK9		; Yes - split
	STAX	D		; No - save it
	INX	H		; Point to next source, dest
	INX	D
	DJNZ	MAKSK6		; - and loop for next

MAKSK9:	XCHG			; Form NUL terminator in SKPSTR
	MVI	M,0
	XCHG			; Restore registers
	PUSHS	D,H		; Save registers
	LXI	H,-SKPSTR	; - and form length byte
	DAD	D		; - in 'l'
	MOV	A,L		; - and save it in length byte
	STA	SKPLEN
	POPS	H,D		; Restore registers
	MOV	A,B		; End of buffer reached?
	ANA	A
	JRZ	MAKSKZ		; Yes - split altogether
	INX	H		; No - point to next source
	DCR	B
	MOV	A,B		; End of buffer reached?
	ANA	A
	JRZ	MAKSKZ		; Yes - split altogether

MAKSKA:	MOV	A,M		; Get a character
	CPI	','		; Length request?
	JRZ	MAKSKD		; Yes - branch
	CPI	'O'		; Set if offset request
	CZ	SETO
	CPI	'K'		; Save key as output?
	CZ	SETKEY		; Yes
	CPI	'C'		; Contiguous request?
	JRNZ	MAKSKB		; No - branch
	STA	CTGSWI		; Yes - set switch

MAKSKB:	INX	H		; Point to next
	DJNZ	MAKSKA		; - and loop for next
	JR	MAKSKZ		; - bail out if not found

MAKSKD:	INX	H		; Found ',' - point to next source
	DCR	B
	MOV	A,B		; End of buffer reached?
	ANA	A
	JRZ	MAKSKZ		; Yes - split altogether
	CALL	MAKVAL		; Determine the key length value
	MOV	A,E		; Nul value?
	ANA	A
	JRZ	MAKSKE		; Yes - branch
	STA	KEYLEN		; No - save it

MAKSKE:	MOV	A,B		; End of buffer reached?
	ANA	A
	JRZ	MAKSKZ		; Yes - split altogether

MAKSKF:	MOV	A,M		; Get next character
	CPI	'O'		; Set if offset '0' request
	CZ	SETO
	CPI	'K'		; Save key as output?
	CZ	SETKEY		; Yes
	CPI	'C'		; Contiguous request?
	JRNZ	MAKSKG		; No - branch
	STA	CTGSWI		; Yes - set switch

MAKSKG:	INX	H		; Point to next
	DJNZ	MAKSKA		; - and loop for next

MAKSKZ:	RET			; To calling

;SBTTL	SETKEY-, SETO- SET KEY=OUTPUT, SET NON-DEFAULT OFFSET
;==========================================================
;
SETKEY:	PUSH	H		; Save register
	LXI	H,SHWFLG	; Point to flag
	SETB	BITK80,M	; Set the bit
	POP	H		; Restore register
	RET			; To calling

SETO:	PUSH	H		; Save register
	LXI	H,SHWFLG	; Point to flag
	SETB	BITK06,M	; Set the bit
	POP	H		; Restore register

	PUSHS	B,H		; Save registers
	INX	H		; Test for end of buffer
	DCR	B
	JRZ	SETO9		; Branch if eobuf
	CALL	MAKVAL		; - else get the value
	MOV	A,E		; - and save it
	STA	OFFSET

SETO9:	POPS	H,B		; Restore registers
	RET			; To calling

PAGE:
;SBTTL	MAKFCB- MAKE FCB FROM SOURCE @ HL TO DST @ DE
;==========================================================
;
MAKFCB:	PUSHS	B,D,H,D,H
	LXI	D,INTBUF+1	; Point to dummy buffer
	LXI	B,16		; Generous length
	LDIR	0		; Move it in
	POPS	D,H		; Reverse registers, too...
	FILFCB	INTBUF+1	; Make a valid fcb for us
	ERROR	FCBMSG,C	; Split on error
	POPS	H,D,B		; Pass flag info to calling
	RET			; To calling

PAGE:
;SBTTL	OPNFIL- OPEN INPUT & OUTPUT FILES
;==========================================================
;
OPNFIL:	OPEN	'I',SRCFCB,OPNFIX ; Ptr set at assy time
	LDA	DSTFCB+1	; Valid FCB?
	CPI	SPACE
	TRAN	Z,OPNFI9	; No - split
	LXI	H,OPNORR	; Set error message pointer
	SHLD	OPNPTR
	OPEN	'I',DSTFCB	; Check for existing file
	TRAN	C,OPNFI8	; No file - branch
	PRINTM	OH$OH		; Tell user file exists
	PAUSE			; - and get response
	ANI	UPPER
	CPI	'Y'		; Ok to trash it?
	ERROR	USRABT,NZ	; No - split

OPNFI8:	OPEN	'O',DSTFCB,OPNFIX ; Yes - open the file
OPNFI9:	RET			; To calling

OPNFIX:	ERROR	(OPNPTR)	; Output appropriate error message
??XX??	EQU	$
;SBTTL	END OF TASK


	END	100H