;COM/ASM - RS232 Driver Program
	TITLE	'<COM/DVR - LS-DOS 6.2>'
;
LF	EQU	10
CR	EQU	13
;
*GET	COPYCOM:3		;Copyright message
*GET	SVCMAC:3		;SVC Macro equivalents
;
	ORG	2400H
;
BEGIN
	@@CKBRKC
	JR	Z,BEGINA	;Continue if no BREAK
	LD	HL,-1
	RET			;Return with abort code
;
BEGINA	PUSH	DE		;Save DCB address
	POP	IX		;  in index reg
	LD	(CLDCB),DE	;  and in driver header
	@@DSPLY	HELLO$		;Welcome the user
;
;	Check if entry from SET command
;
	@@FLAGS			;IY => flag table base
	BIT	3,(IY+'C'-'A')	;System request?
	JP	Z,VIASET	;"Install with Set
;
;	Grab system dependent vectors
;
	PUSH	IY		;Set DE to flag base
	POP	DE
	LD	HL,'K'-'A'	;KFLAG$
	ADD	HL,DE
	LD	(KFLAG),HL	;Save keyboard flag locn
	LD	HL,'S'-'A'	;SFLAG$
	ADD	HL,DE
	LD	(SFLAG),HL	;Save system flag location
	LD	HL,'W'-'A'	;WRINT$
	ADD	HL,DE
	IF	@BLD631
	LD	(L2520),HL	;<631>Save int mask
	ENDIF
	LD	(WRINT),HL	;Save int mask
	LD	HL,10-44	;INTVC$+10
	ADD	HL,DE		;Save for receive int
	LD	(INTVC),HL	;  vector
;
;	Move @ICNFG vector into driver
;
	LD	A,(IY+28)	;Get current opcode
	LD	(LINK),A	;Save in driver
	LD	L,(IY+29)	;Get current address
	LD	H,(IY+30)	;Put in driver code
	LD	(LINK+1),HL
;
;	Check if driver alread resident
;
	LD	DE,CL$		;Check if driver is
	@@GTMOD			;  already resident
	EX	DE,HL		;Put DCB ptr to HL
	JR	NZ,NOTRES	;Go if not
;
;	Make sure that the new DCB is same as the old
;
	LD	C,(HL)		;P/u DCB pointer LSB
	INC	HL
	LD	B,(HL)		;P/u DCB pointer MSB
	LD	HL,6		;Get old DCB name &
	ADD	HL,BC		;  stuff into error
	LD	A,(HL)		;  message in case
	INC	L		;  a different DCB
	LD	H,(HL)		;  is referenced
	LD	L,A
	LD	(DCBNAM$),HL	;Stuff message with spec
	LD	HL,(CLDCB)	;P/u DCB existing DCB
	OR	A		;  pointer
	SBC	HL,BC		;Same DCB pointer?
	JP	NZ,DCBERR	;Can't install if diff
	JP	ISRES
NOTRES	LD	DE,'IK'
	@@GTDCB			;Locate low memory ptr
	JP	NZ,IOERR	;Go if not found
	DEC	L
	LD	D,(HL)		;P/u pointer to
	DEC	L		;  start of free
	LD	E,(HL)		;  low core
	LD	(LCPTR+1),HL	;Save ptr for later
	LD	HL,CLEND-CLDVR-1
	ADD	HL,DE		;Start + driver length
	LD	(SVEND+1),HL
	LD	BC,1300H	;Max addr + 1
	XOR	A
	SBC	HL,BC		;See if room low
	JR	C,PUTLOW	;  and install there if so
;
;	Check if high memory available
;
	BIT	0,(IY+'C'-'A')	;Memory frozen?
	JP	NZ,NOROOM	;Can't install if so
	LD	HL,0
	LD	B,L		;Get HIGH$
	@@HIGH$
	LD	(SVEND+1),HL	;Top of driver
	OR	A
	LD	BC,CLEND-CLDVR	;  minus length
	SBC	HL,BC
	LD	B,0
	PUSH	HL
	@@HIGH$			;  is new HIGH$
	POP	HL
	INC	HL		;Plus one is start
	LD	(HCPTR),HL	;Save it
	LD	HL,HCPTR	;  and point to it
	LD	(LCPTR+1),HL
	LD	A,0FFH		;Flag himem used
	LD	(HGHFLG),A
;
;	Relocate internal references in driver
;
PUTLOW	PUSH	IX
	LD	IX,RELTAB	;Point to relocation tbl
SVEND	LD	HL,$-$		;Find distance to move
	LD	(CLDVR+2),HL	;Set last byte used
	LD	DE,CLEND-1
	OR	A		;Clear carry flag
	SBC	HL,DE
	LD	B,H		;Move to BC
	LD	C,L
	LD	A,TABLEN	;Get table length
RLOOP	LD	L,(IX)		;Get address to change
	LD	H,(IX+1)
	LD	E,(HL)		;P/U address
	INC	HL
	LD	D,(HL)
	EX	DE,HL		;Offset it
	ADD	HL,BC
	EX	DE,HL
	LD	(HL),D		;Put it back
	DEC	HL
	LD	(HL),E
	INC	IX
	INC	IX
	DEC	A
	JR	NZ,RLOOP	;Loop till done
	POP	IX		;Restore DCB
;
;	Set up @ICNFG
;
	LD	HL,INIT		;Get (relocated)
RX01	EQU	$-2
	LD	(IY+29),L	;  init address & put
	LD	(IY+30),H	;  into system ICNFG area
	LD	A,0C3H		;Get JP instruction
	LD	(IY+28),A	;Turn on ICNFG
;
;	Move driver
;
LCPTR	LD	HL,$-$		;Low core or himem pointer
	LD	E,(HL)
	INC	L
	LD	D,(HL)
	PUSH	DE		;Save start
	LD	HL,CLDVR
	LD	BC,CLEND-CLDVR	;Calc driver length
	LDIR			;Move into place
	LD	HL,(LCPTR+1)	;If driver went low,
	LD	(HL),E		;  need to update new
	INC	L		;  driver zone pointer
	LD	(HL),D
;
;	Initialize the driver
;
	LD	HL,LINK		;Pt to ICFG link
RX20	EQU	$-2
	LD	E,(HL)		;Save what's there
	LD	(HL),0C9H	;Make a ret.
	PUSH	HL
	DI
	IF	@BLD631
RX02:	EQU	$+1		;<631>
	LD	HL,RECVINT	;<631>
INTVC:	EQU	$+1		;<631>
	LD	(0000H),HL	;<631>
L2520:	EQU	$+1		;<631>
	LD	HL,0000H	;<631>Get interrupt mask
	SET	5,(HL)		;<631>
	ENDIF
	CALL	INIT		;Init the UART
RX11	EQU	$-2
	EI
	POP	HL
	LD	(HL),E		;Restore icnfg chain
;
	POP	DE		;Pop filter start
;
ISRES	LD	HL,CLACT$	;Advise COM/DVR installed
	LD	(IX),7		;Init DCB type to "C/P/G"
	LD	(IX+1),E	;  & stuff the driver
	LD	(IX+2),D	;  address
	@@LOGOT
	LD	A,$-$		;Did it use high memory?
HGHFLG	EQU	$-1
	OR	A		;NZ if high
	JR	Z,NTHGH
	LD	HL,HMEM$	;"Driver in himem...
	@@LOGOT
NTHGH	LD	HL,0		;Init on error code
	RET			;  and exit
;
;	Error exits
;
VIASET	LD	HL,VIASET$	;"Install with Set
	DB	0DDH
DCBERR	LD	HL,DCBERR$	;"Driver being used already
	DB	0DDH
NOROOM	LD	HL,NOROOM$	;"Memory frozen
	@@LOGOT
	LD	HL,-1		;Set abort code
	@@CKBRKC		;Clear any break
	RET
;
IOERR	LD	L,A		;Error code to HL
	LD	H,0
	OR	0C0H		;Set short,return
	LD	C,A		;Error to C
	@@ERROR			;  for error dsply
	@@CKBRKC		;Clear any break
	RET
;
;	Messages & Data tables
;
HCPTR	DW	0		;Save start if going to HIGH$
CL$	DB	'$CL',3
HELLO$	DB	'RS-232 Driver'
;
*GET	CLIENT:3
;
NOROOM$	DB	'No memory space available',CR
DCBERR$	DB	'Driver already attached to *xx',CR
DCBNAM$	EQU	$-3
CLACT$	DB	'COM driver is now resident',CR
VIASET$	DB	'Must install via SET',CR
HMEM$	DB	LF,'Note: driver installed in high memory',CR
;
@WRINT	EQU	0E0H
WRINT$	EQU	80H
;
MASRES	EQU	0E8H		;RS232 ports
MODSTAT	EQU	0E8H
BAUDSET	EQU	0E9H
UARTCTL	EQU	0EAH
UARTST	EQU	0EAH
DATAREG	EQU	0EBH
;
;	Actual driver
;
CLDVR	EQU	$
	JR	CLBGN		;Branch around linkage
	DW	CLEND		;Last byte used
	DB	3,'$CL'
CLDCB	DW	$-$
	DW	0
CLDATA$	EQU	$
MSMASK	EQU	$-CLDATA$
	DB	0
;
;	UART control port image
;
;	bit 7: 1 = even parity, 0 = odd parity
;	bits 6,5: word length <00=5, 10=6, 01=7, 11=8>
;	bit 4: 1 = 2 stop bits, 0 = 1 stop bit
;	bit 3: 1 = disable parity, 0 = enable parity
;	bit 2: 1 = enable transmit data, 0 = break
;	bit 1: 0 = Data Terminal Ready
;	bit 0: 0 = Request to Send
;
UCIMAGE	EQU	$-CLDATA$
	DB	0A5H
BAUDRT	DB	55H		;Init 300 baud
LOGBRK	EQU	$-CLDATA$
	DB	3		;Default is Control-C
CLFLG	EQU	$-CLDATA$
	DB	0		;Init no char in buf
CLBUF	EQU	$-CLDATA$
	DB	0		;One-char buffer
;
;	CL initialization routine. Set up DR interrupt
;	vector & initialize the hardware
;
	IF	@BLD631
WRINT:	EQU	$+1		;<631>
INIT	LD	A,(0000H)	;<631>Interrupt enable mask
	ELSE
INIT	LD	HL,RECVINT	;Vector address
RX02	EQU	$-2
	LD	($-$),HL	;INTVC$+10
INTVC	EQU	$-2
	LD	HL,WRINT$	;Interrupt enable mask
WRINT	EQU	$-2
	SET	5,(HL)		;Enable RS232 DR
	LD	A,(HL)
	ENDIF
	OUT	(@WRINT),A
	CALL	CTL2		;Init the hardware
RX03	EQU	$-2
LINK	RET			;Link back thru any
	DB	0,0		;  existing ICNFG
;
;	Initialize the UART & BRG
;
CTL2	LD	BC,(CLDATA$+UCIMAGE)	;P/u values from DCB
RX04	EQU	$-2
	OUT	(MASRES),A	;Reprime UART
	LD	A,C
	OUT	(UARTCTL),A
	LD	A,B
	OUT	(BAUDSET),A
	RET
;
CLBGN	LD	IX,CLDATA$	;Point to data area
RX05	EQU	$-2
	JR	C,RECV		;Go if @GET request
	JR	Z,SEND		;Go if @PUT request
	LD	A,C		;P/U @CTL byte
	OR	A		;@CTL 00 ?
	JR	Z,CANISND	;Go if so
	DEC	A		;@CTL 01 ?
	JR	Z,CTL1		;Go if so
	DEC	A		;Was it CTL-2 "INIT UART"
	JR	Z,CTL2		;Go if so
	CP	4-2		;Wakeup feature?
	JR	Z,CTL4		;Go if wakeup feature
	XOR	A
	RET
;
CTL4	PUSH	IY		;Transfer pointer to HL
	IF	@BLD631
	POP	DE		;<631>
	LD	A,D		;<631>Test if set or reset
	OR	E		;<631>
	LD	A,0C9H		;<631>Init disable wakeup
RX06:	EQU	$+1		;<631>
	LD	HL,(WAKEADR+1)	;<631>P/u old address
	ELSE
	POP	HL
	LD	A,H		;Test if set or reset
	OR	L
	LD	A,0C9H		;Init disable wakeup
	EX	DE,HL		;Switch new value to DE
	LD	HL,(WAKEADR+1)	;  & p/u old in HL
RX06	EQU	$-2
	ENDIF
	JR	Z,SETWAK	;Jump if disable
	LD	A,0C3H		;Make enable
SETWAK	LD	(WAKEADR),A	;Load the opcode
RX07	EQU	$-2
	LD	(WAKEADR+1),DE	;Then the address
RX08	EQU	$-2
	PUSH	HL		;Transfer pointer to IY
	POP	IY
	RET
;
;	Check if ready to send
;
CANISND	IN	A,(UARTST)	;Look at TX empty bit
	CPL			;Flip it
	AND	40H		;Mask out all else
	IN	A,(MODSTAT)	;P/U modem status reg
	RET	NZ		;Return if can't send
	LD	B,A		;Save modem status reg
	XOR	(IX+MSMASK)	;Mask for which to flip
	RRA			;Move into bits 0-3
	RRA
	RRA
	RRA
	AND	(IX+MSMASK)	;Mask for which to check
	AND	0FH		;Mask off garbage
	LD	A,B		;Get back reg
	RET			;Ret with Z or NZ
;
;	Send character
;
SEND	LD	A,(IX+UCIMAGE)	;Get UART ctrl reg
	OUT	(UARTCTL),A	;Put it (clears BREAK)
SWAIT	CALL	CANISND		;Poll
RX09	EQU	$-2
	JR	NZ,SWAIT	; until ready
	LD	A,C		;Get byte to send
	OUT	(DATAREG),A	;Send it with Z-flag
	RET			;  unchanged for return
;
;	Receive character - Get from buffer if available
;
RECV1	CALL	CKINP		;Ck if avail from port
RX10	EQU	$-2
	RET	NZ		;Back if none
RECV	SLA	(IX+CLFLG)	;Ck if avail from buf
	JR	NC,RECV1	;Go if none avail
	LD	A,(IX+CLBUF)	;Get the char
	CP	A		;Set Z-flag & exit
	RET
;
;	Break request
;
CTL1	LD	A,(IX+UCIMAGE)	;Pick up UART ctl image
	RES	2,A		;Show BREAK bit
	OUT	(UARTCTL),A
	RET			;With Z-flag
;
;	Data received interrupt handler
;
RECVINT	LD	IX,CLDATA$	;Base of data area
RX13	EQU	$-2
	CALL	CKINP		;See if available from port
RX12	EQU	$-2
	LD	A,B
WAKEADR	RET			;Wakeup if enabled
	DW	0		;Space for address
;
;	Routine to check on a received character
;
CKINP	IN	A,(UARTST)	;Check if actually RX
	LD	B,A		;Save status
	IF	@BLD631
	CPL			;<631>Invert bit 7
	AND	80H		;<631>Set NZ if none avail
	ELSE
	AND	80H		;Mask Data Received bit
	XOR	80H		;Set NZ if none avail
	ENDIF
	LD	A,0		;Set "No error"
	RET	NZ		;Return if none
	IN	A,(DATAREG)	;Pick up character
	LD	C,A		;Save tempy in reg-C
;
;	Break, Pause & Enter handler routine
;
	LD	HL,$-$		;KFLAG$
KFLAG	EQU	$-2
	CP	CR		;ENTER char received?
	JR	NZ,PAWSCK	;Go if not
	SET	2,(HL)		;Set ENTER bit
	JR	RECVEX
;
PAWSCK	CP	60H		;Pause char received?
	JR	NZ,BRKCHK	;Go if not
	SET	1,(HL)		;Set pause bit
	JR	RECVEX
;
BRKCHK	LD	A,(IX+LOGBRK)	;Break char received?
	OR	A		;Check if LOGBRK=0
	JR	Z,RECVEX	;No valid break if =0
	CP	C		;Check if a valid BREAK
	JR	Z,BRKRECD	;Go if so
	IN	A,(UARTST)	;Check for framing error
	IF	@BLD631
	AND	10H		;<631>
	ELSE
	BIT	4,A
	ENDIF
	JR	Z,RECVEX	;Quit if none
;
;	A BREAK was received, ck system's BREAK disable
;
BRKRECD	LD	A,($-$)		;Check if break key
SFLAG	EQU	$-2
	AND	10H		;  is disabled
	LD	A,0		;Return NZ & A=0 if
	RET	NZ		;  the BREAK is disabled
	SET	0,(HL)		;Else set break bit
	LD	C,80H		;  & reset BREAK code
RECVEX	LD	(IX+CLBUF),C	;Put char into 1-char buf
	LD	(IX+CLFLG),80H	;  & set char available
	XOR	A		;Set Z flag
	RET
CLEND	EQU	$
;
	IF	@BLD631
RELTAB	DW	RX01,RX02,RX03,RX04,RX05,RX06,RX07,RX08	;<631>
	ELSE
RELTAB	DW	RX01,RX02,RX03,RX04,RX05,RX06,RX07,RX08
	ENDIF
	DW	RX09,RX10,RX11,RX12,RX13,RX20
TABLEN	EQU	$-RELTAB/2
;
	END	BEGIN