.SBTTL	XLHASP - translate task for HASP multileaving 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.
; also contains compression and decompression tasks for 
; hasp-multileaving. 

.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

; SPECIFY TRANSLATE OPTIONS AVAILABLE

; BIT 0 = IBM 3780/2780
; BIT 1 = HASP MULTILEAVING

XLOPTN=XLOPTN!B1		;hasp-multileaving translation added
;		REVISION HISTORY

; 3(001) BS	LIMIT INPUT MESSAGES QUEUED TO A MAX OF 2
;
; 3(002) BS	SEND COMPRESSED DATA FOR CARD STYLE OUTPUT
;
; 3(003) BS	ALLOW TASK TO PROCESS ONLY ONE INPUT MESSAGE AT A TIME
;
; 3(004) BS	ALLOW THE PRINTER TO PRINT A DELETE (ASCII 177)
;
; 3(005) BS	DO NOT SEND EOF TO CONSOLE IN OR CONSOLE OUT
;
; 3(006) BS	SIGNAL INPUT EOF ONLY AFTER LAST MESSAGE SENT TO PDP-10
;
; 3(007) BS	RELEASE MESSAGES ON END OF FILE ONLY IF THEY EXIST
;
; 3(010) KR	If TCIRH bit on when we clear input EOF, pretend request came
;		in then
;
; 4(011) BS	ACCEPT TRANSMIT ABORT SCB IN HASP MODE AND TREAT AS END OF FILE
;
; 4(012) RLS	PAD CARDS TO 80 COLUMNS (XLHEOR)
;
; 4(013) RLS	CHANGES FOR NEW STORAGE MGT
;
; 4(014) RLS	CHANGE XLDSON TO COUNT CHARACTERS IN SIGNON MSG IN TCHPS
;		INSTEAD OF TCHCNT...SO CALL TO XLHEOR WILL PROPERLY PAD CARD
;		TO 80 CHARACTERS + CRLF (82 CHARACTER UNIT RECORD).
;
; 4(015) RLS	SET DEVICE ACTIVE BIT WHEN TCIEC SET SINCE ACTION BY TEN IS
;		REQUIRED TO CLEAR IT.
;
; 4(016) RLS	ADD HSPIGO PARAMETER USE IN XHEBAS TO CONTROL REPETITIVE
;		TRANSLATION OF INPUT BLOCKS WITHOUT SLEEPING.
;
; 4(017) RLS	PATCH IN XLHEOR TO AVOID PADDING RECORD IMAGE FOR CONSOLE DEV.
;
; 4(020) RLS	REMOVE HSPIGO. PUT IN MORE GLOBAL FLOW CONTROLS.

; 4(021) RLS	11-MAR-81
;		check LS.ENB in abort processors XHDIAB,XHDOAB instead of
;		 LF.DIP - consistent with XLIABT,XLOABT.

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

; 4(023) RLS	17-APR-81
;		Transform static flow control to static/line control

; 4(024) RLS	19-APR-82	GCO 4.2.1325
;		Insert a space in empty non-lpt records to preserve blank line
;		in file...send a null record appears to lose - XLHSCD.

; 4(025) RLS	26-APR-82	GCO 4.2.1334
;		use record size TCRSZ for record length control and padding
; 4(026) RLS	25-JUN-82	GCO 4.2.1402
;		check for signed on emulation node before granting input permission
; 4(027) RLS	28-JUN-82	GCO 4.2.1405
;		check for error returns from GETSTG which might happen during 
;		aborts.
; 4(030) RLS	28-JUN-82	GCO 4.2.1407
;		don't wait for abort ack if no io running on device
; 4(031) RLS	05-JUL-82	GCO 4.2.1418
;		keep device active bit set in XHEBAS as long as there is unread
;		input data for the 10.
; 4(032) RLS	11-JUL-82	gco 4.2.1433
;		equivalence immediate mode and delayed mode vfu srcb's in XHIPRS
; 4(033) RLS	16-AUG-82	GCO 4.2.1490
;		don't clear running bits in XHDOAB because an eof will follow
; 4(034) RLS	16-AUG-82	GCO 4.2.1491
;		account for discarded ascii chunks in flow control data in XHDOAB
; 4(035) RLS	18-AUG-82	GCO 4.2.1494
;		add timeout to general event wait  in XLHASP top level.
; 4(036) RLS	23-AUG-82	GCO 4.2.1500
;		in XLHCNK, ignore null ascii characters

VHASP=036


VEDIT=VEDIT+VHASP
; this task handles the translation and compression/decompression
; of data for hasp-multileaving devices.

XLHASP:	MOV	TCLCB(R5),R4	;point to lcb
	BIT	#TCOAB!TCIAB!TCIAC!TCOAC,TCFG2(R5) ;any aborts?
	BNE	12$		;yes, deal with aborts first
	MOV	LB.TC1(R4),R0	;point to bsc task
	BIT	#TCOPG,TCFG2(R0) ;is bidding complete?
	BNE	12$		;yes.

	BIT	#LF.SIM, LB.FGS(R4) ;simulation mode
	BEQ	10$		;no, bid only when 10 requests

	BIS	#TCOPR,TCFG2(R0) ;ask for a bid for the line

10$:

	MOV	#20.*JIFSEC,R1	;20 secs max for bid
11$:	DSCHED	#EBINTR,R1
	BIT	#TCOPG,TCFG2(R0) ;bidding complete?
	BNE	12$		;yes.
	MOV	TCTIM(R5),R1	;did time expire?
	BNE	11$		;no, keep waiting.
	BR	XLHASP		;the bid was a failure.

12$:
	BIT	#TCIOM,TCFG1(R5) ;input mode
	BEQ	13$		;no, output mode
	CALL	XHDINP		;process input
	BR	15$

13$:	CALL	XHDOUT		;process for output

15$:	DSCHED	#EBINTR!EBQCHK!EBQMSG,#JIFSEC/4
	BR	XLHASP		;and recirculate
	.SBTTL		XHDOUT,XLHSEB - HASP output processing

; this subroutine processes output to be sent to bsc task

XHDOUT:	BIT	#TCOAB,TCFG2(R5) ;output aborted for device?
	BEQ	11$		;no.
	CALL	XHDOAB		;process device abort
10$:	RETURN

11$:	CMP	#RCBCTL,TCCTP(R5) ;check for signon
	BNE	16$		;no, treat as normal
	BIS	#TCOPG!TCORN,TCFG2(R5) ;for signon indicate opg
16$:
	BIT	#TCORN!TCOPG,TCFG2(R5) ;output device permission granted?
	BEQ	10$		;no - go away

; here when device permission is granted and bidding complete

14$:	MOV	TCCTP(R5),R1	;get the device number
	CALL	HSETAC		;set device active

	BIS	#TCORN,TCFG2(R5) ;output running
	BIC	#TCDSP,TCFG2(R5) ;unsuspend output for device
22$:	MOV	TCBFP(R5),R0	;initialize line buffer
	CLR	TCHPS(R5)	;assume we start at left margin
	CLR	TCVPS(R5)	; and at the top of a page
	MOV	TCCTP(R5),R1	;get the rcb (component selection field)
	BNE	15$		;is it legal rcb?
13$:	STOPCD	HSF		;trap if rcb zero

15$:
	CLR	R2		;initialize char count in line buffer
	CALL	XLAPBF		;put rcb in buffer
	MOVB	#200,R1		;"ccw" for no spacing
	CALL	XLAPBF		;put the srcb in line buffer

; here to translate chunks from ascii to ebcdic.

XLHSEB:
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?
	BNE	22$		;yes, empty the queues.
	CALL	DEQCHK		;no, get a chunk
	BCC	16$		;got one.
	BIT	#TCOEF,TCFG2(R5) ;none, end of file?
	BNE	17$		;yes,send zero length record
	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	XLHDMP		;empty our buffers
	BCS	23$		;stream aborted
	RETURN

13$:
.IF NE,DEBUG
	BIT	#TCORN!TCOPG,TCFG2(R5) ;is it doing output?
	BNE	14$		;yes.
27$:	STOPCD	DBG		;no, error.
14$:
.ENDC	;.if ne,debug
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	XLHCNK		;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	XLHEOF		;signal end of file to the printer

19$:	DSCHED	#EBINTR,#JIFSEC/2
	BIT	#TCOAB,TCFG2(R5) ;stream aborted?
	BNE	23$		;yes.
	BIT	#TCOTC,TCFG1(R5) ;has eof been shipped by bsc
	BNE	19$		;no, wait till it is
	BIS	#TCOEC,TCFG2(R5) ;completed eof processing
	BIC	#TCORN!TCOPG,TCFG2(R5) ;clear run and grant
20$:	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.
	DSCHED	#EBINTR,#JIFSEC/2
	BR	20$		;see if acknowldeged yet

21$:	BIC	#TCOEF,TCFG2(R5) ;clear eof signal

	MOV	TCCTP(R5),R1	;get device number
	CALL	HCLRAC		;clear the device active

	MOV	TCSBF(R5),R0	;any compressed buffer to release?
	BEQ	24$		;no.
	CLR	TCSBF(R5)	;clear pointer to compress buffer
	CALL	FRECHK		;free the buffer
24$:	RETURN			;when all done recirculate

; here when the message stream is aborted.

22$:	MOV	(SP)+,R2	;discard line counter
	MOV	(SP)+,R0	; and line pointer
23$:	CALL	XHDOAB		;do the abort processing
	BR	21$		;reset flags and release buffer
	.SBTTL		XLHCNK - translate 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

XLHCNK:
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	XLHSCD		;no, card style output
	BR	16$

14$:	CALL	XLHSPR		;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	TCCTP(R5),R1	;get device number
	TST	TCCHKQ(R5)	;any chunks queued to this task ?
	BEQ	21$		;no, set the device active bit
25$:	CALL	HCLRAC		;yes, clear dev active bit, buffers full
	BR	22$		;continue
21$:	CALL	HSETAC		;set dev active bit, buffers empty
22$:

	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
	RETURN
	.SBTTL		XHDINP,XHEBAS - HASP input processing

; this subroutine processes input data received from bsc task

XHDINP:	BIT	#TCIAB,TCFG2(R5) ;device input abort?
	BEQ	12$		;no.
10$:	CALL	XHDIAB		;free all queued messages
11$:	RETURN			;recirculate

12$:	BIT	#TCIRN,TCFG2(R5) ;input running?
	BNE	15$		;yes
	BIT	#TCIPR!TCIWR,TCFG2(R5) ;input requested?
	BEQ	11$		;no, loop
	BIT	#LF.SIM,LB.FGS(R4) ;check for emulation
	BEQ	13$		;no - grant permission
	BIT	#LF.SON,LB.FGS(R4) ;yes - check if signed on already
	BEQ	11$		;no - don't grant permission

13$:	BIS	#TCIRN,TCFG2(R5) ;yes - we are now running

15$:	BIC	#TCIPR!TCIWR!TCIPG,TCFG2(R5) ;clear all input req flags
	CALL	XHESAC		;make sure device active bit is on

; go translate ebcdic to ascii

; here when we have the bsc task running, at end-of-file
;  or aborted.  set up for input data processing.

XHEBAS:	CLR	TCHPS(R5)	;clear hpos
	CLR	TCVPS(R5)	; and vpos
	MOVB	#201,TCCCI(R5)	;initial spacing is single
11$:
19$:	CALL	DEQMSG		;get a message for this device
	BCS	12$		;none.
	MOV	R0,R1
	CALL	CNTMSG		;count the chunks
	SAVE	R0		;save it til later
	MOV	R1,R0
	CALL	XHIMSG		;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$:	TST	TCIMC(R5)	;check if there is input pending for the 10
	BEQ	21$
	CALL	XHESAC		;yes - make sure device active bit is on

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



; here if no message to process.

12$:	BIT	#TCIAB,TCFG2(R5) ;has stream been aborted?
	BEQ	13$		;no.

16$:	CALL	XHDIAB		;yes, do abort processing
	RETURN

13$:	BIT	#TCIEF,TCFG2(R5) ;reached eof?
	BEQ	20$		;no, wait

				;eof

14$:	BIS	#TCIEC,TCFG2(R5) ;tell 10 REACHED EOF
	CALL	XHESAC		;set device active bit since ten must clear TCIEC
15$:	DSCHED	#EBINTR!EBQMSG
	BIT	#TCIAB,TCFG2(R5) ;aborted?
	BNE	16$		;yes - can't expect eof acknowledgement
	BIT	#TCIEC,TCFG2(R5) ;eof acknowledged yet?
	BNE	15$		;no, keep waiting
	BIT	#TCIPH,TCFG1(R5) ;any more requests from remote?
	BNE	XHEICP		;yes, dont clear request
	BIC	#TCIPR!TCIWR,TCFG2(R5) ;clear input req flags


XHEICP:	BIC	#TCIEF!TCIPG!TCIRN,TCFG2(R5) ;clear input eof indicator

	BIT	#TCIRH,TCFG1(R5) ;did we stack a permission request?
	BNE	5$		;no, just exit
	RETURN

5$:	BIS	#TCIPH,TCFG1(R5) ;yes, set appropriate
	BIS	#TCIWR!TCIPR,TCFG2(R5) ; bits
	BIC	#TCIRH,TCFG1(R5) ;clear it


XHESAC:				;set device active bit
	SAVE	R1
	MOV	TCCTP(R5),R1	;get device number
	CALL	HSETAC		;set the device active bit
	RESTOR	R1
	RETURN
	.SBTTL		XHDIAB - process input abort
; subroutine to process a device input abort.
; r5 = points to device's xlate tcb

XHDIAB:	BIS	#TCIAB,TCFG2(R5) ;make sure its aborted.
11$:	CALL	DEQMSG		;any messages left?
	BCS	12$		;no, abort complete
	SAVE	R0
	CALL	CNTMSG
	MOV	TCLCB(R5),R4
	SUB	R0,LB.RES(R4)	;unreserve xlate chunks
	BGE	10$
	CLR	LB.RES(R4)
10$:	RESTOR	R0
	CALL	FREMSG		;flush the garbage
	BR	11$		;see if there are any more

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

14$:	BIT	#LS.ENB,@TCLCB(R5) ;check for line disabled
	BEQ	13$		;yes - don't wait for 10 t0 clear  abort bits
	PIOFF
	BIT	#TCIAC,TCFG2(R5) ;is it acknowledged?
	BEQ	15$		;yes - clean up
	CALL	XHESAC		;keep the active bit on
	PION
	DSCHED	#EBINTR,#JIFSEC/4 ;wait for acknowldegment - from the 10
	BR	14$

15$:	PION

13$:				;clear abort and running bits
	BIC	#TCIAB!TCIAC!TCIPR!TCIWR!TCIPH!TCIPG!TCIRN!TCIEF!TCIEC,TCFG2(R5)
	CLR	TCIMC(R5)	;clear count of input messages queued
	CALL	XHEICP		;clear all input indicators
	CALL	POKBSC		;let the BSC task know
	RETURN
	.SBTTL		XHDOAB - process output abort

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

XHDOAB:	BIS	#TCOAB,TCFG2(R5) ;make sure device is aborted
	MOV	TCMSG(R5),R0	;are we building a message?
	BEQ	11$		;no.
	CALL	FREMSG		;flush the garbage
	CLR	TCMSG(R5)	;we no longer have a message

11$:	MOV	TCLCB(R5),R4

12$:	CALL	DEQCHK		;is there a chunk?
	BCS	13$		;no.
	CALL	FRECHK		;yes, free it
	SUB	#TXLN,LB.RES(R4) ;unreserve resources
	BGE	12$
	CLR	LB.RES(R4)
	BR	12$		; and get the rest.

13$:	BIS	#TCOAC,TCFG2(R5) ;abort completed by xlate
	BIT	#TCOPR!TCOPG!TCORN!TCOEF!TCOEC,TCFG2(R5) ;check if running
	BEQ	17$

14$:	BIT	#LS.ENB,@TCLCB(R5) ;check for line disabled
	BEQ	20$		;yes - don't wait for 10 t0 clear  abort bits
	PIOFF
	BIT	#TCOAC,TCFG2(R5) ;abort acknowledged?
	BEQ	15$		;yes
	CALL	XHESAC		;keep the active bit on
	PION
	DSCHED	#EBINTR,#JIFSEC/4
	BR	14$

15$:	PION

17$:	BIC	#TCOAB!TCOAC!TCOPR!TCOEF!TCOEC,TCFG2(R5) ;clear abort bits
	CALL	POKBSC		;let the bsc task know
	RETURN

20$:	BIC	#TCOPR!TCOPG!TCORN,TCFG2(R5) ;clear running bits
	BR	17$
	.SBTTL		XLHSPR - tranlate 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.

XLHDBG:	STOPCD	DBG		;for debugging

XLHSPR:	CMPB	R1,#' 		;compare char with blank
	BHIS	12$		;graphic, space
	MOVB	ASCSPC(R1),R3	;control--get its code
	JMP	@11$(R3)	;dispatch on the code

; dispatch table for ascii control character types

11$:	.WORD	24$		;invalid -- ignore
	.WORD	23$		;ht
	.WORD	24$		;esc (invalid) -- ignore
	.WORD	22$		;cr
	.WORD	16$		;ff
	.WORD	17$		;other vertical control (lf, vt)
; here on space, graphic or del.

12$:	CMPB	#200,R1		;allow a delete but nothing bigger
	BHI	5$
	MOV	#'?,R1		;map crufty ascii character to ?
5$:	BIT	#TCLBK,TCST2(R5) ;no, is previous line broken?
	BNE	15$		;yes, graphic or space after line break
	CMP	TCHPS(R5),TCRSZ(R5) ;no, beyond end of line?
	BLT	13$		;no.
	MOV	R1,-(SP)	;yes, save character
	MOV	#12,R1		;give free lf (= crlf)
	CALL	XLHSPR		;this will break the line
	MOV	(SP)+,R1	;restore character
	BR	15$		;send the line

; here if the line has not overflowed.

13$:	MOVB	ASCEBC(R1),R1	;translate to ebcdic
	CALL	XLAPBF		;store character in buffer
14$:	INC	TCHPS(R5)	;increment horizontal position
	BR	24$		; and give successful return.
; here if the previous line had ended.  since this character
;  is a graphic or space, send the previous line.

15$:	CALL	XHSNDL		;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.

16$:	CALL	XLHSTF		;top of form
	CLR	TCVPS(R5)	;clear vertical position
	BR	22$		;clear hpos and give ok return.

; here on other vertical motion character -- lf, vt, dc...

17$:	MOV	TCVPS(R5),R3	;current vertical position
	INC	R3		;look at next position
	TSTB	XLVFU(R3)	;at bottom of page?
	BPL	19$		;no.
	BR	16$		;yes, skip to top of next form.

18$:	CALL	XLHSSF		;single space the printer
	INC	TCVPS(R5)	;down one vertical space
	BR	22$		;clear hpos and give ok return.

; here if we are not at the bottom of the vfu.

19$:	BITB	XLLPCH-12(R1),XLVFU(R3) ;should this char stop here?
	BNE	18$		;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.

20$:	INC	R3		;look at next position
	TSTB	XLVFU(R3)	;bottom of form?
	BLT	16$		;yes, treat as form feed.

; here if we are not yet at bottom of form.  see if the
;  vfu says we should stop here.

21$:	BITB	XLLPCH-12(R1),XLVFU(R3) ;this channel punched here?
	BEQ	20$		;no, look at next position
	CALL	XLHSSF		;yes, give single space
	CLR	TCHPS(R5)	;move to left margin
	INC	TCVPS(R5)	;down one vertical space
	BR	17$		;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.

22$:	CLR	TCHPS(R5)	;horiz. pos. to left margin
	BIS	#TCLBK,TCST2(R5) ;set "tclbk"
	BR	24$		;give ok return.

; here on horizontal tab.  output spaces until the horizontal
;  position is a multiple of 8.  always output at least one
;  space.

23$:	MOV	#' ,R1		;space
	CALL	XLHSPR		;output it
	BIT	#7,TCHPS(R5)	;is horizontal position mod 8 = 0?
	BNE	23$		;no, output another space

; here to give ok return.

24$:	CLC			;signal success
25$:	RETURN
	.SBTTL		XLHSTF - 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 xhsndl 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.

XLHSTF:	MOV	TCBFP(R5),R3	;point to line buffer
	CMPB	#200,1(R3)	;carriage control = no spacing?
	BEQ	11$		;yes, change to top of form.
	CALL	XHSNDL		;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	#221,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		XLHSSF - 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.
;

XLHSSF:	MOV	TCBFP(R5),R3	;point to line buffer
	INC	R3		;point to carriage control (srcb)
	CMPB	#200,(R3)	;no spacing?
	BEQ	11$		;yes, make single space
	CMPB	#201,(R3)	;no, single space?
	BEQ	12$		;yes, make double space
	CMPB	#202,(R3)	;no, double space?
	BEQ	13$		;yes, make triple space
	CALL	XHSNDL		;no, send the line
	BR	XLHSSF		;change no spacing to single

; here on no spacing to change to single

11$:	MOVB	#201,(R3)	;make single spacing
	BR	14$

; here on single spacing to change to double

12$:	MOVB	#202,(R3)	;make double spacing
	BR	14$

; here on double spacing to change to triple

13$:	MOVB	#203,(R3)	;make triple spacing
14$:	CLC			;signal ok
15$:	RETURN

	.SBTTL		XLHSCD - translate card reader character from ASCII to EBCDIC

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

XLHSCD:	CMPB	R1,#' 		;is it graphic, space or del?
	BGE	11$		;yes.
	TST	R1		;null?
	BEQ	13$		;yes, just ignore it.
	CMPB	#12,R1		;no, is it line feed?
	BEQ	15$		;yes, end of card.
	CMPB	#11,R1		;no, horizontal tab?
	BEQ	16$		;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),TCRSZ(R5) ;is line full?
	BGE	13$		;yes, ignore character.
	MOVB	ASCEBC(R1),R1	;no, translate to ebcdic
	BEQ	13$		;ignore untranslatable chars

; 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 line feed.  this marks the end of the card.

15$:	TST	TCHPS(R5)	;check for blank line
	BNE	17$		;something there
	MOVB	ASCEBC+' ,R1	;empty line - get ebcdic space
	CALL	12$		;process it

17$:	CALL	XHSNDL		;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.

16$:	CMP	TCHPS(R5),TCRSZ(R5) ;no, at end of card?
	BEQ	13$		;yes, we are all done.
	MOV	#' ,R1		;space
	CALL	XLHSCD		;output it
	BIT	#7,TCHPS(R5)	;are we at a mult. of 8 ?
	BEQ	13$		;yes, give success return.
	BR	16$		;no, give another space.
	.SBTTL		HSCMPS - HASP data compression

; this subroutine does compression of data to be sent to 
; hasp-multileaving site. two or more identical characters 
; (blank or non-blank) will be compressed. in case the 
; compressed data length exceeds more than 4 characters 
; of the original length of data, data is repacked 
; as a string data with non-duplicate characters.
; the subroutine picks up data from line buffer of the 
; device and after compressing it, puts it in a 
; buffer which is copied in to message later.

HSCMPS:	CLR	TCCSCB(R5)	;initialize scb
	MOV	TCSBF(R5),R0	;compress buffer exist?
	BNE	10$		;yes.
	CALL	GETSTG		;get storage
	BCS	11$		;things are truly desperate

10$:	MOV	R0,TCPRCB(R5)	;save ptr to rcb
	MOV	R0,R4		;initialize buffer ptr
	MOV	R0,TCSBF(R5)	;save ptr to start of buffer
	ADD	#CHSIZE-1,R0	;point to end of compress buffer
	MOV	R0,TCEBF(R5)	;save ptr to end of buffer
	MOV	TCBFP(R5),R3	;point to start of line buffer
	CMP	#RCBCTL,TCCTP(R5) ;is it signon?
	BNE	31$		;no, treat as normal record
	CALL	XLHSON		;make a signon message
11$:	RETURN

31$:	BIT	#TCCPS,TCFG1(R5) ;records need be compressed?
	BEQ	HSCMPO		;no, compression off
	MOVB	(R3)+,(R4)+	;yes, put rcb in buffer
	MOVB	(R3)+,(R4)+	;put srcb in buffer
	CMP	R3,TCELB(R5)	;end of line buffer?
	BEQ	32$		;yes. must be space a line
	MOVB	(R3)+,R1	;get first data character
	BR	13$		;initialize as non-duplicate string

32$:	CMPB	#RCBPR1,TCCTP(R5) ;allow this for lpt only
	BNE	34$		;not for card or console data
	MOV	#201,R2		;send single space
	MOV	R4,TCPSCB(R5)	;save pointer to scb
	INC	R4		;make room for scb too
	BR	HSCMP1		;done processing line buffer
34$:	CLR	R3		;to indicate empty buffer
	BR	HSCMP2		;exit

; real compression starts here
; r1=character from line buffer
; r2=count of characters in the scb
; r3=points in the line buffer (to pick up next char from)
; r4=points in the buffer (where next character is stored)

12$:	MOVB	TCCSCB(R5),@TCPSCB(R5) ;move in max scb
13$:	MOV	R4,TCPSCB(R5)	;point to new scb
	INC	R4		;make room for it
	CMP	R4,TCEBF(R5)	;buffer full?
	BEQ	16$		;yes.
	MOV	#377,TCCSCB(R5)	;set up non-duplicate scb
	MOV	#-76,R2		;set new scb count for one char
	BR	15$		;move in the character

14$:	CMP	R3,TCELB(R5)	;done with line buffer?
	BEQ	23$		;yes.
	MOVB	(R3)+,R1	;pick up next character
	CMP	R0,R1		;is it a duplicate character?
	BEQ	17$		;yes, process dup char
	INC	R2		;count char in scb
	BGT	12$		;scb got full

15$:	MOV	R1,R0		;make it prev char for next time
	MOVB	R0,(R4)+	;move char into buffer
	CMP	R4,TCEBF(R5)	;is buffer full
	BNE	14$		;no, then carry on
16$:	BR	HSCMPO		;compress original string

; here to process duplicate string

17$:	DEC	R2		;remove first dup char from count
	ADD	TCCSCB(R5),R2	;form the scb
	BIT	#77,R2		;was there only one in string?
	BEQ	22$		;yes.
	MOVB	R2,@TCPSCB(R5)	;put in old scb
	DEC	R4		;back past first dup
18$:	MOV	R4,TCPSCB(R5)	;point to the scb
	INC	R4		;point past it, there is room
	MOV	#-35,R2		;set scb count (there are already two)
	CMP	R0,#100		;is it blank char?
	BNE	21$		;no.
	MOV	#237,TCCSCB(R5)	;yes, set up blank scb
19$:	CMP	R3,TCELB(R5)	;done with line buffer?
	BEQ	23$		;yes.
	MOVB	(R3)+,R1	;pick up next character
	CMP	R0,R1		;still duplicate?
	BNE	20$		;no.
	INC	R2		;count dup chars
	BLE	19$		;carry on if less than 31 dup chars
	BR	12$		;end scb if too many

; here when a non-duplicate character is encountered.

20$:	ADD	TCCSCB(R5),R2	;form scb
	MOVB	R2,@TCPSCB(R5)	;put it in buffer
	BR	13$		;start non-dup string

; here to set up non-blank duplicate string

21$:	MOVB	R0,(R4)+	;move in the char
	CMP	R4,TCEBF(R5)	;buffer full?
	BEQ	16$		;yes.
	MOV	#277,TCCSCB(R5)	;set up current scb
	BR	19$		;go process string

; here if non-duplicate string had one character

22$:	MOV	TCPSCB(R5),R4	;point back to scb
	BR	18$		;carry on building new scb

; here when we have finished processing a line buffer

23$:	ADD	TCCSCB(R5),R2	;calculate last scb

HSCMP1:	MOVB	R2,@TCPSCB(R5)	;put it in buffer
	CLRB	(R4)+		;set eor with scb of zero
	MOV	R4,TCEBF(R5)	;save end buf ptr
HSCMP2:	CLC			;indicate success
	RETURN

; here when the buffer got full, means compression has 
; expanded the strings. use orignal string as is with 
; appropriate scb's every 63 characters.

HSCMPO:
	MOV	TCBFP(R5),R3	;point to start of l.b.
	MOV	TCSBF(R5),R4	;point to start of buffer
	MOVB	(R3)+,(R4)+	;movbe in rcb
	MOVB	(R3)+,(R4)+	;movbe in srcb
10$:	CLR	R2		;initialize the scb count
	MOV	R4,TCPSCB(R5)	;save pointer to scb
	MOV	#300,TCCSCB(R5) ;initialize scb for non-dup char
	INC	R4		;make room for scb
	CMP	R4,TCEBF(R5)	;buffer overflowed?
	BEQ	12$		;yes, give error return
11$:	CMP	R3,TCELB(R5)	;done with line buffer?
	BEQ	13$		;yes.
	MOVB	(R3)+,(R4)+	;move character into buffer
	INC	R2		;count bytes in scb
	CMP	R4,TCEBF(R5)	;overflowed buffer?
	BEQ	12$		;yes.
	CMP	R2,#77		;scb full?
	BEQ	14$		;yes.
	BR	11$		;no, keep going

12$:	SEC			;indicate failure
	RETURN

13$:	ADD	TCCSCB(R5),R2	;add count to form complete scb
	MOVB	R2,@TCPSCB(R5)	;fill the scb
	CLRB	(R4)+		;set e-o-r, scb of 00
	MOV	R4,TCEBF(R5)	;save end of buffer data pointer
	CLC			;indicate success
	RETURN

14$:	ADD	TCCSCB(R5),R2	;form the scb
	MOVB	R2,@TCPSCB(R5)	;and fill in the scb
	BR	10$		;join the main loop
	.SBTTL		XLHSON - create signon message

; this subroutine makes a message for signon when copmpression 
; is noticed off. signon message text is exactly 80 characters 
; long and is trail-filled with blanks if necessary.
; on entry r3 = pointer to line buffer (where data is)
;	   r4 = pointer to compressed buffer (where data is put)

; on return r4 and tcebf(r5) point to end of comressed buffer

XLHSON:	CLR	R2		;initialize character count
	MOVB	#RCBCTL,(R4)+	;put control rcb for control record
	MOVB	#RCBSON,(R4)+	;put srcb for signon record
	MOV	(R3)+,R1	;skip over the rcb and srcb in l.b.
11$:	MOVB	(R3)+,R1	;get next character
12$:	MOVB	R1,(R4)+	;put it in buffer
	INC	R2		;count characters
	CMP	R2,#80.		;signon is explicitly 80. characters
	BGE	13$
	CMP	R3,TCELB(R5)	;done with line buffer?
	BNE	11$		;no, keep going
	MOV	#EBCBLK,R1	;yes, fill rest with blanks 
	BR	12$		;till count of 80 chars

13$:	MOV	R4,TCEBF(R5)	;save end of compressed buff ptr
	TRACE	TRCXLD,R5	;indicate it happened
	CLC
	RETURN
	.SBTTL		XHSNDL - send the 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 rcb and the srcb (#200 for no space)
;	otherwise (card output) the line buffer is empty.
;	tclbk is clear.

XHSNDL:	MOV	R1,-(SP)	;save current character
	MOV	R0,TCELB(R5)	;save end of line buffer
	CALL	HSCMPS		;compress the line buffer
	BCC	10$
				;errror in compression
5$:	RETURN

10$:	TST	R3		;empty buffer
	BEQ	18$		;yes
12$:	MOV	TCMSG(R5),R0	;point to partial message
	BNE	14$		;there is one.
13$:	CALL	XHMSTP		;none, set up a message
	BCS	5$		;things are truly desperate
	MOV	R0,TCMSG(R5)	;we now have a message
	BR	15$		;put this line in it

; here when there is already a partially filled message

14$:	MOV	TCSBF(R5),R3	;point to start of buffer
	SUB	TCEBF(R5),R3	;compute length of buffer
	NEG	R3		;true count
	CALL	XHSNDM		;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.

15$:	MOV	TCSBF(R5),R3	;point to the start of buffer
	MOV	TCEBF(R5),R2	;point to end of compressed buffer

; this is the loop which copies characters from the compressed buffer
;  into the device message.

16$:	CMP	R2,R3		;all done?
	BEQ	17$		;yes.
	MOVB	(R3)+,R1	;get next char from buffer
	CALL	MSGAPC		;append to message
	BR	16$		;process all chars

; here when all done.

17$:	INC	MSGNLR(R0)	;count logical records in message

; processing of the line buffer is now complete.

18$:	BIC	#TCLBK,TCST2(R5) ;line is no longer broken
	MOV	TCBFP(R5),R0	;point r0 to line buffer
	CLR	R2		;clear line buffer counter
	MOV	TCCTP(R5),R1	;get the rcb from component type
	CMP	#RCBCTL,R1	;is it signon?
	BNE	22$		;no, send eof for rcb device
	MOV	TCDEV(R5),R1	;get the device #
	BIS	#220,R1		;make it rcb
22$:	CALL	XLAPBF	
	MOVB	#200,R1		;second character is srcb
	CALL	XLAPBF	
	MOV	(SP)+,R1	;restore character
	RETURN
	.SBTTL		XHSNDM - send message if current record won't fir

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

XHSNDM:	MOV	TCLCB(R5),R1	;point to lcb
	CMP	MSGNLR(R0),LB.MLR(R1) ;reached record limit?
	BEQ	11$		;yes.
	ADD	MSGLEN(R0),R3	;no, compute new length
	CMP	R3,#360.	;would result be too big?
				;368=400.-overhead for hasp message
	BLT	12$		;no, append it.
11$:	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
	CMPB	MSGID(R0),#RCBCTL ;was the queued message signon?
	BEQ	23$		;yes, dont count as device message
	INC	TCMSC(R5)	;count messages sent for this device
12$:	CLC			;success
	RETURN

23$:	MOV	TCDEV(R5),R1	;get dev #
	ADD	#220,R1		;make rcb
	MOV	R1,TCCTP(R5)	;fix the rcb
	RETURN
	.SBTTL		XLHDMP - 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.

XLHDMP:	CALL	XHSNDL		;send the current line

XLHDM0:	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...
	CALL	XHSNDM		; and send it.
11$:	BIS	#TCOTC,TCFG1(R5) ;output complete for this device
	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
	.SBTTL		XHMSTP - set up a HASP message

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

XHMSTP:	CALL	CREATM		;get a message header(waiting variety)
	BCC	10$
	RETURN			;things are rather desperate

10$:	MOV	TCLCB(R5),R1	;point to lcb
	MOVB	LB.LNU(R1),MSGID+1(R0) ;set line # in left byte of i.d.
	MOVB	TCCTP(R5),MSGID(R0) ;rcb in right byte

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

	JMP	XLPREL		;use common code in 2780 msg allocator
	.SBTTL		XLHEOF - HASP output end of file processing

; subroutine to send an end-of-file indication to the output.

XLHEOF:	BIT	#TCPRO,TCFG1(R5) ;printer style output?
	BEQ	11$		;no, lose any unterminated line
	CALL	XHSNDL		;compress and send line to buffer

11$:	MOV	TCMSG(R5),R0	;point to current message
	BNE	12$		;there is one.
	CALL	XHMSTP		;none, build one.
	BCC	10$
	RETURN			;desperation mode

10$:	MOV	R0,TCMSG(R5)	;we now have a message
12$:	MOV	TCCTP(R5),R1	;get the rcb
	BNE	14$

	STOPCD	XMB		;trouble

14$:	CMP	#RCBCTL,R1	;is it signon?
	BEQ	16$		;yes, dont send eof
	CMP	#221, R1	; is it console output ? 3(005)
	BEQ	16$		; yes, do not send eof 3(005)
	CMP	#222, R1	; is it console input ? 3(005)
	BEQ	16$		; yes, do not send eof 3(005)
15$:	CALL	MSGAPC		;append to message
	MOV	#200,R1		;srcb for no-space
	CALL	MSGAPC		;append to message
	CLR	R1		;scb of zero, means zero length record
	CALL	MSGAPC		;append scb to message
	INC	TCCEOF(R5)	;count eof's sent
16$:	JMP	XLHDM0		; exit with dump output buffers
	.SBTTL		XHIMSG - translate a HASP input message

; subroutine to translate an input message.  the ascii is sent
;  to the dte20/dl10 task for the user's buffer.

XHIMSG:	MOV	R0,-(SP)	;save pointer to message
	TST	MSGLEN(R0)	;check for null message
	BNE	XLHMSR
	JMP	XLHINL		;ignore null messages

XLHMSR:	CALL	CREATM		;get a message header(waiting variety)
	BCC	11$
	JMP	XLHINL		;all is coming apart

; we have the header chunk for the ascii message

11$:	MOV	(SP),R2		;point to ebcdic message
	MOV	MSGID(R2),MSGID(R0) ;store message i.d. for dte task

12$:	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
13$:	MOV	(R2),TCXPCH(R5) ;save pointer to next data chunk
	MOV	CHLEN(R2),R3	;get count of bytes in this chunk
	MOV	MSGPTR(R2),R2	;get initial ptr
	CMPB	#RCBCTL,MSGID(R0) ;is it signon?
	BNE	14$		;no.
	JMP	XLDSON		;take care of signon message
14$:	CALL	XHGTC		;get rcb for the record
	BCS	15$		;done with message
	CALL	XHGTC		;get srcb
	BCS	15$		;done with message
	MOVB	R1,TCCCI(R5)	;save srcb for carriage control
	CALL	XHGTC		;get scb for the string
	BCS	15$		;done with chunk
	TST	R1		;check the character for eof
	BNE	32$		;decompress the record
	BIS	#TCIEF,TCFG2(R5) ;input eof received.
	BR	14$		;get next character (rcb) if any

15$:	JMP	XHIMSE

; the decompression of a record starts here
; r1 must have the scb for the string

31$:	CALL	XHGTC		;get scb for the string
	BCS	XHIMSE		;done with chunk
32$:	MOV	R1,R4		;scb in r4 for count
	BEQ	36$		;process eor and get next rcb

	CMPB	#100, R1	;is this a transmission abort scb ?
	BEQ	45$		;yes, treat as end of file
	TSTB	R1		;no, check for legal scb

	BPL	37$		;error if high bit not set
	BIT	#100,R1		;dup string?
	BEQ	38$		;yes, process dup string
	BIC	#177700,R4	;get count of chars in string
	BEQ	37$		;cant be zero
33$:	CALL	XHGTC		;get character from message
	BCS	XHIMSE		;done with chunk
	CALL	XLDPCM		;translate and deposit char in msg
	SOB	R4,33$		;loop till done with string
	BR	31$		;get next scb

36$:	CALL	XLHEOR		;process eor
	BR	14$		;get next rcb

37$:	STOPCD	HSF		;format error

; here for duplicate characters

38$:	BIT	#40,R4		;blank string?
	BNE	41$		;no.
	MOV	#40,R1		;yes, put blanks
39$:	BIC	#177740,R4	;get dup char count
	BEQ	37$		;format error
	TST	R1		;toss out nulls
	BEQ	31$		;but count as dup char
40$:	SAVE	R2
	MOV	R4,R2
	CALL	MSGAPN		;stuff the block
	RESTOR	R2
	ADD	R4,TCHPS(R5)	;count in horz pos
	BR	31$		;get next string's scb

41$:	CALL	XHGTC		;get the character
	BCS	37$		;must never finish in middle
	MOVB	EBCASC(R1),R1	;translate the char
	BR	39$		;join the loop

45$:	BIS	#TCIEF, TCFG2(R5) ;set end of file
	BR	31$		;next scb = 0


	.SBTTL		XLHEOR - process input end of record
; here on eor

XLHEOR:	CMPB	#4,TCDEV(R5)	;device lpt?
	BNE	14$		;no, treat as card device
	CALL	XHIPRS		;yes, process eor for lpt
	RETURN

11$:	CMP	TCHPS(R5),TCRSZ(R5) ;check for full record
	BGE	15$		;yes - end it all
	SAVE	R2		;no - pad to record size
	MOV	#40,R1
	MOV	TCRSZ(R5),R2
	SUB	TCHPS(R5),R2	;number to pad
	ADD	R2,TCHPS(R5)	;for completeness
	CALL	MSGAPN		;stuff them all at once
	RESTOR	R2

15$:	MOV	#15,R1		;put cr and lf in message
	CALL	MSGAPC		;put in message
	MOV	#12,R1		;lf
	CALL	MSGAPC		;in message
	INC	TCVPS(R5)	;we have done a line
	CLR	TCHPS(R5)	;reset horzpos
	CLC			;success
13$:	RETURN

14$:	CMPB	#3,TCDEV(R5)	;don't pad console
	BLE	11$		;card device
	BR	15$		;console
	.SBTTL		XHIMSE - 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.

XHIMSE:				;R0/ptr to completed ascii message

;set the device active bit for hasp input

	SAVE	<R0,R1>
	MOVB	MSGID(R0),R1	;get RCB-device number
	MOVB	MSGID+1(R0),R0	;get line number
	CMPB	#360,R1		;is this a signon message ?
	BEQ	1$		;yes it is
	BIT	#7,R1		;is this a control message ?
	BEQ	3$		;yes, exit without setting device active bit
	BR	2$		;no, it is real data, set device active bit
1$:	MOV	#223,R1		;signon is cdr # 0
2$:	CALL	HSETAC		;set device active bit
3$:	RESTOR	<R1,R0>


	CMPB	#360, MSGID(R0)	;is this a signon ?
	BNE	4$		;no, continue
	MOVB	#223, MSGID(R0)	;yes, point the message to cdr0
4$:
	MOV	TCDLDR,R1	;point to tentsk
	CALL	QUEMSG		;send it the ascii msg

5$:				;discard old tcst2
				;discard old tchps
				;discard old tcvps
				;discard old tccci
	ADD	#4*2,SP

XLHINL:	MOV	(SP)+,R0	;get back ebcdic message
	CALL	FREMSG		;flush the garbage
	CLC			;signal all ok
	RETURN

XLDPCM:	MOVB	EBCASC(R1),R1	;translate character from ebcdic to ascii
	BEQ	11$		;ignore untranslatables
	INC	TCHPS(R5)	;add to hor pos
	CALL	MSGAPC		;put char in message
11$:	CLC			;success
12$:	RETURN
	.SBTTL		XHIPRS - translate input printer IRS

; subroutine to process an irs character in printer mode.
;  do the indicated carriage control.

XHIPRS:	MOVB	TCCCI(R5),R1	;get srcb char 
	MOVB	#201,TCCCI(R5)	;return to single space

;NOTE: the following only works because no data is sent with immediate mode vfu

	BIC	#40,R1		;equivalence immediate and delayed mode vfu

	CMPB	#200,R1		;overprint request?
	BEQ	14$		;yes.
	CMPB	#221,R1		;no, skip to top of form?
	BEQ	15$		;yes.
	CMPB	#201,R1		;no, single space?
	BEQ	13$		;yes.
	CMPB	#202,R1		;no, double space?
	BEQ	12$		;yes.
	CMPB	#203,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
	.SBTTL		XLDSON -  read a HASP signon message

; subroutine to direct signon message to card reader stream

XLDSON:	CLR	TCHPS(R5)	;clear the char count
	CALL	XHGTC		;ignore rcb
	CALL	XHGTC		;and srcb for signon
11$:	CALL	XHGTC		;get char from ebcdic message
	BCS	12$		;processing complete for message
	MOVB	EBCASC(R1),R1	;translate the character
	BEQ	11$		;ignore untranlatables
	CALL	MSGAPC		;append to message
	INC	TCHPS(R5)	;count chars received
	CMP	TCHPS(R5),TCRSZ(R5) ;reached 80 for signon
	BLT	11$		;loop for next char
				;yes, indicate eof

12$:	CALL	XLHEOR		;send eor (cr/lf)
	BIS	#TCIEF,TCFG2(R5) ;indicate eof for signon card
	TRACE	TRCXLD,<R5,R0>	;trace task and signon message
	JMP	XHIMSE		;end of message

; this subroutine gets a character from ebcdic message
; sets c when message is all done , pointer to next data
; chunk is set in tcxpch in xlate tcb.

XHGTC:
11$:	TST	R3		;done with current chunk
	BEQ	12$		;yes, set up new one
	DEC	R3		;count down char count
	MOVB	(R2)+,R1	;get character
	CLC			;indicate success
	RETURN
12$:	MOV	TCXPCH(R5),R2	;get pointer to data chunk
	BEQ	13$		;all done with message
	MOV	(R2)+,TCXPCH(R5) ;save pointer to next data chunk
	MOV	(R2)+,R3	;r3 has count of chars in chunk
	BR	11$		;now get char from new chunk
13$:	SEC			;indicate all done with message
	RETURN