;SYS3/ASM - LS-DOS 6.3
	TITLE	<SYS3 - LS-DOS 6.3>
;
*LIST	OFF			;Get SYS0/EQU
*GET	SYS0/EQU:2
*LIST	ON
LF	EQU	10
CR	EQU	13
;
*GET	COPYCOM:3		;Copyright message
;
	ORG	1E00H
;
SYS3	AND	70H
	RET	Z		;Back on zero entry
	CP	10H
	JR	Z,CLOSE		;Jump if close
	CP	20H
	JP	Z,FNAME		;Jump if filespec recover
	CP	30H
	JP	Z,DOID		;Get CS id number
	RET
CLOSE	LD	A,(DE)		;Test for device
	BIT	7,A
	JP	Z,CLOSDEV	;Jump if closing device
	CALL	CKOPEN@		;Test for open file
	LD	C,(IX+6)	;P/u drive #
;
;	Special MINI check drive routine
;
	PUSH	IY		;Save IY
	CALL	@GTDCT		;Pick up DCT for drive
CKAGN	CALL	@RSLCT		;Wait until not busy
	JP	NZ,HOLDUP	;Go to error handler
	BIT	3,(IY+3)	;If hard drive, bypass
	JR	NZ,SAWBLK
	BIT	4,(IY+4)	;If "ALIEN" by pass
	JR	NZ,SAWBLK
	BIT	7,(IY+4)	;Ck if CKDRV inhibit
	JR	NZ,SAWBLK	;Go if so
;
;	Test for diskette in drive (no index)
;
	PUSH	DE
	LD	D,(IY+5)	;P/u current track
	LD	E,0		;Set to sector 0
	CALL	@SEEK		;Do a command
	POP	DE
	LD	B,30H		;Set up count (short)
BLACK	CALL	@RSLCT		;Check for index pulse
	BIT	1,A		;Test index
	JR	Z,SAWBLK	;Saw black, seems OK
	DJNZ	BLACK
	JP	HOLDUP		;Close fault handler
;
;	Diskette is there, let's continue
;
SAWBLK	POP	IY		;Restore IY
	LD	B,(IX+7)	;P/u DEC of fpde
	CALL	@DIRRD		;Read the directory
	RET	NZ		;Quit if error there
	BIT	4,(HL)		;Ck for killed file
	RET	Z		;Quit if killed file
	PUSH	HL
	PUSH	BC
	CALL	RWRIT@		;Write last buffer?
	POP	BC
	POP	HL
	RET	NZ		;Ret on i/o error
	BIT	6,(IX+0)	;If user does not have
	JP	Z,RCVN0		;  close authority...
	INC	L		;  else reset possible
	RES	5,(HL)		;  file-open bit in DIR+1
	INC	L		;Determine if the EOF
	INC	L		;  byte has changed
	LD	A,(IX+8)	;P/u EOF byte offset
	PUSH	HL		;Save ptr to DIR+3
	CP	(HL)
	JR	NZ,CLOS1	;Go if moved
	LD	A,11H
	ADD	A,L
	LD	L,A
	LD	A,(IX+12)	;P/u lo-order ERN
	CP	(HL)
	JR	NZ,CLOS1	;Go if moved
	INC	L
	LD	A,(IX+13)	;P/u hi-order ERN
	CP	(HL)
	JR	NZ,CLOS1	;Go if moved
	POP	AF
	JR	CLOS2		;Didn't move
;
;	Routine to change the 3-byte EOF marker
;
CLOS1	POP	HL		;Pop DIR+3
	LD	A,(IX+8)	;Xfer the eof offset
	LD	(HL),A
	LD	A,11H
	ADD	A,L
	LD	L,A
	LD	A,(IX+12)	;  and the ERN from the FB
	LD	(HL),A
	INC	L
	LD	A,(IX+13)	;  to the DIR entry
	LD	(HL),A
	BIT	2,(IX+0)	;If file was updated
	JR	NZ,CLOS3	;  then update mod date
	JR	CLOS5		;  else don't
;
;	Three-byte EOF marker did not change
;
CLOS2	BIT	2,(IX+0)	;If file was updated
	JR	NZ,CLOS3	;  then update mod date
	BIT	6,(IX+0)	;If close authority then
	JR	NZ,CLOS5	;  write back the DIR
	JR	CLOS6		;  else continue
;
;	Routine to insert packed date into directory
;
CLOS3	PUSH	HL		;Save ptr to DIR+21
	LD	A,L		;Pt to start of dir rec
	AND	0E0H
	LD	L,A
	INC	L		;Pt to DIR+1
	SET	6,(HL)		;Set the MOD flag
	LD	DE,DATE$	;Point to year
	LD	A,(DE)		;P/u year and save
	PUSH	AF		;Save year
	PUSH	BC		;Must save BC
	INC	DE		;Pt to day
	INC	L		;DIR+2
	AND	7		;Old year mod 8
	LD	B,A		;Save bits 0-2
	LD	A,(DE)		;Get day
	RLCA			;Shift to bits 3-7
	RLCA
	RLCA
	OR	B		;Merge old bits 0-2
	LD	(HL),A		;Save day and old year
	DEC	L		;DIR+1
	INC	DE		;Pt to month
	LD	A,(DE)		;Get month
	LD	B,A		;Save tempy
	LD	A,(HL)
	AND	0F0H		;Mask old month
	OR	B		;Merge new
	LD	(HL),A		;Back in DIR+1
;
;	If old disk, dont do the rest
;
	LD	A,C		;Get drive
	AND	7
	LD	B,A		;Save in B
	INC	B		;Always do once
	LD	A,47H-8		;Set to make bit x,a
CLOS3A	ADD	A,8
	DJNZ	CLOS3A		;Add to get opcode
	LD	(CLOS3B),A	;Stuff opcode
	LD	A,(YFLAG$)	;Get date flag byte
	BIT	0,A		;Test the bit
CLOS3B	EQU	$-1
	JR	NZ,CLOS3C	;Go if new style
	POP	BC		;Clean off stack
	POP	AF		;  cause we're done
	JR	CLOS4
CLOS3C	LD	A,L		;Now pt to
	ADD	A,17		; DIR+18, time locn
	LD	L,A
	LD	DE,(TIME$+1)	;Get hours, mins
	LD	A,D		;Hours to A
	LD	D,E		;Mins to D
	LD	E,0		;Init fresh
	LD	B,3
CLOSD1	SRL	D
	RR	E
	DJNZ	CLOSD1		;Split mins to DE
	RLCA			;Shif hours bits 3-7
	RLCA
	RLCA
	OR	D		;Merge into D
	LD	D,A
	POP	BC		;Restore BC
	POP	AF		;Get back year
	OR	A		;Was year set?
	JR	Z,CLOSD2	;No, use 0
	SUB	80		;Get year offset
	OR	E		;Merge w/mins
	LD	E,A
CLOSD2	LD	(HL),D		;Save hours/mins
	INC	HL
	LD	(HL),E		;Save mins/year
CLOS4	POP	HL		;Rcvr DIR+21
CLOS5	PUSH	HL
	CALL	@DIRWR		;Write back DIR entry
	POP	HL
	RET	NZ
CLOS6	INC	L		;Pt to DIR+22 which is
	PUSH	HL		;  the 1st extent
	LD	A,L
	SUB	15H		;Backup to DIR+1
	LD	L,A
	BIT	7,(HL)		;Test if created
	POP	HL
	JP	NZ,RCVN0	;Bypass if created
	LD	DE,0		;Init gran counter
CLOS7	LD	A,(HL)		;P/u cyl indicator
	INC	L		;Pt to gran alloc
	CP	0FEH		;Extent in use?
	JR	NC,CLOS8	;Jump if spare or FXDE
	LD	A,(HL)		;P/u granule allocation
	INC	L		;Pt to next extent
	AND	1FH		;Strip off # of grans &
	INC	A		;  adjust for zero offset
	ADD	A,E		;Accumulate the number of
	LD	E,A		;  grans in this extent
	JR	NC,CLOS7	;Any previous quantity
	INC	D
	JR	CLOS7
CLOS8	JR	NZ,CLOS9	;Found all grans in this
	LD	B,(HL)		;  extent, ck for FXDE
	CALL	@DIRRD
	RET	NZ
	LD	A,L		;Point to extents in FXDE
	ADD	A,16H
	LD	L,A
	JR	CLOS7		;Go to continue count
;
;	Routine to determine need to deallocate
;
CLOS9	PUSH	HL		;Save ptr to last extent
	LD	L,(IX+12)	;P/u ending record #
	LD	H,(IX+13)
	LD	A,8		;Get # sectors/gran
	CALL	@DCTBYT
	AND	1FH		;Remove other data
	PUSH	AF		;Save the #
	ADD	A,L		;Round up to next
	LD	L,A		;  higher gran
	JR	NC,CLOS10
	INC	H
CLOS10	POP	AF		;Rcvr # sectors/gran
	INC	A		;Adjust for division
	CALL	@DIV16		;Calculate # grans in use
	XOR	A		;Subtract the # of grans
	EX	DE,HL		;  used from the # of
	SBC	HL,DE		;  grans allocated in the
	EX	DE,HL		;  directory, and move DE
	POP	HL		;Rcvr ptr to last extent
	JP	Z,RCVN0		;Jump if same quantity
	JP	C,RCVN0		;Jump if now more
;
;	Need to deallocate space
;
	CALL	@GATRD		;Read GAT
	RET	NZ
	JR	BAKUP		;B/u to last used extent
CLOS11	PUSH	DE		;Sv count of excess grans
	LD	A,(HL)		;P/u alloc info
	AND	0E0H		;Get starting relative
	RLCA			;  gran into reg-E
	RLCA
	RLCA
	LD	E,A
	LD	A,(HL)		;# of contiguous grans
	AND	1FH		;Remove unneeded data
	ADD	A,E		;Calculate ending
	LD	E,A		;  relative gran #
	LD	A,8		;P/u the # of grans
	CALL	@DCTBYT		;  per cylinder
	RLCA
	RLCA
	RLCA
	AND	7		;Move into bits 0-2
	INC	A		;Adjust for zero offset
	LD	D,A		;Save count
	LD	A,4
	CALL	@DCTBYT
	BIT	5,A		;2-sided disk?
	LD	A,D		;Rcvr count
	JR	Z,$+3		;Bypass if 1-sided
	RLCA			;Double count
	CALL	@DIV8		;A=quotient, E=remainder
	DEC	L		;Pt to starting cylinder
	ADD	A,(HL)		;Bump cyl pointer by how
	LD	D,A		;  many excessive cyls to
	PUSH	HL		;  start from the rear
	PUSH	BC
	LD	H,DIRBUF$<-8	;Pt to that cyl's GAT
	LD	L,D
	LD	B,(HL)		;P/u the GAT allocation
	LD	A,E
	CALL	CALCBIT		;Deallocate a gran
	LD	(HL),B		;Repl GAT byte
	POP	BC
	POP	HL
	INC	L		;Repoint to alloc info
	DEC	(HL)		;Reduce by 1 gran
	LD	A,(HL)		;Get info on contig gran
	INC	A		;Adj for zero offset
	AND	1FH		;Strip unneeded
	POP	DE		;Rcvr excess gran count
	DEC	DE		;  and count down
	JR	NZ,CLOS12	;Go if extent still used
BAKUP	LD	(HL),0FFH	;  else extent is spare
	DEC	L
	LD	(HL),0FFH
	DEC	L
	LD	A,L		;Chack if backed all the
	AND	1FH		;  way thru this entry
	CP	15H
	JR	NZ,CLOS12	;Go if not
	XOR	L		;Deallocate this FXDE
	LD	L,A
	BIT	7,(HL)		;Was it the FPDE?
	JR	Z,CLOS12	;Bypass if FPDE
	LD	(HL),0		;Show dir is spare
	CALL	@DIRWR		;Write back
	RET	NZ
	LD	A,B		;P/u deallocated DEC
	AND	0E0H
	INC	A		;Pt to DIR+1
	LD	L,A
	LD	A,(HL)		;P/u previous DEC
	LD	(STUFDEC+1),A	;Save in instruction
	CALL	@HITRD		;Read the HIT
	RET	NZ
	LD	L,B		;Point to deallocated HIT
	LD	(HL),0		;Deallocate space in HIT
	CALL	@HITWR		;Write back
	RET	NZ
STUFDEC	LD	B,0		;P/u previous DEC
	CALL	@DIRRD		;Read its dir entry
	RET	NZ
	LD	A,B
	OR	1FH		;Pt to end of entry
	LD	L,A
	LD	(HL),0FFH	;Erase pointer
	DEC	L		;  to deallocated FXDE
	LD	(HL),0FFH
	DEC	L		;Point to previous extent
	PUSH	HL		;Save pointer
	CALL	@DIRWR		;Write back
	POP	HL
	RET	NZ
CLOS12	LD	A,D		;Loop if still more to
	OR	E		;  deallocate
	JP	NZ,CLOS11
	CALL	@DIRWR
	JR	Z,CLOS13	;Go if no write error
	CP	15		;"write protected...
	RET	NZ		;Bad if not
	JR	RCVN0
;
CLOS13	CALL	@GATWR		;Write back the altered GAT
	RET	NZ
;
;	Routine starts to recover file spec
;
RCVN0	LD	A,(IX+7)	;P/u DEC of FPDE
	LD	C,(IX+6)	;P/u drive
	XOR	B		;Check if its directory
	AND	1FH		;  record is resident
	LD	B,(IX+7)	;P/u DEC of FPDE
	CALL	NZ,@DIRRD	;Get FPDE dir if needed
	RET	NZ
	PUSH	IX		;Transfer FCB to DE
	POP	DE
RCVNAM	LD	A,C
	AND	7		;Convert drive to ASCII
	OR	'0'
	LD	(RCVN5+1),A
	LD	H,SBUFF$<-8	;Pt to DIR+5 (name)
	LD	A,B
	AND	0E0H
	OR	5
	LD	L,A
	PUSH	HL		;Save name start posn
	LD	B,8		;Init 8 chars max
RCVN1	LD	A,(HL)		;Move filename from
	CP	' '		;  direc to fcb
	JR	Z,RCVN2
	LD	(DE),A
	INC	HL
	INC	DE
	DJNZ	RCVN1		;Loop up to 8
RCVN2	POP	HL
	LD	A,L
	ADD	A,8		;Pt to extension
	LD	L,A
	LD	A,(HL)
	CP	' '
	JR	Z,RCVN4		;Jump if none
	LD	A,'/'
	LD	(DE),A		;Stuff separator into fcb
	INC	DE
	LD	B,3		;Init 3-char extension
RCVN3	LD	A,(HL)		;Stuff the ext
	CP	' '		;  into fcb
	JR	Z,RCVN4
	LD	(DE),A
	INC	HL
	INC	DE
	DJNZ	RCVN3
RCVN4	LD	A,':'		;Stuff drive indicator
	LD	(DE),A
	INC	DE
RCVN5	LD	A,0		;P/u drive in ASCII
	LD	(DE),A		;  & stuff it
	INC	DE
	LD	A,3		;Close FCB with ETX
	LD	(DE),A
	XOR	A
	RET
;
;	Routine to recover the filespec
;
FNAME	PUSH	HL
	PUSH	DE
;
;	Calculate the number of directory sectors
;	= (#sectors x #heads) - 2 for GAT & HIT
;
	LD	A,7		;Get highest # sector
	CALL	@DCTBYT
	LD	D,A		;Store heads & sectors
	AND	1FH		;Rake off # sectors
	LD	E,A		;  & stuff into E
	INC	E		;Bump for 0 offset
	XOR	D		;Recover # heads
	RLCA			;  into bits 0-2
	RLCA
	RLCA
	INC	A		;Bump for 0 offset
	CALL	@MUL8		;Multiply sectors x heads
	LD	E,A		;Now check double bit
	LD	A,4
	CALL	@DCTBYT
	BIT	5,A		;Set if 2-sided
	LD	A,E
	JR	Z,ONESID	;Go if not set else
	ADD	A,A		;  double value
ONESID	SUB	2		;Reduce for GAT & HIT
	LD	D,A
	LD	A,B
	AND	1FH		;Calc req sector #
	CP	D
	JR	C,FNAM1
	LD	A,16		;"Illegal logical file #
	OR	A
	JR	FNAM2
FNAM1	POP	DE
	PUSH	DE
	CALL	@DIRRD
	CALL	Z,RCVNAM	;Rcvr the filespec
FNAM2	POP	DE
	POP	HL
	RET
;
;	Close a logical device
;
CLOSDEV	CP	10H		;If not open device,
	LD	A,38		;  return "file not open...
	RET	NZ
	CALL	LNKFCB@		;Link to FCB
	LD	C,(IX+6)	;Get device name
	LD	B,(IX+7)
	LD	(IX+0),'*'	;Stuff device indicator
	LD	(IX+1),C	;Stuff 1st char of name
	LD	(IX+2),B	;Stuff 2nd char of name
	LD	(IX+3),3	;Terminate with ETX
	XOR	A
	RET
;
;	Calculate GAT bit to deallocate
;
CALCBIT	AND	7		;Make binary bit # into
	RLCA			;  the proper RES
	RLCA			;  opcode
	RLCA
	OR	80H
	LD	(CALC1+1),A
CALC1	RES	0,B		;Reset bit in GAT
	RET
;
;	User removed disk with an open file
;
HOLDUP	PUSH	HL
	PUSH	DE
	LD	HL,HOLDUP$	;Pt to message
	CALL	@DSPLY		;Display to console
	CALL	@CKBRKC		;Clear out break bit
WAITING	CALL	@KBD		;Scan the keyboard
	JR	NZ,WAITING	;Keep looking
	CP	CR		;Check for <ENTER>
	JR	Z,TRYNOW
	CALL	@CKBRKC		;Check for a break
	JR	Z,WAITING
ABRT	POP	DE
	POP	HL
	POP	IY		;Restore from above
	LD	A,32		;Show illegal drive #
	OR	A		;Set NZ condition
	RET			;Go back now
TRYNOW	POP	DE
	POP	HL
	JP	CKAGN		;Try checking again
HOLDUP$	DB	LF,'** CLOSE FAULT **  Drive not ready, '
	DB	'<ENTER> to retry, <BREAK> to abort',CR
;
DOID
	IF	@BLD631
	RET			;<631>
	ELSE
	LD	DE,22F6H	;Pt to serial #
	LD	HL,NOTDSP-1	;Pt to not displayed
	LD	B,10		;Bytes to check
	LD	A,(DE)
	XOR	88H
	AND	41H
	LD	C,A		;Save result
	INC	DE		;Next byte
	LD	A,(DE)		;Get value
	XOR	0C8H
	AND	41H		;Must be opposite of 1st
	XOR	C
	RET	Z		;Back if 0
	INC	DE		;1st byte of serial#
	EX	DE,HL		;Make into ascii
	LD	B,8		;8 bytes remaining
DOID1	LD	A,(HL)
	CP	(HL)
	LD	(HL),A
	INC	HL
	DJNZ	DOID1
	PUSH	IY		;Save IY
	PUSH	DE
	POP	IY		;To build area
	DEC	HL		;Last byte of serial#
	LD	A,(HL)		;Digit 3
	LD	(IY+3),A
	LD	B,A		;B also gets 3
	DEC	HL
	LD	C,(HL)		;#3+#5
	DEC	HL
	LD	D,(HL)		;Digit 5
	LD	(IY+5),D
	DEC	HL
	LD	E,(HL)
	LD	(IY+4),E	;Digit 4
	ADD	A,D		;Add 3,5
	CALL	ABS
	CP	C		;Cp 3+5
	JR	NZ,BADID
	DEC	HL
	LD	C,(HL)		;#2-#3
	PUSH	DE		;Save 4,5
	DEC	HL
	LD	E,(HL)		;A+#4+#5
	DEC	HL
	LD	A,(HL)		;Digit 1
	LD	(IY+1),A
	DEC	HL
	LD	A,(HL)		;Digit 2
	LD	(IY+2),A
	SUB	B		;2-3
	CALL	ABS
	CP	C
	JR	NZ,BADID
	LD	C,E		;A+4+5 to C
	POP	DE
	LD	A,E
	ADD	A,D
	ADD	A,'A'-30H
	CP	C
	JR	NZ,BADID
;
	JR	CKSTOR		;Check hidden one
BADID	POP	IY
	RET
;	Ok, looks like displayed # is ok
;
CKSTOR	POP	HL		;Pt HL at ascii
	LD	HL,NOTDSP
	PUSH	HL
	LD	B,5
CKLP	LD	A,(HL)
	ADD	A,30H
	LD	(HL),A
	INC	HL
	DJNZ	CKLP
	POP	HL
	CALL	@DECHEX		;Make binary
;
;	Now get CS number
;
	LD	HL,STOR$	;Pt to it
	RLC	(HL)
	RLC	(HL)
	LD	A,(HL)		;Result to A
	INC	HL
	RLC	(HL)
	RLC	(HL)		;2nd byte done
	RLD
	PUSH	BC		;Save real serial #
	PUSH	BC		;Twice
	LD	D,(HL)
	LD	E,A		;Stored to DE
	POP	HL		;Real serial #
	EX	DE,HL		;Stored to HL
	LD	BC,13974	;Offset
	OR	A
	SBC	HL,BC		;Now should match visible
	OR	A
	SBC	HL,DE		;Be sure the same
	POP	HL		;Get in case good
	RET	NZ		;Back if bad
	ADD	HL,BC
	LD	DE,CSBUFF+4
	CALL	@HEXDEC
	LD	HL,CSBUFF
	CALL	@DSPLY
	RET
;
;	Return a number between 0 and 10
;
ABS	CP	0		;See if negative
	JP	P,ABS1		;Go if not
	NEG			;Else make pos
	RET
ABS1	CP	10		;Less than 10
	RET	C		;Done if so
	SUB	10
	RET
;
;
NOTDSP	DC	6,0		;User serial #
STOR$	DB	0A5H,0DCH
CSBUFF	DB	'CS#      ',13
;
	ENDIF
LAST	EQU	$
	IFGT	$,DIRBUF$
	ERR	'Module too big'
	ENDIF
	ORG	MAXCOR$-2
	DW	LAST-SYS3	;Overlay length
;
	END	SYS3