; SAPP v52  SORT AND PACK CP/M DISK DIRECTORY -- 07/01/85
;
; v52 07-01-85	(DJM P*PS)
;	1.  Fixed unbalanced stack in dodate which caused
;	    eratic exit behaviour in some circumstances
;	2.  Minor tidy up of some comments and exit
;
; v51 02-23-85
;	1.  Preserved original attributes of '!!!TIME&.DAT' file
;
; v50 11/13/84
;	1.  Added support for DateStamper time-and-date file, if
;		present on disk.  The datestamp entries are
;		rewritten in the new directory order, with updated
;		checksums.
;	2.  New, faster sort routine swaps pointers rather than
;		directory entries.
;	3.  Directory writes speeded up by flushing only the final
;		sector.
;	4.  Zero-length files are erased only if confirmed by user.
;	5.  Prompt for drive if no command line.
;	6.  Erase temporary files of form 'filename.$$$'
;	7.  Removed the 'PACK' routine.
;		As written, it converted 'filename.n$$' extent=0 files
;		to 'filename.$$$' extent=n-'0'.
;		If the intent was to erase temporary files it should
;		be done BEFORE sorting, as v 5.0 now does.
;	8.  Note: not tested on cp/m 1.4
;
;				Bridger Mitchell (Plu*Perfect Systems)
;
;-----------------------------------------------------------------------
;
; This program reads the disk directory tracks, sorts them alphabetically
; then replaces them on the disk.  All unused or erased areas on the di-
; rectory track are reformatted with continuous 'E5' characters.  (This
; erases previous file names which have been deactivated.)  Sorting the
; directory in this manner offers many advantages.  Some of them are:
;
;	1)  allows 'DIR' to show an alphabetized listing (horizontal)
;	2)  eliminates potential problems with "UNERASE" programs
;	3)  speeds access via 'SD' and other special programs
;	4)  assists on working directly on the disk with 'DU', etc.
;	5)  removes files from the disk somebody else could recover
;	6)  erases all files of zero length (except those starting
;	      with '-' for catalog use with MAST.CAT)
;
;				- notes by Irv Hoff W6FFC
;
;=======================================================================
;
; 09/17/84  Added 'Previously sorted' statement that was included in v37
;   v40     but got dropped from v38 when the Shell-Metnzer sort was put
;	    in.  It still rewrites the directory even if previously
;	    sorted, to insure erased programs at end of directory are
;	    properly cleared.		- Irv Hoff
;
; 07/27/84  Corrected sorting of last directory entry.
;   v39 				- WOD
;
; 10/16/83  Now using a Shell-Metzner sort which speeds the sorting time
;   v38     considerably, especially on large directories. (SFK)
;
; 07/27/83  Shows an error flag for MP/M and CP/M+ both.  Rewrites the
;   v37     directory even if previously sorted, to insure erased pro-
;	    grams at end of directory are properly cleared.
;					- Irv Hoff
;
; 1977	Written by L. E. Hughes.  Modified extensively since by Bruce
;	Ratoff, Keith Petersen, James Prest, Ron Fowler, Frank Gaude,
;	Sigi Kluger, Irv Hoff and likely others.
;
;=======================================================================
;
;
VERS	EQU	52
;
;
BDOS	EQU	0005H
;
;
; BDOS functions
;
VERNO	EQU	12		; Provides CP/M version number
RESET	EQU	13		; Bdos reset drives fn
SELDRV	EQU	14		; Select drive fn
OPEN	EQU	15
CLOSE	EQU	16
USERFN	EQU	32		; BDOS user function
ATTFN	EQU	30
GETDSK	EQU	25		; BDOS "get disk #" function
DMAFN	EQU	26
READFN	EQU	20
WRITFN	EQU	21
;
FCB	EQU	5CH
TBUFF	EQU	80H
;
BS	EQU	08H
CR	EQU	0DH
LF	EQU	0AH
JMP	EQU	0C3H
;
;
DPBLEN	EQU	15		; Size of CP/M 2.2 disk parameter block
;
;
	ORG	100H
;
;
START:	LD	SP,STACK	; Use our own stack
	LD	DE,WBOOT	; Get bios vector
	LD	HL,(0001H)
	LD	B,16*3		; DJM 7/1/85
	CALL	MOVE
	CALL	ILPRT
	DEFB	CR,LF,'SAP v '
	DEFB	VERS/10 +'0',(VERS MOD 10) +'0'
;
VERDAT:	DEFB	' 07/01/85',CR,LF,LF
	DEFB	'Sort and Pack Directory -- '
	DEFB	'with DateStamper(TM) support.',CR,LF,0
	LD	C,VERNO		; Check for CP/M ver 2.2
	CALL	BDOS
	LD	A,H		; H=1 for MPM
	OR	A
	JP	NZ,MPMYES	; Exit if MPM, we can't use it
	LD	A,L		; HL = 0022H if CP/M ver 2.2
	CP	22H+1		; Check for MPM or CP/M 3.0
	JP	NC,MPMYES	; Exit if CP/M 3.0, we can't use it
	LD	(VERFLG),A
;
;
;-----------------------------------------------------------------------
;
;		   	  MAIN PROGRAM
;
;-----------------------------------------------------------------------
;
SAP:	CALL	SETUP
	CALL	TSTWRT
	CALL	RDDIR
	CALL	CLEAN
	CALL	SORT
	CALL	WRDIR		; Write directory and DateStamper file
	CALL	ILPRT
	DEFB	'... Done.',CR,LF,0
;
EXIT:	LD	A,(O$DISK)	; Restore login status
	LD	E,A
	LD	C,SELDRV	; Sets bios drive too
	CALL	BDOS
	LD	A,(O$USER)
	LD	E,A
;
S8:	LD	C,USERFN
	CALL	BDOS
	RST	8*0		; Warm boot - required after
				; Change in directory checksum
;
;-----------------------------------------------------------------------
;
;			INITIALIZATION
;
;-----------------------------------------------------------------------
;
; Setup for selecting drive and  loading disk parm block
;
SETUP:	XOR	A
	LD	(CLEANFLG),A
	LD	C,USERFN	; Save original drive & user number
	LD	E,0FFH
	CALL	BDOS
	LD	(O$USER),A
	LD	C,GETDSK
	CALL	BDOS
	LD	(O$DISK),A
	LD	(CURDSK),A
	LD	A,(FCB)
	OR	A
	JP	NZ,SETUP1
;
;
; Prompt for drive before proceeding
;
REASK:	CALL	ILPRT
	DEFB	CR,LF,'Which drive ?',BS,0
	CALL	CI
	CP	'C'-'@'		; Abort on ^C bailout
	JP	Z,0
	AND	5FH
	PUSH	AF
	CALL	AOUT
	POP	AF
;
STUP0:	SUB	'A'-1
;
SETUP1:	DEC	A
	LD	(CURDSK),A
	CP	0
	JP	C,BADDRV
	CP	16
	JP	C,LOGIT
;
BADDRV:	LD	C,7
	CALL	AOUT
	JP	REASK
;.....
;
;
LOGIT:	LD	E,A		; Login designated drive thru BDOS
	LD	C,SELDRV
	CALL	BDOS
	LD	E,0		; Set user 0
	LD	C,USERFN
	CALL	BDOS
	LD	A,(CURDSK)	; BIOS call to get DPH to HL
	LD	C,A
	CALL	SELDSK
	LD	A,(VERFLG)	; If CP/M 1.4
	OR	A
	JP	Z,DO14		; If 1.4, then do it the 1.4 way
	CALL	CPM22
	JP	SETUP2
;.....
;
;
DO14:	CALL	CPM14
;
SETUP2:	LD	HL,(DRM)	; Number of directory entries
	INC	HL		; Relative to 1
	LD	(SCOUNT),HL
	PUSH	HL
	ADD	HL,HL		; Allocate 2*#dir entries
	LD	DE,ORDER	; For pointer words
	ADD	HL,DE
	LD	(BUFBASE),HL
	POP	HL
	PUSH	HL
	CALL	ROTRHL		; Divide by 4
	CALL	ROTRHL		; To get record count
	LD	(DIRLEN),HL
	CALL	ROTRHL		; And by 8 for time&date
	LD	(TDCNT),HL	; 
;
;
; Check for sufficient memory--
;
	POP	HL		; # entries *32
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	EX	DE,HL
	LD	HL,(BUFBASE)	; + BUFBASE
	ADD	HL,DE
	EX	DE,HL
	LD	HL,(6)		; - available TPA
	CALL	SUBDE
	RET	NC
	CALL	ILPRT
	DEFB	CR,LF,7,'Insufficient memory!',0
	JP	EXIT
;.....
;
;
CPM22:	LD	E,(HL)		; CP/M 2.2 routine
	INC	HL
	LD	D,(HL)
	INC	HL
	EX	DE,HL
	LD	(RECTBL),HL
	EX	DE,HL
	LD	DE,8		; Offset to DPB within header
	ADD	HL,DE		; Returned by seldsk in CP/M 2.2
	LD	A,(HL)		; Get adrress of DPB
	INC	HL
	LD	H,(HL)
	LD	L,A
	LD	DE,DPB		; Point to destestination: our DPB
	LD	B,DPBLEN
	JP	MOVE
;.....
;
;
; CP/M 1.4 routine
;
CPM14:	LD	HL,(BDOS+1)
	LD	L,0
	LD	A,JMP
	LD	(RECTRN),A
	PUSH	HL
	LD	DE,15		; RECTRAN offset from BDOS in CP/M 1.4
	ADD	HL,DE
	LD	(RECTRN+1),HL
	POP	HL
	LD	DE,3AH		; Offset from BDOS to 1.4 DPB
	ADD	HL,DE
	LD	D,0
	LD	E,(HL)
	INC	HL
	EX	DE,HL
	LD	(SPT),HL
	EX	DE,HL
	LD	E,(HL)
	INC	HL
	EX	DE,HL
	LD	(DRM),HL
	EX	DE,HL
	LD	A,(HL)
	INC	HL
	LD	(BSH),A
	LD	A,(HL)
	INC	HL
	LD	(BLM),A
	LD	E,(HL)
	INC	HL
	EX	DE,HL
	LD	(DSM),HL
	EX	DE,HL
	LD	E,(HL)
	INC	HL
	EX	DE,HL
	LD	(AL0),HL
	EX	DE,HL
	LD	E,(HL)
	EX	DE,HL
	LD	(SYSTRK),HL
	RET
;
;
; Read & write 1st directory record to ensure writable disk
;
TSTWRT:	LD	C,RESET
	CALL	BDOS
	CALL	SETCUR
	LD	HL,(SYSTRK)
	CALL	DOTRAK
	LD	HL,1
	CALL	DOREC
	LD	HL,TBUFF
	LD	B,H
	LD	C,L
	CALL	SETDMA
	CALL	READ
	OR	A
	JP	NZ,RTERR
	LD	C,1		; Directory write forces flush
	CALL	WRITE
	OR	A
	JP	NZ,WTERR
	CALL	CKTD		; See if special DateStamper file is on disk
	RET
;.....
;
;
WTERR:	CALL	ILPRT
	DEFB	CR,LF,7,'Can''t write disk -- '
	DEFB	'check write-protect tab',0
	RET
;.....
;
;
RTERR:	CALL	ILPRT
	DEFB	CR,LF,7,'Can''t read disk',0
	RET

;
;-----------------------------------------------------------------------
;
;			READ & WRITE DIRECTORY
;
;-----------------------------------------------------------------------
;
; Write directory
;
WRDIR:	LD	A,(NOSWAP)
	OR	A
	JP	NZ,WRDIR1
	CALL	ILPRT
	DEFB	'(Previously sorted) ',0
	LD	A,(CLEANFLG)	; If in sorted order
	OR	A		; And no erasures
	RET	Z		; We're all done
;
WRDIR1:	CALL	ILPRT
	DEFB	CR,LF,'          ---> Writing, ',0
;
WRDIR2:	CALL	DMA80		; Set default dma
	LD	HL,(DIRLEN)
	LD	(DIRCNT),HL
	LD	HL,ORDER	; Set initial pointer
	LD	(PTR),HL
	LD	A,1		; Flag write operation
	CALL	DODIR
	CALL	DODATE		; Then update the DateStamper file
	RET
;.....
;
;
; Read directory
;
RDDIR:	CALL	ILPRT
	DEFB	CR,LF,'---> Reading, ',0
	LD	HL,(DIRLEN)
	LD	(DIRCNT),HL
	LD	HL,(BUFBASE)
	LD	(ADDR),HL	; For read DMA address
	LD	HL,ORDER
	LD	(PTR),HL
	LD	A,0		; Readflg
;
DODIR:	LD	(WRFLAG),A
	LD	HL,(SYSTRK)
	CALL	DOTRAK		; Set the track
	LD	HL,0
	LD	(RECORD),HL
;
DLOOP:	LD	HL,(RECORD)	; Get records per track
	INC	HL
	EX	DE,HL
	LD	HL,(SPT)	; Current record
	CALL	SUBDE		; Record - SPT
	EX	DE,HL
	JP	NC,NOTROV
;
;
; Track overflow, bump to next
;
	LD	HL,(TRACK)
	INC	HL
	CALL	DOTRAK
	LD	HL,1		; Rewind record number
;
NOTROV:	CALL	DOREC		; Set current record
	LD	A,(WRFLAG)	; Time to figure out
	OR	A		; If we are reading
	JP	NZ,DWRT		; Or writing
;
;
; Reading
;
	LD	HL,(ADDR)
	LD	B,H		; Set up DMA address
	LD	C,L
	CALL	SETDMA
	CALL	READ
	OR	A		; Test flags on read
	JP	NZ,RERROR	; NZ=error
	LD	HL,(ADDR)
	LD	B,4		; Install ptrs for 4 entries in this rec.
	EX	DE,HL
	LD	HL,(PTR)
;
PLP:	LD	(HL),E
	INC	HL
	LD	(HL),D
	INC	HL
	PUSH	HL
	LD	HL,32
	ADD	HL,DE
	EX	DE,HL
	POP	HL
	DEC	B
	JP	NZ,PLP
	LD	(PTR),HL
	EX	DE,HL
	LD	(ADDR),HL	; New dma
;
;
; Common r/w code
;
MORE:	LD	HL,(DIRCNT)	; Countdown entries
	DEC	HL
	LD	(DIRCNT),HL
	LD	A,H		; Test for zero left
	OR	L
	JP	NZ,DLOOP	; Loop till zero
;
;
; Directory I/O done, reset DMA address
;
DMA80:	LD	BC,TBUFF
	JP	SETDMA
;.....
;
;
; Write-directory code
;
DWRT:	LD	B,4
	LD	DE,TBUFF
;
DWRT1:	PUSH	BC		; Copy 4 sorted entries to buffer
	CALL	NXTENT
	CALL	MOVE32
	POP	BC
	DEC	B
	JP	NZ,DWRT1
	LD	C,0		; Write allocated...
	LD	HL,(DIRCNT)
	DEC	HL
	LD	A,H
	OR	L
	JP	NZ,DWRT3	; Unless it's the last record
	LD	C,1		; Which must be flushed
;
DWRT3:	CALL	WRITE
	OR	A
	JP	NZ,WERROR
	JP	MORE
;.....
;
;
; Return HL = pointer to next sorted entry
;
NXTENT:	PUSH	DE
	LD	HL,(PTR)
	LD	E,(HL)
	INC	HL
	LD	D,(HL)
	INC	HL
	LD	(PTR),HL
	EX	DE,HL
	POP	DE
	RET
;.....
;
;
; Track and record update routines
;
DOTRAK:	LD	(TRACK),HL
	LD	B,H
	LD	C,L
	JP	SETTRK
;.....
;
;
DOREC:	LD	(RECORD),HL
	LD	B,H
	LD	C,L
	LD	HL,(RECTBL)
	EX	DE,HL
	DEC	BC
	CALL	RECTRN
	LD	B,H
	LD	C,L
	LD	A,(VERFLG)
	OR	A
	RET	Z
	JP	SETREC
;.....
;
;
;-----------------------------------------------------------------------
;
;	CLEAN OUT ERASED ENTRIES
;	Also  any zero-length files, if affirmed by user.
;	Preserve '-' zero-length (catalog) filenames.
;
;-----------------------------------------------------------------------
;
CLEAN:	LD	HL,0		; I = 0
;
CLNLOP:	LD	(I),HL
	CALL	INDEX		; HL = BUF + 32 * I
	LD	A,(HL)		; Jump if this is a deleted file
	CP	0E5H
	JP	Z,FILLE5
	LD	B,H		; Save index in BC
	LD	C,L
	LD	DE,9		; If filetype is '$$$'
	ADD	HL,DE
	LD	A,'$'
	CP	(HL)
	JP	NZ,CLN1
	INC	HL
	CP	(HL)
	JP	NZ,CLN1
	INC	HL
	CP	(HL)
	JP	Z,FILLE5	; Erase it
;
CLN1:	LD	HL,12
	ADD	HL,BC
	LD	A,(HL)		; Check extent field
	OR	A
	JP	NZ,CLBUMP	; Skip if not extent 0
	INC	HL		; Point to record count field
	INC	HL
	LD	A,(HL)		; Get S2 byte (extended RC)
	AND	0FH		; For CP/M 2.2, 0 for CP/M 1.4
	LD	E,A
	INC	HL
	LD	A,(HL)		; Check record count field
	OR	E
	JP	NZ,CLBUMP	; Jump if non-zero
	LD	HL,(I)		; Keep any files beginning with '-'
	CALL	INDEX
	INC	HL
	LD	A,(HL)		; Get first character of filename
	DEC	HL		; MAST.CAT catalog programs
	CP	'-'		; Have diskname of zero length
	JP	Z,CLBUMP	; That start with '-', do not delete
	PUSH	HL		; For other 0-length files...
	CALL	ILPRT		; Ask for confirmation before erasing
	DEFB	CR,LF,'Erase zero-length file: ',0
	LD	A,(CURDSK)
	ADD	A,'A'
	CALL	AOUT
	POP	HL
	PUSH	HL		; +1
	LD	A,(HL)
	CP	10
	JP	C,ONES
	PUSH	AF
	ADD	A,'0'-10
	CALL	AOUT
	POP	AF
;
SULP:	SUB	10
	JP	P,SULP
	ADD	A,10
;
ONES:	ADD	A,'0'
	CALL	AOUT
	LD	A,':'
	CALL	AOUT
	POP	HL
	PUSH	HL		; +1
	INC	HL
	CALL	FNFT
	CALL	ILPRT
	DEFB	' ?',BS,0
	CALL	CI
	CP	'Y'
	POP	HL		; +0
	JP	Z,YESANS
	CP	'y'
	JP	Z,YESANS
	LD	A,'N'
	CALL	AOUT
	JP	CLBUMP
;.....
;
;
YESANS:	CALL	AOUT
;
FILLE5:	LD	HL,(I)		; Recompute entry address
	CALL	INDEX
	LD	C,32		; Number of bytes to clear
	LD	A,0E5H
;
FILLE6:	CP	(HL)
	JP	NZ,FILLE7
	INC	HL
	DEC	C
	JP	NZ,FILLE6
	JP	CLBUMP		; Already clean
;.....
;
;
FILLE7:	LD	(CLEANFLG),A
;
FILLOP:	LD	(HL),A		; Make it all E5'S
	INC	HL
	DEC	C
	JP	NZ,FILLOP
;
CLBUMP:	LD	HL,(DRM)	; Get count of filenames
	INC	HL
	EX	DE,HL
	LD	HL,(I)		; Our current count
	INC	HL
	PUSH	HL
	CALL	SUBDE		; Subtract
	POP	HL
	JP	C,CLNLOP	; Loop till all cleaned
	RET
;.....
;
;
; Type 'FILENAME.TYP' at (HL)
;
FNFT:	LD	B,8
	CALL	TYPEFN
	LD	A,'.'
	CALL	AOUT
	LD	B,3
;
TYPEFN:	PUSH	BC
	LD	A,(HL)
	CALL	AOUT
	INC	HL
	POP	BC
	DEC	B
	JP	NZ,TYPEFN
	RET
;.....
;
;
AOUT:	PUSH	BC
	PUSH	HL
	LD	C,A
	CALL	CO
	POP	HL
	POP	BC
	RET
;.....
;
;
; Print a string:  Address is on top of stack, preserves BC
;
ILPRT:	EX	(SP),HL		; Get address from stack
	LD	A,(HL)		; Get character
	INC	HL		; Point to next address
	EX	(SP),HL		; Restore to stack
	OR	A		; Are we done?
	RET	Z		; Yes, return past string
	CALL	AOUT		; Preserves hl,bc
	JP	ILPRT		; Continue
;.....
;
;
INDEX:	ADD	HL,HL		; *32
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	EX	DE,HL
	LD	HL,(BUFBASE)
	ADD	HL,DE
	RET
;.....
;
;
MOVE16:	LD	B,16
	JP	MOVE
;
MOVE32:	LD	B,32
;
;
; Move (B) bytes from (HL) to (DE)
;
MOVE:	LD	A,(HL)
	LD	(DE),A
	INC	HL
	INC	DE
	DEC	B
	JP	NZ,MOVE
	RET
;.....
;
;
;-----------------------------------------------------------------------
;
;			 Sort the directory
;
;-----------------------------------------------------------------------
;
SORT:	XOR	A
	LD	(NOSWAP),A	; Zero the flag in case already sorted
	CALL	ILPRT
	DEFB	CR,LF,'   ---> Sorting, ',0
;
;
; This sort routine is adapted from SOFTWARE TOOLS by Kernigan and
; Plaugher.  Routine extracted from SD.
;
	LD	HL,(SCOUNT)	; Number of entries
	LD	A,(TDFLAG)
	OR	A
	JP	Z,L0
	DEC	HL		; Skip past TIME&DAT entry
	LD	(SCOUNT),HL
;
L0:	OR	A		; Clear carry
	LD	A,H		; GAP=GAP/2
	RRA
	LD	H,A
	LD	A,L
	RRA
	LD	L,A
	OR	H		; Is it zero?
	RET	Z		; Then none left
	LD	A,L		; Make gap odd
	OR	1
	LD	L,A
	LD	(GAP),HL
	INC	HL		; I=GAP+1
;
L2:	LD	(I),HL
	EX	DE,HL
	LD	HL,(GAP)
	LD	A,E		; J=I-GAP
	SUB	L
	LD	L,A
	LD	A,D
	SBC	A,H
	LD	H,A
;
L3:	LD	(J),HL
	EX	DE,HL
	LD	HL,(GAP)	; JG=J+GAP
	ADD	HL,DE
	LD	(JG),HL
	CALL	COMPARE		; Compare (J) and (JG)
;
L3A:	JP	P,L5		; If A(J)<=A(JG)
	LD	HL,(J)
	EX	DE,HL
	LD	HL,(JG)
	CALL	SWAP		; Exchange A(J) and A(JG)
	LD	HL,(J)		; J=J-GAP
	EX	DE,HL
	LD	HL,(GAP)
	LD	A,E
	SUB	L
	LD	L,A
	LD	A,D
	SBC	A,H
	LD	H,A
	JP	M,L5		; If J>0 GOTO L3
	OR	L		; Check for zero
	JP	NZ,L3		; * shortened
;
L5:	LD	HL,(SCOUNT)	; For later
	EX	DE,HL
	LD	HL,(I)		; I=I+1
	INC	HL
	LD	A,E		; If I<=N GOTO L2
	SUB	L
	LD	A,D
	SBC	A,H
	JP	P,L2
	LD	HL,(GAP)
	JP	L0
;.....
;
;
; Returns SIGNED comparison
;
COMPARE:CALL	GETBAS
	ADD	HL,HL		; *2
	ADD	HL,BC		; +base
	EX	DE,HL		; 1st pointer to DE
	ADD	HL,HL
	ADD	HL,BC
	EX	DE,HL		; 2nd to HL
	LD	C,(HL)		; Fetch 1st to BC
	INC	HL
	LD	B,(HL)
	EX	DE,HL		; Fetch 2nd to HL
	LD	E,(HL)
	INC	HL
	LD	D,(HL)
	EX	DE,HL
;
;
; Should be 1+11+ext - sort by userno,NAME,TYPE,extent
;
	LD	E,13
;
COMPBH:	LD	A,(HL)		; 7-bit signed compare of (BC), (HL)
	AND	7FH
	LD	D,A
	LD	A,(BC)
	AND	7FH
	CP	D
	INC	BC
	INC	HL
	RET	NZ
	DEC	E
	JP	NZ,COMPBH
	RET
;.....
;
; Swap entries in the order table
;
SWAP:	LD	A,0FFH
	LD	(NOSWAP),A
	CALL	GETBAS
	ADD	HL,HL		; *2
	ADD	HL,BC		; + base
	EX	DE,HL
	ADD	HL,HL		; *2
	ADD	HL,BC		; + base
	LD	C,(HL)
	LD	A,(DE)
	EX	DE,HL
	LD	(HL),C
	LD	(DE),A
	INC	HL
	INC	DE
	LD	C,(HL)
	LD	A,(DE)
	EX	DE,HL
	LD	(HL),C
	LD	(DE),A
	RET
;.....
;
;
GETBAS:	LD	BC,ORDER-2	; If TIME&DAT file
	LD	A,(TDFLAG)
	OR	A
	RET	Z
	INC	BC		; Start at 2nd entry
	INC	BC
	RET
;.....
;
;
;-----------------------------------------------------------------------
;
;	DATESTAMPER SUPPORT CODE
;
;	1. checks for presence of DateStamper(TM) file
;	2. re-writes time and date entries in sorted order
;	   corresponding to the new directory order.
;
;-----------------------------------------------------------------------
;
; Check 1st directory entry for "TIME&.DAT" file
;
CKTD:	LD	HL,TDNAM0	; User # 0 too
	LD	B,12
	PUSH	HL
	PUSH	BC
	LD	DE,TDFCB	; Initialize userno,name in fcb now
	CALL	MOVE
	XOR	A
	LD	B,36-12
;
ZLP:	LD	(DE),A
	INC	DE
	DEC	B
	JP	NZ,ZLP
	POP	BC
	POP	HL
	LD	DE,TBUFF	; See if it's the time&dat file
	CALL	MATCH7		; 
	JP	NZ,NOTD
	LD	A,0FFH
	JP	SETTD
;
NOTD:	XOR	A
;
SETTD:	LD	(TDFLAG),A	; Set flag if special file present
	RET
;.....
;
;
; Rewrite the TIME&DAT file in sorted order
;	1. read the file to (bufbase)
;	2. use ptrs to index to each 16-byte entry
;	3. write new records
;
DODATE:	LD	A,(TDFLAG)
	OR	A
	RET	Z		; No TIME&DAT file
	LD	C,RESET		; Directory has been changed
	CALL	BDOS		; Force new checksum in bdos
	CALL	SETCUR
;
;
; 1. open file to get all attributes
; 2. reset R/O bit
;
	LD	DE,TDFCB
	PUSH	DE
	LD	C,OPEN
	CALL	BDOS
	INC	A
	POP	DE
	JP	Z,TDOERR
	LD	HL,TDFCB+9	; Set file r/w
	LD	A,(HL)
	AND	7FH
	LD	(HL),A
	LD	C,ATTFN
	CALL	BDOS
;
DOD1:	LD	B,0		; Record counter
	LD	HL,(BUFBASE)
;
TDRLP:	EX	DE,HL
	PUSH	DE
	PUSH	BC
	LD	C,DMAFN
	CALL	BDOS
	LD	DE,TDFCB
	LD	C,READFN
	CALL	BDOS
	OR	A
	POP	BC
	POP	DE
	JP	NZ,RDDONE
	INC	B
	LD	HL,80H
	ADD	HL,DE
	JP	TDRLP
;.....
;
;
RDDONE:	LD	HL,(BUFBASE)
;
; Check the checksum for all records
;
CKLP:	PUSH	BC
	CALL	CKSUM
	CP	(HL)
	INC	HL
	POP	BC
	JP	Z,SOK
	CALL	ILPRT
	DEFB	CR,LF,'Checksum error in original "!!!TIME&.DAT" file'
	DEFB	' -- proceeding',0
;
SOK:	DEC	B
	JP	NZ,CKLP
;
;
; Initialize for writing
;
	XOR	A
	LD	(TDFCB+12),A	; Extent
	LD	(TDFCB+32),A	; Currec
	CALL	DMA80
	LD	HL,ORDER	; Initialize ptr
	LD	(PTR),HL
	LD	HL,(TDCNT)
;
WTLP1:	PUSH	HL
;
;
; Copy 8  time&date entries to TBUFF
;
	LD	DE,TBUFF
	LD	B,8
;
WTLP2:	PUSH	BC		; +1
	PUSH	DE		; +2
	LD	HL,(PTR)	; Get  ptr to next entry
	LD	E,(HL)
	INC	HL
	LD	D,(HL)
	INC	HL
	LD	(PTR),HL	; Save next ptr
;
;
; DateStamper entries are 16 bytes
;
	LD	HL,(BUFBASE)	; Get: BUFBASE + [(PTR)-BUFBASE]/2
	PUSH	HL
	EX	DE,HL
	CALL	SUBDE		; (PTR)-BUFBASE
	CALL	ROTRHL		; /2
	POP	DE		; + BUFBASE
	ADD	HL,DE		; 
	POP	DE		; Move it to TBUFF
	CALL	MOVE16		; De points to next slot in TBUFF
	POP	BC		; +0
	DEC	B
	JP	NZ,WTLP2
	LD	HL,TBUFF	; Update the record's checksum byte
	CALL	CKSUM
	LD	(HL),A
	LD	DE,TDFCB	; Write the record
	LD	C,WRITFN
;
DBUG:	CALL	BDOS
	OR	A
	POP	HL
	JP	NZ,TDWERR
	DEC	HL		; Count down
	LD	A,H
	OR	L
	JP	NZ,WTLP1
	LD	DE,TDFCB	; Close TIME&DAT file
	PUSH	DE
	LD	C,CLOSE
	CALL	BDOS
	POP	DE
	INC	A
	JP	Z,TDCERR
	LD	HL,TDFCB+9	; Return file to R/O status
	LD	A,(HL)
	OR	80H
	LD	(HL),A
	LD	C,ATTFN
	JP	BDOS
;.....
;
; Check-sum 1st 127 bytes at (HL)
;
CKSUM:	LD	B,127
	XOR	A
;
CKSU1:	ADD	A,(HL)
	INC	HL
	DEC	B
	JP	NZ,CKSU1
	RET
;.....
;
;
TDNAM0:	DEFB	0,'!!!TIME&DAT'
;
TDOERR:	CALL	ILPRT
	DEFB	CR,LF,7,'Can''t open',0
;
FNERR:	CALL	ILPRT
	DEFB	' "!!!TIME&.DAT" file!',CR,LF,0
	RET
;.....
;
;
TDWERR:	CALL	ILPRT
	DEFB	CR,LF,7,'Write error',0
	JP	FNERR
;.....
;
;
TDCERR:	CALL	ILPRT
	DEFB	CR,LF,7,'Close error',0
	JP	FNERR
;.....
;
;
;-----------------------------------------------------------------------
;
;		  MISCELLANEOUS SUPPORT ROUTINES
;
;-----------------------------------------------------------------------
;
SETCUR:	LD	A,(CURDSK)
	LD	E,A		; Put drive back
	LD	C,SELDRV
	JP	BDOS
;.....
;
;
; Compare B bytes at DE and HL - (W/O attributes )
;
MATCH7:	LD	A,(DE)
	XOR	(HL)
	AND	7FH		; Ignore attributes
	RET	NZ
	INC	HL
	INC	DE
	DEC	B
	JP	NZ,MATCH7
	RET
;.....
;
;
; Utility subtraction subroutine...HL = HL-DE
;
SUBDE:	LD	A,L
	SUB	E
	LD	L,A
	LD	A,H
	SBC	A,D
	LD	H,A
	RET
;.....
;
;
; Divide HL by 2
;
ROTRHL:	OR	A		; Clear carry
	LD	A,H
	RRA
	LD	H,A
	LD	A,L
	RRA
	LD	L,A
	RET
;.....
;
;
; Come here if we get a read error
;
RERROR:	CALL	ILPRT
	DEFB	'++ READ ERROR - NO CHANGE made'
	DEFB	CR,LF,0
	JP	EXIT
;.....
;
;
; Come here if we get a write error
;
WERROR:	CALL	ILPRT
	DEFB	'++ WRITE ERROR - '
	DEFB	'directory left in UNKNOWN condition',CR,LF,0
	JP	EXIT
;.....
;
;
; M/PM OR CP/M 3.0 not allowed with this program
;
MPMYES:	CALL	ILPRT
	DEFB	CR,LF,'SAP '
	DEFB	VERS/10 +'0','.',(VERS MOD 10) +'0'
	DEFB	' not useable with M/PM or CP/M 3.0',0
	JP	EXIT
;.....
;
;
; Data area
;
ADDR:	DEFS	2
DIRLEN:	DEFS	2
DIRCNT:	DEFS	2
I:	DEFS	2
J:	DEFS	2
GAP:	DEFS	2
JG:	DEFS	2
RECTBL:	DEFS	2
RECORD:	DEFS	2
TRACK:	DEFS	2
TDCNT:	DEFS	2
NOSWAP:	DEFS	1
VERFLG:	DEFS	1
WRFLAG:	DEFS	1
TDFLAG:	DEFS	1
CLEANFLG:
	DEFS	1
;
;
; Disk parameter block:
;
DPB:
SPT:	DEFS	2
BSH:	DEFS	1
BLM:	DEFS	1
EXM:	DEFS	1
DSM:	DEFS	2
DRM:	DEFS	2
AL0:	DEFS	1
AL1:	DEFS	1
CKS:	DEFS	2
SYSTRK:	DEFS	2
CURDSK:	DEFS	1
O$DISK:	DEFS	1
O$USER:	DEFS	1
BUFBASE:DEFS	2
PTR:	DEFS	2
SCOUNT:	DEFS	2
;
TDFCB:	DEFS	36		; DateStamper file control block
;.....
;
;
VECTRS:	DEFS	17*3		; Room for jump vectors
;
WBOOT	EQU	VECTRS+3	; Do not change these equates
CSTS	EQU	VECTRS+6
CI	EQU	VECTRS+9
CO	EQU	VECTRS+12
LO	EQU	VECTRS+15
PO	EQU	VECTRS+18
RI	EQU	VECTRS+21
HOME	EQU	VECTRS+24
SELDSK	EQU	VECTRS+27
SETTRK	EQU	VECTRS+30
SETREC	EQU	VECTRS+33
SETDMA	EQU	VECTRS+36
READ	EQU	VECTRS+39
WRITE	EQU	VECTRS+42
LSTS	EQU	VECTRS+45	; Only in CP/M 2.2
RECTRN	EQU	VECTRS+48	; Only in CP/M 2.2
;.....
;
;
;
	DEFS	32		; Minimum stack depth
;
;
EVEN	EQU	($+255)/256*256	; Start buffer on even page, which also
				;   can increase stack area greatly
;
	ORG	EVEN
;
STACK	EQU	$-2
;
ORDER:	DEFS	0
;
;
	END