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

	.SBTTL	XL3780 - translate task for 2780/3780 lines


; this section contains the translate 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) 1982,1981,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
;
; 3(006) RLS	NEW STORAGE MGT CHANGES
;
; 3(007) RLS	SET DEVICE ACTIVE BIT WHEN TCIEC SET SINCE ACTION BY TEN
;		REQUIRED TO CLEAR IT.
;
; 3(010) RLS	ADD HSPIGO PARAMETER USE IN XLEBAS TO CONTROL REPETITIVE
;		TRANSLATION OF INPUT BLOCKS WITHOUT SLEEPING.
; 3(011) RLS	REDUCE WAIT AFTER PERMISSION GRANT IN XLWAIT.DON'T CLEAR TCIRN
;		UNTIL TCIEC CLEARED IN XLEBAS.
;
; 3(012) RLS	REMOVE HSPIGO. ADD MORE GLOBAL FLOW CONTROL.

; 3(013) RLS	6-Mar-81
;		Create common end of message fucntion XLSNDE to be used
;		by XLSNDM and XLEOFO.
;		Makes XLEOFO increment LB.MSC when queuing EOF msg also.

; 3(014) RLS	9-MAR-81
;		Make XLOABT and XLIABT check for LS.ENB clear so they won't
;		 wait in vain	for the 10 to clear abort complete bits

; 3(015) RLS	07-APR-81
;		Changes to reflect use of message header to store data.

; 3(016) RLS	17-APR-81
;		Transform static flow control to static/line control

; 4(017) RLS	17-MAR-82	GCO 4.2.1270
;		Check for input request before output requests at XLATE.
; 4(020) RLS	14-APR-82	GCO 4.2.1316
;		if TCOPR set, check for TCOPG already set in bsc...race.
; 4(021) RLS	19-APR-82	GCO 4.2.1326
;		Fix obscure race condtions in XLIABT,XLOABT,XLODMP.
; 4(022) RLS	18-JUN-82	GCO 4.2.1392
;		do input abort processing similar to input eof.
; 4(023) RLS	25-JUN-82	GCO 4.2.1402
;		check for signed on emulation node before granting input permission
; 4(024) RLS	28-JUN-82	GCO 4.2.1405
;		check for error returns might happen from GETSTG if aborting
; 4(025) RLS	28-JUN-82	GCO 4.2.1407
;		check for active io on device before waiting for ack of abort
; 4(026) RLS	01-JUL-82	GCO 4.2.1415
;		in XLESEB set LF.SON after eof completes so input can be accepted
; 4(027) RLS	07-JUL-82	GCO 4.2.1425
;		in XLEBAS restore R1 after call to SACTI to prevent crash when
;		line is disabled.
; 4(030) RLS	09-AUG-82	GCO 4.2.1489
;		in XLIABT, fix initial not running test to save ps before going
;		to label that restores it(15$)
; 4(031) RLS	16-AUG-82	GCO 4.2.1491
;		in XLOABT, account for reserved chunks when discarding ascii chunks
; 4(032) RLS	23-AUG-82	GCO 4.2.1500
;		in XLOCNK, ignore null ascii characters

V3780=032


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

	.SBTTL		XLATE  - 2780/3780 translate task

; this task translates data from ascii to ebcdic and from 
;  ebcdic to ascii.

XLATE:	CALL	XLWAIT		;check for input
	BIT	#TCOPR,TCFG2(R5) ;no - output permission requested?
	BNE	11$		;yes, start output.
	BIT	#TCOAB,TCFG2(R5) ;was abort flag set?
	BEQ	10$		;no.
	CALL	XLOABT		;yes, clear it (no output running)

10$:	DSCHED	#EBINTR!EBQCHK!EBQMSG,#JIFSEC/4
	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
	BIT	#TCOPG,TCFG2(R0) ;do we already have output permission?
	BNE	13$		;yes - no waiting
	BIS	#TCOPR,TCFG2(R0) ;ask for a bid for the line
	MOV	#20.*JIFSEC,R0	;wait this long for response
12$:	DSCHED	#EBINTR,R0
	MOV	LB.TC1(R4),R0	;point to bsc task
	BIT	#TCOPG,TCFG2(R0) ;do we have output permission?
	BNE	13$		;yes - proceed
	BIT	#TCOPR,TCFG2(R0) ;no - still bidding for the line?
	BEQ	15$		;no - bid failed
	MOV	TCTIM(R5),R0	;yes, did time expire?
	BNE	12$		;no, keep waiting.
	BIC	#TCOPR,TCFG2(R0) ;yes, cease bidding
15$:	BIC	#TCOPR,TCFG2(R5) ;kill output request
	BR	XLATE		;the bid was a failure.

; here when bidding is complete.

13$:	BIS	#TCOPG,TCFG2(R5) ;yes, tell the pdp-10 we have permission
	BIC	#TCOPR,TCFG2(R5) ;no longer requesting permission

	CALL	SACTO		;set the output device active

	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
	CALL	XLAPBF		; of the line buffer
	MOVB	ASCEBC+'M,R1	;and an 'M' in the second place
	CALL	XLAPBF		; to mean "no spacing".
14$:				; fall into XLASEB

	.SBTTL		XLASEB - 2780/3780 output processing

; 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$:	BIT	#TCOAB,TCFG2(R5) ;is the stream aborted?
	BEQ	29$
	JMP	22$		;yes, empty the queues
29$:	CALL	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
	CALL	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
	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$:	DSCHED	#EBINTR!EBQCHK
	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
	CALL	XLOCNK		;translate a chunk from ascii to ebcdic
	MOV	TCLCB(R5),R4	;get the lcb
	SUB	#TXLN,LB.RES(R4) ;unreserve translation chunks
	BR	11$		;try to translate another chunk

; here on end of file.

17$:	MOV	(SP)+,R2	;restore r2
	MOV	(SP)+,R0	;restore r0
18$:	CALL	XLEOFO		;signal end of file to the printer

19$:	DSCHED	#EBINTR,#JIFSEC/2
	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	#TCOAB,TCFG2(R5) ;stream aborted?
	BNE	23$		;yes.
	BIT	#TCOEC,TCFG2(R1) ;no, completed eof processing?
	BEQ	19$		;no, wait for it.
	BIS	#LF.SON,LB.FGS(R4) ;set signon so input can be accepted
	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$:	BIT	#TCOAB,TCFG2(R5) ;has the stream aborted?
	BNE	23$		;yes, (may be too late, but try.)
	BIT	#LS.ENB,(R4)	;has the line been blown away?
	BEQ	23$		;yes - can't expect eof to be cleared by the 10
	BIT	#TCOEC,TCFG2(R5) ;output eof acknowledged?
	BEQ	21$		;yes, all done.
	DSCHED	#EBINTR,#JIFSEC/2
	BR	20$		;see if acknowldeged yet

21$:
	CALL	CACTO		;clear the output device active
	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$:	CALL	XLOABT		;do the abort processing
	JMP	XLATE		; and recirculate

	.SBTTL		XLOCNK - 2780/3780 translate an ASCII chunk to EBCDIC 

; 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
	BEQ	12$		;flush nulls
	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.
	CALL	XLASCD		;no, card style output
	BR	16$

14$:	CALL	XLASPR		;send character to printer

; 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	R3,R0		;put chunk pointer in r0
	CALL	FRECHK		;flush the garbage
	MOV	(SP)+,R0	;restore r0

				;set or clear the device active bit


XLCSAB:	SAVE	<R0,R1,R2>
	MOV	TCLCB(R5),R2	;point to lcb
22$:	MOV	LB.TCD(R2),R0	;point to xlate task
	TST	TCCHKQ(R0)	;any messages queued to this task ?
	BEQ	23$		;no, set device active bit
25$:	CALL	CACTO		;yes, clear device active bit, buffers full
	BR	24$		;continue
23$:	CALL	SACTO		;no, buffers empty, set device active bit
24$:	RESTOR	<R2,R1,R0>
	RETURN

	.SBTTL		XLOABT - output abort processing

; 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	12$		;no.
	CALL	FREMSG		;flush the garbage
	CLR	TCMSG(R5)	;we no longer have a message
	BR	12$		;no need to sleep immediately

11$:	DSCHED	#EBINTR!EBQCHK,#JIFSEC/4
12$:	CALL	DEQCHK		;is there a chunk?
	BCS	13$		;no.
	CALL	FRECHK		;yes, free it
	MOV	TCLCB(R5),R4
	SUB	#TXLN,LB.RES(R4) ;unreserve resources
	BGE	12$
	CLR	LB.RES(R4)
	BR	12$		; and get the rest.

13$:	MOV	TCLCB(R5),R4	;point to lcb
	MOV	LB.TC1(R4),R1	;point to bsc driver tcb
	BIT	#TCOAC,TCFG2(R1) ;has it completed the abort?
	BNE	14$		;yes - proceed
	BIS	#TCOAB,TCFG2(R1) ;be sure it's aborted [1(715]
	SIGNAL	R1,EBINTR	;wake the bsc task
	BR	11$

14$:	TST	TCMSG1(R1)	;maybe, has it more messages?
	BNE	11$		;yes, wait until it flushes those
				;aborts all done - have only to wait for 10
	MOV	TCLCB(R5),R4	;yes, point to lcb
	BIS	#TCOAC,TCFG2(R5) ;we have completed the abort
	BIT	#TCOPR!TCOPG!TCORN!TCOEF!TCOEC,TCFG2(R5) ;check if running
	BEQ	20$

16$:	BIT	#LS.ENB,(R4)	;line disabled ?
	BEQ	20$		; yes - can't wait for 10 to come by
	PIOFF
	BIT	#TCOAC,TCFG2(R5) ;abort acknowledged?
	BEQ	19$		;yes - clean up
				;not yet.  (ack is from the pdp-10)
	CALL	SACTO		;keep the active bit on
	PION
	DSCHED	#EBINTR,#JIFSEC/4
	BR	16$

19$:	PION

20$:	MOV	LB.TC1(R4),R1	;point to bsc driver tcb
	BIC	#TCOAB!TCOAC,TCFG2(R1) ;acknowledge abort
				;clear abort and running bits
	BIC	#TCOAB!TCOAC!TCOPR!TCOPG!TCORN!TCOEF!TCOEC,TCFG2(R5)
	SIGNAL	R1,EBINTR	;wake the bsc task
	CALL	CACTO		;device no longer active
	RETURN

	.SBTTL		XLWAIT - check for input to do

; subroutine to wait for a message from the line 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	TCLCB(R5),R4	;point to lcb
	MOV	LB.TC1(R4),R0	;point to bsc task
	PIOFF
	BIT	#TCIPR!TCIRN,TCFG2(R0) ;input permission requested or still running?
	BEQ	14$		;no - go away
				;yes - try to synchronize 10 and remote
	BIT	#LF.SIM,LB.FGS(R4) ;check for emulation
	BEQ	10$		;no - grant permission
	BIT	#LF.SON,LB.FGS(R4) ;yes - check if signed on already
	BEQ	14$		;no - don't grant permission

10$:	BIS	#TCIPG,TCFG2(R0) ;pass grant to bsc task
	BIS	#TCIRN,TCFG2(R5) ;we are now running
	BIC	#TCIPG!TCIPR!TCIWR,TCFG2(R5) ;clear grant flag
	SIGNAL	R0,EBINTR	;wake the bsc task
	PION
	BR	XLEBAS		;translate ebcdic to ascii

; here if input permission has not been requested.

14$:	PION
	BIT	#TCIAB!TCIAC,TCFG2(R0) ;check for bsc task abort
	BNE	XLEBAS		;yes - go do the abort processing
	BIT	#TCIAB,TCFG2(R5) ;xlate abort while idle?
	BNE	XLEBAS		;yes, process the abort.
15$:	RETURN

	.SBTTL		XLEBAS - translate chunk from EBCDIC to ASCII

; 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$:
19$:	CALL	DEQMSG		;get a message
	BCS	12$		;none
	MOV	R0,R1
	CALL	CNTMSG		;count the chunks
	SAVE	R0		;save it til later
	MOV	R1,R0
	CALL	XLIMSG		;got one, process it.
	MOV	TCLCB(R5),R4
	SUB	(SP)+,LB.RES(R4) ;unreserve xlate chunks
	BGE	19$
	CLR	LB.RES(R4)
	BR	19$		;try again

20$:	DSCHED	#EBQMSG!EBINTR
	BR	11$		; and do the rest.


; here if no message to process.

12$:	MOV	TCLCB(R5),R4	;get lcb
	MOV	LB.TC1(R4),R1	;get bsc task
	BIT	#TCIAB!TCIAC,TCFG2(R1) ;is the bsc task input aborted?
	BNE	10$		;yes - check for cleaup
	BIT	#TCIAB,TCFG2(R5) ;has stream been aborted?
	BEQ	13$		;no.
10$:	BIS	#TCIAB,TCFG2(R1) ;make sure bsc is input aborted
	BIT	#TCIAC,TCFG2(R1) ;check if bsc input abort complete
	BEQ	20$		;continue processing input til it is
	CALL	XLIABT		;yes, do abort processing
	RETURN

13$:	BIT	#LS.ENB,(R4)	;has the line been blown away?
	BEQ	10$		;yes - can't expect eof to be cleared by the 10
	BIT	#TCIEC,TCFG2(R1) ;have we reached eof?
	BEQ	20$		;no - nap awhile

				;EOF

14$:	BIS	#TCIEC,TCFG2(R5) ;flag end of file

15$:	CALL	SACTI		;set device active bit since ten must clear tciec
	MOV	LB.TC1(R4),R1	;restore pointer to bsc task
	BIT	#LS.ENB,(R4)	;has the line been blown away?
	BEQ	10$		;yes - can't expect eof to be cleared by the 10
	DSCHED	#EBQMSG!EBINTR
	BIT	#TCIEC,TCFG2(R5) ;eof acknowledged yet?
	BNE	15$		;no, keep waiting
	BIC	#TCIRN,TCFG2(R5) ; 3(011) rls flag no longer running
	BIC	#TCIEC,TCFG2(R1) ;clear its eof complete bit
	BIT	#TCIRN,TCFG2(R5) ;check if input still running(blocked messages)
	BEQ	25$
	JMP	XLWAIT		;yes - another message is already here

25$:	CALL	CACTI		;device no longer active

; here to return to check for output

16$:	RETURN

	.SBTTL		XLIABT - process input abort

;  subroutine to process an input abort.

XLIABT:				;come here only when bsc input abort complete

12$:	MOV	TCLCB(R5),R4	;point to lcb

13$:	BIS	#TCIAC,TCFG2(R5) ;indicate abort complete
	BIT	#TCIRN!TCIPG!TCIEF!TCIEC,TCFG2(R5) ;check if running
	BEQ	16$

14$:	PIOFF
	BIT	#LS.ENB,(R4)	;line disabled?
	BEQ	15$		;yes - can't wait for 10 to acknowledge
	BIT	#TCIAC,TCFG2(R5) ;is it acknowledged?
	BEQ	15$		;yes - clean up
	CALL	SACTI		;keep the active bit on
	PION
	DSCHED	#EBINTR,#JIFSEC/4
	BR	14$

16$:	PIOFF			;accomodate main loop

15$:				;clear abort and running bits
	BIC	#TCIAB!TCIAC!TCIPR!TCIWR!TCIPG!TCIRN!TCIEF!TCIEC,TCFG2(R5)
	MOV	LB.TC1(R4),R1	;point to bsc task
	BIC	#TCIAB!TCIAC,TCFG2(R1) ;clear abort bits
	PION

	SIGNAL	R1,EBINTR	;wake the BSC task
	CALL	CACTI		;device no longer active
	RETURN

	.SBTTL		XLAPBF - stash EBCDIC character in line buffer

; 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$:	RETURN

	.SBTTL		XLASPR - translate printer character from ASCII to EBCDIC

; 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?
	BLT	13$		;no.
	MOV	R1,-(SP)	;yes, save character
	MOV	#12,R1		;give free lf (= crlf)
	CALL	XLASPR		;this will break the line
	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.
	CALL	XLASSP		;yes, try to compress it.
	BCC	15$		;nothing to store, just inc hpos
14$:	CALL	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$:	CALL	XLSNDL		;send line
	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$:	CALL	XLASTF		;top of form
	CLR	TCVPS(R5)	;clear vertical position
	BR	24$		;clear hpos and give ok 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$:	CALL	XLASSF		;single space the printer
	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
	CALL	XLASSF		;yes, give single space
	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
	CALL	XLASPR		;output it
	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$:	RETURN

	.SBTTL		XLASTF - skip printer to top of page

; 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.

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.
	CALL	XLSNDL		;no, finish off that line

; 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
13$:	RETURN

	.SBTTL		XLASSF - vertical space printer

; 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
	CALL	XLSNDL		;no, send the line
	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$:	RETURN

	.SBTTL		XLASCD - translate card reader character from ASCII to EBDCIC

; 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
	CALL	XLAPBF		;store in line buffer
13$:	CLC			;indicate success
14$:	RETURN

; here on space or improper control character, treated as space.

15$:	CMP	TCHPS(R5),#80.	;is line already full?
	BGE	13$		;yes, ignore character
	CALL	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.
	CALL	XLASSP		;no, append a space
	BCC	18$		;nothing to store
	CALL	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$:	CALL	XLSNDL		;send the card, blocking with
				; previous if possible
	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
	CALL	XLASCD		;output it
	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
	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.
	RETURN			;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
	RETURN

	.SBTTL		XLSNDL - 2780/3780 send line buffer to BSC task

; 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$:	CALL	MSGSUP		;none, set up a message
	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
	CALL	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.

	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
	CALL	MSGAPC		;append to message
	BR	16$		;rejoin common path.

15$:	CALL	XLIBCC		;store intermediate bcc
16$:	TST	MSGSNL(R0)	;will we need a sync?
	BGT	17$		;no, wait for next record
	MOV	#EBCSYN,R1	;yes, append a sync
	CALL	MSGAPC		; to the message
	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
	CALL	MSGAPC		;append to message
	BR	18$		;process all the characters

; here when all done.

19$:	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
	CALL	XLAPBF	
	MOVB	ASCEBC+'M,R1	;second char is "m"
	CALL	XLAPBF	
21$:	MOV	(SP)+,R1	;restore current character
	CLC			;signal all ok
	RETURN

	.SBTTL		XLIBCC - insert IUS and BCC in message

; 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
	CALL	MSGAPC		;put in the block
	JMP	STOBCC		;put bcc after the ius

	.SBTTL		XLSNDM - send the message if current record won't fit

; 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.

	.ENABL	LSB
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$:	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
	CALL	MSGAPC		;append to message
12$:	MOV	#EBCETB,R1	;"etb"

XLSNDE:				; wind up a message
				; r0/msg ptr
				; r1/end character
	KGACUM	R1		;accumulate bcc
	CALL	MSGAPC		;append to message
	CALL	STOBCC		;append bcc
	CALL	XLPADS		;append pads to message
	CALL	MSGAPE		;return unused chunks
	MOV	TCLCB(R5),R4	;point to lcb
	MOV	LB.TC1(R4),R1	;point to bsc driver
	CALL	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
13$:	RETURN
	.DSABL	LSB

	.SBTTL		XLODMP - 2780/3780 dump output buffers

; 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:	CALL	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	13$		;no.
	MOV	TCLCB(R5),R1	;point to lcb
	MOV	LB.MLR(R1),MSGNLR(R0) ;yes, pretend it is full...
	CALL	XLSNDM		; and send it.

11$:	DSCHED	#EBINTR,#JIFSEC/4

13$:	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
	RETURN

; here if the stream is aborted.

12$:	MOV	(SP)+,R2	;restore line buffer count
	MOV	(SP)+,R0	; and position
	SEC			;flag stream aborted
	RETURN

	.SBTTL		MSGSUP - 2780/3780 message setup

; 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.
;	note: msgsup will not fail for translate tasks - only for tentsk and
;		bsc tasks.

	.ENABL	LSB

MSGSUP:	CALL	CREATM		;get a message header
	BCS	17$		;out of chunks.
	MOV	#EBCLPD,R1	;get leading pad character (alt bits)
	CALL	MSGAPC		;store in message
	BCS	16$
	MOV	#5,R2		;count of leading syncs
11$:	MOV	#EBCSYN,R1	;"synchronous idle"
	CALL	MSGAPN		;put character in string
	BCS	16$
	MOV	TCLCB(R5),R4	;point to lcb
.IF NE,FT.HSP
	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$:	CALL	MSGAPC		;append to message
	BCS	16$
.ENDC	;.IF NE,FT.HSP

21$:	MOV	#EBCSTX,R1	;"start of text"
	CALL	MSGAPC		;append to string
	BCS	16$
	CALL	XLPREL		;preallocate chunks
	BCS	16$
	KGLOAD	#0		;initialize the kg11-a

	MOV	#SYNLEN,MSGSNL(R0) ;initialize intermediate
				; synch counter.
	CLC			;suc
	RETURN

; 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.

XLPREL:				; common to hasp msg allocator
	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$:	CALL	GETSTG		;get a hunk
	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
	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$:	CALL	FREMSG		;flush the garbage
	SEC			;signal error
17$:	RETURN

	.DSABL	LSB

	.SBTTL		XLEOFO - 2780/3780 output end of file processing

; 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
	CALL	XLSNDL		;finish off the current line
11$:	MOV	TCMSG(R5),R0	;point to current message
	BNE	12$		;there is one.
	CALL	MSGSUP		;none, build one.
	MOV	R0,TCMSG(R5)	;we now have a message
12$:	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
	CALL	MSGAPC		;append to message
13$:	MOV	#EBCETX,R1	;end of text
	CALL	XLSNDE		; wind up the message
	BIS	#TCOEF,TCFG2(R1) ;indicate last message
	CLC			;signal success
	RETURN

; 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:	SAVE	R2
	MOV	TCLCB(R5),R2	;get line block ptr
	MOV	LB.TRL(R2),R2	;count of pads
	MOV	#EBCPAD,R1	;pad character
	CALL	MSGAPN		;append a pad character
	RESTOR	R2
	RETURN

	.SBTTL		XLIMSG - 2780/3780 translate message from EBCDIC to ASCII

; 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
	TST	MSGLEN(R0)	;check for null messages
	BNE	XLIMSR		;[1006]there is a first chunk
	JMP	XLIIGN		;[1006]there is none, ignore message.

XLIMSR:	CALL	CREATM		;get a message header even if have to wait all day
	BCC	11$
	JMP	XLIIGN		;things are truly desperate

; we have the header chunk for the ascii message

11$:	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.
	CALL	XLITSP		;yes, special translation
10$:	JMP	XLIMSE		;successful translation

; here if the message is not transparent.

12$:	MOV	CHLEN(R2),R3	;get count in header block
	MOV	(R2),-(SP)	;save ptr to next chunk
	MOV	MSGPTR(R2),R2	;get initial ptr
	BIC	#TCPRI,TCFG1(R5) ; set punch flag
	BR	14$

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	; is this an escape ?
	BEQ	24$		; 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.
	CALL	XLIPRS		;yes, process an irs
	BR	14$		;process next character

; not an irs

17$:	CMPB	#EBCHT,R1	;horizontal tab?
	BNE	21$		;no, try to treat as ordinary char
	CALL	XLIPHT		;yes, process horizontal tab
	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

;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
	SAVE	R2
	MOV	#' ,R1		;no, get a blank
	MOV	#80.,R2		;calc number to pad
	SUB	TCHPS(R5),R2
	CALL	MSGAPN		;append the block
	RESTOR	R2

32$:	CLR	TCHPS(R5)	;start the next card at the beginning


	MOV	#15,R1		;yes, put crlf in ascii message
	CALL	MSGAPC	
	MOV	#12,R1
	CALL	MSGAPC	
	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
	CALL	XLIPGS		;yes, process the igs
	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

				; esc-4 says this is a punch
	CMPB	#364,R1		; ebcdic 4 ?
	BEQ	23$		; yes, continue as punch
	BIS	#TCPRI,TCFG1(R5) ; no, flag as printer

23$:				; 
	CMPB	#EBCHT,R1	;have we an "esc ht" sequence?
	BNE	14$		;no.  get next character.
	CALL	XLISHT		;yes, set horiz. tabs.
	BR	14$		;get next character. (probably an escape)


24$:	BIS	#TCESC,TCST2(R5) ; flag last character was escape
	BR	14$		; 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
	CALL	MSGAPC		;store ascii character in message
	BR	14$		;go process another character

; 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

	.SBTTL		XLIMSE - end of input message processing

; here when processing is complete.  send the ascii message
;  to the tentsk task and the ebcdic message to be freed.

XLIMSE:				;r0/ptr to completed ascii message
	MOV	TCDLDR,R1	;point to tentsk
	CALL	QUEMSG		;send it the ascii msg
				;discard old tcst2
				;discard old tchps
				;discard old tcvps
				;discard old tccci
	ADD	#4*2,SP
	CALL	SACTI		;set device active bit

XLIIGN:				;[1006]here is message has no chunks.
	MOV	(SP)+,R0	;get back ebcdic message
	CALL	FREMSG		;flush the garbage
	CLC			;signal all ok
	RETURN

	.SBTTL		XLITSP - translate transparent input messages
; 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	CHLEN(R2),R3	;get count in header block
	MOV	(R2),-(SP)	;save ptr to next chunk
	MOV	MSGPTR(R2),R2	;get initial ptr
	CLR	TCHPS(R5)	;we are at front of line
	BR	12$

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
	CALL	MSGAPC		;put character in ascii msg
13$:	INC	TCHPS(R5)	;we have processed a character
	BIT	#TCPRI,TCFG1(R5) ; lpt mode or card ??
	BEQ	9$		; the venerable card
	CMP	TCHPS(R5),#132.	; lpt - wider by far
	BR	10$

9$:	CMP	TCHPS(R5),#80.	;reached end of card?

10$:	BLT	12$		;no, process next character
	MOV	#15,R1		;yes, send crlf to ascii file
	CALL	MSGAPC	
	MOV	#12,R1
	CALL	MSGAPC	
	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
	CALL	MSGAPC	
	MOV	#12,R1
	CALL	MSGAPC	
15$:	CLC			;give ok return
	RETURN

	.SBTTL		XLIPRS - translate printer character from ASCII to EBCDIC

; 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$:	CALL	XLIPSP		;space once

; here on double space

12$:	CALL	XLIPSP		;space once

; here on single space

13$:	CALL	XLIPSP		;space once
	BR	16$		;process next character

; here on overprint request

14$:	CALL	XLIPCR		;just send carriage return
	BR	16$		;process next character

; here on top of form

15$:	CALL	XLIPTF		;go to top of next page

; here to give successful return.  worry about eating all of cpu.

16$:	CLC			;indicate no error
17$:	RETURN

; 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
	CALL	MSGAPC		;put in user's buffer
	CLR	TCHPS(R5)	;horizontal position now = 0
11$:	RETURN

; subroutine to space the printer once, returning
;  the carriage if necessary and counting vpos.

XLIPSP:	CALL	XLIPCR		;set hpos = 0
	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$:	CALL	MSGAPC		;put char in user's buffer
	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$:	RETURN

; subroutine to go to top of form.

XLIPTF:	CALL	XLIPCR		;set hpos = 0
	MOV	#14,R1		;form feed
	CALL	MSGAPC		;put in user's buffer
	CLR	TCVPS(R5)	;set vpos = 0
	RETURN

	.SBTTL		XLIPGS - generate the count of blanks after IGS

; 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
	BEQ	12$		;count is zero
	SAVE	R2
	MOV	R1,R2
	ADD	R2,TCHPS(R5)
	MOV	#' ,R1		;get a blank
	CALL	MSGAPN		;append to output message
	RESTOR	R2
12$:	CLC			;indicate success
	RETURN

	.SBTTL		XLISHT - set horizontal tab stops from input message

; 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
	RETURN

; here if the message ends before the nl or irs.  this is not allowed.

20$:	STOPCD	HTS		;end of message before nl or irs

	.SBTTL		XLIPHT - process input horizontal tab

; subroutine to process a horizontal tab found in the
;  data stream.

XLIPHT:	MOV	#' ,R1		;send a blank to the '10
	CALL	MSGAPC	
	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?
	BGE	13$		;yes, return.
	MOV	#1,R0		;build mask for tab bit
	BIC	#177760,R1	;no, mask out all but bit index
	BEQ	12$		;yes.
11$:	CLC
	ROL	R0		;rotate left one
	SOB	R1,11$

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$:	RETURN

	.SBTTL		ASCSPC - ASCII special control character table

; 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
;

	.SBTTL		EBCSPC - EBCDIC special control character table

; 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		XLVFU - 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

	.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