;LBDEVICE/ASM - DEVICE Command
	TITLE	<DEVICE - LS-DOS 6.2>
;
LF	EQU	10
CR	EQU	13
*GET	BUILDVER:3
*GET	SVCMAC:3		;SVC Macro equivalents
;
	ORG	2400H
;
DEVICE
	@@CKBRKC		;Check for break
	JR	Z,DEVICEA	;Continue if not
	LD	HL,-1		;  else abort
	RET
;
DEVICEA	LD	(SAVESP+1),SP	;Save stack pointer
	LD	DE,PRMTBL$	;First check for user parms
	@@PARAM
	JP	NZ,IOERR	;Go if parm error
	@@FLAGS			;Get flag table pointer
	CALL	RESKFL		;Reset Pause and Enter
	EI			;Make sure they're on
DPARM	LD	HL,-1		;Check Drive parameter
	LD	A,H
	OR	L
	JP	Z,DEND		;Go if D=NO
	LD	C,0		;Init to drive 0
DEV1	PUSH	BC		;Save drive #
	XOR	A		;Reset flag stuff
	LD	(WPTEST+1),A	;  location
	@@GTDCT			;Get DCT address
	LD	A,(IY+0)	;Is this drive disabled?
	CP	0C3H
	JP	NZ,POPDRV	;Ignore if it is
	@@CKDRV			;This drive available?
	JR	NZ,DEV2		;Go if no diskette
	RRA			;Shift C-flag to bit-7
	LD	(WPTEST+1),A	;  & save for WP test
	LD	HL,BUFFER	;Pick up the GAT for the
	LD	D,(IY+9)	;  pack name
	LD	E,L
	@@RDSSC
	LD	A,20		;"GAT read error
	JP	NZ,IOERR
	LD	HL,BUFFER+0D8H	;Shove bracket ETX
	LD	(HL),']'
	INC	L
	LD	(HL),' '
	INC	L
	LD	(HL),3
	LD	L,0D0H		;Point to start of name
	JR	DEV2A
;
;	Drive info for this active drive
;
DEV2	LD	HL,NOPACK$	;Display pack name
	LD	DE,BUFFER+0D0H
	LD	BC,12
	LDIR
DEV2A	LD	A,':'		;Output the colon
	CALL	BYTOUT
	POP	BC		;Get drive # back
	PUSH	BC
	LD	A,C		;Get drive # converted
	ADD	A,'0'		;  to ASCII & display it
	CALL	BYTOUT
	IF	@BLD631
	CALL	OUTSP		;<631>
WPTEST	LD	A,0		;<631>P/u CKDRV FDC status
	OR	(IY+3)		;<631>
	AND	80H		;<631>
	ELSE
	LD	A,' '		;Space out one
	CALL	BYTOUT
WPTEST	LD	A,0		;P/u CKDRV FDC status
	RLCA			;Hardware write protect?
	JR	C,DEV2B		;Force "WP" if it is
	BIT	7,(IY+3)	;Test software WP
	ENDIF
	LD	A,' '		;Output '  ' for read &
	LD	B,' '		;  write access or
	JR	Z,$+6
DEV2B	LD	A,'W'		;  WP for read only
	LD	B,'P'
	CALL	BYTOUT
	LD	A,B		;Xfer the 2nd char
	CALL	BYTOUT		;  & display it
	IF	@BLD631
	CALL	OUTSP	;<631>
	ELSE
	LD	A,' '
	CALL	BYTOUT
	ENDIF
	LD	A,'['		;Left bracket
	CALL	BYTOUT
	LD	HL,BUFFER+0D0H	;Write the pack name
	CALL	LINOUT
;
;	Determine if 5" or 8"
;
	BIT	5,(IY+3)	;Test 5"/8" drive
	LD	A,'5'		;Init to 5
	JR	Z,$+4		;Bypass if not 8
	LD	A,'8'		;  else init to 8
	CALL	BYTOUT
	BIT	3,(IY+3)	;Test rigid/floppy
	LD	HL,FLOPY$	;Init to floppy
	JR	Z,$+5		;Bypass if that kind
	LD	HL,RIGID$	;  else is hard
	CALL	LINOUT
	LD	A,(IY+4)	;Output drive select addr
	AND	0FH		;  in ASCII
	ADD	A,90H
	DAA
	ADC	A,40H
	DAA
	CALL	BYTOUT
DEV3	LD	L,(IY+6)	;P/u highest cylinder
	LD	H,0
	INC	HL		;Adjust for zero offset
	BIT	3,(IY+3)	;Hard drive?
	JR	Z,DEV4		;Bypass if soft
	BIT	5,(IY+4)	;2-sided hard drives
	JR	Z,DEV4		;  are 2*cyl
	ADD	HL,HL		;  & multiply by 2
DEV4	LD	DE,COMMA$	;Convert # of cyls to
	IF	@BLD631
	LD	B,3		;<631>
	@@HEXD			;<631>
	ELSE
	CALL	CVRTDEC		;  decimal & stuff in msg
	ENDIF
	LD	HL,CYLS$	;Display cyls=xxx
	CALL	LINOUT
	BIT	3,(IY+3)	;Bypass if soft drive
	JR	Z,FLOPPY
	BIT	2,(IY+3)	;Test fixed/removable
	LD	HL,REMOV$	;Init to removable
	JR	Z,$+5		;Bypass if that way
	LD	HL,FIXED$	;  else init fixed
	CALL	LINOUT
	JR	ENDLINE		;Bypass DEN, STEP, DLY
;
;	Next section deals only with floppies
;
FLOPPY	BIT	6,(IY+3)	;Test SDEN/DDEN
	LD	A,'S'		;Init to sden
	JR	Z,$+4		;Bypass if sden
	LD	A,'D'		;  else init to dden
	CALL	BYTOUT
	LD	HL,DEN$		;Now display "den"
	CALL	LINOUT
	BIT	5,(IY+4)	;Test # of sides
	LD	A,'1'		;Init to 1
	JR	Z,$+3		;Bypass if single sided
	INC	A		;  else bump to 2
	CALL	BYTOUT
	LD	HL,STEP$	;Display "step="
	CALL	LINOUT
	LD	A,(IY+3)	;P/u step rate & 8/5
	AND	23H		;Convert step rate to an
	LD	B,A		;  index into the table
	RRCA
	RRCA			;5/8 bit to bit 2
	RRCA
	OR	B		;Merge step rate
	RLCA
	AND	0EH		;Mask off garbage
	LD	HL,STPRAT$	;Get table base
	ADD	A,L		;Add table lo order
	LD	L,A		;Set lo-order
	ADC	A,H
	SUB	L
	LD	H,A
	LD	A,(HL)		;P/u 1st step char
	INC	HL		;Bump to second
	CALL	BYTOUT		;Display the first
	LD	A,(HL)		;P/u the second
	CALL	BYTOUT		;Display the second
	LD	HL,MS$		;Display "ms,"
	CALL	LINOUT
	BIT	5,(IY+3)	;Bypass DELAY if 8"
	JR	NZ,ENDLINE	;8" drives always running
	LD	HL,DLY$		;Display "dly="
	CALL	LINOUT
	BIT	2,(IY+3)	;Test off/on
	LD	A,' '		;1 sec if DELAY=ON
	LD	B,'1'
	JR	Z,$+6
	LD	A,'.'		;0.5 sec if DELAY=OFF
	LD	B,'5'
	CALL	BYTOUT
	LD	A,B
	CALL	BYTOUT
	LD	A,'s'		;Indicate seconds
	CALL	BYTOUT
ENDLINE	CALL	CKPAWS		;Check pause of display
POPDRV	POP	BC		;Recover drive #
	INC	C		;Bump to next drive
	LD	A,C
	CP	8		;Loop thru all 8
	JP	NZ,DEV1
DEND	EQU	$
;
;	Byte I/O devices
;
BPARM	LD	HL,$-$		;Check B parameter
	LD	A,H
	OR	L
	JP	Z,BEND		;Go if B=NO (default)
;
;	Display the device vectoring
;
	LD	DE,'IK'		;Start of device tables
	@@GTDCB
	JP	NZ,IOERR
LOGDCB	LD	A,(HL)		;Bypass this device if
	OR	A		;  table shows spare
	JP	Z,DVRB2
	LD	DE,STRBUF	;Pt to string buffer
	PUSH	HL		;Save origin ptr
	CALL	MOVNAM		;Move dev name -> strbuf
	POP	HL		;Rcvr org of table
	PUSH	HL
LOGDCB1	BIT	3,(HL)		;If NIL, don't show
	JR	NZ,DVRADDR	;  any routes
	BIT	4,(HL)		;Is device routed?
	JR	Z,DVRADDR	;Bypass if not
;
;	This device is routed
;
	IF	@BLD631
LOGRTE	CALL	GETPTR		;<631>Pt to vector & get it
	ELSE
LOGRTE	INC	L		;Pt to vector & get it
	LD	A,(HL)
	INC	L
	LD	H,(HL)
	LD	L,A
	ENDIF
	BIT	7,(HL)		;Is the route to a file?
	JP	NZ,RTEFCB	;Jump if a file
	PUSH	HL		;Hang onto this vector
	CALL	DCBDIR		;Get device direction
	CALL	MOVNAM		;Move dev name -> strbuf
	POP	HL		;Rcvr org of routee
	BIT	4,(HL)		;Is routee also routed?
	JR	NZ,LOGRTE	;Loop de loop if yes
	JR	DVRB1		;  else go display the line
;
;	Device has no routes - show its driver address
;
DVRADDR	CALL	DCBDIR		;Get device direction
	BIT	3,(HL)		;Is this a NIL device
	JP	NZ,MOVNIL	;No address if NIL
;
;	If linked, show device name of link
;
	BIT	5,(HL)		;Any link DCB?
	JR	Z,DVRA0		;Go if none
	IF	@BLD631
	CALL	GETPTR		;<631>Get address of link DCB
	ELSE
	INC	L		;Get address of link DCB
	LD	A,(HL)
	INC	L
	LD	H,(HL)
	LD	L,A
	ENDIF
;
;	Now move in the name of the linked DCB
;
	PUSH	HL
	PUSH	HL
	CALL	MOVNAM		;Move name of LINK DCB
	LD	A,'|'		;Get separator for display and
	LD	(DE),A		;  put in the buffer
	INC	DE
	POP	IY		;Pop address to IY
	LD	L,(IY+4)	;P/u linked DCB address
	LD	H,(IY+5)
	CALL	MOVNAM		;Move name of linked DCB
	POP	HL		;Recover address
	EX	DE,HL		;Switch tempy, HL to
	LD	(HL),' '	;  display buffer
	INC	HL
	LD	(HL),'&'	;Show the link
	INC	HL
	EX	DE,HL		;Back to normal
	JR	LOGDCB1		;Go ck this one
;
;	If filtered, find the filter DCB
;
DVRA0	BIT	6,(HL)		;If filtered, recover the
	JR	Z,DVRB0		;  original data by
	PUSH	HL		;  swapping back the
	LD	A,'['
	LD	(DE),A
	INC	DE
	PUSH	DE
	LD	D,H
	LD	E,L
	IF	@BLD631
	CALL	GETPTR		;<631>1st three bytes with the FILTER DCB
	ELSE
	INC	L		;  1st three bytes with
	LD	A,(HL)		;  the FILTER DCB
	INC	L
	LD	H,(HL)
	LD	L,A
	ENDIF
	LD	BC,4		;HL now points to the
	ADD	HL,BC		;  entry point. Get its
	LD	C,(HL)		;  DCB address by peeking
	INC	C		;  past the name field
	ADD	HL,BC
	IF	@BLD631
	CALL	GETPTR2		;<631>
	ELSE
	LD	A,(HL)		;Get low-order
	INC	HL
	LD	H,(HL)		;Get hi-order
	LD	L,A
	ENDIF
	PUSH	HL		;If DCB is itself, then
	SBC	HL,DE		;  bring in the "inactive
	POP	HL
	POP	DE		;Recover string buf ptr
	JR	NZ,DVRA1
	LD	HL,INACT$
	LD	BC,8
	LDIR
	JR	DVRA2
;
DVRA1	CALL	MOVNAM		;Move name of filter DCB
DVRA2	LD	A,']'		;Put dsp chars into buffer
	LD	(DE),A
	INC	DE
	LD	A,' '
	LD	(DE),A
	INC	DE
	POP	HL		;Recover orig DCB ptr
;
;	Routine to construct address "X'xxxx'"
;
DVRB0	LD	A,'X'		;Show address as
	LD	(DE),A		;  X'dddd'
	INC	DE
	LD	A,27H		;Single quote
	LD	(DE),A
	INC	DE
	IF	@BLD631
	CALL	GETPTR		;<631>P/U vector
	ELSE
	INC	L
	LD	A,(HL)		;P/u lo-order vector
	INC	L
	LD	H,(HL)		;P/u hi-order vector
	LD	L,A		;Put lo in place
	ENDIF
	EX	DE,HL		;Vector value to DE
	@@HEX16			;Convert to hex digits
	EX	DE,HL		;Restore strbuf ptr to DE
	LD	A,27H		;Closing '
	LD	(DE),A
	INC	DE
DVRB1	LD	A,CR
	LD	(DE),A		;Stuff end-of-line
	LD	HL,STRBUF	;Display the info
	CALL	LINOUT
	CALL	CKPAWS0		;Ck with no CR
	POP	HL		;Rcvr table org
DVRB2	LD	A,L		;Advance to next table
TABLEN	ADD	A,8
	LD	L,A
	JP	C,SPARM		;Exit if finished
	JP	LOGDCB		;  else loop
;
;	Device routed to a file - grab its filespec
;
RTEFCB	PUSH	HL		;Save control block org
	LD	HL,IO$		;Show 2-way device
	LD	BC,5
	LDIR
	POP	HL
	LD	A,L		;Pt to file route data
	ADD	A,6		;  by indexing into FCB
	LD	L,A
	ADC	A,H
	SUB	L
	LD	H,A		;HL = FCB+6
	LD	C,(HL)		;P/u drive #
	INC	HL
	LD	B,(HL)		;P/u DEC
	PUSH	DE
	@@FNAME			;Fetch filename
	POP	DE
	JP	NZ,IOERR
RTEF1	LD	A,(DE)		;Find end of filename
	CP	3
	JR	Z,DVRB1		;Exit on ETX to put CR
	INC	DE
	JR	RTEF1
;
;	Move in 'NIL' as driver address
;
MOVNIL	LD	HL,NIL$		;Move in NIL
	LD	BC,3
	LDIR
	JR	DVRB1
;
;	Routine to denote i/o direction
;
	IF	@BLD631
DCBDIR	CALL	ADDSPA		;<631>1st need a space
	ELSE
DCBDIR	LD	A,' '		;1st need a space
	LD	(DE),A
	INC	DE
	ENDIF
	BIT	0,(HL)		;Test if input device
	JR	Z,DCBD1		;Put another space if not
	LD	A,'<'		;Else show input capable
DCBD1	LD	(DE),A
	INC	DE
	LD	A,'='		;Always need this
	BIT	6,(HL)		;If a filter, then
	JR	Z,$+4		;  reset to '#'
	LD	A,'#'
	LD	(DE),A
	INC	DE
	LD	A,' '		;Init a space
	BIT	1,(HL)		;Output device?
	JR	Z,DCBD2		;Use space if not
	LD	A,'>'		;Else show output capable
DCBD2	LD	(DE),A
	INC	DE
	IF	@BLD631
ADDSPA				;<631>
	ENDIF
	LD	A,' '		;Close with a space
	LD	(DE),A
	INC	DE
	RET
	IF	@BLD631
GETPTR	INC	L		;<631>
GETPTR2	LD	A,(HL)		;<631>
	INC	L		;<631>
	LD	H,(HL)		;<631>
	LD	L,A		;<631>
	RET			;<631>
	ELSE
;
;	Convert HL to 3-place decimal & stuff into (DE)
;
CVRTDEC	PUSH	DE		;Save place
	LD	DE,BUFFER
	@@HEXDEC		;Convert to decimal ASCII
	LD	HL,BUFFER+2	;Skip leading spaces
	POP	DE
	LD	BC,3
	LDIR
	RET
	ENDIF
;
;	Move device name into string buffer
;
MOVNAM	LD	A,L		;Pt to name field
	ADD	A,6
	LD	L,A
	LD	A,'*'		;Stuff * in string buf
	LD	(DE),A
	INC	DE		;Bump ptr to next pos
	LDI			;Move the first char
	LD	A,(HL)		;P/U next char
	OR	A		; Check for 0
	RET	Z		; return on NULL
	LD	(DE),A
	INC	DE
	RET
BEND	EQU	$
;
;	Show high memory device drivers
;
SPARM	LD	HL,-1		;Check S parameter
	LD	A,H
	OR	L
	JP	Z,EXIT		;Exit if through
	LD	HL,DVCHDR$	;Display header
	CALL	LINOUT
	@@FLAGS			;Get flag table pointer
	LD	A,(IY+'D'-'A')	;P/u device flag
	OR	A		;Exit if none in use
	PUSH	AF		;Save flag
	JR	Z,SHOWFS	;Go if nothing on
	LD	HL,DVCS$	;Pt to word string
	LD	BC,8<8!0FFH	;Init for 8 flag bits
DOD1	POP	AF		;Rcvr link
	RRCA			;Test if active
	PUSH	AF
	JR	NC,DOD3		;Bypass if inactive
	INC	C		;Do we do the comma?
	LD	A,','		;End of word, do comma
	CALL	NZ,BYTOUT
	IF	@BLD631
	CALL	OUTSP		;<631>Start with a space
	ELSE
	LD	A,' '		;Start with a space
	CALL	BYTOUT
	ENDIF
DOD2	LD	A,(HL)		;Display word until carry
	INC	HL
	PUSH	AF
	AND	7FH		;Strip possible carry
	CALL	BYTOUT		;Display the char
	POP	AF
	RLCA			;Was carry set
	JR	NC,DOD2		;Loop if not
	DJNZ	DOD1		;Loop for 8 bits
	JR	SHOWFS		;Exit the loop
DOD3	LD	A,(HL)		;Loop & ignore word
	INC	HL
	RLCA			;Carry set on last char
	JR	NC,DOD3
	DJNZ	DOD1		;Loop for 8 bits
SHOWFS	BIT	3,(IY+'S'-'A')	;Show FAST or SLOW
	JR	NZ,FAST
	LD	HL,SLOW$	;Point to slow$
	JR	SHOWIT
FAST	LD	HL,FAST$	;Point to fast$
SHOWIT	LD	A,(IY+'D'-'A')	;Check if others shown
	OR	A
	JR	NZ,COMAOK
	INC	HL		;Bypass comma
COMAOK	CALL	LINOUT
;
;	Display system modules resident
;
DORES	POP	AF		;Stack integrity
NOTON	CALL	CKPAWS
	LD	DE,RES$		;Check if driver resident
	@@GTMOD			;  in memory
	JP	NZ,EXIT		;Done if nothing res'd
	LD	HL,5
	ADD	HL,DE		;Point to hi-order table
	PUSH	HL
	LD	HL,SYSRES$	;Display header
	CALL	LINOUT
	POP	HL
	LD	BC,16<8!0FFH	;Init for 16 modules
DORES1	LD	A,(HL)		;P/u a high-order vector
	INC	HL		;Bump pointer to next
	INC	HL
	OR	A		;Is this module resident?
	JR	Z,DORES3	;Go if not
	INC	C
	LD	A,','		;Need comma if 2nd
	CALL	NZ,BYTOUT
	IF	@BLD631
	CALL	OUTSP		;<631>Start with a space
	ELSE
	LD	A,' '		;Start with a space
	CALL	BYTOUT
	ENDIF
	LD	A,16
	SUB	B		;Calculate module #
	LD	D,-1
DORES2	INC	D
	SUB	10
	JR	NC,DORES2
	PUSH	AF		;Save units place
	LD	A,D		;Test tens place
	ADD	A,'0'		;  for non-zero
	CP	'0'
	CALL	NZ,BYTOUT	;Output if non-zero
	POP	AF		;Get units
	ADD	A,'0'+10	;Adjust to ASCII
	CALL	BYTOUT
DORES3	DJNZ	DORES1
	CALL	CKPAWS		;One last ck for CR
	JR	EXIT
;
;	Output display routines
;
LINOUT	@@DSPLY
	JR	NZ,IOERR
	LD	A,(PPARM+1)	;Ck P-parm
	OR	A
	RET	Z
	@@PRINT			;Also print if needed
	JR	NZ,IOERR
	RET
;
	IF	@BLD631
OUTSP	LD	A,' '		;<631>
	ENDIF
BYTOUT	PUSH	BC
	LD	C,A
	@@DSP			;Display it
	JR	NZ,POPBC
PPARM	LD	DE,0		;P/u P-parm
	LD	A,E
	OR	D
	JR	Z,POPBC
	@@PRT			;Print chr if needed
POPBC	POP	BC
	RET	Z
IOERR	LD	L,A		;Save error code
	LD	H,0
	OR	0C0H		;Abbrev & return
	LD	C,A
	@@ERROR
	JR	SAVESP
;
;	Routine to ck on pause or break
;
CKPAWS	LD	A,CR		;End line first
	CALL	BYTOUT
CKPAWS0	@@FLAGS			;Get flag table pointer
	LD	A,(IY+'K'-'A')	;P/u KFLAG
	BIT	0,A		;Check for break
	JR	NZ,BREAK	;  if so exit
	BIT	1,A		;Check for pause
	RET	Z		;Ret if not
CKPAW1	@@KEY			;Wait for key input
	CP	60H
	JR	Z,CKPAW1	;Loop on pause
	CP	80H		;Abort on BREAK
	JR	Z,BREAK
RESKFL	LD	A,(IY+'K'-'A')	;Reset Pause & Enter bits
	AND	0F9H		;
	LD	(IY+'K'-'A'),A
	RET
;
;	BREAK handler routine
;
BREAK	CALL	RESKFL
	LD	HL,-1
SAVESP	LD	SP,$-$		;Restore the stack
	@@CKBRKC		;Clear any <BREAK>
	RET			;  and RETurn
EXIT	LD	HL,0		;Init to no error
	JR	SAVESP		;P/u stack & return
;
;	String area
;
NOPACK$	DB	'No  Disk] ',3
INACT$	DB	'Inactive'
DVCHDR$	DB	LF,'Options:',3
DVCS$	DB	'Spoole','r'!80H,'Typ','e'!80H
	DB	'Verif','y'!80H,'Smoot','h'!80H
	DB	'Memdis','k'!80H,'Form','s'!80H
	DB	'KS','M'!80H,'Graphi','c'!80H
FAST$	DB	', Fast',3
SLOW$	DB	', Slow',3
RES$	DB	'SYSRES',3
SYSRES$	DB	'System modules resident:',3
STPRAT$	DB	' 6122030 3 61015'
FLOPY$	DB	'" Floppy #',3
RIGID$	DB	'" Rigid  #',3
CYLS$	DB	', Cyls='
COMMA$	DB	'   , ',3
REMOV$	DB	'Removable',3
FIXED$	DB	'Fixed',3
DEN$	DB	'den, Sides=',3
STEP$	DB	', Step=',3
MS$	DB	'ms',3
DLY$	DB	', Dly=',3
NIL$	DB	'Nil'
IO$	DB	' <=> '
PRMTBL$	EQU	$
VAL	EQU	80H
SW	EQU	40H
STR	EQU	20H
SGL	EQU	10H
	DB	80H
	DB	SW!SGL!6,'BYTEIO',0
	DW	BPARM+1
	DB	SW!SGL!6,'DRIVES',0
	DW	DPARM+1
	DB	SW!SGL!5,'PRINT',0
	DW	PPARM+1
	DB	SW!SGL!6,'STATUS',0
	DW	SPARM+1
	DB	SW!SGL!6,'OPTION',0
	DW	SPARM+1
	NOP
;
	ORG	$<-8+1<8
BUFFER	DS	256
STRBUF	EQU	$
;
	END	DEVICE