*  PROGRAM:  PROTECT
*  AUTHOR:  RICHARD CONN
*  VERSION:  1.0
*  DATE:  26 OCT 81
*  PREVIOUS VERSIONS:  None

VERS	EQU	10	; Version Number

*
*  PROTECT --
*	PROTECT is used to set the file protection and tag attribute bits
* for CP/M 2.x files.  It is invoked via command lines of the following
* forms:
*
*		PROTECT afn keys	<-- Set unconditionally
*		PROTECT afn keys /I	<-- Inspect Mode
*		PROTECT afn /S		<-- Set Each ufn Individually
*
*	In the above examples, the reference 'keys' is a string of zero or
* more characters which may be any of the following:
*
*		R <-- Set R/O Attribute
*		S <-- Set SYS Attribute
*		n <-- Set Tag Attribute (1 <= n <= 4)
*
*	Examples:
*		PROTECT *.COM RS	<-- Sets all COM files to R/O System
*		PROTECT *.COM RS /I	<-- Same, with user approval
*		PROTECT *.COM /S	<-- Allow user to specify for each file
*		PROTECT MYPROG.COM 1R	<-- Sets Tag Bit 1 and R/O Attribute
*

*
*  PROT CONSTANTS
*
DELIM		EQU	'/'	; OPTION DELIMITER CHAR
INSP$OPT	EQU	'I'	; OPTION LETTER FOR INSPECTION
SET$OPT		EQU	'S'	; OPTION LETTER FOR SETTING INDIVIDUAL FILES
ENTRY$SIZE	EQU	12	; NUMBER OF BYTES/DIRECTORY ENTRY STORED

*
*  CP/M CONSTANTS
*
BDOS	EQU	5	; BDOS ENTRY
FCB	EQU	5CH	; FIRST FCB
FCB2	EQU	5CH+16	; 2ND FCB
TBUFF	EQU	80H	; INPUT LINE
CR	EQU	0DH	; <CR>
LF	EQU	0AH	; <LF>

	ORG	100H

*
*  SAVE OLD STACK PTR AND SET NEW
*
	LXI	H,0	; SAVE STACK PTR
	DAD	SP
	SHLD	STACK	; SAVE SP IN BUFFER
	LXI	SP,STACK	; RESET STACK PTR

*
*  PRINT PROGRAM NAME
*
	CALL	PRINT$MESSAGE
	DB	'PROTECT  Version '
	DB	VERS/10+'0','.',(VERS MOD 10)+'0'
	DB	0

*
*  CHECK FOR USER-SPECIFIED DRIVE AND LOG IN IF SELECTED
*
	LDA	FCB	; GET FROM FCB BYTE
	STA	UDRIVE	; SET FLAG
	ORA	A	; 0=DEFAULT
	JZ	CK$VERS
	DCR	A	; ADJUST FOR LOGIN
	PUSH	PSW	; SAVE A
	MVI	C,25	; GET CURRENT DISK
	CALL	BDOS
	INR	A	; ADJUST TO 1-16
	STA	UDRIVE	; SET FLAG
	POP	PSW	; GET NEW DISK
	MOV	E,A	; NUMBER IN E
	MVI	C,14	; SELECT DRIVE
	CALL	BDOS


*
*  CHECK FOR CP/M VERSION NUMBER -- MUST BE 2.X
*
CK$VERS:
	MVI	C,12	; GET VERSION NUMBER
	CALL	BDOS
	MOV	A,H	; HL=0 IF 1.4
	ORA	L
	JNZ	PROT1
	CALL	PRINT$MESSAGE
	DB	CR,LF,'ERROR -- PROT must run under CP/M 2.x',0

*
*  RETURN TO OS
*
RETURN:
	LDA	UDRIVE	; GET SELECTED DRIVE
	ORA	A	; 0=DEFAULT
	JZ	RETURN1
	DCR	A	; ADJUST TO 0-15
	MOV	E,A
	MVI	C,14	; SELECT DISK
	CALL	BDOS
RETURN1:
	LHLD	STACK	; GET ORIGINAL STACK PTR
	SPHL		; SET IT
	RET		; RETURN TO OS

*
*  CONTINUE PROCESSING
*
PROT1:
	XRA	A	; A=0
	STA	SET$FLAG	; CLEAR SET FLAG
	STA	INSP$FLAG	; CLEAR INSPECT FLAG

	LXI	H,TBUFF	; PT TO INPUT LINE
	MOV	B,M	; CHAR COUNT IN B
	MOV	A,B	; CHECK FOR EMPTY LINE
	ORA	A	; 0 CHARS = HELP
	JNZ	PROT2

*
*  PRINT PROT HELP MESSAGE
*
PROT$HELP:
	CALL	PRINT$MESSAGE
	DB	CR,LF,'PROT is invoked by a command of the form:'
	DB	CR,LF,'	PROT afn keys		<-- Set unconditional'
	DB	CR,LF,'	PROT afn keys /I	<-- Inspect mode'
	DB	CR,LF,'	PROT afn /S		<-- Set individual'
	DB	CR,LF,'where "keys" may be any combination of:'
	DB	CR,LF,'	R S 1 2 3 4'
	DB	CR,LF,'to indicate R/O, SYS, or Tag Bits 1, 2, 3, or 4'
	DB	CR,LF,'  Any bit not specified is cleared (R/W, DIR, etc)'
	DB	CR,LF
	DB	CR,LF,'  Examples:'
	DB	CR,LF,'	PROT *.COM RS	<-- Set *.COM to R/O SYS'
	DB	CR,LF,'	PROT *.COM 1R	<-- Set *.COM to R/O DIR'
	DB	CR,LF,'				with Tag Bit 1 Set'
	DB	CR,LF,'	PROT *.COM /I	<-- Set *.COM to R/W DIR'
	DB	CR,LF,'				with user inspection'
	DB	CR,LF,'	PROT *.COM /S	<-- Set *.COM to user-selected'
	DB	CR,LF,'				attributes on '
	DB	'individual basis'
	DB	0
	JMP	RETURN

*
*  CONTINUE PROCESSING
*
PROT2:
	INX	H	; PT TO FIRST CHAR
	MOV	A,M	; GET IT
	CPI	DELIM	; OPTION?
	JNZ	PROT3
	DCR	B	; COUNT DOWN
	JZ	PROT$HELP
	INX	H	; PT TO NEXT
	MOV	A,M	; GET OPTION CHAR
	CPI	SET$OPT	; SET INDIVIDUAL FILES?
	JZ	PROT2$SET
	CPI	INSP$OPT	; INSPECT?
	JZ	PROT2$INSP
	JMP	PROT$HELP	; HELP OTHERWISE
PROT2$SET:
	MVI	A,0FFH	; SET FLAG
	STA	SET$FLAG
	JMP	PROT3
PROT2$INSP:
	MVI	A,0FFH	; SET FLAG
	STA	INSP$FLAG
PROT3:
	DCR	B	; COUNT DOWN
	JNZ	PROT2

*
*  CHECK FOR FILE NAME SPECIFIED
*
	LDA	FCB+1	; GET FIRST LETTER OF FILE NAME
	CPI	DELIM	; DELIMITER CAUGHT?
	JZ	FN$ERR
	CPI	' '	; NO FILE SPECIFIED?
	JNZ	PROT4
FN$ERR:
	CALL	PRINT$MESSAGE
	DB	CR,LF,'ERROR -- File Name not specified',0
	JMP	RETURN
KEY$ERR:
	CALL	PRINT$MESSAGE
	DB	CR,LF,'ERROR -- Invalid Key specified',0
	JMP	RETURN
*
*  CHECK FOR KEYS AND CLEAR IF OPTION CAUGHT
*
PROT4:
	LXI	H,FCB2+1	; PT TO FIRST BYTE OF NAME
	MOV	A,M		; GET IT
	CPI	DELIM		; OPTION CAUGHT?
	JNZ	PROT5
	MVI	B,11		; CLEAR ALL OF FILE NAME/TYPE
	MVI	A,' '		; <SP> FILL
	CALL	FILL

*
*  COPY 2ND FCB INTO KEY$BUFFER
*
PROT5:
	LXI	D,FCB2+1	; PT TO FCB2
	CALL	SET$KEY$BUFFER	; LOAD KEY$BUFFER IN SORTED ORDER

*
*  ALL SET TO GO --
*	FCB CONTAINS FILE NAME/TYPE
*	FCB2 AND KEY$BUFFER CONTAIN KEYS
*	SET$FLAG IS SET CORRECTLY
*	INSP$FLAG IS SET CORRECTLY
*

*  LOAD DIRECTORY INTO DIR1 BUFFER
DIR:
	LXI	H,ENDALL		; PT TO END OF PROGRAM
	SHLD	DIR1			;  AND SET PTR TO DIR1
	LXI	H,0			; HL=0
	SHLD	FILE$COUNT		; TOTAL SELECTED FILES = 0
DIR$USER:
	MVI	C,17	; SEARCH FOR FILE
	LXI	D,FCB	; PT TO FILE NAME
	CALL	BDOS
	CPI	255	; NO MATCH?
	JZ	DIR$LOOP1
DIR$LOOP:
	CALL	PUT$ENTRY	; PLACE ENTRY IN DIR
	MVI	C,18	; SEARCH FOR NEXT MATCH
	CALL	BDOS
	CPI	255	; DONE?
	JNZ	DIR$LOOP

*  CHECK FOR ANY SELECTIONS
DIR$LOOP1:
	LHLD	FILE$COUNT	; GET COUNT
	MOV	A,H		; ZERO?
	ORA	L
	JNZ	COMP$ORDER
	CALL	PRINT$MESSAGE
	DB	CR,LF,'No Files Selected -- Aborting',0
	JMP	RETURN

*  COMPUTE POINTER TO ORDER TABLE
COMP$ORDER:
	MVI	B,ENTRY$SIZE-1	; B=NUMBER OF BYTES/ENTRY-1
	MOV	D,H		; DE=HL=NUMBER OF ENTRIES
	MOV	E,L
COMP$ORDER$LOOP:
	DAD	D		; HL=HL+DE
	DCR	B		; COUNT DOWN
	JNZ	COMP$ORDER$LOOP
	XCHG			; DE=NUMBER OF BYTES OCCUPIED BY ENTRIES
	LHLD	DIR1		; HL PTS TO FIRST ENTRY
	DAD	D		; HL PTS TO AFTER LAST ENTRY
	INR	H		; HL PTS TO NEXT PAGE
	MVI	L,0
	SHLD	ORDER		; ORDER PTR SET

*  ALPHABETIZE DIRECTORY ENTRIES
	CALL	ALPHABETIZE

*  SET PROTECTION ATTRIBUTES
	CALL	PROTECT

*  RETURN TO CP/M
	JMP	RETURN

*
*  LOAD KEY$BUFFER WITH KEYS PTED TO BY DE
*
SET$KEY$BUFFER:
	MVI	B,'1'		; CHECK FOR KEYS 1-4
	LXI	H,KEY$BUFFER	; PT TO KEY BUFFER
PROT5A:
	CALL	PROT$SCAN	; SCAN FOR/SET KEY
	INR	B		; INCREMENT COUNTER
	MOV	A,B		; GET B INTO A FOR TEST
	CPI	'5'		; DONE?
	JNZ	PROT5A
	MVI	B,'R'		; CHECK FOR R/O KEY
	CALL	PROT$SCAN	; SCAN FOR/SET KEY
	MVI	B,'S'		; CHECK FOR SYS KEY
	CALL	PROT$SCAN	; SCAN FOR/SET KEY
*  CHECK FOR ERROR
	MVI	B,11		; 11 BYTES (ALL MUST BE <SP>)
PROT5B:
	LDAX	D		; GET CHAR
	CPI	' '		; <SP>
	JNZ	KEY$ERR
	INX	D		; PT TO NEXT
	DCR	B		; COUNT DOWN
	JNZ	PROT5B
	RET

*
*  SCAN FCB2+1 FOR KEY IN REG B
*
PROT$SCAN:
	PUSH	D		; SAVE PTR
	MVI	C,11		; 11 BYTES
	MVI	M,' '		; SET INITIAL <SP>
PS1:
	LDAX	D		; GET KEY
	CALL	CAPS		; CAPITALIZE
	CMP	B		; MATCH?
	JNZ	PS2
	MOV	M,A		; SET KEY
	MVI	A,' '		; <SP> KILL
	STAX	D
PS2:
	INX	D		; PT TO NEXT
	DCR	C		; COUNT DOWN
	JNZ	PS1
	POP	D		; RESTORE PTR
	INX	H		; PT TO NEXT ATTRIBUTE
	RET

*
*  PLACE ENTRY IN DIR1 IF:
*    1 -- NOT AN ERASED ENTRY
*    2 -- SELECTED USER NUMBER
*    3 -- MATCHES SPECIFICATION FCB
*    4 -- ATTRIBUTES CORRESPOND
*
*  ON INPUT,  A=0-3 FOR ADR INDEX IN BUFF OF ENTRY FCB
*	      FILE$COUNT=NUMBER OF SELECTED FILES
*  ON OUTPUT, FILE$COUNT=NUMBER OF SELECTED FILES
*
PUT$ENTRY:
	PUSH PSW ! PUSH B ! PUSH D ! PUSH H
	RRC		; MULTIPLY BY 32 FOR OFFSET COMPUTATION
	RRC
	RRC
	ANI	60H	; A=BYTE OFFSET
	LXI	D,TBUFF	; PT TO BUFFER ENTRY
	MOV	L,A	; LET HL=OFFSET
	MVI	H,0
	DAD	D	; HL=PTR TO FCB
	MOV	A,M	; GET USER NUMBER
	CPI	0E5H	; DELETED?
	JZ	PE4	; SKIP IT IF DELETED
	XCHG		; DE=PTR TO FCB
	PUSH	D	; SAVE IT
	LHLD	FILE$COUNT	; GET NUMBER OF ENTRIES SO FAR
	SHLD	ECOUNTER
	MOV	A,H	; NONE?
	ORA	L	; ZERO FLAG SET IF SO
	LHLD	DIR1	; PT TO DIR1
	JZ	PE2	; IF NO ENTRIES, THIS IS THE FIRST
	LXI	D,ENTRY$SIZE	; HL PTS TO DIR1 BASE, DE=NUMBER OF BYTES/ENTRY
PE1:
	DAD	D	; PT TO NEXT
	CALL	ECOUNT	; ECOUNTER=ECOUNTER-1
	JNZ	PE1
PE2:
	POP	D	; DE PTS TO FCB TO PLACE IN DIR1
	XCHG
*
*	ON INPUT, DE=ADR TO PLACE ENTRY IN DIR1
*		  HL=ADR OF FCB IN BUFF
*

*  COMPARE ENTRY AGAINST FILE SELECTION FCB
PE2$COMP:
	PUSH	H	; SAVE HL, DE PTRS
	PUSH	D
	MVI	B,11	; 11 BYTES IN FILE NAME AND FILE TYPE
	LXI	D,FCB+1	; PT TO FILE NAME IN FCB
	INX	H	; PT TO FILE NAME OF ENTRY

*  COMPARISON LOOP
PE2$COMP1:
	LDAX	D	; GET FCB BYTE
	ANI	7FH	; MASK MSB
	CPI	'?'	; WILD?
	JZ	PE2$COMP2
	MOV	C,A	; SAVE BYTE
	MOV	A,M	; GET ENTRY BYTE
	ANI	7FH	; MASK MSB
	CMP	C	; COMPARE
	JZ	PE2$COMP2	; MATCH
	POP	D	; RESTORE DE, HL
	POP	H
	JMP	PE4	; ABORT
PE2$COMP2:
	INX	H	; PARTIAL MATCH -- PT TO NEXT
	INX	D
	DCR	B	; COUNT DOWN
	JNZ	PE2$COMP1
	POP	D	; RESTORE DE, HL
	POP	H

*  ENTRY COMPLETELY ACCEPTED -- HL PTS TO ENTRY, DE PTS TO DIRECTORY
PE2$COPY:
	PUSH	H	; SAVE PTR
	LXI	B,12	; CHECK FOR ZERO EXTENT
	DAD	B	; HL PTS TO EXTENT
	MOV	A,M	; GET EXTENT
	POP	H	; RESTORE HL
	ORA	A	; ZERO?
	JNZ	PE4	; ABORT IF NOT
	MVI	B,ENTRY$SIZE	; B=NUMBER OF BYTES/ENTRY
	CALL	MOVE	; COPY INTO DIRECTORY

*  INCREMENT FILE COUNT
	LHLD	FILE$COUNT	; INCREMENT FILE COUNT
	INX	H
	SHLD	FILE$COUNT

*  DONE WITH PUT$ENTRY
PE4:
	POP H ! POP D ! POP B ! POP PSW
	RET

*
*  COUNT DOWN WITH 16-BIT COUNTER ECOUNTER; SET ZERO FLAG IF IT HITS ZERO
*
ECOUNT:
	PUSH	H	; SAVE HL
	LHLD	ECOUNTER	; GET COUNT
	DCX	H	; COUNT DOWN
	SHLD	ECOUNTER	; NEW COUNT
	MOV	A,H	; ZERO?
	ORA	L	; ZERO FLAG SET IF SO
	POP	H	; RESTORE HL
	RET

*
*  ALPHABETIZE -- ALPHABETIZES DIR1; FILE$COUNT CONTAINS
*	THE NUMBER OF FILES IN DIR1
*
ALPHABETIZE:
	LHLD	FILE$COUNT	; GET FILE COUNT
	MOV	A,H	; ANY ENTRIES?
	ORA	L
	RZ
*
*  SHELL SORT --
*    THIS SORT ROUTINE IS ADAPTED FROM "SOFTWARE TOOLS"
*    BY KERNIGAN AND PLAUGHER, PAGE 106.  COPYRIGHT, 1976, ADDISON-WESLEY.
*  ON ENTRY, HL=NUMBER OF ENTRIES
*
SORT:
	MOV	B,H	; COUNT IN BC
	MOV	C,L
	LHLD	DIR1	; SET UP POINTERS TO DIRECTORY ENTRIES
	XCHG		; ... IN DE
	LHLD	ORDER	; PT TO ORDER TABLE
*
*  SET UP ORDER TABLE; HL PTS TO NEXT ENTRY IN ORDER TABLE, DE PTS TO NEXT
*    ENTRY IN DIRECTORY, BC = NUMBER OF ELEMENTS REMAINING
*
SORT1:
	MOV	M,E	; STORE LOW-ORDER ADDRESS
	INX	H	; PT TO NEXT ORDER BYTE
	MOV	M,D	; STORE HIGH-ORDER ADDRESS
	INX	H	; PT TO NEXT ORDER ENTRY
	PUSH	H	; SAVE PTR
	LXI	H,ENTRY$SIZE	; HL=NUMBER OF BYTES/ENTRY
	DAD	D	; PT TO NEXT DIR1 ENTRY
	XCHG		; DE PTS TO NEXT ENTRY
	POP	H	; GET PTR TO ORDER TABLE
	DCX	B	; COUNT DOWN
	MOV	A,B	; DONE?
	ORA	C
	JNZ	SORT1
*
*  THIS IS THE MAIN SORT LOOP FOR THE SHELL SORT IN "SOFTWARE TOOLS" BY K&P
*

*
*  SHELL SORT FROM "SOFTWARE TOOLS" BY KERNINGHAN AND PLAUGER
*
	LHLD	FILE$COUNT	; NUMBER OF ITEMS TO SORT
	SHLD	GAP	; SET INITIAL GAP TO N FOR FIRST DIVISION BY 2

*  FOR (GAP = N/2; GAP > 0; GAP = GAP/2)
SRT$LOOP0:
	ORA	A	; CLEAR CARRY
	LHLD	GAP	; GET PREVIOUS GAP
	MOV	A,H	; ROTATE RIGHT TO DIVIDE BY 2
	RAR
	MOV	H,A
	MOV	A,L
	RAR
	MOV	L,A

*  TEST FOR ZERO
	ORA	H
	JZ	SORT$DONE	; DONE WITH SORT IF GAP = 0

	SHLD	GAP	; SET VALUE OF GAP
	SHLD	I	; SET I=GAP FOR FOLLOWING LOOP

*  FOR (I = GAP + 1; I <= N; I = I + 1)
SRT$LOOP1:
	LHLD	I	; ADD 1 TO I
	INX	H
	SHLD	I

*  TEST FOR I <= N
	XCHG		; I IS IN DE
	LHLD	FILE$COUNT	; GET N
	MOV	A,L	; COMPARE BY SUBTRACTION
	SUB	E
	MOV	A,H
	SBB	D	; CARRY SET MEANS I > N
	JC	SRT$LOOP0	; DON'T DO FOR LOOP IF I > N

	LHLD	I	; SET J = I INITIALLY FOR FIRST SUBTRACTION OF GAP
	SHLD	J

*  FOR (J = I - GAP; J > 0; J = J - GAP)
SRT$LOOP2:
	LHLD	GAP	; GET GAP
	XCHG		; ... IN DE
	LHLD	J	; GET J
	MOV	A,L	; COMPUTE J - GAP
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	SHLD	J	; J = J - GAP
	JC	SRT$LOOP1	; IF CARRY FROM SUBTRACTIONS, J < 0 AND ABORT
	MOV	A,H	; J=0?
	ORA	L
	JZ	SRT$LOOP1	; IF ZERO, J=0 AND ABORT

*  SET JG = J + GAP
	XCHG		; J IN DE
	LHLD	GAP	; GET GAP
	DAD	D	; J + GAP
	SHLD	JG	; JG = J + GAP

*  IF (V(J) <= V(JG))
	CALL	ICOMPARE	; J IN DE, JG IN HL

*  ... THEN BREAK
	JC	SRT$LOOP1

*  ... ELSE EXCHANGE
	LHLD	J	; SWAP J, JG
	XCHG
	LHLD	JG
	CALL	ISWAP	; J IN DE, JG IN HL

*  END OF INNER-MOST FOR LOOP
	JMP	SRT$LOOP2

*
*  SORT IS DONE -- RESTRUCTURE DIR1 IN SORTED ORDER IN PLACE
*
SORT$DONE:
	LHLD	FILE$COUNT	; NUMBER OF ENTRIES
	MOV	B,H		; ... IN BC
	MOV	C,L
	LHLD	ORDER	; PTR TO ORDERED POINTER TABLE
	SHLD	PTPTR	; SET PTR PTR
	LHLD	DIR1	; PTR TO UNORDERED DIRECTORY
	SHLD	PTDIR1	; SET PTR DIR1

*  FIND PTR TO NEXT DIR1 ENTRY
SRTDN:
	LHLD	PTPTR	; PT TO REMAINING POINTERS
	XCHG		; ... IN DE
	LHLD	PTDIR1	; HL PTS TO NEXT DIR1 ENTRY
	PUSH	B	; SAVE COUNT OF REMAINING ENTRIES

*  FIND PTR TABLE ENTRY
SRTDN1:
	LDAX	D	; GET CURRENT POINTER TABLE ENTRY VALUE
	INX	D	; PT TO HIGH-ORDER POINTER BYTE
	CMP	L	; COMPARE AGAINST DIR1 ADDRESS LOW
	JNZ	SRTDN2	; NOT FOUND YET
	LDAX	D	; LOW-ORDER BYTES MATCH -- GET HIGH-ORDER POINTER BYTE
	CMP	H	; COMPARE AGAINST DIR1 ADDRESS HIGH
	JZ	SRTDN3	; MATCH FOUND
SRTDN2:
	INX	D	; PT TO NEXT PTR TABLE ENTRY
	DCX	B	; COUNT DOWN
	MOV	A,C	; END OF TABLE?
	ORA	B
	JNZ	SRTDN1	; CONTINUE IF NOT

*  FATAL ERROR -- INTERNAL XDIR ERROR; POINTER TABLE NOT CONSISTENT
FERR$PTR:
	CALL	PRINT$MESSAGE
	DB	CR,LF,'PROTECT ERROR -- Pointer Table Not Consistent',0
	JMP	RETURN

*  FOUND THE POINTER TABLE ENTRY WHICH POINTS TO THE NEXT UNORDERED DIR1 ENTRY
*    MAKE BOTH POINTERS (PTR TO NEXT, PTR TO CURRENT UNORDERED DIR1 ENTRY)
*    POINT TO SAME LOCATION (PTR TO NEXT DIR1 ENTRY TO BE ORDERED)
SRTDN3:
	LHLD	PTPTR	; GET PTR TO NEXT ORDERED ENTRY
	DCX	D	; DE PTS TO LOW-ORDER POINTER ADDRESS
	MOV	A,M	; MAKE PTR TO NEXT UNORDERED DIR1 PT TO BUFFER FOR
	STAX	D	;   DIR1 ENTRY TO BE MOVED TO NEXT UNORDERED DIR1 POS
	INX	H	; PT TO NEXT PTR ADDRESS
	INX	D
	MOV	A,M	; MAKE HIGH POINT SIMILARLY
	STAX	D

*  COPY NEXT UNORDERED DIR1 ENTRY TO HOLD BUFFER
	MVI	B,ENTRY$SIZE	; B=NUMBER OF BYTES/ENTRY
	LHLD	PTDIR1	; PT TO ENTRY
	LXI	D,HOLD	; PT TO HOLD BUFFER
	PUSH	B	; SAVE B=NUMBER OF BYTES/ENTRY
	CALL	MOVE
	POP	B

*  COPY TO-BE-ORDERED DIR1 ENTRY TO NEXT ORDERED DIR1 POSITION
	LHLD	PTPTR	; POINT TO ITS POINTER
	MOV	E,M	; GET LOW-ADDRESS POINTER
	INX	H
	MOV	D,M	; GET HIGH-ADDRESS POINTER
	LHLD	PTDIR1	; DESTINATION ADDRESS FOR NEXT ORDERED DIR1 ENTRY
	XCHG		; HL PTS TO ENTRY TO BE MOVED, DE PTS TO DEST
	PUSH	B	; SAVE B=NUMBER OF BYTES/ENTRY
	CALL	MOVE
	POP	B
	XCHG		; HL PTS TO NEXT UNORDERED DIR1 ENTRY
	SHLD	PTDIR1	; SET POINTER FOR NEXT LOOP

*  COPY ENTRY IN HOLD BUFFER TO LOC PREVIOUSLY HELD BY LATEST ORDERED ENTRY
	LHLD	PTPTR	; GET PTR TO PTR TO THE DESTINATION
	MOV	E,M	; GET LOW-ADDRESS POINTER
	INX	H
	MOV	D,M	; HIGH-ADDRESS POINTER
	LXI	H,HOLD	; HL PTS TO HOLD BUFFER, DE PTS TO ENTRY DEST
	CALL	MOVE	; B=NUMBER OF BYTES/ENTRY

*  POINT TO NEXT ENTRY IN POINTER TABLE
	LHLD	PTPTR	; POINTER TO CURRENT ENTRY
	INX	H	; SKIP OVER IT
	INX	H
	SHLD	PTPTR

*  COUNT DOWN
	POP	B	; GET COUNTER
	DCX	B	; COUNT DOWN
	MOV	A,C	; DONE?
	ORA	B
	JNZ	SRTDN
	RET		; DONE

*
*  SWAP (Exchange) the pointers in the ORDER table whose indexes are in
*    HL and DE
*
ISWAP:
	PUSH	H		; SAVE HL
	LHLD	ORDER		; ADDRESS OF ORDER TABLE - 2
	MOV	B,H		; ... IN BC
	MOV	C,L
	POP	H
	DCX	H		; ADJUST INDEX TO 0...N-1 FROM 1...N
	DAD	H		; HL PTS TO OFFSET ADDRESS INDICATED BY INDEX
				;   OF ORIGINAL HL (1, 2, ...)
	DAD	B		; HL NOW PTS TO POINTER INVOLVED
	XCHG			; DE NOW PTS TO POINTER INDEXED BY HL
	DCX	H		; ADJUST INDEX TO 0...N-1 FROM 1...N
	DAD	H		; HL PTS TO OFFSET ADDRESS INDICATED BY INDEX
				;   OF ORIGINAL DE (1, 2, ...)
	DAD	B		; HL NOW PTS TO POINTER INVOLVED
	MOV	C,M		; EXCHANGE POINTERS -- GET OLD (DE)
	LDAX	D		; -- GET OLD (HL)
	XCHG			; SWITCH
	MOV	M,C		; PUT NEW (HL)
	STAX	D		; PUT NEW (DE)
	INX	H		; PT TO NEXT BYTE OF POINTER
	INX	D
	MOV	C,M		; GET OLD (HL)
	LDAX	D		; GET OLD (DE)
	XCHG			; SWITCH
	MOV	M,C		; PUT NEW (DE)
	STAX	D		; PUT NEW (HL)
	RET
*
*  ICOMPARE compares the entry pointed to by the pointer pointed to by HL
*    with that pointed to by DE (1st level indirect addressing); on entry,
*    HL and DE contain the numbers of the elements to compare (1, 2, ...);
*    on exit, Carry Set means ((DE)) < ((HL)), Zero Set means ((HL)) = ((DE)),
*    and Non-Zero and No-Carry means ((DE)) > ((HL))
*
ICOMPARE:
	PUSH	H		; SAVE HL
	LHLD	ORDER		; ADDRESS OF ORDER - 2
	MOV	B,H		; ... IN BC
	MOV	C,L
	POP	H
	DCX	H		; ADJUST INDEX TO 0...N-1 FROM 1...N
	DAD	H		; DOUBLE THE ELEMENT NUMBER TO POINT TO THE PTR
	DAD	B		; ADD TO THIS THE BASE ADDRESS OF THE PTR TABLE
	XCHG			; RESULT IN DE
	DCX	H		; ADJUST INDEX TO 0...N-1 FROM 1...N
	DAD	H		; DO THE SAME WITH THE ORIGINAL DE
	DAD	B
	XCHG

*
*  HL NOW POINTS TO THE POINTER WHOSE INDEX WAS IN HL TO BEGIN WITH
*  DE NOW POINTS TO THE POINTER WHOSE INDEX WAS IN DE TO BEGIN WITH
*	FOR EXAMPLE, IF DE=5 AND HL=4, DE NOW POINTS TO THE 5TH PTR AND HL
* TO THE 4TH POINTER
*
	MOV	C,M		; BC IS MADE TO POINT TO THE OBJECT INDEXED TO
	INX	H		; ... BY THE ORIGINAL HL
	MOV	B,M
	XCHG
	MOV	E,M		; DE IS MADE TO POINT TO THE OBJECT INDEXED TO
	INX	H		; ... BY THE ORIGINAL DE
	MOV	D,M
	MOV	H,B		; SET HL = OBJECT PTED TO INDIRECTLY BY BC
	MOV	L,C

*
*  COMPARE DIR ENTRY PTED TO BY HL WITH THAT PTED TO BY DE;
*	NO NET EFFECT ON HL, DE; RET W/CARRY SET MEANS DE<HL
*	RET W/ZERO SET MEANS DE=HL
*
CMP$ENTRY:

*  COMPARE BY FILE NAME, FILE TYPE, EXTENSION, AND USER NUM (IN THAT ORDER)
CMP$FN$FT:
	PUSH D ! PUSH H
	INX	H	; PT TO FN
	INX	D
	MVI	B,11	; COMPARE FN, FT
	CALL	COMP
	POP H ! POP D
	RET
*
*  COMP COMPARES DE W/HL FOR B BYTES; RET W/CARRY IF DE<HL
*	MSB IS DISREGARDED
*
COMP:
	MOV	A,M	; GET (HL)
	ANI	7FH	; MASK MSB
	MOV	C,A	; ... IN C
	LDAX	D	; COMPARE
	ANI	7FH	; MASK MSB
	CMP	C
	RNZ
	INX	H	; PT TO NEXT
	INX	D
	DCR	B	; COUNT DOWN
	JNZ	COMP
	RET

*
*  PERFORM PROTECTION BIT SETTING
*
PROTECT:
	LHLD	FILE$COUNT	; HL=NUMBER OF FILES
	XCHG
	LHLD	DIR1		; HL PTS TO DIR1, DE=NUMBER OF FILES
	LDA	SET$FLAG	; MANUALLY SET EACH FILE?
	ORA	A		; 0=NO
	JNZ	PROTECT$SET

*  PRINT FILE NAME, KEYS, AND PERFORM ATTRIBUTE SETTING
PROTECT$LOOP:
	CALL	PRINT$MESSAGE
	DB	CR,LF,'File: ',0
	CALL	PRINT$FN	; PRINT FILE NAME
	CALL	PRINT$MESSAGE
	DB	' Set to ',0
	CALL	PRINT$KEYS	; PRINT ATTRIBUTES
	CALL	INSPECT		; INSPECT IF FLAG SET ELSE SET ATTRIBUTES
	LXI	B,ENTRY$SIZE	; PT TO NEXT ENTRY
	DAD	B		; HL PTS TO NEXT ENTRY
	DCX	D		; COUNT DOWN
	MOV	A,D		; DONE?
	ORA	E
	JNZ	PROTECT$LOOP
	RET

*  PRINT FILE NAME AND PROMPT USER FOR KEYS
PROTECT$SET:
	CALL	PRINT$MESSAGE
	DB	CR,LF,'File: ',0
	CALL	PRINT$FN	; PRINT FILE NAME
	CALL	GET$KEYS	; GET KEYS
	RZ			; ABORT?
	CALL	SET$KEYS	; SET KEYS
	LXI	B,ENTRY$SIZE	; PT TO NEXT ENTRY
	DAD	B		; HL PTS TO NEXT ENTRY
	DCX	D		; COUNT DOWN
	MOV	A,D		; DONE?
	ORA	E
	JNZ	PROTECT$SET
	RET

*
*  PRINT FILE NAME PTED TO BY HL+1
*
PRINT$FN:
	PUSH	H		; SAVE PTR
	INX	H		; PT TO FIRST CHAR
	MVI	B,8		; 8 CHARS
	CALL	PRFN		; PRINT NAME PART
	MVI	A,'.'		; PRINT DOT
	CALL	CHAR$OUT
	MVI	B,3		; 3 CHARS
	CALL	PRFN		; PRINT TYPE PART
	POP	H		; RESTORE PTR
	RET
PRFN:
	MOV	A,M		; GET CHAR
	ANI	7FH		; MASK OUT MSB
	CALL	CHAR$OUT
	INX	H		; PT TO NEXT
	DCR	B		; COUNT DOWN
	JNZ	PRFN
	RET

*
*  PRINT CONTENTS OF KEYS BUFFER
*
PRINT$KEYS:
	PUSH	H		; SAVE PTR
	LXI	H,KEY$BUFFER	; CHECK FOR ANY TAGS
	XRA	A		; SET FLAG
	STA	TAG$FLAG
	MVI	B,4
PKEY0:
	MOV	A,M		; GET BYTE
	INX	H		; PT TO NEXT
	CPI	' '		; <SP>
	JZ	PKEY1
	MVI	A,0FFH		; SET FLAG
	STA	TAG$FLAG
PKEY1:
	DCR	B		; COUNT DOWN
	JNZ	PKEY0
	LDA	TAG$FLAG	; ANY SET?
	ORA	A		; 0=NO
	JZ	PKEY2
	CALL	PRINT$MESSAGE
	DB	'Tags: ',0
	LXI	H,KEY$BUFFER	; PT TO BUFFERS
	MVI	B,4		; PRINT 4 CHARS (1-4)
	CALL	PRFN		; USE COMMON ROUTINE
PKEY2:
	CALL	PRINT$MESSAGE
	DB	' R/',0
	MOV	A,M		; CHECK R/O FLAG
	INX	H		; PT TO NEXT
	CPI	'R'		; R/O?
	JZ	PKRO
	MVI	A,'W'		; R/W
	DB	1		; LXI B,XXXX
PKRO:	MVI	A,'O'		; R/O (PART OF LXI B,XXXX IF R/W SELECTED)
	CALL	CHAR$OUT
	MOV	A,M		; CHECK SYS FLAG
	POP	H		; RESTORE PTR
	CPI	'S'		; SYS?
	JZ	PKSYS
	CALL	PRINT$MESSAGE
	DB	' DIR',0
	RET
PKSYS:
	CALL	PRINT$MESSAGE
	DB	' SYS',0
	RET

*
*  PERFORM INSPECTION IF OPTION SET -- ELSE, SET KEYS
*
INSPECT:
	LDA	INSP$FLAG	; GET FLAG
	ORA	A		; 0=NO
	JZ	SET$KEYS	; SET KEYS IF NOT
	CALL	PRINT$MESSAGE
	DB	' -- Ok (Y/N)? ',0
INSP1:
	CALL	CHAR$IN
	CALL	CAPS		; CAPITALIZE
	CPI	'Y'		; OK?
	JZ	SET$KEYS	; SET IF SO
	CPI	'N'		; NOT OK?
	RZ
	CALL	PRINT$MESSAGE
	DB	CR,LF,'Type Y or N -- Ok (Y/N)? ',0
	JMP	INSP1

*
*  SET KEYS OF FILE PTED TO BY HL
*
SET$KEYS:
	PUSH	H		; SAVE PTR
	PUSH	D		; SAVE COUNTER
	INX	H		; PT TO 1ST BYTE OF SOURCE FILE NAME
	LXI	D,FCBX		; CLEAR DRIVE
	XRA	A		; A=0
	STAX	D
	INX	D		; PT TO 1ST BYTE OF DEST FILE NAME
	MVI	B,11		; 11 BYTES
	CALL	MOVE
	XCHG			; HL PTS TO FCBX
	MVI	B,24		; CLEAR REST OF FCBX
	XRA	A		; A=0
	CALL	FILL
	LXI	D,KEY$BUFFER	; PT TO BUFFER
	LXI	H,FCBX+1	; PT TO TYPE ATTRIBUTE
	MVI	B,4		; SET TAG BITS
	CALL	SK$SET
	INX	H		; PT TO R/O BYTE
	INX	H
	INX	H
	INX	H
	MVI	B,2		; SET R/O AND SYS BITS
	CALL	SK$SET
	LXI	D,FCBX		; PT TO FCB
	MVI	C,30		; SET FILE ATTRIBUTES
	CALL	BDOS
	POP	D		; RESTORE COUNTER
	POP	H		; RESTORE PTR
	RET
SK$SET:
	MOV	A,M		; CLEAR ATTRIBUTE
	ANI	7FH
	MOV	M,A
	LDAX	D		; GET TAG
	CPI	' '		; NO SET?
	JZ	SK$SET1
	MOV	A,M		; SET ATTRIBUTE
	ORI	80H
	MOV	M,A
SK$SET1:
	INX	D		; PT TO NEXT
	INX	H
	DCR	B		; COUNT DOWN
	JNZ	SK$SET
	RET

*
*  GET KEYS SPECIFIED BY USER
*	RETURN WITH ZERO FLAG SET IF ABORT GIVEN
*
GET$KEYS:
	PUSH	H		; SAVE PTR
	PUSH	D		; SAVE COUNTER
	CALL	PRINT$MESSAGE
	DB	' Keys (1/2/3/4/R/S/A=Abort)? ',0
	LXI	H,INLINE+2	; PT TO INPUT BUFFER
	MVI	A,' '		; <SP> FILL
	MVI	B,LINELEN	; NUMBER OF CHARS POSSIBLE
	CALL	FILL
	LXI	D,INLINE	; READ INTO BUFFER
	MVI	C,10		; BDOS READLN
	CALL	BDOS
	LXI	H,INLINE+2	; SCAN FOR ABORT FLAG
	MVI	B,11		; SCAN 11 BYTES
GK1:
	MOV	A,M		; GET IT
	INX	H		; PT TO NEXT
	CALL	CAPS		; CAPITALIZE
	CPI	'A'		; ABORT?
	JZ	GK2
	DCR	B		; COUNT DOWN
	JNZ	GK1
	LXI	D,INLINE+2	; PUT INTO KEY$BUFFER
	CALL	SET$KEY$BUFFER
	POP	D		; RESTORE COUNTER
	POP	H		; RESTORE PTR
	MVI	A,0FFH		; CLEAR ZERO FLAG
	ORA	A
	RET
GK2:
	POP	D		; RESTORE COUNTER
	POP	H		; RESTORE PTR
	XRA	A		; SET ZERO FLAG
	RET

*
*  CHARACTER INPUT ROUTINE
*
CHAR$IN:
	PUSH	H	; SAVE REGS
	PUSH	D
	PUSH	B
	MVI	C,1	; CONSOLE INPUT
	CALL	BDOS
	POP	B	; RESTORE REGS
	POP	D
	POP	H
	ANI	7FH	; MASK OUT MSB
	RET

*
*  CHARACTER OUTPUT ROUTINE
*
CHAR$OUT:
	PUSH	H	; SAVE REGS
	PUSH	D
	PUSH	B
	PUSH	PSW
	MOV	E,A	; CHAR IN E
	MVI	C,2	; CONSOLE OUTPUT
	CALL	BDOS
	POP	PSW	; RESTORE REGS
	POP	B
	POP	D
	POP	H
	RET

*
*  PRINT MESSAGE PTED TO BY RET ADR ENDING IN 0
*
PRINT$MESSAGE:
	XTHL		; SAVE HL AND SET HL TO MESSAGE
PM1:
	MOV	A,M	; GET BYTE
	INX	H	; PT TO NEXT
	ORA	A	; DONE?
	JZ	PM2
	CALL	CHAR$OUT	; PRINT
	JMP	PM1
PM2:
	XTHL		; RESTORE HL AND RET ADR
	RET

*
*  CAPITALIZE CHAR IN A
*
CAPS:
	ANI	7FH	; MASK OUT MSB
	CPI	61H	; SMALL A
	RC
	CPI	7BH	; SMALL B + 1
	RNC
	ANI	5FH	; CAPITALIZE
	RET

*
*  MOVE (HL) TO (DE) FOR (B) BYTES
*
MOVE:
	MOV	A,M	; GET
	STAX	D	; PUT
	INX	H	; PT TO NEXT
	INX	D
	DCR	B	; COUNT DOWN
	JNZ	MOVE
	RET

*
*  FILL (HL) FOR (B) BYTES WITH (A)
*
FILL:
	MOV	M,A	; PUT
	INX	H	; PT TO NEXT
	DCR	B	; COUNT DOWN
	JNZ	FILL
	RET

*
*  BUFFERS
*
	DS	100	; WHY NOT?
STACK	DS	2	; OLD SP

LINELEN	EQU	20	; 20 CHARS/INPUT LINE
INLINE:	DB	LINELEN	; LENGTH OF INPUT LINE
	DS	1	; RETURNED LINE LENGTH
	DS	LINELEN	; INPUT LINE
	DS	4	; BUFFER

DIR1:
	DS	2	; DIR1 PTR
ORDER:
	DS	2	; ORDER TABLE PTR
UDRIVE:
	DS	1	; USER-SELECTED DRIVE NUMBER (1-16)
TAG$FLAG:
	DS	1	; TAG FLAG (0=NO TAGS SPECIFIED)
INSP$FLAG:
	DS	1	; INSPECT FLAG (0=NO)
SET$FLAG:
	DS	1	; MANUALLY SET ATTRIBUTES FLAG (0=NO)
FILE$COUNT:
	DS	2	; NUMBER OF FILES SELECTED
ECOUNTER:
	DS	2	; COUNTER FOR PUT$ENTRY
PTPTR:
	DS	2	; SORT PTR
PTDIR1:
	DS	2	; SORT DIR1 PTR
GAP:
	DS	2	; SORT NUMBER
I:
	DS	2	; SORT NUMBER
J:
	DS	2	; SORT NUMBER
JG:
	DS	2	; SORT NUMBER
KEY$BUFFER:
	DS	11	; KEY BUFFER
HOLD:
	DS	ENTRY$SIZE	; HOLD BUFFER FOR SORT
FCBX:
	DS	40	; FCB BUFFER FOR CHANGE

*
*  BEGINNING OF DYNAMIC BUFFER REGION
*
ENDALL	EQU	$/256*256+256	; PAGE BOUNDARY

	END