TITLE	'LP: Device Driver for SC Two Thirds Card'
*
*	Commented disassembly
*
*	G. Roberts	12-Nov-2016
*
	SPACE	4
	STL	'System equates'

	XTEXT	HOSEQU		HDOS system equivalences
	XTEXT	ASCII		ASCII character equivalences
	XTEXT	DDDEF		Device driver communucation flags
	XTEXT	ECDEF		System error codes
	XTEXT	PICDEF		PIC format equivalences (bytes 0-5)
	XTEXT	DEVDEF		Device table entries
	XTEXT	DVDDEF		Device driver equivalences
	XTEXT	SETCAL		Fixed address routines in SET
	XTEXT	TBRA		Branch relative thru table (in ROM)
	XTEXT	TYPTX		Type text to console (in ROM)
*
* ----- Begin position independent code
*
	CODE	PIC
*
* ----- Device header (bytes 6-21)
*
	DB	DVDFLV		Flag as a Device Driver
	DB	DT.CW		Device capability:  Write
	DB	00000001B	Mounted unit mask
	DB	1		Only one unit (unit 0)
	DB	DT.CW		Unit  0   : capable of write
	DS	7		Units 1-7 : don't exist
	DB	DVDFLV		Unit capable of SET options
	DW	0		Pointer to INIT code

.	SET	025Q		Header must be exactly 21 bytes
	ERRNZ	*-.
*
* ----- Heath reserved area
*
	DS	DVD.STE-.	Reserve through SeT Entry point

	EJECT
	STL	'Flags and assembly constants'

PORTA	EQU	320Q
PORTB	EQU	321Q
PORTC	EQU	322Q
PCTRL	EQU	323Q

CCINT	EQU	040334A		S.CAADR+1

	EJECT
	STL	'SET processing'
***	SET processing entry point
*
*	SET commands enter code here
*
*	ENTRY:	(DE) = line pointer
*		(A)  = unit number
*
*	EXIT:	'C' clear : no error
*		'C' set   : error
*		(A) = error code
*
*	USES:	ALL
*
SETNTR	EQU	*
	ERRNZ   *-DVD.STE	Must be at SET entry point
	
	ANA	A		Must call unit 0 (only one)
	JNZ	SET1		if not, then return with error
	MOV	B,D		else
	MOV	C,E		(BC) = parameter list address
	LXI	D,PRCTAB	(DE) = processor table address
	LXI	H,OPTTAB	(HL) = option table address
	CALL	$SOP		Call Set Option Processor
	RC			If error, return
	CALL	$SNA		Else Scan for Next Argument
	RZ			if none, then return normally
	
	MVI	A,EC.ILO	Else flag error for ILlegal Option
	STC			and set carry to flag error.
	RET			Return.

SET1	MVI	A,EC.UUN	Unknown Unit Number error
	STC			set carry to flag error.
	RET			Return.

	SPACE	4,10
***	FLAG
*
*	Process Byte Flag
*
*	ENTRY:	(HL)	= address of table vector
*
*	EXIT:	'C'	clear : no error
*		'C'	set   : error
*
*	USES:	ALL
*
*
FLAG	EQU	$PBF

	SPACE	4,10
***	VAL
*
*	Process Value Flag option specification
*
*	ENTRY:	(BC)	= next character address
*		(HL)	= table vector index
*
*	EXIT:	(BC)	updated
*		'C'	clear : no error
*		'C'	set   : error
*
*	USES:	ALL
*
*
VAL	EQU	$PBV


UNK52	MVI	A,EC.ILV
	STC
	RET

	SPACE	4,10
**	HELP
*
*	Type help (list valid options) on colsole
*
HELP	CALL	$TYPTX
	DB	ESC,'E'
	DB	ESC,'Y',37,60	Row 37, Col. 60
	DB	'SET OPTIONS'
	DB	ESC,'Y',38,57	Row 38, Col. 57
	DB	'90-1001-700 REV. 1',NL,NL
	
	DB	TAB,TAB,'MX80'
	DB	TAB,TAB,'SELECT MX80',NL
	
	DB	TAB,TAB,'NOMX80'
	DB	TAB,TAB,'DESELECT MX80',NL
	
	DB	TAB,TAB,'WIDTH n'
	DB	TAB,TAB,'CHAR./LINE 1<n<=132',NL
	
	DB	TAB,TAB,'FORM'
	DB	TAB,TAB,'FORM FEED AT CLOSE',NL
	
	DB	TAB,TAB,'NOFORM'
	DB	TAB,TAB,'NO FORM FEED',NL
	
	DB	TAB,TAB,'LENGTH n'
	DB	TAB,'FORM LENGTH, n LINES 0<n<=127',NL
	
	DB	TAB,TAB,'HELP'
	DB	TAB,TAB,'PRINT THIS LIST',NL+200Q
	
	LDA	TLP.MX8
	ANA	A
	RZ
	
	JMP	MXHELP
*
*	Double strike - ESC G
*
DBLON	MVI	A,'G'
	STA	TLP.DP
	ANA	A
	RET
*
*	Cancel double strike - ESC H
*
DBLOFF	MVI	A,'H'
	STA	TLP.DP
	ANA	A
	RET
*
*	Emphasized - ESC E
*
EMPON	MVI	A,'E'
	STA	TLP.EP
	ANA	A
	RET
*
*	Cancel emphasized - ESC F
*
EMPOFF	MVI	A,'F'
	STA	TLP.EP
	ANA	A
	RET


***	OPTTAB - option table
*
*
OPTTAB	DW	OPTTABE 	Address of end of table end, (001.352)
	DB	6		6 bytes per table entry

	DB	'FOR','M'+200Q,FLAGI,1,1
	DW	TLP.FRM
	DB	0
	
	DB	'NOFOR','M'+200Q,FLAGI,1,0
	DW	TLP.FRM
	DB	0
	
	DB	'MX8','0'+200Q,FLAGI,1,1
	DW	TLP.MX8
	DB	0

	DB	'NOMX8','0'+200Q,FLAGI,1,0
	DW	TLP.MX8
	DB	0
	
	DB	'WIDT','H'+200Q,VALI,10,1,132
	DW	TLP.MAR
	
	DB	'LENGT','H'+200Q,VALI,10,0,127
	DW	TLP.LPP

	DB	'LP','I'+200Q,VALI,10,1,255
	DW	TLP.LS
	
	DB	'SKI','P'+200Q,VALI,10,1,127
	DW	TLP.SOP
	
	DB	'EMP','H'+200Q,EMPI
	DB	0,0,0,0,0
	
	DB	'NOEMP','H'+200Q,NEMPI
	DB	0,0,0,0,0
	
	DB	'DBLS','T'+200Q,DBLI
	DB	0,0,0,0,0
	
	DB	'NODBLS','T'+200Q,NDBLI
	DB	0,0,0,0,0
	
	DB	'HEL','P'+200Q,HELPI
	DB	0,0,0,0,0
	
OPTTABE	DB	0
	SPACE	4,10
***	PRCTAB - processor table
*
*
PRCTAB	DS	0
VALI	EQU	*-PRCTAB/2
	DW	VAL
FLAGI	EQU	*-PRCTAB/2
	DW	FLAG
HELPI	EQU	*-PRCTAB/2
	DW	HELP
DBLI	EQU	*-PRCTAB/2
	DW	DBLON
NDBLI	EQU	*-PRCTAB/2
	DW	DBLOFF
EMPI	EQU	*-PRCTAB/2
	DW	EMPON
NEMPI	EQU	*-PRCTAB/2
	DW	EMPOFF
	SPACE	4
*
*	Force address to DVD.ENT
*
	CODE	-REL		Turn off relocation temporarily,
.	SET	*		save current address,
	CODE	+REL		and turn relocation back on.
	DS	DVD.ENT-.	Blank space to DVD entry address

	EJECT
	STL	'Main driver entry routine'
***	LP: entry point
*
*	ENTRY:	(A)   = Process code
*		(BC)  = Byte count
*		(DE)  = Buffer address
*
*	EXIT:	(PSW) = 'C' clear : no errors
*		      = 'C' set   : error
*		(A)   = error code
*
*	USES:	ALL
*
LPDVD	EQU	*
	ERRNZ	*-DVD.ENT
	CPI	DC.MAX		Max?
	JNC	LPDVD1		Out of range
	
	CALL	$TBRA

	DB      LPNSUIT-*       0 = Read from device
	DB      LPWRITE-*       1 = Write to device
	DB      LPNSUIT-*       2 = Read regardless
	DB      LPOPEN-*	3 = Open for reads
	DB      LPOPEN-*	4 = Open for writes
	DB      LPNSUIT-*       5 = Open for updates
	DB      LPCLOSE-*       6 = Close channel to device 
	DB      LPABORT-*       7 = Abort - treat as close
	DB      LPABORT-*       8 = Mount the device
	DB      LPLOADD-*       9 = Load the device
*
*	Proess illegal request
*
LPDVD1	MVI	A,EC.ILR	Illegal request
	STC
	RET
*
*	Printer not suited for request
*
LPNSUIT	EQU	*
	MVI	A,EC.DNS	Device not suitable
	STC
	RET
*
*	LPOPEN - open printer
*
LPOPEN	LDA	TLP.AS		Check Assigned flag
	ANI	10000000B
	JZ	LPOPEN1		Not assigned, continue
	
	MVI	A,EC.UNA	Unit not available!
	STC
	RET

LPOPEN1	MVI	A,10000000B	Flag unit as assigned
	STA	TLP.AS
	CALL	I8255		Initialize the 8255
	CALL	INITP		Initialize the printer
	ANA	A
	RET
*
*	LPABORT - Abort and close the device
*
LPABORT	CALL	LPCLOSE

LPABT1	MVI	A,EC.DDA	Device driver abort
	STC
	RET
*
*	Load device
*
LPLOADD	ANA	A
	RET
*
*	Close out the print job
*
LPCLOSE	LDA	TLP.AS		Assigned?
	ANA	A
	JNZ	LPCLS2		Yes, OK to close

LPCLS1	MVI	A,EC.UNA	Unit Not assigned
	STC
	RET

LPCLS2	LDA	TLP.FRM		Form Feed on close?
	ANA	A
	RZ			No, just return

	MVI	A,FF		Yes, print form feed
	CALL	LPOUTCH
	ANA	A
	RET
*
*	Read port B
*
UNK68	LDA	TLP.AS		Assigned?
	ANA	A
	JZ	LPCLS1		No, Unit Not assigned error

	IN	PORTB
	XRA	A
	RET
*
*	(DE) = Text buffer
*	(BC) = length of string

LPWRITE	LDA	TLP.AS		Is it assigned
	JZ	LPCLS1		no, abort!
	
LPWR1	MOV	A,B		Byte count = 0?
	ORA	C
	RZ			Yes - Done!
	
	LDA	CCINT		Check for Control-c
	ANA	A
	JNZ	LPWR11		Interrupted! close the job
	
	LDA	TLP.MX8
	ANA	A
	JNZ	LPWR3
	
	LDAX	D		Fetch a byte to print
	CPI	TAB		is it a TAB
	JNZ	LPWR3		no, jump
*
*	TAB processor - Expand tabs to spaces 
*	(tabs set every 8 columns)
*
LPWR2	MVI	A,' '		Expand TABs to Blank
	CALL	LPOUTCH		Print it
	LDA	TLP.CX		Load column index
	
	PUSH	H
	LXI	H,TLP.MAR	(HL) = right margin
	INR	A		Increment column index
	STA	TLP.CX		and store it
	CMP	M		at margin?
	POP	H
	
	JZ	LPWR4		Yes, start a new line

	LDA	TLP.CX		Check current column
	ANI	7		Multiple of 8 ?
	JZ	LPWR10		Done!
	JMP	LPWR2		Nope, keep expanding
*
*	All other characters besides TAB
*
LPWR3	LDAX	D		Fetch a byte to print
	CALL	LPOUTCH		print it
	LDAX	D		Fetch it back
	CPI	CR		Carriage return?
	JZ	LPWR6		process return
	
	CPI	LF		Line Feed?
	JZ	LPWR7		process line feed
	
	LDA	TLP.MX8
	ANA	A		Set flags
	JNZ	LPWR10		continue looping
	
	LDAX	D
	CPI	FF		Form Feed?
	JZ	LPWR5		process form feed
	
	PUSH	H
	LXI	H,TLP.MAR	(HL) = right margin
	LDA	TLP.CX		get column
	INR	A		next
	STA	TLP.CX		save it
	CMP	M		at margin?
	POP	H
	
	JNZ	LPWR10		no, continue the loop...
*
*	Output CR/LF
*
LPWR4	MVI	A,CR		Carriage Return
	CALL	LPOUTCH		print it
	MVI	A,NL		Line Feed
	CALL	LPOUTCH		print it
	MVI	A,0
	STA	TLP.CX		Set column to 0
	JMP	LPWR9		and see if need new page
*
*	Form Feed
*
LPWR5	MVI	A,0
	STA	TLP.LX		Zero line index
	STA	TLP.CX		Zero column index
	JMP	LPWR10		and continue the loop...
*
*	Carriage Return (must add the LF)
*
LPWR6	MVI	A,LF		Add LF after CR
	JMP	LPWR8
*
*	Line Feed (must add the CR)
*
LPWR7	MVI	A,CR		Add CR after LF
*
*	Process CR/LF
*
LPWR8	CALL	LPOUTCH		print it
	LDA	TLP.MX8
	ANA	A		set flags
	JNZ	LPWR10		NZ -> continue looping
	
	MVI	A,0		Zero
	STA	TLP.CX		Column Index
*
*	Check if need new page
*
LPWR9	LDA	TLP.LPP		A = lines per page
	ANA	A		Check for 0
	JZ	LPWR10		Don't care, continue the loop...

	LDA	TLP.LX		A = Line Index
	
	PUSH	H
	LXI	H,TLP.LPP	(HL) = Lines per Page
	INR	A		Next line
	STA	TLP.LX		save it
	CMP	M		at max?
	POP	H
	
	JNZ	LPWR10		no, continue the loop...
	
	MVI	A,FF		yes! Form Feed
	CALL	LPOUTCH		output the character
	JMP	LPWR5		and reset LX and CX

LPWR10	INX	D
	DCX	B
	JMP	LPWR1

LPWR11	PUSH	H
	PUSH	PSW
	CALL	LPCLOSE
	POP	PSW
	POP	H
	RET
*
*	MXHELP - features only on MX80
*
MXHELP	CALL	$TYPTX
	DB	TAB,TAB,'LPI n',TAB,TAB
	DB	'LINES/INCH (=216/n) 1<n<=255',NL
	
	DB	TAB,TAB,'SKIP n',TAB,TAB
	DB	'SKIP n LINES OVER PERF. 0<n<=127',NL
	
	DB	TAB,TAB,'EMPH',TAB,TAB
	DB	'SET EMPHISIZE PRINT MODE',NL
	
	DB	TAB,TAB,'NOEMPH',TAB,TAB
	DB	'SET STANDARD PRINT MODE',NL
	
	DB	TAB,TAB,'DBLST',TAB,TAB
	DB	'SET DOUBLE STRIKE',NL
	
	DB	TAB,TAB,'NODBLST',TAB,TAB
	DB	'CANCEL DOUBLE STRIKE',NL
	DB	ENL
	
	XRA	A
	RET
*
*	LPOUTCH - Output a character to the Line Printer
*
LPOUTCH	PUSH	PSW
	MVI	A,0
	STA	EXT40
	
LPOUT1	IN	PORTC
	ANI	00001000B	Ready?
	JZ	LPOUT2		Ready - print the char

	LDA	CCINT		Check for Control-C
	ANA	A
	JZ	LPOUT1		None, continue
*
*	Print job interrupted!
*
	POP	PSW
	XTHL
	POP	H
	JMP	LPABT1		Do soft abort!

LPOUT2	POP	PSW		Get back the character
	OUT	PORTA		and output it on Port A
*
*	Strobe
*
	MVI	A,01111111B
	OUT	PORTC
*
*	Delay loop
*
	MVI	A,16
DLY1	DCR	A
	JNZ	DLY1
	
	MVI	A,11111111B
	OUT	PORTC

UNK78B	IN	PORTC
	ANI	00000001B
	JNZ	UNK79
	LDA	CCINT		Check for Control-C
	ANA	A
	JZ	UNK78B		No interrupt, keep waiting
	
	JMP	LPABT1		Do soft abort

UNK79	IN	PORTB
	RET
*
*	I8255 - Initialize 8255 port
*
I8255	MVI	A,10000111B
	OUT	PCTRL
	MVI	A,11101111B
	OUT	PORTC
	MVI	A,11111111B
	OUT	PORTC
	MVI	A,00000101B
	OUT	PCTRL
	RET
*
*	INITP - Initialize the printer.
*
INITP	PUSH	B
	PUSH	D
	
	LDA	TLP.MX8		MX80?
	ANA	A
	JNZ	INITP1		Yes, send MX80 ESC sequences
	
	MVI	A,0		Zero
	STA	TLP.LX		Line index
	STA	TLP.CX		Column index
	
	POP	D
	POP	B
	ANA	A		set flags
	RET


INITP1	LXI	D,TLP.INI	Point to ESC sequences
	MVI	B,TLP.IE-TLP.INI  Byte count
	
INITP2	LDAX	D		Grab one
	CALL	LPOUTCH		print it
	INX	D		next one
	DCR	B		decrement
	JNZ	INITP2		loop
	
	POP	D
	POP	B
	ANA	A		set flags
	RET
*
*	Data Storage Area
*
TLP.AS	DB	0		Unit assigned
TLP.MX8	DB	0		Flag if settings changed
TLP.FRM	DB	1
	DB	320Q
	DB	5
EXT40	DB	0
	DB	0
TLP.LX	DB	10		Line index
TLP.CX	DB	9		Column index
*
*	MX80 setup sequence
*
TLP.INI	EQU	*
	DB	ESC,'Q'		ESC Q n = set right margin
TLP.MAR	DB	80		Right margin

	DB	ESC,'3'		ESC 3 n = select n/216 line spacing
TLP.LS	DB	36		Default 6 lines/inch

	DB	ESC,'C'		ESC C n = set page length
TLP.LPP	DB	66		Default 66 lines/page

	DB	ESC,'N'		ESC N n = skip over perforation
TLP.SOP	DB	6		Default 6 lines
	
	DB	ESC		ESC E/F = emphasized print
TLP.EP	DB	'F',CR		Default: OFF

	DB	ESC		ESC G/H = double strike
TLP.DP	DB	'H',CR		Default: OFF

TLP.IE	EQU	*

	DW	'LH'		Dummy address for relocation
	DS	64		Room for patches
	
	END