;LBPURGE/ASM - PURGE Command
	TITLE	<PURGE - LS-DOS 6.3>
;
LF	EQU	10
CR	EQU	13
PAR_ERR	EQU	44		;Parameter Error
PASSWORD	EQU	42E0H
;
*GET	SVCMAC:3		;SVC Macro equivalents
;
	ORG	2400H
;
PURGE	@@CKBRKC		;Break key down?
	JR	Z,BEGINA	;Ok if not
	LD	HL,-1		;  else abort
	RET
;
BEGINA	LD	(SAVESP+1),SP	;Save stack pointer
	PUSH	HL		;Save cmdline ptr
	@@FLAGS
	PUSH	IY
	POP	DE		;Flag base to DE
	LD	HL,'Y'-'A'	;Year type flag
	ADD	HL,DE
	LD	(YFLAG1),HL
	LD	(YFLAG2),HL	;Save for date dsply
	POP	HL		;Restore cmdline ptr
PURGE1	LD	A,(HL)		;Bypass cmd line blanks
	INC	HL
	CP	' '
	JR	Z,PURGE1
	LD	DE,BLANKS	;Pt to filespec area
	LD	B,8		;Init for file name
	CP	'-'		;If -, set up flag
	JR	NZ,PUR0
	LD	(MFLG+1),A
	LD	A,(HL)
	INC	HL
PUR0	CALL	PRSPEC
	CP	'.'		;Also as extent
	JR	Z,PUR1A
	CP	'/'		;Ck on file EXT entered
	JR	NZ,PUR1		;Jump if no extension
PUR1A	LD	DE,BLANKS+8	;Point to ext field
	LD	B,3		;Max 3 chars
	LD	A,(HL)
	INC	HL
	CALL	PRSPEC		;Ck on EXT
PUR1	CP	':'		;Drive entered?
	LD	C,0		;Init to drive 0
	JR	NZ,PRMERRA	;Quit if no drive #
	LD	A,(HL)		;P/u drive #
	INC	HL		;Bump to next field
	CALL	PATCH1		;Ck drive range 0-7
	LD	B,C		;Set bit instruct
	INC	B		;Always once
	LD	A,47H-8
PUR2A	ADD	A,8
	DJNZ	PUR2A
	LD	(DVTEST1),A	;This is bit x,a
	LD	(DVTEST2),A	;  opcode
	LD	A,C		;Xfer drive to regA
	LD	(TSTMPW+1),A	;  & stuff for later
	@@CKDRV			;Ck if drive available
	LD	A,32		;"drive not avail...
	CALL	PATCH2		;Ck WP or missing disk
	@@GTDCT			;DCT to reg IY
	LD	DE,PRMTBL$	;Get parms
	@@PARAM
PRMERRA	JP	NZ,PRMERR	;Jump on error
DATPRM	LD	HL,0		;P/u date="from-to"
	LD	A,H
	OR	L
	JR	Z,PUR3		;Bypass if not entered
	LD	A,(HL)		;Check for "-to"
	CP	'-'
	JR	Z,CKTO
	LD	A,80H		;Set from bit
	LD	(FTFLG),A	;Note from entered
	CALL	PAKDAT		;Pack the date entry
	JP	NZ,IOERR	;Quit if bad date
	LD	(FMPAKD),BC
	LD	A,(HL)
	CP	'"'
	JR	Z,FRCTO
	CP	'-'		;Check for "-to"
	JR	NZ,PUR3
CKTO	INC	HL		;Bypass the '-'
	LD	A,(HL)		;Ck for end of parm
	CP	'"'
	JR	Z,PUR3		;Go on parm end
	CALL	PAKDAT		;  else pack the date
	JP	NZ,IOERR	;Quit on bad date
FRCTO	LD	A,(FTFLG)
	OR	1		;Set TO bit
	LD	(FTFLG),A
	LD	(TOPAKD),BC	;Stuff for later
PUR3	LD	A,(QPARM+1)	;Query parm used?
	OR	A
	JR	Z,DOEVER	;Go if not
	CALL	CKINDO		;Invalid command during
	JP	NZ,IOERR	;  <DO> processing
DOEVER	CALL	TSTMPW		;Ck on master password
	JP	NZ,IOERR	;Go if worng
	LD	A,(TSTMPW+1)	;P/u drive
	LD	C,A
	LD	D,(IY+9)	;Get DIR cylinder
	LD	E,1		;Pt to HIT sector
	LD	HL,HITBUF
	@@FLAGS			;Pt IY => Flags
	@@RDSSC			;Read the HIT
	LD	A,16H		;Init "HIT read error...
	JP	NZ,IOERR	;Abort on read error
	JR	SCNH3
;
;	Major loop to scan HIT for files
;
SCNHIT	POP	HL
SCNH1	POP	BC		;Rcvr HIT ptr DEC
	LD	H,HITBUF<-8	;Pt to hi-order buffer
	LD	L,B		;Set lo-order DEC
SCNH2	LD	A,L
	ADD	A,32		;Pt to next one in
	LD	L,A		;Same dir sector
	JR	NC,SCNH3	;Jump if still in sector
	INC	L		;Bump to next dir sector
	CP	1FH		;End of the line?
	JR	NZ,SCNH3	;Loop if not
	LD	C,CR
	@@DSP			;Write new line & exit
	JP	EXIT
;
;	Routine to check on dir record in use
;
SCNH3	LD	A,L		;Ignore BOOT & DIR
	AND	0FEH
	JR	Z,SCNH2
	LD	A,(HL)		;P/u HIT hash byte
	OR	A
	JR	Z,SCNH2		;Ignore if spare
	LD	B,L		;Save DEC
	PUSH	BC
	LD	A,L		;Get record # in L
	AND	0E0H
	LD	L,A
	XOR	B		;Get sector # in A
SCNH3A	CP	0FFH		;Same as what's in core?
	JR	Z,SCNH4		;Bypass if same
	LD	(SCNH3A+1),A	;Update indicator byte
	@@DIRRD			;Read this directory
	JP	NZ,IOERR	;Quit on read error
	LD	A,H		;Set SBUFF pointer
	LD	(SCNH4+1),A
SCNH4	LD	H,0		;Pt to dir buf hi-order
	LD	A,(HL)		;L set to lo-order
	BIT	4,A		;Ignore if not assigned
	JR	Z,SCNH1
	BIT	7,A		;Ignore if it's an
	JR	NZ,SCNH1	;  extended dir record
	BIT	6,A		;Jump if not a SYS file
	JR	Z,CKINV
SPARM	LD	DE,0		;P/u S-parm
	LD	A,D
	OR	E		;Ignore this one if
	JP	Z,SCNH1		;  S-parm not entered
	JR	CKNAM
;
;	Non-SYS file
;
CKINV	BIT	3,A		;Jump if visible
	JR	Z,CKNAM
IPARM	LD	DE,0		;I-parm
	LD	A,D		;Ignore if I-parm not
	OR	E		;  entered as this file
	JP	Z,SCNH1		;  is invisible
;
;	Parms match, grab filename & check class
;
CKNAM	PUSH	HL		;Save ptr to record
	LD	A,L		;Pt to filename in dir
	ADD	A,5
	LD	L,A
	LD	DE,BLANKS	;Pt to parsed input
	LD	B,11		;Ck name/ext (11-chars)
SCNH5	LD	A,(DE)
	CP	'$'		;Wild char?
	JR	Z,SCNH6		;Always a match
	CP	(HL)		;Not global, char match?
	JR	Z,SCNH6		;Ck more if match
	CP	' '		;Blank = end of ck
	JR	NZ,MFLG		;If not blank, no match
SCNH6	INC	HL		;Bump pointers
	INC	DE
	DJNZ	SCNH5		;Loop for 11 chars
	LD	A,(MFLG+1)	;Bypass if a match but
	OR	A		;  - exclude given
	JP	NZ,SCNHIT
	JR	SCNH6A
MFLG	LD	A,0		;Ignore if no match &
	OR	A		;  no exclude given
	JP	Z,SCNHIT
SCNH6A	POP	HL		;Rcvr ptr to DIR+0
	PUSH	HL
;
;	Now check if date matches
;
	INC	HL		;Pt to date field
	CALL	UNPACK		;Alter date for cpr
	LD	A,(FTFLG)
	RLCA			;Tst fm bit
	JR	NC,SCNH6B
	LD	A,D		;Ignore if no date
	OR	E		;  in DIR for file
	JP	Z,SCNHIT
	LD	HL,(FMPAKD)	;P/u user entry
	EX	DE,HL
	CALL	CPHLDE		;HL-DE
	EX	DE,HL
	JP	C,SCNHIT	;Go if out of range
SCNH6B	LD	A,(FTFLG)
	RRCA			;Tst TO bit
	JR	NC,MATCHES	;Go if no TOPARM
	LD	A,D		;  else ck if file is dated
	OR	E
	JP	Z,SCNHIT	;Go if no dir date
	LD	HL,(TOPAKD)	;P/u user's packed date
	CALL	CPHLDE		;HL-DE
	JP	C,SCNHIT	;Go if out of range
MATCHES	POP	HL		;Rcvr pointer to DIRREC
DONAM	PUSH	HL
	LD	A,L		;  & point to file name
	ADD	A,5
	LD	L,A
	LD	DE,FCB1$	;Pt to name/ext buffer
	LD	B,8		;Max 8-char name
DONAM1	LD	A,(HL)		;Move filename into
	CP	' '		;  buffer until space
	JR	Z,DONAME2	;  or 8 characters
	LD	(DE),A
	INC	HL
	INC	DE
	DJNZ	DONAM1
DONAME2	LD	A,L		;Point to file ext
	ADD	A,B
	LD	L,A
	LD	A,(HL)		;Is there an extension?
	CP	' '
	JR	Z,DONAM5	;Bypass if not
	LD	A,'/'
	LD	(DE),A		;Stuff ext separator
	INC	DE
	LD	B,3		;Init 3-char ext max
DONAM4	LD	A,(HL)		;Transfer up to space
	CP	' '		;  or 3 chars
	JR	Z,DONAM5
	LD	(DE),A
	INC	HL
	INC	DE
	DJNZ	DONAM4
DONAM5	LD	A,':'		;Add the drivespec
	LD	(DE),A
	INC	DE
	LD	A,(TSTMPW+1)	;P/u drivespec
	OR	'0'		;Make it ASCII & stuff
	LD	(DE),A
	INC	DE
	LD	A,3		;Terminate with ETX
	LD	(DE),A
	PUSH	DE		;Save pointer
QPARM	LD	DE,-1		;Query each file?
	LD	A,D
	OR	E
	JP	Z,NOPRMPT	;Not if not Q=N
;
	@@DSPLY	PRGFIL$		;"Purge file?...
	POP	DE		;Rcvr ptr to file buf ETX
	POP	HL		;Rcvr ptr to 1st dir byte
	PUSH	DE
	INC	HL		;Pt to MOD bit
	BIT	6,(HL)		;Test MOD flag
	JR	Z,SCDAT1	;Go if not mod'ed
	LD	A,' '		;Put a space
	LD	(DE),A
	INC	DE
	LD	A,'+'		;  and the mod sign
	LD	(DE),A
	INC	DE
SCDAT1	LD	A,' '		;Write a space
	LD	(DE),A
	INC	DE
	INC	HL		;Advance to date field
	EX	DE,HL
	LD	(HL),'{'	;Stuff left brace
	INC	HL
	EX	DE,HL
	LD	A,(HL)
	OR	A
	JR	Z,SCDAT4	;Ignore if no date saved
	RRCA			;Has date, get day
	RRCA
	RRCA
	AND	1FH
	LD	B,2FH		;Convert day to decimal
SCDAT2	INC	B		;  by counting # of 10's
	SUB	10		;Sub 10 from day #
	JR	NC,SCDAT2
	ADD	A,3AH		;Cvrt lo order to ASCII
	PUSH	AF		;Save day low order
	LD	A,B		;Stuff day hi order
	LD	(DE),A
	INC	DE		;Bump
	POP	AF		;Rcvr lo order day #
	LD	(DE),A		;Stuff low order
	INC	DE		;Bump pointer to msg
	LD	A,'-'		;Init seperator
	LD	(DE),A		;  and stuff in buffer
	INC	DE		;Pt to month field
	PUSH	HL		;Save DIR ptr
	DEC	HL		;Pt to DIR+1 (month+)
	LD	A,(HL)		;P/u month etc
	AND	0FH		;Strip off flags
	DEC	A		;(mon-1)*3 indexes string
	LD	C,A		;  conversion table
	RLCA
	ADD	A,C
	LD	C,A
	LD	B,0
	LD	HL,MONTBL
	ADD	HL,BC		;Add offset to tbl start
	LD	C,3
	LDIR			;Move 3-char month
	LD	A,'-'		;Suff separator char
	LD	(DE),A
	INC	DE		;Advance to year field
	POP	HL		;Get ptr to dir+2
	LD	C,'8'		;Init 1980
	LD	A,($-$)		;Year type flag
YFLAG2	EQU	$-2
	DB	0CBH
DVTEST2	DB	47H
	JR	NZ,NEWDT2	;Using new style
	LD	A,(HL)		;Get old date
	AND	7
	JR	THERE		;Make for dsp
NEWDT2	LD	A,L
	ADD	A,17		;Pt to new year
	LD	L,A
	LD	A,(HL)		;get year
	AND	1FH
	CP	10		;1980's
	JR	C,THERE		;Go if so
	LD	C,'9'
	SUB	10		;Sub off decade
	CP	10		;Must be less
	JR	C,THERE
	LD	A,9		;Else bogus, use 1999
THERE	LD	B,A		;Save year
	LD	A,C
	LD	(DE),A		;Stuff decade
	INC	DE
	LD	A,B
	ADD	A,'0'		;Make ascii
	LD	(DE),A		;Stuff year
	INC	DE
SCDAT4	LD	A,3		;Show etx for display
	LD	(DE),A
	@@DSPLY	FCB1$		;Display filename
	@@DSPLY	QMARK$		;Display ???
	LD	HL,LILBUF$	;Get response y,n
	LD	BC,3<8		;For Yes, No
	@@KEYIN
	JP	C,BREAK		;Abort on <BREAK>
	LD	A,(HL)		;P/u response
	RES	5,A		;Strip l/c if entered
	CP	'Y'		;Is it yes?
	JP	NZ,SCNHIT	;Bypass if not
	EX	(SP),HL		;Place dummy HL below
	PUSH	HL		;  pointer
NOPRMPT	BIT	0,(IY+'K'-'A')	;Ck if BREAK bit in
	JP	NZ,BREAK	;  KFLAG is active
	@@LOGOT	PURGE$		;Dsply "Purging: "
	POP	HL		;Get pointer where ETX is
	LD	(HL),CR		;  & replace with CR
	@@LOGOT	FCB1$		;Dsply filename
	POP	HL		;Pop dummy or DIRREC ptr
	POP	BC		;Get drive & DEC
	PUSH	BC
	LD	A,B		;P/u the DEC
	LD	(FCB+7),A	;  & stuff
	LD	A,(TSTMPW+1)	;P/u drive
	LD	(FCB+6),A	;  & stuff
	LD	A,1		;Set up FCB for remove
	LD	(FCB+1),A
	LD	A,80H		;Show FCB as open
	LD	(FCB),A
	LD	DE,FCB		;Remove the file
	@@REMOV
	JP	NZ,IOERR	;Jump on error
	LD	A,0FFH		;Show we don't have the
	LD	(SCNH3A+1),A	;  latest dir record
	JP	SCNH1		;Loop
;
;	Routine to get the master password & match it
;
TSTMPW	LD	C,$-$		;Init to drive requested
	CALL	GATRD		;Read GAT into GATBUF
	RET	NZ		;Back on error
	LD	HL,(GATBUF+0CEH)
	LD	DE,PASSWORD	;Password="PASSWORD" ?
	XOR	A
	SBC	HL,DE
	RET	Z		;Back if PASSWORD
;
;	MPW is not "PASSWORD" - check entry match
;
PWPARM	LD	DE,0		;P/u MPW string addr
	LD	HL,MPW$		;Init prompt
	CALL	GETMPW		;Hash parm or entry
	RET	NZ
	EX	DE,HL		;Xfer hashed MPW to DE
	LD	HL,(GATBUF+0CEH)	;Grab pack MPW &
	XOR	A		;  check if user entered
	SBC	HL,DE		;  the pack MPW
	LD	HL,BADMPW$	;Init error pointer
	LD	A,63		;Set extended error
	RET			;Z or NZ
;
;	Routine to get 8-char password
;
GETMPW	CALL	GMPW1		;Test if user entered MPW
	RET	NZ
	LD	A,0E4H		;Hash password (DE) to HL
	RST	28H		;Ret to what called
GMPW1	LD	A,D		;Test if user entered MPW
	OR	E
	JR	Z,GMPW3		;Prompt if not
	INC	A		;  or no operand
	JR	Z,GMPW3
;
;	Place entered password into buffer
;
	LD	HL,BUFFER
	PUSH	HL
	LD	B,8		;Max entry of 8 chars
GMPW2	LD	A,(DE)		;P/u pswd char
	CP	CR		;End of the line?
	JR	Z,GMPW4		;Space out if so
	CP	','		;Comma separator?
	JR	Z,GMPW4
	CP	'"'		;Closing quote?
	JR	Z,GMPW4
	INC	DE
	LD	(HL),A		;Xfer the char
	INC	HL
	DJNZ	GMPW2		;Loop for 8
	JR	GMPW5
;
;	Not entered as parm, grab from keyboard
;
GMPW3	CALL	CKINDO		;Can't prompt in <DO>
	RET	NZ
	@@DSPLY			;Display request
	RET	NZ
	LD	BC,8<8		;Max 8 chars input
	LD	HL,BUFFER	;Pt to buffer
	PUSH	HL
	@@KEYIN			;Get parm input
	JP	C,BREAK		;Exit on Break
	EX	DE,HL		;Buf start to DE
	LD	H,0		;Buf len to HL
	LD	L,B
	ADD	HL,DE		;Pt to 1st unused pos
	LD	A,8		;Calculate spaces needed
	SUB	B
	JR	Z,GMPW5		;Ret if none needed
	LD	B,A		;Set counter for spaces
GMPW4	LD	(HL),' '	;  & put them in
	INC	HL
	DJNZ	GMPW4
;
;	Convert (SP) through (SP)+7 to upper case
;
GMPW5	POP	HL		;Rcvr pointer to buf
	PUSH	HL
	LD	B,8		;Loop through field
GMPW6	LD	A,(HL)
	CP	'a'
	JR	C,GMPW7
	CP	'z'+1
	JR	NC,GMPW7
	RES	5,(HL)		;L/c -> U/C
GMPW7	INC	HL
	DJNZ	GMPW6
	POP	DE		;Rcvr ptr to start
	XOR	A		;Indicate no error
	RET
;
;	Routine to read the granule allocation table
;
GATRD	PUSH	DE
	PUSH	HL
	LD	D,(IY+9)	;Dir cylinder
	LD	HL,GATBUF
	LD	E,L		;Set to sector 0
	@@RDSSC
	POP	HL
	POP	DE
	LD	A,14H		;Init "GAT read error
	RET			;Z or NZ
;
;	Routine to check if <DO> active
;
CKINDO	PUSH	IY
	@@FLAGS
	BIT	5,(IY+'S'-'A')	;Set if DO active
	POP	IY
	RET	Z
	LD	HL,NOINDO$
	LD	A,63
	RET
;
;	Parse file name or ext on command line
;
PRSPEC	CP	'*'
	JR	NZ,PS4
	LD	A,'$'		;Wild card char
PS5	LD	(DE),A		;Store it
	DJNZ	PS5
	LD	A,(HL)		;P/u terminator
	INC	HL
	RET
;
PS4	CP	'$'		;Wild character?
	JR	Z,PRS2		;Always a match
	CP	'A'		;Ck on filename entry
	JR	NC,PRS1		;Jump if possible alpha
	CP	'9'+1		;Ck on 0-9
	RET	NC		;Bad if > 9 and < A
	CP	'0'
	RET	C		;Bad if < 0
PRS1	CP	'a'		;Cvrt to UC if needed
	JR	C,PRS2
	CP	'z'+1
	JR	NC,PRS2
	RES	5,A
PRS2	LD	(DE),A		;Xfer char to buffer
	INC	DE		;Bump dest ptr
	LD	A,(HL)		;Get next char
	INC	HL		;Bump source ptr
	DJNZ	PRSPEC		;Loop 8 max
	RET
;
;	Routine to extract date from directory
;
UNPACK	LD	A,(HL)		;P/u DIR+1
	AND	0FH		;Mask all but month
	LD	E,0
	SRL	A
	RR	E
	LD	D,A		;Month to DE
	INC	HL		;Pt to day
	LD	A,(HL)
	AND	0F8H		;Mask off year
	RRCA			;Day to bits 2-6
	OR	E
	LD	E,A		;Mon,day in E
	LD	A,($-$)		;Get YFLAG
YFLAG1	EQU	$-2
	DB	0CBH		;Bit x,A
DVTEST1	DB	47H
	JR	NZ,NEWDT	;Go if new style
	LD	A,(HL)
	AND	7		;Get old style date
SHFTD	RLCA
	RLCA
	RLCA
	OR	D		;Merge year w/MSbits mon
	LD	D,A
	RET
;
NEWDT	LD	A,L		;Pt to new year style
	ADD	A,17
	LD	L,A
	LD	A,(HL)		;Get year
	AND	1FH		;Mask mins
	JR	SHFTD		;Store
;
;	Pack user date string
;
PAKDAT	LD	A,(HL)
	LD	C,'/'		;Init separator
	CALL	PARSDAT		;Parse entry
	JR	NZ,BADFMT	;Jump on format error
	EX	DE,HL
	LD	A,(LILBUF$)	;Is year a leap year?
	AND	3
	LD	HL,MAXDAYS+1	;Set Feb to have 29 days
	JR	NZ,$+3		;  if so
	INC	(HL)
	LD	A,(LILBUF$+2)	;P/u month
	DEC	A		;Range check
	CP	12
	JR	NC,BADFMT	;Go if 0 or >12
	DEC	HL		;Point to Jan entry
	ADD	A,L		;Index the month
	LD	L,A
	LD	A,H
	ADC	A,0
	LD	H,A
	LD	A,(LILBUF$+1)	;P/u day entry
	DEC	A		;Reduce for test (0->FF)
	CP	(HL)
	JR	NC,BADFMT	;Go if too large (or 0)
	LD	HL,LILBUF$+2	;Pt to month
	LD	B,(HL)		;Get month
	LD	C,0
	SRL	B		;Split month to BC
	RR	C
	DEC	HL
	LD	A,(HL)		;Get day
	RLCA			;Shift into bits 2-6
	RLCA
	OR	C
	LD	C,A		;Merge day into C
	DEC	HL
	LD	A,(HL)		;Get year
	SUB	80		;Offset only
	JR	NC,GDATE	;OK if >= 1980
	XOR	A		;  else use 1980
GDATE	RLCA			;Shift into bits 3-7
	RLCA
	RLCA
	OR	B		;  & merge with month
	LD	B,A
	EX	DE,HL
	XOR	A		;Set Z, no error
	RET
;
BADFMT	LD	HL,BADFMT$	;Init error pointer
	LD	A,63		;Set extended error
	OR	A
	RET
;
;	Routine to parse DATE/TIME entry
;
PARSDAT	LD	DE,LILBUF$+2	;Point to buf end
	LD	B,3		;Process 3 fields
PRSD1	PUSH	DE		;Save pointer
	CALL	PRSD2		;Get a digit pair
	POP	DE		;Recover pointer
	RET	NZ		;Ret if bad digit pair
	LD	(DE),A		;  else stuff the value
	DEC	DE		;Backup the pointer
	DEC	B		;Loop countdown
	RET	Z
	LD	A,(HL)		;Ck for valid separator
	INC	HL		;Bump pointer
	CP	C		;Separator char required
	JR	Z,PRSD1		;Loop if match
	RET			;  else ret bad (NZ)
;
;	Routine to parse a digit pair
;
PRSD2	CALL	PRS4		;Get a digit
	JR	NC,PRSD3	;Jump if bad digit
	LD	E,A		;Multiply by ten
	RLCA
	RLCA
	ADD	A,E
	RLCA
	LD	E,A
	CALL	PRS4		;Get another digit
	JR	NC,PRSD3	;Jump on bad digit
	ADD	A,E		;Accumulate new digit
	LD	E,A		;Save 2-digit value
	XOR	A		;Clear flags
	LD	A,E		;Xfer field value
	RET
;
PRSD3	OR	A		;Set NZ
	RET
PRS4	LD	A,(HL)		;P/u a digit &
	INC	HL		;  convert to binary
	SUB	'0'
	CP	10
	RET
;
;	Routine to compare DE to HL
;
CPHLDE	LD	A,H
	SUB	D
	RET	NZ
	LD	A,L
	SUB	E
	RET
;
;	Error processing
;
PRMERR	LD	A,PAR_ERR	;Parameter Error
IOERR	CP	63		;Extended error?
	JR	Z,EXTERR
	LD	L,A
	LD	H,0
	OR	0C0H		;Abbrev & return
	LD	C,A
	@@ERROR
	JR	SAVESP
;
;	BREAK handler routine
;
BREAK	@@CKBRKC		;Clear Break Bit
ERREXIT	LD	HL,-1
SAVESP	LD	SP,$-$		;Restore the stack
	LD	(RETCOD),HL
EXIT	EQU	$		;Exit clears Break
	LD	HL,0
RETCOD	EQU	$-2
	@@CKBRKC
	RET
;
EXTERR	@@LOGOT
	JR	ERREXIT
NOINDO$	DB	'Invalid command during <DO> '
	DB	'processing',CR
MPW$	DB	'Master password ?      ',3
BADMPW$	DB	'Invalid master password',CR
MAXDAYS	DB	31,28,31,30,31,30,31,31,30,31,30,31
BADFMT$	DB	'Bad date format',CR
;
PRGFIL$	DB	'Purge file: ',3
QMARK$	DB	'} ?  ',3
PURGE$	DB	'Purging: ',3
MONTBL	DM	'JanFebMarAprMayJunJulAugSepOctNovDec'
BLANKS	DM	'           '
FTFLG	DB	0
FMPAKD	DS	2
TOPAKD	DS	2
LILBUF$	DS	4
FCB1$	DS	27
;
;	Parameter table
;
PRMTBL$	DB	80H
VAL	EQU	80H
SW	EQU	40H
STR	EQU	20H
SGL	EQU	10H
	DB	SW!SGL!3,'INV',0
	DW	IPARM+1
	DB	SW!SGL!3,'SYS',0
	DW	SPARM+1
	DB	SW!STR!SGL!3,'MPW',0
	DW	PWPARM+1
	DB	SW!SGL!5,'QUERY',0
	DW	QPARM+1
	DB	STR!SGL!4,'DATE',0
	DW	DATPRM+1
	NOP
;
FCB	DS	32
PATCH1	SUB	'0'		;Cvrt to binary
	CP	7+1
	JP	NC,PRMERR
	LD	C,A
	RET
;
PATCH2	JP	NZ,IOERR	;Go on CKDRV error
	LD	A,15		;Init WP error
	JP	C,IOERR		;Exit if WP
	RET
;
	ORG	$<-8+1<+8
BUFFER	DS	256
GATBUF	DS	256
HITBUF	DS	256
LAST	EQU	$-1
;
	END	PURGE
