;LBSPOOLB/ASM - Actual spool driver
;
;
;	This is the spool/despool driver - bank 0
;
FIX1	CALL	SPLR2		;Code mods to module-A
RX16	EQU	$-2		;  if strictly bank-0
	XOR	A
	RET
	CALL	DSPLR1
RX17	EQU	$-2
	XOR	A
	RET
	CALL	GETBLK2
RX18	EQU	$-2
	XOR	A
	RET
;
DVRABGN	EQU	$
	JR	DVREPT		;Branch around linkage
	DW	$-$		;Last byte used
	DB	5
SPOOL$	DB	'SPOOL'
S0DCB	DW	0,0		;Space for DCB pointers
PRMSAV	DW	0		;HIGH$ before space alloc
	DW	DVRABGN-1	;HIGH$ after space alloc
	DW	0		;Previous MPARM
	DW	0		;Previous DPARM
MODDVR	DW	0		;DCB address of device
SPLBNK	DB	0		;Bank of RAM
	DW	SPLFCB		;FCB pointer
RX8	EQU	$-2
;
DVREPT	JR	Z,PUTCHAR	;Go on @PUT
	JR	NC,CKCTL	;Go on @CTL
	LD	A,0		;Show nothing on @GET
	RET
CKCTL	XOR	A
	RET			;Show available on CTL-0
;
;	Move stack low if needed
;
STKCTL	PUSH	HL
	LD	HL,8005H
	ADD	HL,SP		;Stack in what bank?
	POP	HL
	RET	NC		;Ok if stack low
	DI
	LD	(SVHL),HL
RX19	EQU	$-2
	POP	HL		;Return address
	LD	(SAVSTK),SP	;Save the current stack
RX20	EQU	$-2
	IF	@BLD631
	LD	SP,STACK$-40H	;<631>Force it low
	ELSE
	LD	SP,STACK$-20H	;Force it low
	ENDIF
	PUSH	HL		;User ret back on
	LD	HL,SPOLRET
RX21	EQU	$-2
	EX	(SP),HL		;Now, ultimate ret 1st,
	PUSH	HL		;  and local ret 2nd
	LD	HL,(SVHL)	;Restore HL
RX23	EQU	$-2
	EI
	RET
;
SPOLRET
	DI			;Just in case
	LD	SP,(SAVSTK)	;Get the old stack
RX22	EQU	$-2
	EI
	RET
SAVSTK	DW	0
SVHL	DW	0
;
;	Character to PUT - Get bank activated
;
PUTCHAR	LD	HL,SPLR1A	;Point to transfer addr
RX01	EQU	$-2
	LD	E,C		;Xfer char to PUT
	LD	BC,0<8!0!80H	;P/u function & bank req
BANKX1	EQU	$-2
	CALL	STKCTL		;Move stack low?
RX24	EQU	$-2
	@@BANK			;  & invoke bank transfer
	RET
;
;	Task processor despooling routine
;
DSPLTCB	DW	DSPLR		;Despool task control blk
RX02	EQU	$-2
DSPLR	LD	A,($-$)		;P/u PFLAG$ & ck if
DFLAG	EQU	$-2		;  despooling is active
	RLCA
	RET	NC		;Back if not
	LD	HL,(S0DCB)	;If spooler is inactive
RX08	EQU	$-2		;  then don't try to
	INC	L		;  do any despooling
	LD	C,(HL)		;Get DCB vector
	INC	L
	LD	B,(HL)		;  into BC
	LD	HL,DVRABGN	;P/u spooler start
RX09	EQU	$-2
	XOR	A
	SBC	HL,BC		;If the same, then
	RET	Z		;  module is not active
FIX2UP	LD	HL,DSPLR0	;Point to transfer addr
RX03	EQU	$-2
	LD	BC,0<8!0!80H	;P/u function & bank req
BANKX2	EQU	$-2
	CALL	STKCTL		;Move stack low?
RX25	EQU	$-2
	@@BANK			;  & invoke bank transfer
	RET
;
;	KI task routine to get a disk block
;
GETBLK	LD	HL,GETBLK1	;Point to transfer addr
RX04	EQU	$-2
	LD	BC,0<8!0!80H	;P/u function & bank req
BANKX3	EQU	$-2
	CALL	STKCTL		;Move stack low?
RX26	EQU	$-2
	@@BANK			;  & invoke bank transfer
GETBLK0	DB	0,0,0		;Orig @KITSK
DVRAEND	EQU	$-1
RELTABA	DB	TABALEN
	DW	RX02,RX05,RX06,RX08,RX09
	DW	RX19,RX20,RX21,RX22,RX23
	DW	RX24,RX25,RX26
TABALEN	EQU	$-RELTABA/2
;
;
DVRBBGN	EQU	$
;
;	Spool/despool module in bank x
;
S0DCB1	DW	0
;
;	Spool a character
;
SPLR1A	PUSH	HL		;Save new transfer addr
	PUSH	BC		;Save invocation
	LD	C,E		;Get char to PUT
	CALL	SPLR2		;Spool a char
RX1	EQU	$-2
	POP	BC
	POP	HL
	@@BANK			;Transfer back
SPLR2	LD	IX,SPLFCB
RX2	EQU	$-2
	LD	L,(IX+20H)	;P/u next buffer position
	LD	H,(IX+21H)
	LD	(HL),C		;Stuff char received
	DI
SPLR3	INC	(IX+20H)	;Inc lo order
	JR	Z,SPLR5		;Jump if block full
	CALL	DSPLR1X		;Output to *PR if avail
RX3	EQU	$-2
	EI
	JP	GETBLK2
RX4	EQU	$-2
SPLR5	LD	L,(IX+24H)	;P/u pointer to table
	LD	H,(IX+25H)
SPLR6	LD	A,(HL)		;Find spare pointer field
	INC	HL
	OR	(HL)
	JR	Z,SPLR7		;Jump if spare
	INC	HL		;  else index to next
	INC	HL
	INC	HL
	JR	SPLR6
SPLR7	DEC	HL
	PUSH	HL		;Save pointer
	INC	HL
	INC	HL
	LD	B,(HL)		;P/u memory segment byte
	INC	HL		;  or lo-order recno
	LD	A,(HL)		;End of table?
	CP	0FFH
	JR	NZ,SPLR10	;Jump if still space
	POP	HL
SPLR8	CALL	DSPLR1X		;Output to *PR if avail
RX5	EQU	$-2
	EI
SPLR9	CALL	GETBLK2		;Disk rec to bring back?
RX6	EQU	$-2
	DI
	JR	SPLR5
SPLR10	BIT	7,A		;Test mem or disk block
	JR	NZ,SPLR12	;Jump if disk pointer
;
;	Found a spare memory pointer
;
	POP	HL		;Rcvr ptr to start
	PUSH	HL		;  of spare table field
	LD	(HL),L		;Place address of table
	LD	A,H		;  position into table
	INC	HL
	LD	(HL),A
	LD	(IX+21H),B	;Stuff hi-order free mem
	LD	L,(IX+26H)	;P/u current table ptr
	LD	H,(IX+27H)
	LD	(IX+2AH),L	;Stuff last block pointer
	LD	(IX+2BH),H
	POP	BC		;Rcvr ptr to field start
	LD	(HL),C		;Set up a link to this
	INC	HL		;  block in last block
	LD	(HL),B
	LD	(IX+26H),C	;Reset current block ptr
	LD	(IX+27H),B
	EI
	RET
;
SPLR12	EQU	$
	EI
	LD	C,B		;Lo order recno
	AND	0FH		;Hi-order recno
	LD	B,A
	PUSH	IX		;Position file to recno
	POP	DE		;FCB to DE
	@@POSN			;Posn to desired record
	DB	0,0,0		;Reserved
	LD	C,(IX+26H)	;P/u current table ptr
	LD	B,(IX+27H)
	POP	HL		;P/u ptr to this disk
	PUSH	HL		;Block table field
	LD	(HL),C		;Tell this disk block
	INC	HL		;  field which memory
	LD	(HL),B		;  block it is storing
	POP	BC		;Exchange link in last
	LD	L,(IX+2AH)	;  block pointer with new
	LD	H,(IX+2BH)	;  link since this memory
	LD	(HL),C		;  block is now on disk
	INC	HL
	LD	(HL),B
	LD	(IX+2AH),C
	LD	(IX+2BH),B
	LD	BC,256		;Block move the page
	LD	L,C		;  into the low memory
	LD	H,(IX+21H)	;  buuffer fo disk I/O
	PUSH	DE		;Save fcb pointer
	LD	DE,LOWBUF$
	LDIR
	POP	DE
	@@WRITE			;Write out the block
	DB	0,0,0		;Reserved
	RET
;
DSPLR0	PUSH	HL		;Save new transfer addr
	PUSH	BC		;Save invocation
	CALL	DSPLR1		;Send device a char
RX7	EQU	$-2
	POP	BC
	POP	HL
	@@BANK			;Transfer back
;
;	Routine will output a char to PR if available
;
DSPLR1X	LD	A,($-$)		;P/u PFLAG$ & ck if
DFLAG1	EQU	$-2		;  despooling is active
	RLCA
	RET	NC		;Back if not active
DSPLR1	LD	BC,4<8!0	;Init to CTL-0
	PUSH	IX		;Save current DCB vector
PUDCB	LD	IX,(S0DCB1)	;Point to printer
RX9	EQU	$-2
	@@CHNIO			;Ck *PR status
	POP	IX
	RET	NZ		;Ret if not avail
PUFCB	LD	IX,SPLFCB
RX10	EQU	$-2
	LD	A,(IX+23H)	;See if char in buffer
	OR	A		;  to send to the printer
	RET	Z		;Ret if none
	LD	H,A		;None also if GET pointer
	CP	(IX+21H)	;  is same as PUT pointer
	LD	A,(IX+22H)
	JR	NZ,DSPLR2
	CP	(IX+20H)
	RET	Z		;In & out the same
DSPLR2	LD	L,A		;P/u the character
	LD	C,(HL)		;Xfer to output reg
	PUSH	IX		;Save this dcb vector
	LD	B,2		;Set chain for PUT
PUDCB1	LD	IX,(S0DCB1)	;Pt to spooled DCB
RX11	EQU	$-2
	@@CHNIO			;Output the char
	POP	IX		;Rcvr dcb
	INC	(IX+22H)	;Bump PUT (out) ptr
	RET	NZ		;Ret if still more in buf
	LD	(IX+23H),0	;Block empty, turn off
	RET			;  hi-order & exit
;
;	Routine to see if we can grab a block back from
;	the disk file & insert into a spare memory block
;
GETBLK1	PUSH	HL		;Save new transfer addr
	PUSH	BC		;Save invocation
	CALL	GETBLK2		;Spool a char
RX12	EQU	$-2
	POP	BC
	POP	HL
	@@BANK			;Transfer back
GETBLK2	PUSH	AF
	PUSH	IX		;Save in case DSPLR1
GETBLK3	LD	A,(SPLFCB+23H)	;Jump if block being
RX13	EQU	$-2
	OR	A		;  printed is not empty
	JR	NZ,GETBLK6
;
;	The block's been despooled. Get 1 from D,M?
;
	PUSH	HL
	PUSH	DE
	PUSH	BC
GETBLK4	LD	IX,SPLFCB
RX14	EQU	$-2
	LD	L,(IX+28H)	;P/u pointer of block
	LD	H,(IX+29H)	;  being printed
	PUSH	HL
	LD	C,(HL)		;Point to POSN or hi-mem
	INC	HL		;  byte of field this
	LD	B,(HL)		;  field points to
	LD	HL,2		;P/u the POSN or hi-order
	ADD	HL,BC
	LD	A,(HL)
	INC	HL
	BIT	7,(HL)		;Jump if it is pointing
	JR	NZ,GETBLK7	;  to a disk block
	LD	(IX+23H),A	;Reset hi order of where
	POP	HL		;  next block coming from
	LD	(HL),0		;Show that this block
	INC	HL		;  is spare
	LD	(HL),0
	LD	(IX+28H),C	;Set the next block
	LD	(IX+29H),B	;  to be printed
GETBLK5	POP	BC
	POP	DE
	POP	HL
GETBLK6	EQU	$
	DI
	CALL	DSPLR1X		;Check if we can despool
RX15	EQU	$-2		;  a character while
	EI			;  we are in here
	POP	IX
	POP	AF
	RET
;
;	Next block to print is on disk, get it
;
GETBLK7	LD	C,A		;Set up position
	LD	A,(HL)
	AND	0FH
	LD	B,A
	PUSH	IX		;Set FCB & position
	POP	DE		;  the spool file
	@@POSN
	DB	0,0,0		;Reserved
	POP	HL		;Rcvr table ptr of
	PUSH	HL		;  block just finished
	INC	HL
	INC	HL		;P/u its buffer location
	@@READ			;Read block from file
	DB	0,0,0		;Reserved
	LD	BC,256		;Block move from the
	LD	D,(HL)		;  low memory buffer
	LD	E,C		;  to RAM page
	LD	HL,LOWBUF$
	LDIR
	POP	HL		;Tbl ptr of block fin'd
	PUSH	HL
	LD	A,(HL)		;P/u field addrress of
	INC	HL		;  the next table field
	LD	H,(HL)		;  that gets printed
	LD	L,A
	LD	C,(HL)		;P/u field address of the
	LD	(HL),0		;  block after that to 
	INC	HL		;  print & show this one
	LD	B,(HL)		;  as empty (this was the
	LD	(HL),0		;  disk one just vacated)
	POP	HL
	LD	(HL),C		;Reset current printing
	INC	HL		;  block & point to
	LD	(HL),B		;  new next block
	INC	HL
	LD	B,(HL)
	LD	(IX+23H),B	;Show where new printing
	JR	GETBLK5		;  block is & exit
;
;	File control block area for spool file
;
SPLFCB	DS	32
;
;	Pointer to the memory location where the next
;	character received from *XX can be put
;
PUTNXT$	DS	2
;
;	Pointer to where the next character to print
;	is going to come from
;
GETNXT$	DS	2
;
;	Pointer to start of block map table
;	table configuration is:
;	 TAB+0/1 -> store the TAB address if the field
;	 is currently in use for receiving. If a
;	 block is not current, it stores the
;	 address of the next TAB to print. If
;	 a disk field, then stores the TAB address
;	 of the previous block (link back)
;
;	 TAB+2 -> for a memory block, stores the hi-order
;	 byte of where the memory block starts. If
;	 a disk byte, stores the lo-order POSN #.
;
;	 TAB+3 -> s/b 0 for a memory block or if a disk
;	 block, it contains the hi-order POSN
;	 vector with bit 7 set.
;
MAPPTR$	DS	2
;
;	Pointer to the beginning of the memory table
;	block pointer for the block that is receiving
;	characters from *PR calls (the current block)
;
PUTBLK$	DS	2
;
;	Pointer to the memory table field for the block
;	that is printing characters
;
GETBLK$	DS	2
;
;	Points to the table position of the previous
;	block. This is used to reset the previous link
;
	DW	0
DVRBEND	EQU	$-1
RELTABB	DB	TABBLEN
	DW	RX01,RX03,RX04
	DW	RX1,RX2,RX3,RX4,RX5,RX6,RX7,RX8
	DW	RX9,RX10,RX11,RX12,RX13,RX14,RX15
	DW	RX16,RX17,RX18
TABBLEN	EQU	$-RELTABB/2