Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

.SBTTL	XL3780
;
; THIS SECTION CONTAINS THE TRANSLATE TASK, THE IDLE TASK
;  AND THE TABLES USED BY THE TRANSLATE (XLATE) TASK
;  TO CONVERT BETWEEN ASCII AND EBCDIC, AND TO SIMULATE
;  A PRINTER CARRIAGE CONTROL TAPE.
;
.REPT 0


                          COPYRIGHT (c) 1980, 1979
            DIGITAL EQUIPMENT CORPORATION, maynard, mass.

THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
TRANSFERRED.

THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
CORPORATION.

DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

.ENDR
;

;
;
;REVISION HISTORY
;
;
; 3(001) BS	PAD CARDS TO 80. CHARACTERS WHEN IRS RECEIVED IN 3780 MODE
;
; 3(002) BS	REMOVE EBCDIC TO ASCII TRANSLATION TABLES FOR USE WITH TRNTAB
;
; 3(003) BS	RESET CDR TCHPS TO 0 FOR 2780/3780 SUPPORT AFTER 80 CHARACTERS
;
; 3(004) BS	ALLOW TASK TO PROCESS ONLY ONE MESSAGE AT A TIME
;
; 3(005) BS	SIGNAL INPUT EOF ONLY AFTER LAST MESSAGE SENT TO PDP-10
;
;
V3780=005
;
;
VEDIT=VEDIT+V3780
;
;
;
;

;
;
; SPECIFY TRANSLATE OPTIONS AVAILABLE
;
; BIT 0 = IBM 3780/2780
; BIT 1 = HASP MULTILEAVING
; BIT 2 = IBM 3270
; BITS 3-15 = RESERVED
;
XLOPTN=XLOPTN!B0	;2780/3780 TRANSLATION AVAILABLE
;

;
; THIS TASK TRANSLATES DATA FROM ASCII TO EBCDIC AND FROM 
;  EBCDIC TO ASCII.
;
XLATE:	BIT	#TCOPR,TCFG2(R5) ;OUTPUT PERMISSION REQUESTED?
	BNE	11$		;YES, START OUTPUT.
	JSR	PC,XLWAIT	;NO, WAIT PROCESSING INPUT
	BIT	#TCOAB,TCFG2(R5) ;WAS ABORT FLAG SET?
	BEQ	XLATE		;NO.
	JSR	PC,XLOABT	;YES, CLEAR IT (NO OUTPUT RUNNING)
	BR	XLATE		; AND TRY AGAIN.
;
; HERE IF THE PDP-10 PROGRAM IS REQUESTING OUTPUT PERMISSION.
;
11$:	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.TC1(R4),R0	;POINT TO BSC TASK
	BIS	#TCOPR,TCFG2(R0) ;ASK FOR A BID FOR THE LINE
	MOV	#^D20*JIFSEC,TCTIM(R5) ;20 SECONDS
12$:	MOV	#EBINTR!EBTIME!EBWAIT,(R5) ;WAIT FOR IT
	JSR	PC,WAIT
	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.TC1(R4),R0	;POINT TO BSC TASK
	BIT	#TCOPR,TCFG2(R0) ;STILL BIDDING FOR THE LINE?
	BEQ	13$		;NO.
	TST	TCTIM(R5)	;YES, DID TIME EXPIRE?
	BNE	12$		;NO, KEEP WAITING.
	BIC	#TCOPR,TCFG2(R0) ;YES, CEASE BIDDING
	BIC	#TCOPR,TCFG2(R5) ;KILL OUTPUT REQUEST
	BR	XLATE		;THE BID WAS A FAILURE.
;

;
; HERE WHEN BIDDING IS COMPLETE.
;
13$:	BIC	#TCOPR,TCFG2(R5) ;NO LONGER REQUESTING PERMISSION
	BIT	#TCOPG,TCFG2(R0) ;DO WE HAVE OUTPUT PERMISSION?
	BEQ	XLATE		;NO, THE BID WAS A FAILURE.
	BIS	#TCOPG,TCFG2(R5) ;YES, TELL THE PDP-10 WE HAVE PERMISSION

;;++BS-CODE TO SET THE DEVICE ACTIVE BIT

	JSR	PC, HSSAVR	;SAVE THE REGISTERS
	MOV	TCLCB(R5), R2	;POINT TO LCB
	MOV	LB.LNU(R2), R0	;GET LINE NUMBER
	BIC	#177770, R0	;CLEAR JUNK
	BIT	#LF.SIM, LB.FGS(R2) ;SIMULATION OR SUPPORT ?
	BNE	36$		;YES, MUST BE CDR
	MOV	#4, R1		;NO, SUPPORT, MUST BE LPT
	BR	37$		;SET ACTIVE BIT
36$:	MOV	#3, R1		;SIMULATION, MUST BE CDR
37$:	JSR	PC, HSACMP	;SET THE ACTIVE BIT
	JSR	PC, HSRESR	;RESTORE THE REGISTERS

;;++BS-END OF CODE TO SET THE DEVICE ACTIVE BIT

	CLR	LB.MSC(R4)	;INITIALIZE COUNT OF MSGS TO TRANSMIT
	MOV	TCBFP(R5),R0	;INITIALIZE R0 AND R2 FOR
	CLR	R2		; LINE BUFFER
	CLR	TCHPS(R5)	;ASSUME WE START AT LEFT MARGIN
	CLR	TCVPS(R5)	; AND AT THE TOP OF A PAGE
	BIT	#TCPRO,TCFG1(R5) ;CARRIAGE CONTROL ON OUTPUT?
	BEQ	14$		;NO.
	MOV	#EBCESC,R1	;YES, PUT AN ESCAPE AT THE FRONT
	JSR	PC,XLAPBF	; OF THE LINE BUFFER
	MOVB	ASCEBC+'M,R1	;AND AN 'M' IN THE SECOND PLACE
	JSR	PC,XLAPBF	; TO MEAN "NO SPACING".
14$:
;
; FALL INTO XLASEB
;

;
; HERE TO TRANSLATE CHUNKS FROM ASCII TO EBCDIC.
;
XLASEB:
11$:	MOV	R0,-(SP)	;SAVE R0 (LINE BUFFER POINTER)
	MOV	R2,-(SP)	; AND R2 (LINE BUFFER COUNTER)
12$:	MOV	#EBQCHK!EBINTR!EBTIME!EBWAIT,(R5) ;SET UP FOR WAIT
	MOV	#JIFSEC-11,TCTIM(R5)
	BIT	#TCOAB,TCFG2(R5) ;IS THE STREAM ABORTED?
;	BNE	22$		;YES, EMPTY THE QUEUES.
	BEQ	29$		;NO, GET A CHUNK
	JMP	22$		;YES, EMPTY THE QUEUES
29$:	JSR	PC,DEQCHK	;NO, GET A CHUNK
	BCC	16$		;GOT ONE.
	BIT	#TCOEF,TCFG2(R5) ;NONE, END OF FILE?
	BNE	17$		;YES, SEND ETX.
	BIT	#TCDMP,TCFG1(R5) ;NO, HAS PDP-10 REQUESTED A DUMP?
	BEQ	13$		;NO.
	MOV	(SP)+,R2	;YES, RESTORE R2
	MOV	(SP)+,R0	; AND R0
	JSR	PC,XLODMP	;EMPTY OUR BUFFERS
	BCS	23$		;STREAM ABORTED
	BR	11$		;RECIRCULATE
;
13$:	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.TC1(R4),R0	;POINT TO BSC TASK
.IF NE,DEBUG
	BIT	#TCORN!TCOPG,TCFG2(R5) ;IS IT DOING OUTPUT?
	BNE	14$		;YES.
	STOPCD	DBG		;NO, ERROR.
14$:
.ENDC ;.IF NE,DEBUG
	BIT	#TCORN,TCFG2(R0) ;IS OUTPUT RUNNING?
	BEQ	15$		;NO.
	BIS	#TCORN,TCFG2(R5) ;YES, SET OUR FLAG FOR PDP-10
	BIC	#TCOPG,TCFG2(R5) ; AND CLEAR PERMISSION FLAG
15$:	JSR	PC,WAIT		;WAIT FOR A CHUNK
	BR	12$		; AND TEST AGAIN.
;
; HERE WHEN THERE IS A CHUNK AVAILABLE
;
16$:	MOV	R0,R3		;POINT R3 TO NEW CHUNK
	MOV	(SP)+,R2	;RESTORE R2
	MOV	(SP)+,R0	;RESTORE R0
	JSR	PC,XLOCNK	;TRANSLATE A CHUNK FROM ASCII TO EBCDIC
	BR	11$		;TRY TO TRANSLATE ANOTHER CHUNK
;

;
; HERE ON END OF FILE.
;
17$:	MOV	(SP)+,R2	;RESTORE R2
	MOV	(SP)+,R0	;RESTORE R0
18$:	JSR	PC,XLEOFO	;SIGNAL END OF FILE TO THE PRINTER
	BCC	19$		;WIN.
	MOV	R0,-(SP)	;OUT OF CHUNKS, SAVE R0
	MOV	#EBTIME!EBWAIT,(R5) ;WAIT A WHILE
	MOV	#JIFSEC+11,TCTIM(R5)
	JSR	PC,WAIT
	MOV	(SP)+,R0	;RESTORE R0
	BR	18$		;TRY AGAIN.
;
19$:	MOV	#EBTIME!EBINTR!EBWAIT,(R5)
	MOV	#JIFSEC+12,TCTIM(R5)
	JSR	PC,WAIT		;WAIT FOR TIME OR DQ11 SIGNAL
	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.TC1(R4),R1	;POINT TO BSC TASK
	BIT	#TCOAB,TCFG2(R1) ;STREAM ABORTED?
	BNE	23$		;YES.
	BIT	#TCOEC,TCFG2(R1) ;NO, COMPLETED EOF PROCESSING?
	BEQ	19$		;NO, WAIT FOR IT.
	BIC	#TCOEF!TCOEC,TCFG2(R1) ;YES, ITS ALL DONE.
	BIS	#TCOEC,TCFG2(R5) ;SIGNAL EOF COMPLETE.
	BIC	#TCORN!TCOPG,TCFG2(R5) ;CLEAR PERMISSION AND RUNNING FLAGS
20$:	JSR	PC,XLAWDL	;AWAKEN THE DL10 TASK
	MOV	#EBTIME!EBINTR!EBWAIT,(R5)
	MOV	#JIFSEC+13,TCTIM(R5) ;WAIT FOR COMPLETE ACK
	BIT	#TCOAB,TCFG2(R5) ;HAS THE STREAM ABORTED?
	BNE	23$		;YES, (MAY BE TOO LATE, BUT TRY.)
	BIT	#TCOEC,TCFG2(R5) ;OUTPUT EOF ACKNOWLEDGED?
	BEQ	21$		;YES, ALL DONE.
	JSR	PC,WAIT		;NO, WAIT FOR IT
	BR	20$		;SEE IF ACKNOWLDEGED YET
;

21$:

;;++BS-CODE TO CLEAR THE DEVICE ACTIVE BIT ON END OF FILE

	JSR	PC, HSSAVR	;SAVE THE REGISTERS
	MOV	TCLCB(R5), R2	;POINT TO LCB
	MOV	LB.LNU(R2), R0	;GET LINE NUMBER
	BIC	#177770, R0	;CLEAR JUNK
	BIT	#LF.SIM, LB.FGS(R2) ;SIMULATION OR SUPPORT ?
	BNE	36$		;YES, MUST BE CDR
	MOV	#4, R1		;NO, SUPPORT, MUST BE LPT
	BR	37$		;SET ACTIVE BIT
36$:	MOV	#3, R1		;SIMULATION, MUST BE CDR
37$:	JSR	PC, HSAMPC	;CLEAR THE ACTIVE BIT
	JSR	PC, HSRESR	;RESTORE THE REGISTERS

;;++BS-END OF CODE TO CLEAR THE DEVICE ACTIVE BIT

	JMP	XLATE		;WHEN ALL IS DONE, RECIRCULATE
;
; HERE WHEN THE MESSAGE STREAM IS ABORTED.
;
22$:	MOV	(SP)+,R2	;DISCARD LINE COUNTER
	MOV	(SP)+,R0	; AND LINE POINTER
23$:	JSR	PC,XLOABT	;DO THE ABORT PROCESSING
	JMP	XLATE		; AND RECIRCULATE
;

;
; SUBROUTINE TO TRANSLATE A CHUNK FROM ASCII TO EBCDIC
;
; R0 = POINTER INTO LINE BUFFER
; R2 = COUNT OF CHARS IN LINE BUFFER
; R3 = POINTER TO CHUNK TO TRANSLATE
;
; ON RETURN:
;
; 	R0 = UPDATED POINTER INTO LINE BUFFER
;	R2 = UPDATED COUNT OF CHARS IN LINE BUFFER
;
XLOCNK:
11$:	CLR	-(SP)		;COUNT OF CHARS PROCESSED SO FAR
	MOV	R3,R4		;BUILD POINTER TO DATA SPACE
	ADD	#CHDAT,R4
12$:	CMP	CHLEN(R3),(SP)	;HAVE WE PROCESSED ALL CHARS?
	BEQ	18$		;YES, DONE WITH THE CHUNK.
	INC	(SP)		;NO, INCREMENT CHARS PROCESSED
	MOVB	(R4)+,R1	;GET NEXT CHAR
	TRACE	TRCXLD,R1	;TRACE XLATE CHAR PROCESSING
	MOV	R3,-(SP)	;SAVE CHUNK POINTER
	MOV	R4,-(SP)	;SAVE DATA POINTER
13$:	BIT	#TCPRO,TCFG1(R5) ;PRINTER-STYLE OUTPUT?
	BNE	14$		;YES.
	JSR	PC,XLASCD	;NO, CARD STYLE OUTPUT
	BR	15$
;
14$:	JSR	PC,XLASPR	;SEND CHARACTER TO PRINTER
15$:	BCC	16$		;WIN, DO NEXT CHAR.
	MOV	R0,-(SP)	;LOSE, SAVE R0
	MOV	R2,-(SP)	;SAVE R2
	MOV	#EBTIME!EBWAIT,(R5) ;WAIT A WHILE
	MOV	#<JIFSEC/2>-3,TCTIM(R5) ; (A VERY SHORT WHILE)
	JSR	PC,WAIT
	MOV	(SP)+,R2	;RESTORE R2
	MOV	(SP)+,R0	;RESTORE R0
	BIT	#TCOAB,TCFG2(R5) ;IS THE STREAM ABORTED?
	BNE	17$		;YES, QUIT.
	MOV	(SP),R4		;GET BACK R4
	MOVB	-1(R4),R1	;GET BACK CHARACTER
	BR	13$		;TRY AGAIN FOR CHAR
;

;
; HERE IF WE SUCCESSFULLY SENT THE CHARACTER
;
16$:	MOV	(SP)+,R4	;RESTORE R4
	MOV	(SP)+,R3	;RESTORE R3
	BR	12$		;GO GET NEXT CHARACTER
;
; HERE WHEN AN ABORT IS DETECTED WHILE WAITING FOR MESSAGE
;  SPACE TO FREE UP.
;
17$:	MOV	(SP)+,R4	;RESTORE R4
	MOV	(SP)+,R3	;RESTORE R3
;
; HERE WHEN THE CHUNK IS DEPLETED OR THE STREAM ABORTED.
;
18$:	MOV	R0,(SP)		;SAVE BUFFER POINTER (DONE WITH COUNT)
	MOV	TCIDLE,R1	;POINT TO IDLE TASK
	MOV	R3,R0		;PUT CHUNK POINTER IN R0
	JSR	PC,QUECHK	;SEND IT THE CHUNK TO FREE
	MOV	(SP)+,R0	;RESTORE R0
	JSR	PC, XLCSAB	;SET OR CLEAR THE DEVICE ACTIVE BIT
	RTS	PC		;RETURN

;;++BS-CODE TO SET OR CLEAR DEVICE ACTIVE BIT FOR 2780/3780 OUTPUT

XLCSAB:	JSR	PC, HSSAVR	;SAVE THE REGISTERS
	MOV	TCLCB(R5), R2	;POINT TO LCB
	MOV	LB.LNU(R2), R0	;GET LINE NUMBER
	BIC	#177770, R0	;CLEAR JUNK
	BIT	#LF.SIM, LB.FGS(R2) ;SIMULATION OR SUPPORT ?
	BEQ	21$		;SUPPORT
	MOV	#3, R1		;SIMULATION, OUTPUT IMPLIES CDR
	BR	22$		;CONTINUE
21$:	MOV	#4, R1		;SUPPORT, OUTPUT IMPLIES LPT
22$:	MOV	LB.TCD(R2), R3	;POINT TO XLATE TASK
	TST	TCCHK1(R3)	;ANY MESSAGES QUEUED TO THIS TASK ?
	BEQ	23$		;NO, SET DEVICE ACTIVE BIT
25$:	JSR	PC, HSAMPC	;YES, CLEAR DEVICE ACTIVE BIT, BUFFERS FULL
	BR	24$		;CONTINUE
23$:	CMP	LB.MSC(R2), #MSGXML ;MAXIMUM # OF MESSAGES QUEUED TO BSC ?
	BGT	25$		;YES
	JSR	PC, HSACMP	;NO, BUFFERS EMPTY, SET DEVICE ACTIVE BIT
24$:	JSR	PC, HSRESR	;RESTORE THE REGISTERS
	RTS	PC		;RETURN

;;++BS-END OF CODE TO SET OR CLEAR THE DEVICE ACTIVE BIT FOR 2780/3780 OUTPUT

;	RTS	PC		;RETURN.
;

;
; SUBROUTINE CALLED WHEN THE MESSAGE STREAM IS ABORTED.  WAIT FOR
;  ALL THE DATA WE HAVE SENT TO THE BSC TASK TO
;  BE PROCESSED AND THEN INDICATE THAT THE MESSAGE TERMINATION
;  IS COMPLETE.
;
XLOABT:	MOV	TCMSG(R5),R0	;ARE WE BUILDING A MESSAGE?
	BEQ	11$		;NO.
	MOV	TCIDLE,R1	;YES, SEND MESSAGE TO IDLE TASK
	JSR	PC,QUEMSG	;  TO BE FREED.
	CLR	TCMSG(R5)	;WE NO LONGER HAVE A MESSAGE
11$:	MOV	#EBINTR!EBQCHK!EBTIME!EBWAIT,(R5)
	MOV	#JIFSEC+7,TCTIM(R5)
	JSR	PC,WAIT		;WAIT FOR A CHUNK OR SIGNAL
12$:	JSR	PC,DEQCHK	;IS THERE A CHUNK?
	BCS	13$		;NO.
	JSR	PC,FRECHK	;YES, FREE IT
	BR	12$		; AND GET THE REST.
;
13$:	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.TC1(R4),R1	;POINT TO BSC DRIVER TCB
	BIS	#TCOAB,TCFG2(R1) ;BE SURE IT'S ABORTED [1(715]
	BIT	#TCOAC,TCFG2(R1) ;HAS IT COMPLETED THE ABORT?
	BEQ	11$		;NO, WAIT FOR IT.
	TST	TCMSG1(R1)	;MAYBE, HAS IT MORE MESSAGES?
	BNE	11$		;YES, WAIT UNTIL IT FLUSHES THOSE
	BIS	#TCOAC,TCFG2(R5) ;WE HAVE COMPLETED THE ABORT
	BIC	#TCOPG!TCORN!TCOEF!TCOEC,TCFG2(R5) ;NO LONGER RUNNING
14$:	JSR	PC,XLAWDL	;TELL THE DL10 DRIVER
	MOV	#EBINTR!EBTIME!EBQCHK!EBWAIT,(R5)
	MOV	#JIFSEC+6,TCTIM(R5)
	JSR	PC,WAIT		;WAIT A MOMENT
15$:	JSR	PC,DEQCHK	;GET A CHUNK
	BCS	16$		;NONE LEFT.
	JSR	PC,FRECHK	;GOT ONE, FREE IT.
	BR	15$		;GET THE REST
;



16$:	BIT	#TCOAC,TCFG2(R5) ;ABORT ACKNOWLEDGED?
	BNE	14$		;NOT YET.  (ACK IS FROM THE PDP-10)

	MOV	TCLCB(R5),R4	;YES, POINT TO LCB
	MOV	LB.TC1(R4),R1	;POINT TO BSC DRIVER TCB
	BIC	#TCOAB!TCOAC,TCFG2(R1) ;ACKNOWLEDGE ABORT
	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO AWAKEN THE DL10 DRIVER TASK
;
XLAWDL:	MOV	TCDLDR,R1	;POINT TO DL10 DRIVER TASK
	BIT	#EBINTR,(R1)	;WAITING FOR US?
	BEQ	11$		;NO.
	BIC	#EBINTR!EBWAIT,(R1) ;MAYBE, UNWAIT HIM.
11$:	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO WAIT FOR A MESSAGE FROM THE DQ11 DRIVER, A
;  CHUNK FROM THE DL10 DRIVER, OR JUST FOR SOME TIME TO PASS.
;  CALLED FROM OUTPUT ROUTINE WHEN THERE IS NO OUTPUT GOING.
;
XLWAIT:	MOV	#EBQCHK!EBTIME!EBINTR!EBQMSG!EBWAIT,(R5)
	MOV	#JIFSEC/4,TCTIM(R5) ;WAIT A SHORT WHILE
	JSR	PC,WAIT
	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.TC1(R4),R0	;POINT TO BSC TASK
	BIT	#TCIPR,TCFG2(R0) ;INPUT PERMISSION REQUESTED?
	BEQ	14$		;NO.
	BIS	#TCIPR!TCIWR,TCFG2(R5) ;YES, PASS SIGNAL TO PDP-10
				; AND NOTE PERMISSION WAS REQ. [2(770)]
11$:	JSR	PC,XLAWDL	;AWAKEN DL10 DRIVER
	MOV	#EBINTR!EBTIME!EBWAIT,(R5)
	MOV	#2*JIFSEC,TCTIM(R5) ;WAIT 2 SECONDS
	JSR	PC,WAIT
	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.TC1(R4),R0	;POINT TO BSC TASK
	BIT	#TCIPR,TCFG2(R0) ;STILL WAITING FOR GRANT?
	BEQ	13$		;NO.
	BIT	#TCIPG,TCFG2(R5) ;YES, DID PDP-10 GRANT THE INPUT REQUEST?
	BEQ	11$		;NO, GIVE HIM A WHILE
	BIC	#TCIPR,TCFG2(R5) ;YES, NO LONGER REQUESTING
	BIS	#TCIPG,TCFG2(R0) ;PASS GRANT TO BSC TASK
	BIT	#EBINTR,(R0)	;IS BSC TASK WAITING FOR GRANT?
	BEQ	12$		;NO.
	BIC	#EBINTR!EBWAIT,(R0) ;MAYBE, WAKE IT.
12$:	MOV	#EBINTR!EBTIME!EBWAIT,(R5)
	MOV	#JIFSEC+7,TCTIM(R5) ;WAIT A WHILE
	JSR	PC,WAIT		;FOR DATA TO ARRIVE
	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.TC1(R4),R0	;POINT TO BSC TASK
	BIT	#TCIAB!TCIEC!TCIRN,TCFG2(R0) ;ABORT, EOF OR RUNNING?
	BEQ	12$		;NO, WAIT FOR SOMETHING
	BIC	#TCIPG,TCFG2(R5) ;YES, CLEAR GRANT FLAG
	BIS	#TCIRN,TCFG2(R5) ;WE ARE NOW RUNNING
	BR	XLEBAS		;TRANSLATE EBCDIC TO ASCII
;

;
; HERE WHEN THE INPUT REQUEST WENT AWAY.  IGNORE ANY GRANT
;  AND CANCEL THE REQUEST.
;
13$:	BIC	#TCIPR!TCIPG,TCFG2(R5) ;TURN OFF GRANT AND REQUEST
;
; HERE IF INPUT PERMISSION HAS NOT BEEN REQUESTED.
;
14$:	BIT	#TCIAB,TCFG2(R5) ;ABORT WHILE IDLE?
	BEQ	15$		;NO.
	JSR	PC,XLIABT	;YES, PROCESS THE ABORT.
15$:	RTS	PC		;CHECK FOR OUTPUT TO DO
;

;
; HERE WHEN WE HAVE THE BSC TASK RUNNING, AT END-OF-FILE
;  OR ABORTED.  SET UP FOR INPUT DATA PROCESSING.
;
XLEBAS:	CLR	TCHPS(R5)	;CLEAR HPOS
	CLR	TCVPS(R5)	; AND VPOS
	BIC	#TCESC!TCIGS,TCST2(R5) ;NOT IN ESCAPE OR IGS SEQUENCE
	MOVB	ASCEBC+'/,TCCCI(R5) ;INITIAL SPACING IS SINGLE
11$:	MOV	#EBQMSG!EBTIME!EBINTR!EBWAIT,(R5)
	MOV	#JIFSEC+3,TCTIM(R5) ;PREPARE TO WAIT
	JSR	PC,DEQMSG	;GET A MESSAGE
	BCS	12$		;NONE.
	JSR	PC,XLIMSG	;GOT ONE, PROCESS IT.
	JSR	PC, WAIT	;;++BS-DO ONLY ONE MESSAGE AT A TIME 3(005)
	BR	11$		; AND DO THE REST.

;
; HERE IF NO MESSAGE TO PROCESS.
;
12$:	BIT	#TCIAB,TCFG2(R5) ;HAS STREAM BEEN ABORTED?
	BEQ	13$		;NO.
	JSR	PC,XLIABT	;YES, DO ABORT PROCESSING
	BR	16$		; THEN CHECK FOR OUTPUT
;
13$:	MOV	TCLCB(R5),R4	;NO ABORT, POINT TO LCB
	MOV	LB.TC1(R4),R1	;POINT TO BSC TASK
	BIT	#TCIEC,TCFG2(R1) ;HAVE WE REACHED EOF?
	BNE	14$		;YES.
	JSR	PC,WAIT		;NO, WAIT FOR A MESSAGE
	BR	11$		; AND TRY TO PROCESS IT.
;
; HERE ON EOF.
;
14$:	BIS	#TCIEC,TCFG2(R5) ;FLAG END OF FILE
	BIC	#TCIRN,TCFG2(R5) ;FLAG NO LONGER RUNNING
	JSR	PC,XLAWDL	;WAKE UP THE DL10 TASK
15$:	MOV	#EBQMSG!EBTIME!EBINTR!EBWAIT,(R5)
	MOV	#JIFSEC+5,TCTIM(R5)
	JSR	PC,WAIT		;WAIT FOR DL10 TASK
	BIT	#TCIEC,TCFG2(R5) ;EOF ACKNOWLEDGED YET?
	BNE	15$		;NO, KEEP WAITING
	MOV	TCLCB(R5),R4	;YES, POINT TO LCB
	MOV	LB.TC1(R4),R1	;POINT TO BSC TASK
	BIC	#TCIEC,TCFG2(R1) ;CLEAR ITS EOF COMPLETE BIT
;
; HERE TO RETURN TO CHECK FOR OUTPUT
;
16$:	RTS	PC		;RETURN.
;

;
;  SUBROUTINE TO PROCESS AN INPUT ABORT.
;
XLIABT:
11$:	JSR	PC,DEQMSG	;ANY MESSAGES LEFT?
	BCS	12$		;NO, ABORT COMPLETE
	MOV	TCIDLE,R1	;YES, FREE THEM
	JSR	PC,QUEMSG
	BR	11$		;SEE IF THERE ARE ANY MORE
;
12$:	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.TC1(R4),R1	;POINT TO BSC TASK
	BIT	#TCIAC,TCFG2(R1) ;HAS ABORT COMPLETED?
	BNE	13$		;YES.
	MOV	#EBQMSG!EBTIME!EBINTR!EBWAIT,(R5) ;NO, WAIT
	MOV	#JIFSEC+6,TCTIM(R5)
	JSR	PC,WAIT
	BR	11$		;SEE IF ABORT COMPLETE YET
;
13$:	BIS	#TCIAC,TCFG2(R5) ;INDICATE ABORT COMPLETE
	BIC	#TCIRN,TCFG2(R5) ;INDICATE NO LONGER RUNNING
	JSR	PC,XLAWDL	;AWAKEN THE DL10 TASK
	MOV	#EBQMSG!EBTIME!EBINTR!EBWAIT,(R5)
	MOV	#JIFSEC+6,TCTIM(R5)
	JSR	PC,WAIT		;WAIT FOR ACKNOWLDEGMENT




	BIT	#TCIAC,TCFG2(R5) ;IS IT ACKNOWLEDGED?
	BNE	11$		;NO, BE SURE THE QUEUE IS DRAINED


	MOV	TCLCB(R5),R4	;YES, POINT TO LCB
	MOV	LB.TC1(R4),R1	;POINT TO BSC TASK
	BIC	#TCIAB!TCIAC,TCFG2(R1) ;CLEAR ABORT BITS
	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO ACCEPT A CHARACTER FROM THE 10 AND PUT IT IN
;  THE LINE BUFFER.  THE CHARACTER IS ALREADY IN EBCDIC.
;
; R0 POINTS TO THE CURRENT POSITION IN THE LINE BUFFER
; R1 CONTAINS THE CHARACTER TO BE STORED
; R2 CONTAINS THE NUMBER OF CHARACTERS STORED ALREADY
;
; ON RETURN:
;
;	R0 AND R2 ARE UPDATED
;
XLAPBF:	CMP	R2,TCBFC(R5)	;BUFFER FULL?
	BEQ	11$		;YES, DONT STORE.
	MOVB	R1,(R0)+	;NO, STORE CHAR
	INC	R2		;INCREMENT CHARACTER COUNT
11$:	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO TRANSLATE A CHARACTER FROM ASCII TO 
;  LINE PRINTER EBCDIC.
;  HANDLES FORMAT EFFECTORS AND COMPRESSION.
;
;	R0 = POINTER TO THE CURRENT POSITION IN THE LINE BUFFER
;	R1 = THE CHARACTER TO BE TRANSLATED
;	R2 = THE NUMBER OF CHARACTERS ALREADY STORED IN THE LINE BUFFER
;	TCHPS(R5) = THE CURRENT HORIZONTAL LINE POSITION.
;	   (LEFT MARGIN = 0)
;	TCVPS(R5) = THE CURRENT VERTICAL PAGE POSITION.
;	   (TOP OF PAGE = 0)
;
; ON RETURN:
;
;	TCHPS(R5) AND TCVPS(R5) ARE UPDATED.
;	C IS SET IF WE RAN OUT OF CHUNKS, CLEAR IF NOT.
;
XLASPR:	CMPB	R1,#' 		;COMPARE CHAR WITH BLANK
	BGE	12$		;GRAPHIC, SPACE OR DEL.
	MOVB	ASCSPC(R1),R3	;CONTROL--GET ITS CODE
	JMP	@11$(R3)	;DISPATCH ON THE CODE
;
; DISPATCH TABLE FOR ASCII CONTROL CHARACTER TYPES
;
11$:	.WORD	26$		;INVALID -- IGNORE
	.WORD	25$		;HT
	.WORD	26$		;ESC (INVALID) -- IGNORE
	.WORD	24$		;CR
	.WORD	17$		;FF
	.WORD	19$		;OTHER VERTICAL CONTROL (LF, VT)
;

;
; HERE ON SPACE, GRAPHIC OR DEL.
;
12$:	CMPB	#177,R1		;IS THIS A DEL?
	BEQ	26$		;YES, DONT SEND TO PRINTER.
	BIT	#TCLBK,TCST2(R5) ;NO, IS PREVIOUS LINE BROKEN?
	BNE	16$		;YES, GRAPHIC OR SPACE AFTER LINE BREAK
	CMP	TCHPS(R5),#132.	;NO, BEYOND END OF LINE?
	BNE	13$		;NO.
	MOV	R1,-(SP)	;YES, SAVE CHARACTER
	MOV	#12,R1		;GIVE FREE LF (= CRLF)
	JSR	PC,XLASPR	;THIS WILL BREAK THE LINE
	BCS	18$		;OUT OF BUFFER SPACE
	MOV	(SP)+,R1	;RESTORE CHARACTER
	BR	16$		;SEND THE LINE
;
; HERE IF THE LINE HAS NOT OVERFLOWED.
;
13$:	MOVB	ASCEBC(R1),R1	;TRANSLATE TO EBCDIC
	CMPB	#EBCBLK,R1	;BLANK?
	BNE	14$		;NO.
	JSR	PC,XLASSP	;YES, TRY TO COMPRESS IT.
	BCC	15$		;NOTHING TO STORE, JUST INC HPOS
14$:	JSR	PC,XLAPBF	;STORE CHARACTER IN BUFFER
15$:	INC	TCHPS(R5)	;INCREMENT HORIZONTAL POSITION
	BR	26$		; AND GIVE SUCCESSFUL RETURN.
;

;
; HERE IF THE PREVIOUS LINE HAD ENDED.  SINCE THIS CHARACTER
;  IS A GRAPHIC OR SPACE, SEND THE PREVIOUS LINE.
;
16$:	JSR	PC,XLSNDL	;SEND LINE
	BCS	27$		;OUT OF BUFFER SPACE
	BR	12$		;APPEND TO BUFFER
;
; HERE ON A FORM FEED OR A VERTICAL MOTION CHARACTER WHICH
;  HAS NO STOPS BELOW THE CURRENT VERTICAL POSITION.
;  GO TO THE TOP OF THE NEXT PAGE.
;
17$:	JSR	PC,XLASTF	;TOP OF FORM
	BCS	27$		;OUT OF CHUNKS
	CLR	TCVPS(R5)	;CLEAR VERTICAL POSITION
	BR	24$		;CLEAR HPOS AND GIVE OK RETURN.
;
; HERE IF WE RUN OUT OF MESSAGE BUFFER SPACE WHILE DOING
;  A FREE LINE FEED BECAUSE OF LINE WIDTH OVERFLOW.
;  RESTORE R1 AND GIVE ERROR RETURN.
;
18$:	MOV	(SP)+,R1	;RESTORE R1
	SEC			;SIGNAL OUT OF CHUNKS
	BR	27$		;RETURN.
;

;
; HERE ON OTHER VERTICAL MOTION CHARACTER -- LF, VT, DC...
;
19$:	MOV	TCVPS(R5),R3	;CURRENT VERTICAL POSITION
	INC	R3		;LOOK AT NEXT POSITION
	TSTB	XLVFU(R3)	;AT BOTTOM OF PAGE?
	BPL	21$		;NO.
	BR	17$		;YES, SKIP TO TOP OF NEXT FORM.
;
20$:	JSR	PC,XLASSF	;SINGLE SPACE THE PRINTER
	BCS	27$		;OUT OF CHUNKS
	INC	TCVPS(R5)	;DOWN ONE VERTICAL SPACE
	BR	24$		;CLEAR HPOS AND GIVE OK RETURN.
;
; HERE IF WE ARE NOT AT THE BOTTOM OF THE VFU.
;
21$:	BITB	XLLPCH-12(R1),XLVFU(R3) ;SHOULD THIS CHAR STOP HERE?
	BNE	20$		;YES, SINGLE SPACE AND QUIT
;
; SEE IF THERE IS A STOP FOR THIS CHARACTER BEFORE THE END OF
;  FORM.  IF SO, SPACE DOWN TO IT.  IF NOT, JUST SKIP TO
;  THE TOP OF THE NEXT PAGE.
;
22$:	INC	R3		;LOOK AT NEXT POSITION
	TSTB	XLVFU(R3)	;BOTTOM OF FORM?
	BLT	17$		;YES, TREAT AS FORM FEED.
;
; HERE IF WE ARE NOT YET AT BOTTOM OF FORM.  SEE IF THE
;  VFU SAYS WE SHOULD STOP HERE.
;
23$:	BITB	XLLPCH-12(R1),XLVFU(R3) ;THIS CHANNEL PUNCHED HERE?
	BEQ	22$		;NO, LOOK AT NEXT POSITION
	JSR	PC,XLASSF	;YES, GIVE SINGLE SPACE
	BCS	27$		;OUT OF CHUNKS
	CLR	TCHPS(R5)	;MOVE TO LEFT MARGIN
	INC	TCVPS(R5)	;DOWN ONE VERTICAL SPACE
	BR	19$		;DO IT AGAIN UNTIL WE GET THERE.
;

;
; HERE ON CARRIAGE RETURN AND AFTER VERTICAL MOTION.
;  SET "TCLBK", WHICH
;  WILL CAUSE THE NEXT GRAPHIC TO OUTPUT THE CURRENT LINE BUFFER.
;
24$:	CLR	TCHPS(R5)	;HORIZ. POS. TO LEFT MARGIN
	BIS	#TCLBK,TCST2(R5) ;SET "TCLBK"
	BR	26$		;GIVE OK RETURN.
;
; HERE ON HORIZONTAL TAB.  OUTPUT SPACES UNTIL THE HORIZONTAL
;  POSITION IS A MULTIPLE OF 8.  ALWAYS OUTPUT AT LEAST ONE
;  SPACE.
;
25$:	MOV	#' ,R1		;SPACE
	JSR	PC,XLASPR	;OUTPUT IT
	BCS	27$		;CONTINUE LATER IF BUFFER FULL.
	BIT	#7,TCHPS(R5)	;IS HORIZONTAL POSITION MOD 8 = 0?
	BNE	25$		;NO, OUTPUT ANOTHER SPACE
;
; HERE TO GIVE OK RETURN.
;
26$:	CLC			;SIGNAL SUCCESS
27$:	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO SKIP THE PRINTER TO THE TOP OF THE NEXT PAGE.
;
;  NOTE: CALLER SETS TCLBK ON RETURN TO FORCE THE BUFFER OUT
;   ON THE NEXT CHARACTER.  WE COULD CALL XLSNDL FROM HERE BUT
;   FOR END-OF-FILE PROCESSING, WHICH WOULD CAUSE AN EXTRA LINE
;   IN THAT CASE.
;
; ON RETURN:
;
;	C IS SET IF THE FUNCTION COULD NOT BE PERFORMED DUE
;	  TO LACK OF CHUNKS, CLEAR OTHERWISE.
;
	;[1012]Correct XLASTF to correctly report an out-of-chunks condition.
XLASTF:	MOV	TCBFP(R5),R3	;POINT TO LINE BUFFER
	CMPB	ASCEBC+'M,1(R3) ;CARRIAGE CONTROL = NO SPACING?
	BEQ	11$		;YES, CHANGE TO TOP OF FORM.
	JSR	PC,XLSNDL	;NO, FINISH OFF THAT LINE
	;[1012] Change branch after call to XLSNDL so that carry not cleared.
	BCS	13$		;[1012]OUT OF CHUNKS, TRY AGAIN LATER.
;
; HERE AFTER MAKING SURE THE CURRENT LINE SPECIFIES NO SPACING.
;  CHANGE TO "TOP OF FORM".
;
11$:	MOV	TCBFP(R5),R3	;POINT TO LINE BUFFER
	MOVB	ASCEBC+'A,1(R3)	;MAKE CARRIAGE CONTROL = TOP OF FORM
	BIT	#TCPCE,TCFG1(R5) ;IS PAGE COUNTER ENABLED?
	BEQ	12$		;NO.
	DEC	TCPGC(R5)	;YES, DECREMENT PAGE COUNTER
	BNE	12$		;IT HAS NOT OVERFLOWED
	BIS	#TCPCO,TCFG1(R5) ;IT HAS OVERFLOWED, "INTERRUPT"
12$:	CLC			;INDICATE NO ERROR
	;[1012] Add new label here
13$:	RTS	PC		;[1012]RETURN.
;

;
; SUBROUTINE TO SPACE THE PRINTER VERTICALLY BY ONE.
;  ESCALATE CARRIAGE CONTROL FROM NO SPACING THROUGH
;  1, 2 AND 3 SPACES IF POSSIBLE BEFORE RELEASING THE LINE.
;
;  NOTE: CALLER TAKES RESPONSIBILITY FOR SETTING TCLBK ON RETURN.
;
;
XLASSF:	MOV	TCBFP(R5),R3	;POINT TO LINE BUFFER
	INC	R3		;POINT TO CARRIAGE CONTROL
	CMPB	ASCEBC+'M,(R3)	;NO SPACING?
	BEQ	11$		;YES, MAKE SINGLE SPACE
	CMPB	ASCEBC+'/,(R3)	;NO, SINGLE SPACE?
	BEQ	12$		;YES, MAKE DOUBLE SPACE
	CMPB	ASCEBC+'S,(R3)	;NO, DOUBLE SPACE?
	BEQ	13$		;YES, MAKE TRIPLE SPACE
	JSR	PC,XLSNDL	;NO, SEND THE LINE
	BCS	15$		;OUT OF CHUNKS
	BR	XLASSF		;CHANGE NO SPACING TO SINGLE
;
; HERE ON NO SPACING TO CHANGE TO SINGLE
;
11$:	MOVB	ASCEBC+'/,(R3)	;MAKE SINGLE SPACING
	BR	14$
;
; HERE ON SINGLE SPACING TO CHANGE TO DOUBLE
;
12$:	MOVB	ASCEBC+'S,(R3)	;MAKE DOUBLE SPACING
	BR	14$
;
; HERE ON DOUBLE SPACING TO CHANGE TO TRIPLE
;
13$:	MOVB	ASCEBC+'T,(R3)	;MAKE TRIPLE SPACING
14$:	CLC			;SIGNAL OK
15$:	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO TRANSLATE A CHARACTER FROM ASCII TO CARD PUNCH
;  OR CARD READER EBCDIC.
;
;  R1 = CHARACTER TO BE TRANSLATED
;  TCHPS(R5) = CURRENT HORIZONTAL POSITION
;
; ON RETURN:
;
;	TCHPS(R5) IS UPDATED
;	C IS SET IF WE ARE OUT OF CHUNKS.  THE CHARACTER
;	  SHOULD BE RE-SENT.
;
XLASCD:	CMPB	R1,#' 		;SPACE?
	BEQ	15$		;YES.
	BGT	11$		;NO, GRAPHIC OR DEL
	TST	R1		;NULL?
	BEQ	13$		;YES, JUST IGNORE IT.
	CMPB	#12,R1		;NO, IS IT LINE FEED?
	BEQ	16$		;YES, END OF CARD.
	CMPB	#11,R1		;NO, HORIZONTAL TAB?
	BEQ	20$		;YES, SIMULATE WITH SPACES.
	CMPB	#15,R1		;CARRIAGE RETURN?
	BEQ	13$		;YES, IGNORE.
;
; HERE ON GRAPHIC, DEL OR MISCELLANEOUS CONTROL CHARACTERS.
;
11$:	CMP	TCHPS(R5),#80.	;IS LINE FULL?
	BEQ	13$		;YES, IGNORE CHARACTER.
	MOVB	ASCEBC(R1),R1	;NO, TRANSLATE TO EBCDIC
	BEQ	13$		;IGNORE UNTRANSLATABLE CHARS
	BIT	#300,R1		;CONTROL CHARACTER?
	BNE	12$		;NO, IT IS OK TO SEND.
	TSTB	EBCSPC(R1)	;YES, DATA LINK CTL OR IRS?
	BNE	15$		;YES, CONVERT TO SPACE
;
; HERE ON GRAPHIC, DEL, MISCELLANEOUS CONTROL CHARACTERS
;  WHICH ARE NOT DATA LINK CONTROL CHARACTERS OR IRS
;  AND IF THE SPACE SUBROUTINE WANTS TO STORE A CHARACTER.
;  THE CHARACTER IS IN R1 AND IS IN EBCDIC.
;
12$:	INC	TCHPS(R5)	;INCREMENT HPOS
	JSR	PC,XLAPBF	;STORE IN LINE BUFFER
13$:	CLC			;INDICATE SUCCESS
14$:	RTS	PC		;RETURN.
;

;
; HERE ON SPACE OR IMPROPER CONTROL CHARACTER, TREATED AS SPACE.
;
15$:	CMP	TCHPS(R5),#80.	;IS LINE ALREADY FULL?
	BEQ	13$		;YES, IGNORE CHARACTER
	JSR	PC,XLASSP	;NO, WORRY ABOUT SPACE COMPRESSION
	BCS	12$		;STORE SOMETHING
	INC	TCHPS(R5)	;NOTHING TO STORE, INCREMENT HPOS
	BR	13$		;AND GIVE SUCCESS RETURN.
;
; HERE ON LINE FEED.  THIS MARKS THE END OF THE CARD.
;
16$:	BIT	#TCOBS,TCFG1(R5) ;OLD BSC PROTOCOL
	BEQ	19$		;NO, NO NEED FOR PADDING.
17$:	CMP	TCHPS(R5),#80.	;YES, HAVE WE FINISHED PADDING?
	BEQ	19$		;YES.
	JSR	PC,XLASSP	;NO, APPEND A SPACE
	BCC	18$		;NOTHING TO STORE
	JSR	PC,XLAPBF	;APPEND CHARACTER TO BUFFER
18$:	INC	TCHPS(R5)	;WE HAVE PADDED BY ONE CHARACTER
	BR	17$		;SEE IF WE NEED MORE.
;
; HERE WHEN THE CARD HAS BEEN PADDED TO 80 CHARACTERS IF NECESSARY
;
19$:	JSR	PC,XLSNDL	;SEND THE CARD, BLOCKING WITH
				; PREVIOUS IF POSSIBLE
	BCS	14$		;OUT OF CHUNKS, GIVE ERROR RETURN.
	CLR	TCHPS(R5)	;NOW BACK TO COL. ZERO
	BR	13$		;GIVE SUCCESS RETURN.
;
; HERE ON HORIZONTAL TAB.  CONVERT TO THE PROPER NUMBER OF
;  SPACES.
;
20$:	MOV	#' ,R1		;SPACE
	JSR	PC,XLASCD	;OUTPUT IT
	BCS	14$		;OUT OF CHUNKS, RE-ISSUE THE TAB
	BIT	#7,TCHPS(R5)	;ARE WE AT A MULT. OF 8 ?
	BEQ	13$		;YES, GIVE SUCCESS RETURN.
	CMP	TCHPS(R5),#80. ;NO, AT END OF CARD?
	BEQ	13$		;YES, WE ARE ALL DONE.
	BR	20$		;NO, GIVE ANOTHER SPACE.
;

;
; SUBROUTINE TO STORE A BLANK INTO THE LINE BUFFER, COMPRESSING
;  IF INDICATED.
;
; ON RETURN:
;
; C CLEAR - DO NOTHING.
;
; C SET - PUT R1 IN THE LINE BUFFER.
;
XLASSP:	BIT	#TCCPS,TCFG1(R5) ;COMPRESSION ACTIVE?
	BEQ	12$		;NO, TREAT AS GRAPHIC
	TST	TCHPS(R5)	;ANY CHARS ON LINE?
	BEQ	12$		;NO, FIRST SPACE IS GRAPHIC
	CMPB	#EBCBLK,-1(R0)	;YES, PREV. CHAR A BLANK?
	BEQ	11$		;YES, MAKE 2 COMP. BLANKS
	CMP	TCHPS(R5),#1	;NO, AT LEAST 2 CHARS ALREADY?
	BLE	12$		;NO, CANT BE IN A COMPRESSION.
	CMPB	#EBCIGS,-2(R0)	;YES, ALREADY IN A COMPRESSION?
	BNE	12$		;NO, FIRST BLANK JUST STORED
	CMPB	#EBCBLK+63.,-1(R0) ;YES, ALREADY FULL?
	BEQ	12$		;YES, JUST STORE BLANK
	INCB	-1(R0)		;NO, INCREMENT BLANK COUNT
	CLC			;INDICATE DONT STORE ANYTHING
	RTS	PC		;RETURN.
;
; HERE ON THE SECOND BLANK IN A ROW
;
11$:	MOVB	#EBCIGS,-1(R0)	;TURN BLANK INTO "IGS"
	MOV	#EBCBLK+2,R1	;STORE CHAR INDICATING...
	SEC			; TWO BLANKS.
	RTS	PC		;PUT INTO LINE BUFFER
;
; HERE TO RETURN INDICATING THAT THE BLANK CHARACTER IN R1
;  SHOULD BE STORED IN THE LINE BUFFER.
;
12$:	MOV	#EBCBLK,R1	;PUT EBCDIC BLANK IN R1
	SEC			;FLAG TO STORE R1
	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO SEND THE LINE BUFFER TO THE BSC TASK.  BUILD
;  IT INTO A MESSAGE.
;
; R0 POINTS TO THE LAST USED POSITION OF THE BUFFER.
;
; ON RETURN:
;  C IS SET IF OUT OF CHUNKS.  OTHERWISE, C IS CLEAR AND:
;	THE LINE BUFFER (AND R0 AND R2, WHICH REFER TO IT)
;	CONTAINS "ESC" "M" IF WE ARE DOING PRINTER OUTPUT,
;	OTHERWISE (CARD OUTPUT) THE LINE BUFFER IS EMPTY.
;	TCLBK IS CLEAR.
;
XLSNDL:	MOV	R1,-(SP)	;SAVE CURRENT CHARACTER
	MOV	R0,-(SP)	;SAVE POINTER TO END OF BUFFER
11$:	MOV	TCBFP(R5),R3	;POINT R3 TO START OF BUFFER
	BIT	#TCOBS,TCFG1(R5) ;OLD BSC MODE?
	BEQ	12$		;NO.
	BIT	#TCPRO,TCFG1(R5) ;YES, PRINTER OUTPUT?
	BEQ	12$		;NO.
	CMPB	ASCEBC+'M,1(R3)	;YES, OVERPRINT REQUEST?
	BNE	12$		;NO.
	MOV	(SP)+,R2	;YES, DISCARD POINTER TO END OF BUFFER
	BR	20$		;WE CAN'T OVERPRINT, SO IGNORE LINE.
;
; HERE WHEN THE LINE DOES SPACING OR WE HAVE NEW BSC PROTOCOL,
;  WHICH PERMITS OVERPRINTING.
;
12$:	MOV	TCMSG(R5),R0	;POINT TO PARTIAL MESSAGE
	BNE	14$		;THERE IS ONE.
13$:	JSR	PC,MSGSUP	;NONE, SET UP A MESSAGE
	BCS	22$		;OUT OF CHUNKS
	MOV	R0,TCMSG(R5)	;WE NOW HAVE A MESSAGE
	BR	17$		;PUT THIS LINE IN IT
;
; HERE WHEN THERE IS ALREADY A PARTIALLY FILLED MESSAGE
;
14$:	MOV	TCBFP(R5),R3	;POINT TO START OF BUFFER
	SUB	(SP),R3		;COMPUTE LENGTH OF BUFFER
	ADD	R3,MSGSNL(R0)	;DEPLETE SYNC COUNT BY LENGTH
	NEG	R3		;TRUE COUNT
	JSR	PC,XLSNDM	;SEND MESSAGE IF RECORD TOO BIG
	MOV	TCMSG(R5),R0	;DO WE STILL HAVE A MESSAGE?
	BEQ	13$		;NO, BUILD ANOTHER.
;

;
; HERE IF THERE IS ENOUGH ROOM FOR THIS RECORD IN THE MESSAGE.
;  FIRST END THE PREVIOUS RECORD.
;
	KGLOAD	MSGBCC(R0)	;LOAD THE KG11-A
	BIT	#TCOBS,TCFG1(R5) ;OLD BSC PROTOCOL?
	BNE	15$		;YES, USE IUS WITH BCC.
	MOV	#EBCIRS,R1	;NO, END RECORD WITH IRS
	KGACUM	R1		;ACCUMULATE IN BCC
	JSR	PC,MSGAPC	;APPEND TO MESSAGE
	BCS	23$		;OUT OF CHUNKS.
	BR	16$		;REJOIN COMMON PATH.
;
15$:	JSR	PC,XLIBCC	;STORE INTERMEDIATE BCC
	BCS	23$		;OUT OF CHUNKS
16$:	TST	MSGSNL(R0)	;WILL WE NEED A SYNC?
	BGT	17$		;NO, WAIT FOR NEXT RECORD
	MOV	#EBCSYN,R1	;YES, APPEND A SYNC
	JSR	PC,MSGAPC	; TO THE MESSAGE
	BCS	23$		;OUT OF CHUNKS.
	MOV	#SYNLEN,MSGSNL(R0) ;COME BACK LATER
;
; HERE TO STORE THE LINE BUFFER IN THE MESSAGE.
;
17$:	MOV	TCBFP(R5),R3	;POINT TO LINE BUFFER
	MOV	(SP)+,R2	;POINT TO END OF LINE BUFFER
;
; FALL INTO COPY LOOP
;

;
; THIS IS THE LOOP WHICH COPIES CHARACTERS FROM THE LINE BUFFER
;  INTO THE TRANSMISSION MESSAGE.
;
18$:	CMP	R2,R3		;ALL DONE?
	BEQ	19$		;YES.
	MOVB	(R3)+,R1	;NO, GET NEXT CHARACTER
	KGACUM	R1		;ACCUMULATE BCC
	JSR	PC,MSGAPC	;APPEND TO MESSAGE
	BCS	23$		;OUT OF CHUNKS
	BR	18$		;PROCESS ALL THE CHARACTERS
;
; HERE WHEN ALL DONE.
;
19$:	KGSAVE	MSGBCC(R0)	;RETAIN BCC OF MESSAGE
	INC	MSGNLR(R0)	;COUNT LOGICAL RECORDS IN MESSAGE
;
; PROCESSING OF THE LINE BUFFER IS NOW COMPLETE.
;
20$:	BIC	#TCLBK,TCST2(R5) ;LINE IS NO LONGER BROKEN
	MOV	TCBFP(R5),R0	;POINT R0 TO LINE BUFFER
	CLR	R2		;CLEAR LINE BUFFER COUNTER
	BIT	#TCPRO,TCFG1(R5) ;ARE WE DOING CARRIAGE CONTROL?
	BEQ	21$		;NO.
	MOV	#EBCESC,R1	;YES, PUT ESCAPE AT START OF BUFFER
	JSR	PC,XLAPBF
	MOVB	ASCEBC+'M,R1	;SECOND CHAR IS "M"
	JSR	PC,XLAPBF
21$:	MOV	(SP)+,R1	;RESTORE CURRENT CHARACTER
	CLC			;SIGNAL ALL OK
	RTS	PC		;RETURN.
;
;
; HERE IF CHUNKS ARE DEPLETED WHILE SETTING UP THE MESSAGE.
;  GIVE ERROR RETURN SO WE WILL BE CALLED AGAIN LATER.
;
22$:	MOV	(SP)+,R0	;RESTORE R0
	MOV	(SP)+,R1	;RESTORE R1
	RTS	PC		;RETURN. (C ALREADY SET)
;
; HERE IF CHUNKS ARE DEPLETED WHILE APPENDING TO
;  THE MESSAGE.  THIS SHOULD NOT HAPPEN SINCE THE CHUNKS ARE
;  PRE-ALLOCATED.
;
23$:	STOPCD	XMB		;XLATOR MESSAGE BUILDING PROBLEMS
;

;
; SUBROUTINE TO INSERT IUS, BCC IN A MESSAGE.
;  THIS IS USED ONLY IN "OLD BSC" MODE, SINCE HASP DOES NOT
;  SUPPORT IUS FROM IBM 3780'S.
;
XLIBCC:	MOV	#EBCIUS,R1	;START WITH IUS
	KGACUM	R1		;INCLUDE THE IUS IN THE BCC
	JSR	PC,MSGAPC	;PUT IN THE BLOCK
	BCS	11$		;OUT OF CHUNKS
	JSR	PC,STOBCC	;PUT BCC AFTER THE IUS
11$:	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO DETERMINE IF THERE IS ENOUGH ROOM IN
;  THE CURRENT MESSAGE FOR THE NEXT RECORD, AND IF NOT
;  END THE MESSAGE.  WORRIES ABOUT LOGICAL RECORD LIMIT.
;
;  R0 AND TCMSG(R5) POINT TO THE CURRENT MESSAGE
;  R3 CONTAINS THE LENGTH OF THE NEXT RECORD
;
; ON RETURN:
;
;  TCMSG(R5) IS ZERO IF WE HAD TO FINISH OFF THE CURRENT MESSAGE
;   EITHER BECAUSE WE HAD REACHED OUR RECORD LIMIT OR BECAUSE
;   THE NEXT RECORD IS SO LONG THAT IT WOULD HAVE CAUSED THE MESSAGE
;   TO EXCEED THE LENGTH LIMIT.
;
XLSNDM:	MOV	TCLCB(R5),R1	;POINT TO  LCB
	CMP	MSGNLR(R0),LB.MLR(R1) ;HAVE WE REACHED RECORD LIMIT?
	BEQ	11$		;YES, END MESSAGE NOW.
	ADD	MSGLEN(R0),R3	;NO, COMPUTE NEW LENGTH
	ADD	#7,R3		;ADD OVERHEAD
	CMP	R3,LB.MBL(R1)	;WOULD RESULT BE TOO BIG?
	BLT	13$		;NO, APPEND IT.
11$:	KGLOAD	MSGBCC(R0)	;YES, LOAD THE KG11-A
	BIT	#TCOBS,TCFG1(R5) ;OLD BSC PROTOCOL?
	BNE	12$		;YES, ETB IMPLIES IRS
	MOV	#EBCIRS,R1	;NO, INCLUDE AN EXPLICIT IRS
	KGACUM	R1		;INCLUDE IN BCC
	JSR	PC,MSGAPC	;APPEND TO MESSAGE
	BCS	14$		;OUT OF CHUNKS
12$:	MOV	#EBCETB,R1	;"ETB"
	KGACUM	R1		;ACCUMULATE BCC
	JSR	PC,MSGAPC	;APPEND TO MESSAGE
	BCS	14$		;OUT OF CHUNKS
	JSR	PC,STOBCC	;APPEND BCC
	BCS	14$		;OUT OF CHUNKS
	JSR	PC,XLPADS	;APPEND PADS TO MESSAGE
	BCS	14$		;OUT OF CHUNKS.
	JSR	PC,MSGAPE	;RETURN UNUSED CHUNKS
	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.TC1(R4),R1	;POINT TO BSC DRIVER
	JSR	PC,QUEMSG	;SEND IT THE MESSAGE
	CLR	TCMSG(R5)	;WE NO LONGER HAVE A MESSAGE
	INC	LB.MSC(R4)	;ONE MORE MESSAGE FOR BSC TASK TO TRANSMIT
	MOV	#EBTIME!EBWAIT,(R5) ;WAIT A MOMENT
	MOV	#1,TCTIM(R5)	; TO AVOID EATING ALL THE CPU
	JSR	PC,WAIT
13$:	RTS	PC		;RETURN.
;

;
; HERE IF WE RUN OUT OF CHUNKS.  THIS SHOULD NOT HAPPEN.
;
14$:	STOPCD	XMB		;XLATOR MESSAGE BUILDING PROBLEMS
;

;
; SUBROUTINE TO DUMP OUTPUT, AS REQUESTED BY THE PDP-10.
;  ALL LOCAL BUFFERS ARE CLEARED.
;
; ON RETURN, C SET IF STREAM ABORTED, C CLEAR IF ALL MESSAGES
;  ARE DUMPED.
;
XLODMP:	JSR	PC,XLSNDL	;EMPTY THE LINE BUFFER
	MOV	R0,-(SP)	;SAVE LINE BUFFER POSITION
	MOV	R2,-(SP)	; AND COUNT
	MOV	TCMSG(R5),R0	;IS THERE A MESSAGE WAITING?
	BEQ	11$		;NO.
	MOV	TCLCB(R5),R1	;POINT TO LCB
	MOV	LB.MLR(R1),MSGNLR(R0) ;YES, PRETEND IT IS FULL...
	JSR	PC,XLSNDM	; AND SEND IT.
11$:	MOV	#EBTIME!EBINTR!EBWAIT,(R5)
	MOV	#7,TCTIM(R5)	;WAIT A SHORT WHILE
	JSR	PC,WAIT
	BIT	#TCOAB,TCFG2(R5) ;IS STREAM ABORTED?
	BNE	12$		;YES, RETURN IMMEDIATELY.
	MOV	TCLCB(R5),R4	;NO, POINT TO LCB
	TST	LB.MSC(R4)	;ARE ALL MESSAGES SENT?
	BNE	11$		;NO, WAIT FOR THEM ALL.
	BIC	#TCDMP,TCFG1(R5) ;YES, CLEAR "DUMPING" FLAG
	MOV	(SP)+,R2	;RESTORE LINE BUFFER COUNT
	MOV	(SP)+,R0	; AND POSITION
	CLC			;INDICATE NOT ABORT
	RTS	PC		;RETURN.
;
; HERE IF THE STREAM IS ABORTED.
;
12$:	MOV	(SP)+,R2	;RESTORE LINE BUFFER COUNT
	MOV	(SP)+,R0	; AND POSITION
	SEC			;FLAG STREAM ABORTED
	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO SET UP A MESSAGE.  ALL THE LEADING BSC STUFF
;  IS PLACED IN THE DATA PORTION.
;
; ON RETURN, C IS SET IF WE ARE OUT OF CHUNKS.
;  OTHERWISE, R0 POINTS TO THE FIRST CHUNK OF THE MESSAGE.
;
MSGSUP:	MOV	CHLST,R0	;GET LAST CHUNK ON THE FREE LIST
	JSR	PC,GETCHK	;REMOVE IT FROM THE LIST
	BCS	17$		;OUT OF CHUNKS.
	MOV	R0,MSGLCH(R0)	;FIRST CHUNK IS LAST CHUNK
	MOV	#EBCLPD,R1	;GET LEADING PAD CHARACTER (ALT BITS)
	JSR	PC,MSGAPC	;STORE IN MESSAGE
	BCS	16$		;OUT OF CHUNKS
	MOV	#5,R2		;COUNT OF LEADING SYNCS
11$:	MOV	#EBCSYN,R1	;"SYNCHRONOUS IDLE"
	JSR	PC,MSGAPC	;PUT CHARACTER IN STRING
	BCS	16$		;OUT OF CHUNKS
	SOB	R2,11$		;STORE FIVE SYNCS
	MOV	TCLCB(R5),R4	;POINT TO LCB
	CMP	#TTHASP,LB.DVT(R4) ;HASP MODE?
	BNE	21$		;NO, SEND STX FOR 2780/3780
	BIT	#LF.TSP,LB.FGS(R4) ;TRANSPARENT MODE?
	BNE	22$		;YES, USE DLE-STX
	MOV	#EBCSOH,R1	;NO, USE SOH-STX FOR NON-TRANS
	BR	23$		;PUT IN MESSAGE
22$:	MOV	#EBCDLE,R1	;USE DLE FOR TRANSPARENT
23$:	JSR	PC,MSGAPC	;APPEND TO MESSAGE
	BCS	16$		;OUT OF CHUNKS
21$:	MOV	#EBCSTX,R1	;"START OF TEXT"
	JSR	PC,MSGAPC	;APPEND TO STRING
	BCS	16$		;OUT OF CHUNKS
	KGLOAD	#0		;INITIALIZE THE KG11-A
;
	MOV	#SYNLEN,MSGSNL(R0) ;INITIALIZE INTERMEDIATE
				; SYNCH COUNTER.

;
; NOW PRE-ALLOCATE ENOUGH ROOM FOR A MAX-SIZE MESSAGE SO
;  WE WON'T HAVE TO WORRY ABOUT RUNNING OUT OF CHUNKS WHILE
;  BUILDING IT.
;
	MOV	R0,-(SP)	;SAVE POINTER TO MESSAGE
20$:	MOV	TCLCB(R5),R1	;POINT TO LCB
	MOV	LB.MBL(R1),R0	;GET MAX TRANSMISSION BLOCK SIZE
	ASL	R0		;COMPUTE MAX LENGTH OF MESSAGE
	ASL	R0		; AS 125 PERCENT OF
	ADD	LB.MBL(R1),R0	; THE MAX BLOCK LENGTH
	ASR	R0
	ASR	R0
19$:	MOV	R0,-(SP)	;MAX MESSAGE LENGTH
12$:	CMP	CHFREC,#CHLXLT	;PLENTY OF CHUNKS LEFT?
	BLE	15$		;NO, SUSPEND TRANSLATION.
	MOV	CHLST,R0	;YES, GET A CHUNK
	JSR	PC,GETCHK
	BCS	15$		;OUT OF CHUNKS
	MOV	2(SP),R1	;POINT R1 AT MESSAGE
13$:	TST	(R1)		;IS THIS THE LAST CHUNK?
	BEQ	14$		;YES, APPEND NEW CHUNK HERE
	MOV	(R1),R1		;NO, GO ON TO NEXT CHUNK
	BR	13$	
;
; HERE WHEN WE HAVE FOUND THE LAST CHUNK.  APPEND THE NEW
;  CHUNK HERE.
;
14$:	MOV	R0,(R1)		;APPEND NEW CHUNK
	SUB	#CHDATL,(SP)	;WE HAVE ROOM FOR THAT MANY MORE CHARS
	BGT	12$		;NEED MORE ROOM
	MOV	(SP)+,R0	;DISCARD DEPLETED COUNT
	MOV	(SP)+,R0	;RESTORE POINTER TO MESSAGE
	CLC			;SIGNAL OK
	RTS	PC		;RETURN.
;
; HERE IF WE RUN OUT OF CHUNKS WHILE DOING PRE-ALLOCATION.
;
15$:	MOV	(SP)+,R0	;DISCARD DEPLETED COUNT
	MOV	(SP)+,R0	;RESTORE POINTER TO MESSAGE
;
; HERE IF WE RUN OUT OF CHUNKS OR SHORT OF CHUNKS
;  WHILE BUILDING THE MESSAGE.
;
16$:	MOV	TCIDLE,R1	;POINT TO IDLE TASK
	JSR	PC,QUEMSG	;SEND IT THE MESSAGE TO FREE
	SEC			;SIGNAL ERROR
17$:	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO SEND AN END-OF-FILE INDICATION TO THE OUTPUT.
;
XLEOFO:	BIT	#TCPRO,TCFG1(R5) ;PRINTER-STYLE OUTPUT?
	BEQ	11$		;NO, LOSE ANY UNTERMINATED LINE
	JSR	PC,XLSNDL	;FINISH OFF THE CURRENT LINE
	BCS	14$		;OUT OF CHUNKS
11$:	MOV	TCMSG(R5),R0	;POINT TO CURRENT MESSAGE
	BNE	12$		;THERE IS ONE.
	JSR	PC,MSGSUP	;NONE, BUILD ONE.
	BCS	14$		;OUT OF CHUNKS.
	MOV	R0,TCMSG(R5)	;WE NOW HAVE A MESSAGE
12$:	KGLOAD	MSGBCC(R0)	;LOAD THE KG11-A
	BIT	#TCOBS,TCFG1(R5) ;OLD BSC PROTOCOL?
	BNE	13$		;YES, ETX IMPLIES IRS
	MOV	#EBCIRS,R1	;NO, PROVIDE AN EXPLICIT IRS
	KGACUM	R1		;INCLUDE IN BCC
	JSR	PC,MSGAPC	;APPEND TO MESSAGE
	BCS	15$		;OUT OF CHUNKS
13$:	MOV	#EBCETX,R1	;END OF TEXT
	KGACUM	R1		;INCLUDE IN CRC
	JSR	PC,MSGAPC
	BCS	15$		;OUT OF CHUNKS
	JSR	PC,STOBCC	;APPEND BCC
	BCS	15$		;OUT OF CHUNKS
	JSR	PC,XLPADS	;PUT 5 PADS AT END OF MSG
	BCS	15$		;OUT OF CHUNKS
	JSR	PC,MSGAPE	;RETURN UNUSED CHUNKS
	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.TC1(R4),R1	;POINT TO BSC TASK
	JSR	PC,QUEMSG	;SEND MESSAGE TO BSC TASK
	CLR	TCMSG(R5)	;WE NO LONGER HAVE A MESSAGE
	BIS	#TCOEF,TCFG2(R1) ;INDICATE LAST MESSAGE
	CLC			;SIGNAL SUCCESS
	RTS	PC		;RETURN.
;

;
; HERE IF WE CANNOT BUILD A MESSAGE
;
14$:	SEC			;SIGNAL FAILURE
	RTS	PC		;RETURN.
;
; HERE IF WE RUN OUT OF CHUNKS APPENDING CHARACTERS TO THE
;  MESSAGE.  THIS SHOULD NOT HAPPEN SINCE THE MESSAGE
;  SPACE IS PRE-ALLOCATED.
;
15$:	STOPCD	XMB		;TRANSLATOR MESSAGE BUILDING TROUBLE
;

;
; SUBROUTINE TO APPEND SOME PADS TO THE END OF A MESSAGE.
;  ONLY ONE OF THESE PADS IS ACTUALLY TRANSMITTED; THE
;  OTHERS ARE LOST IN THE DQ11 TRANSMIT BUFFER.
;
XLPADS:	MOV	#DQTRLP,-(SP)	;COUNT OF PADS
11$:	MOV	#EBCPAD,R1	;PAD CHARACTER
	JSR	PC,MSGAPC	;APPEND A PAD CHARACTER
	BCS	12$		;OUT OF CHUNKS
	DEC	(SP)		;ENOUGH PADS?
	BNE	11$		;NO, DO THE REST.
	MOV	(SP)+,R1	;REMOVE DEPLETED COUNT FROM STACK
	CLC			;INDICATE SUCCESS
	RTS	PC		;RETURN.
;
; HERE IF WE RUN OUT OF CHUNKS
;
12$:	MOV	(SP)+,R1	;REMOVE DEPLETED COUNT FROM STACK
	SEC			;SIGNAL ERROR
	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO TRANSLATE AN INPUT MESSAGE.  THE ASCII IS SENT
;  TO THE DL10 TASK FOR THE USER'S BUFFER.
;
XLIMSG:	MOV	R0,-(SP)	;SAVE POINTER TO MESSAGE
	;[1006]Check if message has any data chunks...
		MOV	(R0),R0		;[1006]CHECK FOR NULL MESSAGE CHUNKS
		BNE	XLIMSR		;[1006]THERE IS A FIRST CHUNK
		JMP	XLIIGN		;[1006]THERE IS NONE, IGNORE MESSAGE.
XLIMSR:	MOV	CHLST,R0	;GET A CHUNK
	JSR	PC,GETCHK
	BCC	11$		;GOT ONE
	JMP	XLIMEC		;NONE AVAILABLE
;
; WE HAVE THE HEADER CHUNK FOR THE ASCII MESSAGE
;
11$:	MOV	R0,MSGLCH(R0)	;BUILD FIRST (HEADER) CHUNK OF MESSAGE
	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.LNU(R4),MSGID(R0) ;STORE MESSAGE ID (LINE NO.)
	MOV	(SP),R2		;POINT TO EBCDIC MESSAGE
	MOV	TCCCI(R5),-(SP) ;SAVE CURRENT CARRIAGE CONTROL CHAR
	MOV	TCVPS(R5),-(SP) ; AND CURRENT VERTICAL POSITION
	MOV	TCHPS(R5),-(SP) ; AND CURRENT HORIZONTAL POSITION
	MOV	TCST2(R5),-(SP) ;AND TWO STATUS BITS IN CASE WE
				; RUN OUT OF CHUNKS AND HAVE TO RESTART
	BIT	#MSGTSP,MSGFGS(R2) ;TRANSPARENT?
	BEQ	12$		;NO.
	JSR	PC,XLITSP	;YES, SPECIAL TRANSLATION
	BCS	XLIMEB		;OUT OF CHUNKS, WAIT AND TRY AGAIN
;	BR	XLIMSE		;SUCCESSFUL TRANSLATION
	JMP	XLIMSE		;;++SPR- SUCCESSFUL TRANSLATION
;
; HERE IF THE MESSAGE IS NOT TRANSPARENT.
;
12$:	MOV	(R2),R2		;GET FIRST DATA CHUNK
	BIC	#TCPRI,TCFG1(R5);;++SPR- SET PUNCH FLAG
13$:	MOV	(R2)+,-(SP)	;SAVE POINTER TO NEXT CHUNK
	MOV	(R2)+,R3	;GET COUNT OF BYTES IN THIS CHUNK
14$:	TST	R3		;ANY BYTES LEFT?
	BEQ	22$		;NO, DONE WITH THIS CHUNK
	DEC	R3		;YES, COUNT DOWN COUNTER
	MOVB	(R2)+,R1	;GET EBCDIC CHARACTER
	BIT	#<TCIGS!TCESC>,TCST2(R5) ;LAST CHARACTER IGS OR ESC?
	BNE	19$		;YES, TREAT THIS CHARACTER SPECIALLY
	BIT	#300,R1		;NO, IS THIS A SPECIAL CHARACTER?
	BNE	21$		;NO, TRANSLATE AND SEND TO -10
;
	CMPB	#EBCESC,R1	;;++SPR- IS THIS AN ESCAPE ?
	BEQ	24$		;;++SPR- YES, FLAG IT
;
;

;
; WE HAVE A CONTROL CHARACTER
;
	CMPB	#EBCIGS,R1	;IS IT IGS?
	BNE	15$		;NO.
	BIS	#TCIGS,TCST2(R5) ;YES, REMEMBER THAT
	BR	14$		;PROCESS NEXT CHARACTER IN SPECIAL WAY
;
; THE CHARACTER IS NOT AN IGS
;
15$:	BIT	#TCPRI,TCFG1(R5) ;ARE WE IN "PRINTER" MODE?
	BEQ	18$		;NO.
;
; WE ARE IN PRINTER MODE -- CHECK FOR ESC, IRS AND HT
;
	CMPB	#EBCESC,R1	;IS THIS AN ESCAPE?
	BNE	16$		;NO.
	BIS	#TCESC,TCST2(R5) ;YES, REMEMBER THAT
	BR	14$		;PROCESS NEXT CHARACTER IN SPECIAL WAY
;
; NOT AN ESCAPE
;
16$:	CMPB	#EBCIRS,R1	;IS IT AN IRS?
	BNE	17$		;NO.
	JSR	PC,XLIPRS	;YES, PROCESS AN IRS
	BCS	XLIMEA		;OUT OF CHUNKS
	BR	14$		;PROCESS NEXT CHARACTER
;
; NOT AN IRS
;
17$:	CMPB	#EBCHT,R1	;HORIZONTAL TAB?
	BNE	21$		;NO, TRY TO TREAT AS ORDINARY CHAR
	JSR	PC,XLIPHT	;YES, PROCESS HORIZONTAL TAB
	BCS	XLIMEA		;OUT OF CHUNKS
	BR	14$		;PROCESS NEXT CHARACTER
;

;
; CARD MODE -- CHECK FOR IRS
;
18$:	CMPB	#EBCIRS,R1	;HAVE WE AN IRS?
	BNE	21$		;NO, TRY TO TREAT AS ORDINARY CHAR

;;++BS-PAD TO 80. CHARACTERS WHEN IRS IS ENCOUNTERED IF LESS THAN 80.

31$:	CMP	TCHPS(R5),#80.	;DO WE HAVE 80. CHARACTERS ?
	BGE	32$		;YES, THE LINE IS FINISHED
	MOV	#' ,R1		;NO, GET A BLANK
	JSR	PC,MSGAPC	;APPEND TO OUTPUT MESSAGE
	BCS	XLIMEA		;OUT OF CHUNKS
	INC	TCHPS(R5)	;INCREMENT HORIZONTAL POSITION
	BR	31$		;KEEP PADDING UNTIL 80. CHARACTERS
32$:	CLR	TCHPS(R5)	;START THE NEXT CARD AT THE BEGINNING

;;++BS-END OF CODE TO PAD TO 80. CHARACTERS

	MOV	#15,R1		;YES, PUT CRLF IN ASCII MESSAGE
	JSR	PC,MSGAPC
	BCS	XLIMEA
	MOV	#12,R1
	JSR	PC,MSGAPC
	BCS	XLIMEA
	INC	TCVPS(R5)	;WE HAVE DONE A LINE
	BR	14$		;TRY FOR ANOTHER CHARACTER.
;
; HERE IF PREVIOUS CHARACTER WAS IGS OR ESC
;
19$:	BIT	#TCIGS,TCST2(R5) ;WAS LAST CHAR AN IGS?
	BEQ	20$		;NO, MUST HAVE BEEN ESC
	JSR	PC,XLIPGS	;YES, PROCESS THE IGS
	BCS	XLIMEA		;OUT OF CHUNKS
	BR	14$		;PROCESS NEXT CHARACTER
;
; HERE IF LAST CHARACTER WASN'T AN IGS.  IT MUST HAVE BEEN
;  AN ESC AND WE MUST BE IN PRINTER MODE.
;
20$:	MOVB	R1,TCCCI(R5)	;STORE CHARACTER AFTER THE ESC
				; FOR USE BY IRS
	BIC	#TCESC,TCST2(R5) ;LAST CHAR NO LONGER AN ESC

				;;++SPR- ESC-4 SAYS THIS IS A PUNCH
	CMPB	#364,R1		;;++SPR- EBCDIC 4 ?
	BEQ	23$		;;++SPR- YES, CONTINUE AS PUNCH
	BIS	#TCPRI,TCFG1(R5);;++SPR- NO, FLAG AS PRINTER

23$:				;;++SPR- 
	CMPB	#EBCHT,R1	;HAVE WE AN "ESC HT" SEQUENCE?
	BNE	14$		;NO.  GET NEXT CHARACTER.
	JSR	PC,XLISHT	;YES, SET HORIZ. TABS.
	BR	14$		;GET NEXT CHARACTER. (PROBABLY AN ESCAPE)
;

24$:	BIS	#TCESC,TCST2(R5);;++SPR- FLAG LAST CHARACTER WAS ESCAPE
	BR	14$		;;++SPR- CONTINUE



; HERE ON NORMAL CHARACTER IN CARD AND PRINTER MODES.
;
21$:	MOVB	EBCASC(R1),R1	;TRANSLATE TO ASCII
	BEQ	14$		;IGNORE NULLS AND UNTRANSLATABLES
	INC	TCHPS(R5)	;INCREMENT HORIZONTAL POSITION
	JSR	PC,MSGAPC	;STORE ASCII CHARACTER IN MESSAGE
	BCC	14$		;GO PROCESS ANOTHER CHARACTER
	BR	XLIMEA		;OUT OF CHUNKS.
;
; HERE WHEN WE RUN OUT OF BYTES IN THE CHUNK.
;  GO ON TO THE NEXT, IF THERE IS ONE.
;
22$:	MOV	(SP)+,R2	;GET NEXT CHUNK POINTER
	BNE	13$		;THERE IS ONE, PROCESS IT.
	BR	XLIMSE		;NONE, END OF PROCESSING
;

;
; HERE WHEN WE RUN OUT OF CHUNKS TO EXTEND THE MESSAGE.  FREE THE
;  PARTIALLY BUILT MESSAGE, RESTORE VARIABLES TO ENTRY VALUES,
;  WAIT A WHILE, AND TRY AGAIN.
;
XLIMEA:	MOV	(SP)+,R1	;DISCARD NEXT CHUNK
XLIMEB:	MOV	TCIDLE,R1	;SEND MSG TO BACKGROUND TASK
	JSR	PC,QUEMSG	; WHICH WILL FREE IT
	MOV	(SP)+,R0	;GET OLD TCST2
	BIC	#<TCESC!TCIGS>,TCST2(R5) ;CLEAR FLAG BITS IN TCST2
	BIC	#^C<TCESC!TCIGS>,R0 ;CLEAR ALL OTHER BITS IN OLD TCST2
	BIS	R0,TCST2(R5)	;RESTORE THOSE BITS IN TCST2
	MOV	(SP)+,TCHPS(R5) ;RESTORE HPOS
	MOV	(SP)+,TCVPS(R5)	;RESTORE VPOS
	MOV	(SP)+,TCCCI(R5)	;RESTORE CARRIAGE CONTROL CHAR
XLIMEC:	MOV	#EBTIME!EBWAIT,(R5) ;WAIT A WHILE
	MOV	#JIFSEC+4,TCTIM(R5)
	JSR	PC,WAIT
	JMP	XLIMSR		;TRY AGAIN TO TRANSLATE THE MSG
;
; HERE WHEN PROCESSING IS COMPLETE.  SEND THE ASCII MESSAGE
;  TO THE DL10 DRIVER TASK AND THE EBCDIC MESSAGE TO THE
;  IDLE TASK TO BE FREED.
;
XLIMSE:
	MOV	(R0),R1		;GET POINTER TO CHUNK
	MOV	R1,MSGLCH(R0)	;SAVE IT IN MESSAGE HEADER
	ADD	#CHDAT,R1	;POINT TO THE DATA CHAR
	MOV	R1,MSGPTR(R0)	;SAVE IN MESSAGE HEADER
	MOV	TCDLDR,R1	;POINT TO DTE20 TASK
	JSR	PC,QUEMSG	;SEND IT THE ASCII MSG
	MOV	(SP)+,R0	;DISCARD OLD TCST2
	MOV	(SP)+,R0	;DISCARD OLD TCHPS
	MOV	(SP)+,R0	;DISCARD OLD TCVPS
	MOV	(SP)+,R0	;DISCARD OLD TCCCI

;;++BS-CODE TO SET THE DEVICE ACTIVE BIT FOR 2780/3780 INPUT

	JSR	PC, HSSAVR	;SAVE THE REGISTERS
	MOV	TCLCB(R5), R2	;POINT TO LCB
	MOV	LB.LNU(R2),R0	;PUT LINE NUMBER IN R0
	BIC	#177770, R0	;CLEAR JUNK
	BIT	#LF.SIM, LB.FGS(R2) ;SIMULATION OR SUPPORT ?
	BEQ	1$		;SUPPORT
	MOV	#4, R1		;SIM, THIS MUST BE LPT
	BR	2$		;SET DEVICE ACTIVE BIT
1$:	MOV	#3, R1		;SUP, THIS MUST BE CDR
2$:	JSR	PC, HSACMP	;SET DEVICE ACTIVE BIT
	JSR	PC, HSRESR	;RESTORE THE REGISTERS

;;++BS-END OF CODE THAT SETS THE DEVICE ACTIVE BIT FOR 2780/3780


	;[1006]Add label here after XLIMSE + 10 lines.
	XLIIGN:				;[1006]HERE IS MESSAGE HAS NO CHUNKS.
	MOV	(SP)+,R0	;GET BACK EBCDIC MESSAGE
	MOV	TCIDLE,R1	;POINT TO IDLE TASK
	JSR	PC,QUEMSG	;SEND IT THE EBCDIC MESSAGE
	CLC			;SIGNAL ALL OK
	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO TRANSLATE TRANSPARENT MESSAGES.  A CRLF IS
;  INSERTED EVERY 80 CHARACTERS AND AT THE END OF THE RECORD
;  IF ANY TEXT IS LEFT UNTERMINATED.  (THIS IS TO ACCOMODATE
;  FUTURE EXTENSION TO SUPPORT OF THE IBM 3770'S 51-COLUMN
;  CARD FEATURE.)
;
; R0 = EMPTY ASCII MESSAGE 
; R2 = EBCDIC MESSAGE
;
XLITSP:	MOV	(R2),R2		;POINT TO FIRST CHUNK OF DATA
	CLR	TCHPS(R5)	;WE ARE AT FRONT OF LINE
11$:	MOV	(R2)+,-(SP)	;SAVE POINTER TO NEXT CHUNK
	MOV	(R2)+,R3	;GET COUNT OF BYTES IN THIS CHUNK [2(772)]
12$:	TST	R3		;ANY MORE CHARS IN THIS CHUNK?
	BEQ	14$		;NO, ALL DONE.
	DEC	R3		;YES, NOW ONE FEWER CHAR
	MOVB	(R2)+,R1	;GET CHAR FROM CHUNK
	MOVB	EBCASC(R1),R1	;TRANSLATE TO ASCII
	BEQ	13$		;DONT STORE UNTRANSLATABLES
	JSR	PC,MSGAPC	;PUT CHARACTER IN ASCII MSG
	BCS	16$		;OUT OF CHUNKS, WAIT AND TRY AGAIN
13$:	INC	TCHPS(R5)	;WE HAVE PROCESSED A CHARACTER
	CMP	TCHPS(R5),#80.	;REACHED END OF CARD?
	BNE	12$		;NO, PROCESS NEXT CHARACTER
	MOV	#15,R1		;YES, SEND CRLF TO ASCII FILE
	JSR	PC,MSGAPC
	BCS	16$		;OUT OF CHUNKS
	MOV	#12,R1
	JSR	PC,MSGAPC
	BCS	16$		;OUT OF CHUNKS
	CLR	TCHPS(R5)	;NOW BACK TO LEFT MARGIN
	BR	12$		;PROCESS NEXT CHARACTER
;

;
; HERE AT END OF CHUNK.  GET NEXT CHUNK AND PROCESS IT, IF ANY.
;
14$:	MOV	(SP)+,R2	;POINT TO NEXT CHUNK
	BNE	11$		;PROCESS IT, IF ANY.
;
; HERE WHEN THE MESSAGE IS COMPLETE.  GIVE AN EXTRA CRLF
;  IF NECESSARY.
;
	TST	TCHPS(R5)	;ODD LENGTH LINE?
	BEQ	15$		;NO.
	MOV	#15,R1		;YES, GIVE EXTRA CRLF
	JSR	PC,MSGAPC
	BCS	17$		;OUT OF CHUNKS
	MOV	#12,R1
	JSR	PC,MSGAPC
	BCS	17$		;OUT OF CHUNKS
15$:	CLC			;GIVE OK RETURN
	RTS	PC		;RETURN.
;
; HERE WHEN WE HAVE RUN OUT OF CHUNKS.  GIVE ERROR RETURN
;  SO WE WILL WAIT AND TRY AGAIN.
;
16$:	MOV	(SP)+,R2	;ADJUST STACK
17$:	SEC			;FLAG ERROR
	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO PROCESS AN IRS CHARACTER IN PRINTER MODE.
;  DO THE INDICATED CARRIAGE CONTROL.
;
XLIPRS:	MOVB	TCCCI(R5),R1	;GET CHAR AFTER ESCAPE ("/" IF NONE)
	MOVB	ASCEBC+'/,TCCCI(R5) ;RETURN TO SINGLE SPACE
	CMPB	ASCEBC+'M,R1	;OVERPRINT REQUEST?
	BEQ	14$		;YES.
	CMPB	ASCEBC+'A,R1	;NO, SKIP TO TOP OF FORM?
	BEQ	15$		;YES.
	CMPB	ASCEBC+'/,R1	;NO, SINGLE SPACE?
	BEQ	13$		;YES.
	CMPB	ASCEBC+'S,R1	;NO, DOUBLE SPACE?
	BEQ	12$		;YES.
	CMPB	ASCEBC+'T,R1	;NO, TRIPLE SPACE?
	BEQ	11$		;YES.
;
; IF UNRECOGNIZED CARRIAGE CONTROL, TREAT AS SINGLE SPACE.
;
	BR	13$		;SINGLE SPACE BY DEFAULT
;
; HERE ON TRIPLE SPACE
;
11$:	JSR	PC,XLIPSP	;SPACE ONCE
	BCS	17$		;OUT OF CHUNKS
;
; HERE ON DOUBLE SPACE
;
12$:	JSR	PC,XLIPSP	;SPACE ONCE
	BCS	17$		;OUT OF CHUNKS
;
; HERE ON SINGLE SPACE
;
13$:	JSR	PC,XLIPSP	;SPACE ONCE
	BCS	17$		;OUT OF CHUNKS
	BR	16$		;PROCESS NEXT CHARACTER
;

;
; HERE ON OVERPRINT REQUEST
;
14$:	JSR	PC,XLIPCR	;JUST SEND CARRIAGE RETURN
	BCS	17$		;OUT OF CHUNKS
	BR	16$		;PROCESS NEXT CHARACTER
;
; HERE ON TOP OF FORM
;
15$:	JSR	PC,XLIPTF	;GO TO TOP OF NEXT PAGE
	BCS	17$		;OUT OF CHUNKS
;	BR	16$		;PROCESS NEXT CHARACTER
;
; HERE TO GIVE SUCCESSFUL RETURN.  WORRY ABOUT EATING ALL OF CPU.
;
16$:	JSR	PC,XLCPUT	;WAIT UNTIL OTHER TASKS RUN
	CLC			;INDICATE NO ERROR
17$:	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO WAIT UNTIL WE ARE NO LONGER SHORT OF CPU TIME
;
; PRESERVES ALL REGISTERS.
;
XLCPUT:	MOV	R0,-(SP)	;SAVE R0
	MOV	R1,-(SP)	; AND R1
11$:	MOV	JIFCLK,R0	;GET INTERRUPT CLOCK
	MOV	DSPCLK,R1	;GET DISPATCHER CLOCK
	XOR	R0,R1		;COMPUTE DIFFERENCE
	BIT	#177770,R1	;ARE WE SHORT OF CPU TIME?
	BNE	12$		;YES.
	MOV	(SP)+,R1	;NO, RESTORE R1
	MOV	(SP)+,R0	; AND R0
	RTS	PC		;RETURN.
;
; HERE IF WE ARE SHORT OF CPU TIME.  WAIT A MOMENT.
;
12$:	MOV	R2,-(SP)	;SAVE R2
	MOV	R3,-(SP)	; AND R3
	MOV	R4,-(SP)	; AND R4
	MOV	#EBTIME!EBWAIT,(R5)
	MOV	#1,TCTIM(R5)	;WAIT A SHORT WHILE
	JSR	PC,WAIT		; TO AVOID USING ALL OF CPU
	MOV	(SP)+,R4	;RESTORE R4
	MOV	(SP)+,R3	; AND R3
	MOV	(SP)+,R2	; AND R2
	BR	11$		;TEST AGAIN.
;

;
; SUBROUTINE TO CLEAR HPOS AND OUTPUT A CARRIAGE RETURN
;  IF NECESSARY.
;
XLIPCR:	TST	TCHPS(R5)	;ALREADY AT LEFT MARGIN?
	BEQ	11$		;YES, DON'T NEED CARRIAGE RETURN.
	MOV	#15,R1		;NO, SEND CARRIAGE RETURN
	JSR	PC,MSGAPC	;PUT IN USER'S BUFFER
	BCS	12$		;OUT OF CHUNKS
	CLR	TCHPS(R5)	;HORIZONTAL POSITION NOW = 0
11$:	CLC			;NO ERRORS
12$:	RTS	PC		;RETURN.
;
; SUBROUTINE TO SPACE THE PRINTER ONCE, RETURNING
;  THE CARRIAGE IF NECESSARY AND COUNTING VPOS.
;
XLIPSP:	JSR	PC,XLIPCR	;SET HPOS = 0
	BCS	14$		;OUT OF CHUNKS
	CMP	TCVPS(R5),#59.	;GETTING INTO PERFORATIONS?
	BLT	11$		;NO.
	MOV	#23,R1		;YES, USE SPECIAL SPACING COMMAND
	BR	12$
;
; HERE IF STILL IN BODY OF PAGE.  USE NORMAL LINE FEED.
;
11$:	MOV	#12,R1		;LINE FEED
12$:	JSR	PC,MSGAPC	;PUT CHAR IN USER'S BUFFER
	BCS	14$		;OUT OF CHUNKS
	INC	TCVPS(R5)	;INCREMENT VPOS
	CMP	TCVPS(R5),#66.	;REACHED TOP OF NEXT PAGE?
	BNE	13$		;NO.
	CLR	TCVPS(R5)	;YES, WE ARE NOW AT TOP OF NEXT PAGE
13$:	CLC			;NO ERRORS
14$:	RTS	PC		;RETURN.
;
; SUBROUTINE TO GO TO TOP OF FORM.
;
XLIPTF:	JSR	PC,XLIPCR	;SET HPOS = 0
	BCS	11$		;OUT OF CHUNKS
	MOV	#14,R1		;FORM FEED
	JSR	PC,MSGAPC	;PUT IN USER'S BUFFER
	BCS	11$		;OUT OF CHUNKS
	CLR	TCVPS(R5)	;SET VPOS = 0
	CLC			;NO ERRORS
11$:	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO PROCESS THE CHARACTER FOLLOWING AN "IGS".
;
; R1 = THE CHARACTER FOLLOWING THE "IGS".  THIS IS INTERPRETED
;  AS A COUNT OF BLANKS PLUS THE CODE FOR AN EBCDIC BLANK.
;
XLIPGS:	BIC	#TCIGS,TCST2(R5) ;WE ARE NO LONGER RIGHT AFTER AN IGS.
	SUB	#EBCBLK,R1	;CONVERT TO BLANK COUNT
	MOV	R1,-(SP)	;SAVE BLANK COUNT
	BEQ	12$		;COUNT IS ZERO
11$:	MOV	#' ,R1		;GET A BLANK
	JSR	PC,MSGAPC	;APPEND TO OUTPUT MESSAGE
	BCS	13$		;OUT OF CHUNKS
	INC	TCHPS(R5)	;INCREMENT HORIZONTAL POSITION
	DEC	(SP)		;DECREMENT BLANK COUNT
	BNE	11$		;DO THE REST
12$:	TST	(SP)+		;REMOVE DEPLETED COUNT FROM STACK
	CLC			;INDICATE SUCCESS
	RTS	PC		;RETURN.
;
; HERE IF CHUNKS ARE DEPLETED.
;
13$:	TST	(SP)+		;REMOVE COUNT FROM STACK
	SEC			;SIGNAL CHUNKS DEPLETED
	RTS	PC		;RETURN.
;

;
; SUBROUTINE TO SET HORIZONTAL TAB STOPS.  THE TAB STOPS ARE SET
;  BASED ON AN EBCDIC MESSAGE CONSISITING OF "ESC HT" FOLLOWED
;  BY A SERIES OF BLANKS AND "HT"'S, ENDED BY AN NL.
;  A TAB STOP IS PLACED FOR EACH HT AND CLEARED FOR EACH BLANK.
;
XLISHT:	MOV	R0,-(SP)	;SAVE R0
	MOV	R5,R0		;BUILD POINTER TO TCHFU
	ADD	#TCHFU,R0
	MOV	#<160./16.>,R1	;LENGTH OF TAB BUFFER
11$:	CLR	(R0)+		;CLEAR OUT TABS BUFFER
	SOB	R1,11$		; ... ALL OF IT.
	CLR	TCHPS(R5)	;START AT LEFT MARGIN
12$:	TST	R3		;ANY CHARACTERS LEFT IN THIS CHUNK?
	BNE	13$		;YES, GET THE NEXT CHARACTER.
	MOV	4(SP),R2	;NO, GET NEXT CHUNK
	BEQ	20$		;END OF MESSAGE, THIS IS NOT ALLOWED.
	MOV	(R2)+,4(SP)	;STORE POINTER TO NEXT CHUNK
	MOV	(R2)+,R3	;PUT COUNT IN R3
	BR	12$		;GET FIRST CHAR IN THIS CHUNK
;
13$:	DEC	R3		;DECREMENT COUNT OF CHARS IN THIS CHUNK
	MOVB	(R2)+,R1	;GET NEXT CHAR FROM THIS CHUNK
	MOV	#EBCNL,R0	;GET ENDING CHARACTER
	BIT	#TCOBS,TCFG1(R5) ;OLD BSC PROTOCOL?
	BEQ	14$		;NO, NL IS RIGHT.
	MOV	#EBCIRS,R0	;YES, CHECK FOR THE IRS SUBSTITUTED BY
				; THE BSC TASK FOR THE IUS
				; THAT ENDED THE RECORD.
14$:	CMPB	R0,R1		;HAVE WE THE END CHARACTER?
	BEQ	19$		;YES, ALL DONE.
	CMPB	#EBCHT,R1	;NO, "HT" CHARACTER?
	BEQ	15$		;YES, SET TAB STOP
	CMPB	#EBCBLK,R1	;NO, A BLANK?
	BEQ	18$		;YES, TAB STOP IS CLEAR.
	STOPCD	HTS		;ERROR IN SETTING HORIZ. TABS.
;

;
; HERE TO SET A HORIZONTAL TAB STOP.
;
15$:	MOV	TCHPS(R5),R1	;GET CURRENT HORIZ. POSITION
	BIC	#177760,R1	;LEAVE ONLY LOW-ORDER 4 BITS
	MOV	#1,R0		;BUILD MASK IN R0
16$:	TST	R1		;MASK NEED ANY MORE ROTATION?
				; (NOTE THIS CLEARS C FOR THE ROL)
	BEQ	17$		;NO, DONE.
	ROL	R0		;YES, ROTATE LEFT ONE.
	DEC	R1		;DECREMENT COUNT OF ROTATIONS
	BR	16$		;DO THE REST OF THE ROTATIONS
;
17$:	MOV	TCHPS(R5),R1	;GET HPOS AGAIN
	ASR	R1		; HPOS/2
	ASR	R1		; HPOS/4
	ASR	R1		; HPOS/8
	BIC	#1,R1		; HPOS/16 * 2 FOR WORD ADDRESSING
	ADD	R5,R1		;BUILD POINTER TO TCHFU
	BIS	R0,TCHFU(R1)	;SET TAB STOP BIT
;
; HERE ON SPACE AND FROM ABOVE ON HT.
;
18$:	INC	TCHPS(R5)	;NEXT HORIZONTAL POSITION
	CMP	TCHPS(R5),#160.	;TOO MANY?
	BLE	12$		;NO, GET NEXT CHARACTER
	STOPCD	HTS		;YES, ERROR IN HORIZ. TAB SETTING
;
; HERE ON NL FROM AN IBM 3780 OR END OF RECORD FROM AN IBM 2780.
;  THIS IS THE END OF THE TAB SETTING MESSAGE.
;
19$:	CLR	TCHPS(R5)	;BACK TO LEFT MARGIN
	MOV	(SP)+,R0	;RESTORE R0
	RTS	PC		;RETURN TO CALLER.
;
; HERE IF THE MESSAGE ENDS BEFORE THE NL OR IRS.  THIS IS NOT ALLOWED.
;
20$:	STOPCD	HTS		;END OF MESSAGE BEFORE NL OR IRS
;

;
; SUBROUTINE TO PROCESS A HORIZONTAL TAB FOUND IN THE
;  DATA STREAM.
;
XLIPHT:	MOV	#' ,R1		;SEND A BLANK TO THE '10
	JSR	PC,MSGAPC
	BCS	14$		;OUT OF CHUNKS.
	INC	TCHPS(R5)	;INCREMENT HORIZONTAL POSITION
	MOV	R0,-(SP)	;SAVE R0
	MOV	TCHPS(R5),R1	;GET CURRENT HORIZ. POSITION
	CMP	R1,#160.	;REACHED END OF LINE?
	BEQ	13$		;YES, RETURN.
	BIC	#177760,R1	;NO, MASK OUT ALL BUT BIT INDEX
	MOV	#1,R0		;BUILD MASK FOR TAB BIT
11$:	TST	R1		;DONE ROTATING?
				; (NOTE THIS CLEARS C FOR ROL)
	BEQ	12$		;YES.
	ROL	R0		;NO, ROTATE LEFT ONE (C IS CLEAR)
	DEC	R1		;DECREMENT ROTATE COUNT
	BR	11$		;SEE IF ANY MORE ROTATES NEEDED
;
12$:	MOV	TCHPS(R5),R1	;GET HORIZ. POSITION AGAIN
	ASR	R1		; HPOS/2
	ASR	R1		; HPOS/4
	ASR	R1		; HPOS/8
	BIC	#1,R1		; HPOS/16 * 2 FOR WORD ADDRESSING
	ADD	R5,R1		;BUILD POINTER TO TCHFU
	BIT	R0,TCHFU(R1)	;IS THERE A TAB STOP HERE?
	BNE	13$		;YES, STOP.
	MOV	(SP)+,R0	;NO, RESTORE R0
	BR	XLIPHT		; AND GIVE ANOTHER SPACE.
;
; HERE WHEN WE HAVE REACHED A TAB STOP OR END OF LINE.
;
13$:	MOV	(SP)+,R0	;RESTORE R0
	CLC			;INDICATE SUCCESS
14$:	RTS	PC		;RETURN.
;

.SBTTL	BACKGROUND TASK
;
; THIS IS THE IDLE TIME TASK.  IT RUNS AS LOWEST PRIORITY.
;  ITS JOB IS TO FREE CHUNKS AND MESSAGES SENT TO IT.
;
IDLE:
11$:	JSR	PC,IDLTTM	;ARE WE GETTING BEHIND REAL TIME?
	BCC	12$		;NO.
	MOV	#EBTIME!EBWAIT,(R5) ;YES, WAIT A WHILE
	MOV	#1,TCTIM(R5)	;ONLY 1 TICK TO MAXIMIZE THROUGHPT
	JSR	PC,WAIT
	BR	11$		;BE SURE WE AREN'T STILL BEHIND
;
12$:	JSR	PC,DEQCHK	;ANY CHUNKS QUEUED TO THIS TASK?
	BCS	13$		;NO.
	JSR	PC,FRECHK	;YES, FREE THIS ONE.
	BR	11$		;BE SURE TIME IS AVAILABLE
				; AND TRY FOR MORE
;
; HERE WHEN THERE ARE NO CHUNKS TO FREE.  LOOK FOR MESSAGES.
;
13$:	JSR	PC,DEQMSG	;ANY MESSAGES QUEUED TO THIS TASK?
	BCS	15$		;NO.
14$:	MOV	(R0),-(SP)	;YES, SAVE NEXT CHUNK POINTER
	JSR	PC,FRECHK	;FREE THIS CHUNK
	MOV	(SP)+,R0	;GET NEXT CHUNK OF MESSAGE
	BNE	14$		;FREE REST OF MESSAGE
	BR	11$		;BE SURE TIME IS AVAIL AND
				; LOOK FOR MORE TO FREE
;
; HERE WHEN THERE ARE NO MESSAGES OR CHUNKS TO FREE.
;
15$:	JSR	PC,DLCKDL	;CHECK ANY DIABLED LINES
	MOV	#JIFSEC,TCTIM(R5) ;WAIT ONE SECOND
	MOV	#EBQCHK!EBQMSG!EBTIME!EBWAIT,(R5)
	JSR	PC,WAIT		; OR UNTIL THERE'S A CHUNK OR MESSAGE
	BR	11$		;THEN DEQUEUE SOME MORE
				; (PROVIDED TIME IS NOT SHORT)
;

;
; SUBROUTINE TO TEST FOR TIME RUNNING SHORT.
;
; ON RETURN:
;
;	C IS SET IF TIME IS SHORT, CLEAR IF NOT.
;
IDLTTM:	MOV	JIFCLK,R0	;GET INTERRUPT-DRIVEN CLOCK
	MOV	DSPCLK,R1	;GET DISPATCHER CLOCK
	XOR	R0,R1		;COMPUTE THE DIFFERENCE
	BIT	#177770,R1	;DIFFERENT BY 8 TICKS OR MORE?
	BEQ	11$		;NO, TIME NOT SHORT.
	SEC			;YES, INDICATE TIME IS SHORT.
	RTS	PC		;RETURN.
;
; HERE IF TIME IS NOT RUNNING SHORT.
;
11$:	CLC			;INDICATE TIME IS NOT SHORT
	RTS	PC		;RETURN.
;
;

;
; ASCII SPECIAL CHARACTER TABLE FOR CONTROL CHARACTERS
;
;		 0   1   2   3   4   5   6   7
ASCSPC:	.BYTE	000,000,000,000,000,000,000,000	;000-007
	.BYTE	000,002,012,012,010,006,000,000	;010-017
	.BYTE	012,012,012,012,012,000,000,000	;020-027
	.BYTE	000,000,000,000,000,000,000,000	;030-037
;		 0   1   2   3   4   5   6   7
;
; SPECIAL CODE ASSIGNMENTS USED IN TABLE ASCSPC
;
;	000 = INVALID CHARACTER -- IGNORE
;	002 = HORIZONTAL TAB CHARACTER
;	004 = ESCAPE CHARACTER (NOT CURRENTLY USED)
;	006 = CARRIAGE RETURN CHARACTER
;	010 = FORM FEED CHARACTER
;	012 = OTHER VERTICAL CARRIAGE CONTROL CHARACTER
;

;
; EBCDIC SPECIAL CHARACTER TABLE
;
;		 0   1   2   3   4   5   6   7
;		 8   9   A   B   C   D   E   F
EBCSPC:	.BYTE	000,000,000,006,000,000,000,000	;00-07
	.BYTE	000,000,000,000,000,000,000,000	;08-0F
	.BYTE	016,000,000,000,000,000,000,000	;10-17
	.BYTE	000,000,000,000,000,000,012,010	;18-1F
	.BYTE	000,000,000,000,000,000,004,000	;20-27
	.BYTE	000,000,000,000,000,014,000,000	;28-2F
	.BYTE	000,000,002,000,000,000,000,000	;30-37
	.BYTE	000,000,000,000,000,000,000,000	;38-3F
;		 0   1   2   3   4   5   6   7
;		 8   9   A   B   C   D   E   F
;
; SPECIAL CODE ASSIGNMENTS USED IN TABLE EBCSPC
;
;	000 = MISCELLANEOUS (NONE OF THOSE BELOW)
;	002 = SYN
;	004 = ETB
;	006 = ETX
;	010 = IUS
;	012 = IRS
;	014 = ENQ
;	016 = DLE
;

.SBTTL	CARRIAGE CONTROL TAPE
;
; CARRIAGE CONTROL TAPE, FOR SIMULATING AN LP10
;
XLVFU:	.BYTE 000		; NOT USED
	.BYTE 011		; 5-8
	.BYTE 051		; 3-5-8
	.BYTE 031		; 4-5-8
	.BYTE 051		; 3-5-8
	.BYTE 011		; 5-8
	.BYTE 071		; 3-4-5-8
	.BYTE 011		; 5-8
;
	.BYTE 051		; 3-5-8
	.BYTE 031		; 4-5-8
	.BYTE 055		; 3-5-6-8
	.BYTE 011		; 5-8
	.BYTE 071		; 3-4-5-8
	.BYTE 011		; 5-8
	.BYTE 051		; 3-5-8
	.BYTE 031		; 4-5-8
;
	.BYTE 051		; 3-5-8
	.BYTE 011		; 5-8
	.BYTE 071		; 3-4-5-8
	.BYTE 011		; 5-8
	.BYTE 057		; 3-5-6-7-8
	.BYTE 031		; 4-5-8
	.BYTE 051		; 3-5-8
	.BYTE 011		; 5-8
;
	.BYTE 071		; 3-4-5-8
	.BYTE 011		; 5-8
	.BYTE 051		; 3-5-8
	.BYTE 031		; 4-5-8
	.BYTE 051		; 3-5-8
	.BYTE 011		; 5-8
	.BYTE 175		; 2-3-4-5-6-8
	.BYTE 011		; 5-8
;
	.BYTE 051		; 3-5-8
	.BYTE 031		; 4-5-8
	.BYTE 051		; 3-5-8
	.BYTE 011		; 5-8
	.BYTE 071		; 3-4-5-8
	.BYTE 011		; 5-8
	.BYTE 051		; 3-5-8
	.BYTE 031		; 4-5-8
;

;
; LINE PRINTER VERTICAL FORMAT UNIT CONTINUED
;
	.BYTE 057		; 3-5-6-7-8
	.BYTE 011		; 5-8
	.BYTE 071		; 3-4-5-8
	.BYTE 011		; 5-8
	.BYTE 051		; 3-5-8
	.BYTE 031		; 4-5-8
	.BYTE 051		; 3-5-8
	.BYTE 011		; 5-8
;
	.BYTE 071		; 3-4-5-8
	.BYTE 011		; 5-8
	.BYTE 055		; 3-5-6-8
	.BYTE 031		; 4-5-8
	.BYTE 051		; 3-5-8
	.BYTE 011		; 5-8
	.BYTE 071		; 3-4-5-8
	.BYTE 011		; 5-8
;
	.BYTE 051		; 3-5-8
	.BYTE 031		; 4-5-8
	.BYTE 051		; 3-5-8
	.BYTE 011		; 5-8
	.BYTE 010		; 5
	.BYTE 010		; 5
	.BYTE 010		; 5
	.BYTE 010		; 5
;
	.BYTE 010		; 5
	.BYTE 010		; 5
	.BYTE -1		;FLAG END OF TAPE
;

;
; TRANSLATE TABLE TO CONVERT A VERTICAL MOTION CHARACTER INTO
;  A CHANNEL NUMBER FOR INDEXING INTO THE VFU TABLE.
;
XLLPCH:	.BYTE	001		;LF = CHANNEL 8
	.BYTE	002		;VT = CHANNEL 7
	.BYTE	0,0,0,0		;NOT VERTICAL MOTION CHARS (14-17)
	.BYTE	100		;DLE = CHANNEL 2
	.BYTE	040		;DC1 = CHANNEL 3
	.BYTE	020		;DC2 = CHANNEL 4
	.BYTE	010		;DC3 = CHANNEL 5
	.BYTE	004		;DC4 = CHANNEL 6
;
	.EVEN			;BE SURE NEXT SECTION STARTS
				; ON A WORD BOUNDRY
;