.TITLE	ANSPLR	SPOOLER FOR ANELEX
	.IDENT	/RJDK02/
	.MCALL	GET$R,PUT$R,OPEN$M,ALUN$C
	.MCALL	GET$,OFNB$R,MRKT$C,WTSE$C,FSRSZ$,FDBDF$,FDAT$A
	.MCALL	FDOP$A,FDRC$A,GTSK$C,RCVX$C
	.MCALL	FINIT$,RDAF$C,QIOW$C,QIO$C,WTLO$C
	.MCALL	DELET$
	.MCALL	EXIT$S
	.MCALL	QIOW$S,CLOSE$,GTIM$C,GTSK$C
; PROGRAM TO SPOOL FILES TO THE ANELEX 
;
;
; BASED ON CORAL 66 PROGRAM BY J.R. DRUMMOND
;
				; CHANNEL 1 TI
				; CHANNEL 2 ANELEX
				; CHANNEL 3 SY:
	FSRSZ$	1
	.EVEN
EVBUF:	.BLKW	4
ANERRS:	.WORD	0
RCVBUF:	.BLKW	15.
SPSAV:	.WORD	0
INFDB:	FDBDF$
	FDRC$A	,RECBUF,140.
	FDOP$A	3,,,FO.RD!FA.SHR	
LINCNT:	.WORD	0
RECBUF:	.BLKB	140.
RECLEN:	.WORD	0
FLAGS:	.WORD	0
START:	.WORD	0
END:	.WORD	0
OBF1:	.BLKB	132.
OBF2:	.BLKB	132.
OLEN1:	.WORD	0
OLEN2:	.WORD	0
TABLE:	.WORD	137,106,142,45550,43166,67113,123,155
	.WORD	161,157,115,131,144,173,167,113
	.WORD	176,134,132,170,126,164,162,120
	.WORD	116,154,156,62156,112,150,111,105
	.WORD	141,110,107,146,145,104,143,102
	.WORD	101,140,177,136,135,174,133,172
	.WORD	171,130,127,166,165,124,163,122
	.WORD	121,160,117,114,125,153,63515,75512
; END OF TABLE OF CHARACTERS SPACE THRU _
TMPBUF:	.BLKW	16.
; REFLECT LOWER INTO UPPER AND IGNORE CONTROLS EXCEPT ^I ^J ^K ^L ^M
; WHICH ARE TAB LF VT FF CR

CFDB:	FDBDF$
	FDRC$A	FD.RAN
	FDOP$A	3,CSDS,,FO.MFY
CSDS:	.WORD	4,CDEV,5,CUIC,12.,CFIL
CDEV:	.ASCII	/SY0:/
CUIC:	.ASCII	/[1,7]/
CFIL:	.ASCII	/QUEUEMAN.SYS/
.EVEN
RECPRI:	.WORD	0
RECNO:	.WORD	0

	.MCALL	MRKT$S,WTSE$S

BEGIN:	FINIT$
	ALUN$C	1,TI,0
	ALUN$C	2,TT,20
	QIOW$C	IO.ATT,2,1
	MOV	SP,SPSAV
1$:	OPEN$M	#CFDB		;OPEN CONTROL
	BCC	NXTFIL
	MRKT$S	#1,#5,#1
	WTSE$S	#1
	BR	1$
NXTFIL:	MOV	SPSAV,SP
	;******************* PLUG IN HERE DQ MODULE
	CLR	RECPRI
	CLR	RECNO
	MOV	#1,CFDB+F.RCNM+2
1$:	GET$R	#CFDB,#OBF1,#64.
	BCS	10$
	MOV	CFDB+F.NRBD+2,R5
	CMP	(R5),#<^RLP.>
	BNE	1$
	CMP	4(R5),RECPRI
	BLO	1$
	MOV	4(R5),RECPRI
	MOV	CFDB+F.RCNM+2,RECNO
	BR	1$
10$:	TST	RECNO
	BNE	11$
;NO WORK -- EXIT
	CLOSE$	#CFDB
	EXIT$S
11$:	DEC	RECNO
	MOV	RECNO,CFDB+F.RCNM+2
	GET$R	#CFDB,#OBF1,#64.
	DEC	CFDB+F.RCNM+2
	BIS	#100000,OBF1+4
	PUT$R	#CFDB,#OBF1,#64.
	CLOSE$
;HERE WITH DATA RECORD
;** HERE COPY FNB DATA TO INFDB+F.FNB
	MOV	#INFDB+F.FNB,R0
	MOV	#OBF1+14,R1
	MOV	#10,R2
12$:	MOV	(R1)+,(R0)+
	SOB	R2,12$
	CLR	(R0)+
	CLR	(R0)+
	MOV	#5,R2
13$:	MOV	(R1)+,(R0)+
	SOB	R2,13$
	MOV	OBF1+10,FLAGS
ANNXT:	CALL	ANCLM		;TRY CLAIMING IT
	BCC	ANCLMD		;GOT IT
	MOV	#ANBUSY,R0
	CALL	TYPEIT
	MRKT$C	1,10,2		;WAIT 3 MINS 
	WTSE$C	1
	BR 	ANNXT
ANCLMD:; COPY BUFFER TO INFDB
	CLR	LINCNT
	CLR	ANERRS		;CLEQR COUNT OF ERRORS
	OFNB$R	#INFDB		;READ ON SY:
	BCS	EOFIL		;NO GOOD GO TO NEXT FILE
	CLR	RECLEN
	CALL	PRINTF		;PRINT THE FILE
EOFSTP:	MOV	SPSAV,SP
	TST	FLAGS
	BMI	11$
	CLOSE$	#INFDB		;CLOSE
	BR	12$
11$:	DELET$	#INFDB
12$:	CALL	ANREL
;	LOGIC HERE TO REMOVE OLD Q ENTRY
EOFIL:	OPEN$M	#CFDB
	BCC	2$
	MRKT$S	#1,#5,#1
	WTSE$S	#1
	BR	EOFIL
2$:	;NOW NULL OUT RECORD....
	MOV	#OBF1,R5
	MOV	#32.,R4
1$:	CLR	(R5)+
	SOB	R4,1$
	PUT$R	#CFDB,#OBF1,#64.,RECNO
	JMP	NXTFIL


PRINTF:	;ROUTINE TO PRINT FILE AND HEADER
	CALL	HEADR
1$:	CALL	PRINTL
	RTS	PC

HEADR:	MOV	#RECBUF,R0
	MOV	R0,START
	MOVB	#12,(R0)+
	MOV	#30,R3
2$:	MOVB	#'*,(R0)+
	SOB	R3,2$
	MOVB	#' ,(R0)+
	MOV	OBF1+6,R3
	MOV	#1,R4
	MOV	R0,R2
	CALL	.PPASC
	MOV	#OBF1+38.,R1
	MOV	R2,R0
	MOV	#26.,R2
1$:	MOVB	(R1)+,(R0)+
	SOB	R2,1$
	MOVB	#' ,(R0)+
	GTIM$C	TMPBUF
	MOVB	#'O,(R0)+
	MOVB	#'N,(R0)+
	MOVB	#' ,(R0)+
	MOV	#TMPBUF,R1
	CALL	$DAT
	MOV	#3,R2
	MOVB	#' ,(R0)+
	MOVB	#'A,(R0)+
	MOVB	#'T,(R0)+
	MOVB	#' ,(R0)+
	CALL	$TIM
	MOVB	#' ,(R0)+
	MOV	#30,R3
3$:	MOVB	#'*,(R0)+
	SOB	R3,3$
	MOVB	#12,(R0)+
	MOVB	#12,(R0)+
	MOV	R0,END
	SUB	START,R0
	MOV	R0,RECLEN
	RTS	PC




PRINTL:	; PRINT A LINE FROM THE OPEN FILE
	; CALLS GTC	TO GET NXT CHAR TO R0
	CLR	OLEN1
5$:	CALL	GTC
	BCS	4$
	MOV	OLEN1,R1
	CMP	R0,#40
	BLT	1$			;CONTROL
	SUB	#40,R0
	ASL	R0
	MOV	TABLE(R0),R0
	MOVB	R0,OBF1(R1)
	SWAB	R0
	BIC	#177400,R0
	BNE	77$
	MOV	#137,R0
77$:	MOVB	R0,OBF2(R1)		;MAKE OVERPRINT SPACES NOT NULLS
	INC	OLEN1
	BR	5$			;GET NEXT CHARAXTER
1$:	CMPB	#11,R0
	BNE	3$			;NOT A TAB
	MOV	#137,R0
2$:	MOVB	R0,OBF1(R1)
	MOVB	R0,OBF2(R1)
	INC	R1
	BIT	#7,R1
	BNE	2$
	MOV	R1,OLEN1
	BR	5$
4$:	MOV	#-1,END
3$:				;HERE FOR PRINT LINE CHARS
	MOV	R0,-(SP)	;SAVE THE CHARACTER
	MOV	OLEN1,R0
	MOV	R0,R1
	TST	R0
	BLE	40$
6$:	DEC	R0			;SINCE COUNT PUTS US BEYOND
	CMPB	OBF2(R0),#137
	BNE	8$			;NON SPACE
	TST	R0
	BGT	6$
	BR	7$			;NONE TO PRINT
8$:	INC	R0			;RESTORE COUNT
	QIOW$S	#IO.WAL,#2,#1,,,,<#OBF2,R0,#0>
	MOV	#377,R0
	CALL	ANSND1
7$:	;HAVING PRINTED ANY OVERPRINT -- PRINT THE LINE IF ANY
	DEC	R1
	CMPB	OBF1(R1),#137
	BNE	9$			;REAL CHAR
	TST	R1
	BGT	7$
	BR	10$
9$:	INC	R1
	QIOW$S	#IO.WAL,#2,#1,,,,<#OBF1,R1,#0>
10$:	;DO THE REQUESTED CARRIAGE CONTROL
	MOV	(SP)+,R0
	CMPB	#15,R0
	BNE	20$
	MOV	#377,R0
	CALL	ANSND1
	BR	30$
20$:	CMPB	#12,R0
	BNE	21$
33$:	INC	LINCNT
	MOV	#376,R0
	CALL	ANSND1
	cmp	lincnt,#66.
	bge	22$
	BR	30$
21$:	BIT	#20000,FLAGS
	BNE	33$
	CMP	LINCNT,#3
	BLOS	33$
	MOV	#306,R0
	CALL	ANSND1
22$:	CALL	ANCLM
	clr	lincnt
	BCC	30$
	RTS	PC
30$:	TST	END
	BGE	JPRNT
	RTS	PC
40$:	MOV	#273,R0
	CALL	ANSND1
	BR	10$
JPRNT:	JMP	PRINTL
WAITA:	MRKT$C	3,5,1
	WTSE$C	3
	RTS	PC




GTC:	; CALLS GETREC WHEN REQUIRED - DOES NOT PASS ON ADJACENT 
	;CASE FOR PRINTL - THEREFORE INPUT IS AS IF FROM TEXT FROM .ASCII
	CMP	START,END
	BLT	2$
	CALL	GETLIN
	BCC	GTC
	MOV	#14,R0
	SEC
	RTS	PC
2$:	;HERE THERE IS A REAL CHARACTER IN THE BUFFER - PERHAPS
	; RETURN IT IN R0 IF WE CAN
	;
	MOV	START,R0
	INC	START
	MOVB	(R0),R0
	CMPB	R0,#140
	BLT	3$
	BICB	#40,R0
3$:	;NOW RANGE 0-140
	CMPB	R0,#10
	BLE	GTC
	CMPB	R0,#40
	BLT	4$
	RTS	PC
4$:	CMPB	R0,#15
	BGT	GTC
	BNE	6$
	CMP	START,END
	BGE	5$
	CMPB	@START,#12
	BNE	5$
	INC	START
	MOV	#12,R0
6$:	CMPB	R0,#13
	BNE	5$
	MOV	#14,R0
5$:	CLC
	RTS	PC
; WE RETURN ' '- _ & HT FF CR LF




GETLIN:	;ROUTINE TO READ NEW RECORD INTO RECBUF APPENDING LF IF NEEDED
	CLR	RECLEN
	GET$	#INFDB,#RECBUF,#140.
	BCS	RATEX1
	MOV	INFDB+F.NRBD,RECLEN
	MOV	#RECBUF,START
	MOV	#RECBUF,END
	ADD	RECLEN,END
	CMPB	INFDB+F.RATT,#FD.FTN
	BEQ	RATFTN
	CMPB	INFDB+F.RATT,#FD.CR
	BNE	RATEXT
	MOVB	#12,@END
	INC	END
RATEXT:	CLC
RATEX1:	RTS	PC
RATFTN:	MOV 	#RECBUF,R0
	MOVB	(R0),R1
	CMPB	R1,#'1
	BNE	1$
	MOVB	#14,(R0)
	BR	5$
1$:	CMPB	R1,#'+
	BNE	2$
	MOVB	#15,(R0)
	BR	5$
2$:	MOVB	#12,(R0)
5$:	CLC
	RTS	PC



ANSND:	MRKT$C	7,1,1
	WTSE$C	7
	MOV	R0,RCVBUF
	QIO$C	4432,2,2,,,,<RCVBUF+2,1,0,RCVBUF,1>
	CMP	R0,#306
	BEQ	AFFSND
	MRKT$C	3,30.,1
	BR	AFTSND
AFFSND:	MRKT$C	3,50.,1
AFTSND:	WTLO$C	0,6
	RDAF$C	EVBUF
	BIT	#2,EVBUF
	BNE	GOODRP
	MOV	#-1,RCVBUF+2
	MRKT$C	7,12.,1		;WAIT A BIT
	WTSE$C	7
	QIOW$C	IO.KIL,2,4
	MOV	#377,R0
	RTS	PC
GOODRP:	CLR	R0
	BISB	RCVBUF+2,R0
	RTS	PC
ANTMP:	.WORD	0
ANSND1:	MOV	R0,ANTMP
ANX1:	CALL	ANSND
	CMP	R0,#377
	BEQ	5$
	BIT	#10,R0
	BNE	2$
	BIT	#40,R0
	BNE	1$
5$:	RTS	PC
1$:	MOV	#ANDON,R0
	CALL	TYPEIT
	JMP	EOFSTP
2$:	CALL	ANSTS
	MRKT$C	5,2,3
	WTSE$C	5
	MOV	ANTMP,R0
	BR	ANX1

ANREL:	MOV	#275,R0
	CALL	ANSND
	RTS	PC

ANCLM:	CLR	ANERRS
2$:	MOV	#276,R0
	CALL	ANSND
	MOV	#273,R0
	CALL	ANSND
	CMP	R0,#201
	BNE	1$
	CLC
	RTS	PC
1$:	INC	ANERRS
	CMP	ANERRS,#10
	BLT	2$
	CALL	ANSTS
	SEC
	RTS	PC




ANSTS:	MOV	R0,R4		;ENTER WITH REPLY IN R0 - BYTE ONLY
	MOV	#AMSG0,R0
	CALL	TYPEIT
	CMPB	R4,#377
	BNE	9$
	MOV	#AMSG9,R0
	CALL	TYPEIT
	BR	8$
9$:	BIT	#1,R4		;STARTED ?
	BEQ	1$
	MOV	#AMSG1,R0
	BR	2$
1$:	MOV	#AMSG2,R0
2$:	CALL	TYPEIT
	BIT	#2,R4
	BEQ	3$
	MOV	#AMSG3,R0
	CALL	TYPEIT
3$:	BIT	#4,R4
	BEQ	4$
	MOV	#AMSG4,R0
	CALL	TYPEIT
4$:	BIT	#10,R4
	BEQ	5$
	MOV	#AMSG5,R0
	CALL	TYPEIT
5$:	BIT	#20,R4
	BEQ	6$
	MOV	#AMSG6,R0
	CALL	TYPEIT
6$:	BIT	#40,R4
	BEQ	7$
	MOV	#AMSG7,R0
	CALL	TYPEIT
7$:	BIT	#100,R4
	BEQ	8$
	MOV	#AMSG8,R0
	CALL	TYPEIT
8$:	RTS	PC

ANBUSY:	.ASCIZ	/ANSPLR --  WAITING FOR ANELEX TO BE READY/
ANDON:	.ASCIZ	/ANSPLR -- **FATAL** FILE ABANDONED BY USER REQUEST/
AMSG0:	.ASCIZ	/**-ANELEX STATUS-**/
AMSG1:	.ASCIZ	/    STARTED/
AMSG2:	.ASCIZ	/    STOPPED/
AMSG3:	.ASCIZ	/    PAPER LOW/
AMSG4:	.ASCIZ	/    BUFFER OVERFLOW/
AMSG5:	.ASCIZ	/    PAPER OUT/
AMSG6:	.ASCIZ	/    DISABLED/
AMSG7:	.ASCIZ	/    DISENGAGED/
AMSG8:	.ASCIZ	/    BUSY/
AMSG9:	.ASCIZ	/    NO REPLY/
	.EVEN
TYPEIT:	MOV	R1,-(SP)
	MOV	R0,R1
1$:	TSTB	(R1)+
	BNE	1$
	DEC	R1
	SUB	R0,R1
	QIOW$S	#IO.WLB,#1,#1,,,,<R0,R1,#40>
	MOV	(SP)+,R1
	RTS	PC
	.END	BEGIN