Google
 

Trailing-Edge - PDP-10 Archives - BB-J845A-SM - source/xlhasp.p11
There are 4 other files named xlhasp.p11 in the archive. Click here to see a list.
.SBTTL	XLHASP
;
; THIS SECTION CONTAINS THE TRANSLATE TASK, THE IDLE TASK
;  AND THE TABLES USED BY THE TRANSLATE (XLATE) TASK
;  TO CONVERT BETWEEN ASCII AND EBCDIC, AND TO SIMULATE
;  A PRINTER CARRIAGE CONTROL TAPE.
; ALSO CONTAINS COMPRESSION AND DECOMPRESSION TASKS FOR 
; HASP-MULTILEAVING. 
;
.REPT 0


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

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

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

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

.ENDR
;
; 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 CHARACTERS ON INPUT(TO TEN)...XLHEOR
;
;
VHASP=012
;
;
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) ;;++BS-SIMULATION MODE
	BEQ	10$		;;++BS-NO, BID ONLY WHEN 10 REQUESTS

	BIS	#TCOPR,TCFG2(R0) ;ASK FOR A BID FOR THE LINE

10$:

	MOV	#^D20*JIFSEC,TCTIM(R5) ;20 SECS MAX FOR BID
11$:	MOV	#EBINTR!EBTIME!EBWAIT,(R5) ;WAIT FOR IT
	JSR	PC,WAIT
	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.TC1(R4),R0	;POINT TO BSC TASK
	BIT	#TCOPG,TCFG2(R0) ;BIDDING COMPLETE?
	BNE	12$		;YES.
	TST	TCTIM(R5)	;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
	JSR	PC,XHDINP	;PROCESS INPUT
	BR	XLHASP		;AND RECIRCULATE
;
13$:	JSR	PC,XHDOUT	;PROCESS FOR OUTPUT
	BR	XLHASP		;AND RECIRCULATE
;
;
; THIS SUBROUTINE PROCESSES OUTPUT TO BE SENT TO BSC TASK
;
XHDOUT:	BIT	#TCOAB,TCFG2(R5) ;OUTPUT ABORTED FOR DEVICE?
	BEQ	11$		;NO.
	JSR	PC,XHDOAB	;PROCESS DEVICE ABORT
	RTS	PC		;EXIT
;
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?
	bne	14$		;yes
12$:	MOV	#EBINTR!ebqchk!ebqmsg!EBTIME!EBWAIT,(R5) ;DO SOME WAITING
	MOV	#JIFSEC,TCTIM(R5) ;FOR 1 SECOND
	JSR	PC,WAIT		;WAIT
	RTS	PC		;RETURN
;
;
;
; HERE WHEN DEVICE PERMISSION IS GRANTED AND BIDDING COMPLETE

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

14$:
	JSR	PC, HSSAVR	;SAVE THE REGISTERS
	MOV	TCLCB(R5), R2	;POINT TO LCB
	MOV	LB.LNU(R2), R0	;GET LINE NUMBER
	BIC	#177770, R0	;CLEAR JUNK
	MOV	TCCTP(R5), R1	;GET DEVICE NUMBER
	BIC	#177400, R1	; CLEAR JUNK
	JSR	PC, HSACMP	;SET THE DEVICE ACTIVE BIT
	JSR	PC, HSRESR	;RESTORE THE REGISTERS

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

;
	bis	#tcorn,tcfg2(r5) ;output running
	BIC	#TCDSP,TCFG2(R5) ;UNSUSPEND OUTPUT FOR DEVICE
	MOV	TCLCB(R5),R0	;POINT TO LCB
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
	JSR	PC,XLAPBF	;PUT RCB IN BUFFER
	MOVB	#200,R1		;"CCW" FOR NO SPACING
	JSR	PC,XLAPBF	;PUT THE SRCB IN LINE BUFFER
;
; CONTINUED ON NEXT PAGE
;
;
; 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$:	MOV	#EBQCHK!EBINTR!EBTIME!EBWAIT,(R5) ;SET UP FOR WAIT
	MOV	#JIFSEC-11,TCTIM(R5)
	BIT	#TCOAB,TCFG2(R5) ;IS THE STREAM ABORTED?
	BNE	22$		;YES, EMPTY THE QUEUES.
	JSR	PC,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
	JSR	PC,XLHDMP	;EMPTY OUR BUFFERS
	BCS	23$		;STREAM ABORTED
	RTS	PC		;RETURN TO RECIRCULATE
;
13$:	MOV	TCLCB(R5),R4	;POINT TO LCB
.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$:	JSR	PC,WAIT		;WAIT FOR A CHUNK
	BR	12$		; AND TEST AGAIN.
;
; HERE WHEN THERE IS A CHUNK AVAILABLE
;
16$:	MOV	R0,R3		;POINT R3 TO NEW CHUNK
	MOV	(SP)+,R2	;RESTORE R2
	MOV	(SP)+,R0	;RESTORE R0
	JSR	PC,XLHCNK	;TRANSLATE A CHUNK FROM ASCII TO EBCDIC
	BR	11$		;TRY TO TRANSLATE ANOTHER CHUNK
;
;
; HERE ON END OF FILE.
;
17$:	MOV	(SP)+,R2	;RESTORE R2
	MOV	(SP)+,R0	;RESTORE R0
18$:	JSR	PC,XLHEOF	;SIGNAL END OF FILE TO THE PRINTER
	BCC	19$		;WIN.
	MOV	R0,-(SP)	;OUT OF CHUNKS, SAVE R0
	MOV	#EBTIME!EBWAIT,(R5) ;WAIT A WHILE
	MOV	#JIFSEC+11,TCTIM(R5)
	JSR	PC,WAIT
	MOV	(SP)+,R0	;RESTORE R0
	BR	18$		;TRY AGAIN.
;
19$:	MOV	#EBTIME!EBINTR!EBWAIT,(R5)
	MOV	#JIFSEC+12,TCTIM(R5)
	JSR	PC,WAIT		;WAIT FOR TIME OR DQ11 SIGNAL
	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$:	JSR	PC,XLAWDL	;AWAKEN THE DL10 TASK
	MOV	#EBTIME!EBINTR!EBWAIT,(R5)
	MOV	#JIFSEC+13,TCTIM(R5) ;WAIT FOR COMPLETE ACK
	BIT	#TCOAB,TCFG2(R5) ;HAS THE STREAM ABORTED?
	BNE	23$		;YES, (MAY BE TOO LATE, BUT TRY.)
	BIT	#TCOEC,TCFG2(R5) ;OUTPUT EOF ACKNOWLEDGED?
	BEQ	21$		;YES, ALL DONE.
	JSR	PC,WAIT		;NO, WAIT FOR IT
	BR	20$		;SEE IF ACKNOWLDEGED YET
21$:	BIC	#TCOEF,TCFG2(R5) ;CLEAR EOF SIGNAL

;;++BS-CODE TO CLEAR THE DEVICE ACTIVE BIT WHEN EOT IS TRANSMITTED

	JSR	PC, HSSAVR	;SAVE THE REGISTERS
	MOV	TCLCB(R5), R2	;POINT TO LCB
	MOV	LB.LNU(R2), R0	;GET LINE NUMBER
	BIC	#177770, R0	;CLEAR JUNK
	MOV	TCCTP(R5), R1	;GET DEVICE NUMBER
	BIC	#177400, R1	; CLEAR JUNK
	JSR	PC, HSAMPC	;CLEAR THE DEVICE ACTIVE BIT
	JSR	PC, HSRESR	;RESTORE THE REGISTERS

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

	MOV	TCSBF(R5),R0	;ANY COMPRESSED BUFFER TO RELEASE?
	BEQ	24$		;NO.
	CLR	TCSBF(R5)	;CLEAR POINTER TO COMPRESS BUFFER
	JSR	PC,FRESTG	;FREE THE BUFFER
24$:	RTS	PC		;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$:	JSR	PC,XHDOAB	;DO THE ABORT PROCESSING
	BR	21$		;RESET FLAGS AND RELEASE BUFFER
;
;
; 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
;
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
	TRACE	TRCXLD,R1	;TRACE XLATE CHAR PROCESSING
	MOV	R3,-(SP)	;SAVE CHUNK POINTER
	MOV	R4,-(SP)	;SAVE DATA POINTER
13$:	BIT	#TCPRO,TCFG1(R5) ;PRINTER-STYLE OUTPUT?
	BNE	14$		;YES.
	JSR	PC,XLHSCD	;NO, CARD STYLE OUTPUT
	BR	15$
;
14$:	JSR	PC,XLHSPR	;SEND CHARACTER TO PRINTER
15$:	BCC	16$		;WIN, DO NEXT CHAR.
	MOV	R0,-(SP)	;LOSE, SAVE R0
	MOV	R2,-(SP)	;SAVE R2
	MOV	#EBTIME!EBWAIT,(R5) ;WAIT A WHILE
	MOV	#<JIFSEC/2>-3,TCTIM(R5) ; (A VERY SHORT WHILE)
	JSR	PC,WAIT
	MOV	(SP)+,R2	;RESTORE R2
	MOV	(SP)+,R0	;RESTORE R0
	BIT	#TCOAB,TCFG2(R5) ;IS THE STREAM ABORTED?
	BNE	17$		;YES, QUIT.
	MOV	(SP),R4		;GET BACK R4
	MOVB	-1(R4),R1	;GET BACK CHARACTER
	BR	13$		;TRY AGAIN FOR CHAR
;
;
; HERE IF WE SUCCESSFULLY SENT THE CHARACTER
;
16$:	MOV	(SP)+,R4	;RESTORE R4
	MOV	(SP)+,R3	;RESTORE R3
	BR	12$		;GO GET NEXT CHARACTER
;
; HERE WHEN AN ABORT IS DETECTED WHILE WAITING FOR MESSAGE
;  SPACE TO FREE UP.
;
17$:	MOV	(SP)+,R4	;RESTORE R4
	MOV	(SP)+,R3	;RESTORE R3
;
; HERE WHEN THE CHUNK IS DEPLETED OR THE STREAM ABORTED.
;

;;++BS-CODE TO SET OR CLEAR THE DEVICE ACTIVE BIT FOR HASP OUTPUT

18$:
	JSR	PC, HSSAVR	;SAVE THE REGISTERS
	MOV	TCLCB(R5), R2	;POINT TO LCB
	MOV	LB.LNU(R2), R0	;GET LINE NUMBER
	BIC	#177770, R0	;CLEAR JUNK
	MOV	TCCTP(R5), R1	;GET DEVICE NUMBER
	BIC	#177400, R1	;CLEAR JUNK
	TST	TCCHK1(R5)	;ANY CHUNKS QUEUED TO THIS TASK ?
	BEQ	21$		;NO, SET THE DEVICE ACTIVE BIT
25$:	JSR	PC, HSAMPC	;YES, CLEAR DEV ACTIVE BIT, BUFFERS FULL
	BR	22$		;CONTINUE
21$:	CMP	TCMSC(R5), #MSGXML ;HOW MANY MESSAGES QUEUED TO THIS DEVICE ?
	BGT	25$		;MORE THAN MAXIMUM, CLEAR DEVICE ACTIVE BIT
	JSR	PC, HSACMP	;SET DEV ACTIVE BIT, BUFFERS EMPTY
22$:	JSR	PC, HSRESR	;RESTORE THE REGISTERS

;;++BS-END OF CODE TO SET OR CLEAR THE DEVICE ACTIVE BITS FOR HASP OUTPUT

	MOV	R0,(SP)		;SAVE BUFFER POINTER (DONE WITH COUNT)
	MOV	TCIDLE,R1	;POINT TO IDLE TASK
	MOV	R3,R0		;PUT CHUNK POINTER IN R0
	JSR	PC,QUECHK	;SEND IT THE CHUNK TO FREE
	MOV	(SP)+,R0	;RESTORE R0
	RTS	PC		;RETURN.
;
;
; THIS SUBROUTINE PROCESSES INPUT DATA RECEIVED FROM BSC TASK
;
XHDINP:	BIT	#TCIAB,TCFG2(R5) ;DEVICE INPUT ABORT?
	BEQ	12$		;NO.
	JSR	PC,XHDIAB	;FREE ALL QUEUED MESSAGES
11$:	MOV	#EBINTR!EBTIME!EBWAIT,(R5) ;WAIT FOR A WHILE
	MOV	#JIFSEC,TCTIM(R5) ;ONE SECOND
	JSR	PC,WAIT		;WAIT TO GIVE BSC TASK A CHANCE
	RTS	PC		;RECIRCULATE
;
12$:	BIT	#TCirn,TCFG2(R5) ;INPUT running?
	BNE	15$		;YES
	bit	#tcipr,tcfg2(r5) ;input requested?
	BEQ	11$		;NO, LOOP
14$:	JSR	PC,XLAWDL	;AWAKEN DL10 DRIVER
	MOV	#EBINTR!ebqchk!ebqmsg!EBTIME!EBWAIT,(R5)
	MOV	#2*JIFSEC,TCTIM(R5) ;WAIT 2 SECONDS
	JSR	PC,WAIT
	BIT	#TCIPG,TCFG2(R5) ;YES, DID PDP-10 GRANT THE INPUT REQUEST?
	BEQ	14$		;NO, GIVE HIM A WHILE
	BIS	#TCIRN,TCFG2(R5) ;WE ARE NOW RUNNING
15$:	BIC	#TCIPR!TCIPG,TCFG2(R5) ;CLEAR ALL INPUT REQ FLAGS
	MOV	#EBINTR!EBTIME!EBWAIT,(R5)
	MOV	#JIFSEC+7,TCTIM(R5) ;WAIT A WHILE
	JSR	PC,WAIT		;FOR DATA TO ARRIVE
; 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$:	MOV	#EBQMSG!EBTIME!EBINTR!EBWAIT,(R5)
	MOV	#JIFSEC+3,TCTIM(R5) ;PREPARE TO WAIT
	JSR	PC,DEQMSG	;GET A MESSAGE FOR THIS DEVICE
	BCS	12$		;NONE.
20$:	JSR	PC,XHIMSG	;GOT ONE, PROCESS IT.
	JSR	PC, WAIT	;;++BS-DO ONLY ONE MESSAGE AT A TIME 3(006)
	BR	11$		; AND DO THE REST.


;
; HERE IF NO MESSAGE TO PROCESS.
;
12$:	BIT	#TCIAB,TCFG2(R5) ;HAS STREAM BEEN ABORTED?
	BEQ	13$		;NO.
	JSR	PC,XHDIAB	;YES, DO ABORT PROCESSING
	RTS	PC		;RETURN
;
13$:	JSR	PC,XLAWDL		;WAKE UP DTE TASK
	JSR	PC,WAIT		;NO, WAIT FOR A MESSAGE
	BIT	#TCIEF,TCFG2(R5) ;REACHED EOF?
	BEQ	11$		;NO, WAIT
;
; HERE ON EOF.
;
14$:	BIS	#TCIEC,TCFG2(R5) ;TELL 10 REACHED EOF
	JSR	PC,XLAWDL	;WAKE UP THE DL10 TASK
15$:	MOV	#EBQMSG!EBTIME!EBINTR!EBWAIT,(R5)
	MOV	#JIFSEC+5,TCTIM(R5)
	JSR	PC,WAIT		;WAIT FOR DL10 TASK
	BIT	#TCIEC,TCFG2(R5) ;EOF ACKNOWLEDGED YET?
	BNE	15$		;NO, KEEP WAITING
	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

;;++KR-3(010) CODE TO CHECK IF ANOTHE INPUT PERMISSION  REQUEST IS PENDING

	BIT	#TCIRH,TCFG1(R5);did we stack a permission request?
	BEQ	5$		;no, just exit
	BIS	#TCIPH,TCFG1(R5);yes, set appropriate
	BIS	#TCIWR!TCIPR,TCFG2(R5); bits
	BIC	#TCIRH,TCFG1(R5);CLEAR IT
	JSR	PC,HSSAVR	;save registers
	MOV	TCLCB(R5),R2	;get LCB address
	MOV	LB.LNU(R2),R0	;get line number
	BIC	#177770,R0	;only allow 8 lines
	MOV	TCCTP(R5),R1	;get device number
	BIC	#177400,R1	;clear possible propagated sign bit
	JSR	PC,HSACMP	;set the device active bit
	JSR	PC,HSRESR	;put back the registers
5$:

;;++KR- 3(010) END OF CODE TO CHECK PENDING INPUT PERMISSION REQUEST

	RTS	PC		;RETURN
;
;
; SUBROUTINE TO PROCESS A DEVICE INPUT ABORT.
; R5 = POINTS TO DEVICE'S XLATE TCB
;
XHDIAB:
	bis	#tciab,tcfg2(r5) ;make sure its aborted.
11$:	JSR	PC,DEQMSG	;ANY MESSAGES LEFT?
	BCS	12$		;NO, ABORT COMPLETE
	MOV	TCIDLE,R1	;YES, FREE THEM
	JSR	PC,QUEMSG
	BR	11$		;SEE IF THERE ARE ANY MORE
;
12$:	bis	#TCIAC,TCFG2(R5) ;abort complete for this device
	BIC	#TCIRN,TCFG2(R5) ;INDICATE NO LONGER RUNNING
	JSR	PC,XLAWDL	;AWAKEN THE DL10 TASK
	MOV	#EBQMSG!EBTIME!EBINTR!EBWAIT,(R5)
	MOV	#JIFSEC+6,TCTIM(R5)
	JSR	PC,WAIT		;WAIT FOR ACKNOWLDEGMENT

	JSR	PC, HTDIPF	;;++BS-CHECK FOR DISABLE IN PROGRESS
	BCS	13$		;;++BS-YES, FORGET ABOUT PDP-10


	BIT	#TCIAC,TCFG2(R5) ;IS IT ACKNOWLEDGED?
	BNE	11$		;NO, BE SURE THE QUEUE IS DRAINED
13$:	bic	#tciab!tciac,tcfg2(r5) ;clear abort bits
	CLR	TCIMC(R5)	;;++BS-CLEAR COUNT OF INPUT MESSAGES QUEUED
	BR	XHEICP		;CLEAR ALL INPUT INDICATORS
;
;
; 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.
	MOV	TCIDLE,R1	;YES, SEND MESSAGE TO IDLE TASK
	JSR	PC,QUEMSG	;  TO BE FREED.
	CLR	TCMSG(R5)	;WE NO LONGER HAVE A MESSAGE
11$:	MOV	#EBINTR!EBQCHK!EBTIME!EBWAIT,(R5)
	MOV	#JIFSEC+7,TCTIM(R5)
	JSR	PC,WAIT		;WAIT FOR A CHUNK OR SIGNAL
12$:	JSR	PC,DEQCHK	;IS THERE A CHUNK?
	BCS	13$		;NO.
	JSR	PC,FRECHK	;YES, FREE IT
	BR	12$		; AND GET THE REST.
;
13$:	bis	#tcoac,tcfg2(r5) ;abort completed by xlate
	BIC	#TCOPG!TCORN!TCOEF!TCOEC,TCFG2(R5) ;NO LONGER RUNNING
14$:	JSR	PC,XLAWDL	;TELL THE DL10 DRIVER
	MOV	#EBINTR!EBTIME!EBQCHK!EBWAIT,(R5)
	MOV	#JIFSEC+6,TCTIM(R5)
	JSR	PC,WAIT		;WAIT A MOMENT
15$:	JSR	PC,DEQCHK	;GET A CHUNK
	BCS	16$		;NONE LEFT.
	JSR	PC,FRECHK	;GOT ONE, FREE IT.
	BR	15$		;GET THE REST
;


16$:	JSR	PC, HTDIPF	;;++BS-CHECK FOR DISABLE IN PROGRESS
	BCS	17$		;;++BS-YES, FORGET ABOUT PDP-10


	bit	#tcoac,tcfg2(r5) ;abort acknowledged?
	bne	14$		;no
17$:	bic	#tcoab!tcoac,tcfg2(r5) ;yes, clear abort bits
	rts	pc		;return
;
;
; SUBROUTINE TO TRANSLATE A CHARACTER FROM ASCII TO 
;  LINE PRINTER EBCDIC.
;  HANDLES FORMAT EFFECTORS AND COMPRESSION.
;
;	R0 = POINTER TO THE CURRENT POSITION IN THE LINE BUFFER
;	R1 = THE CHARACTER TO BE TRANSLATED
;	R2 = THE NUMBER OF CHARACTERS ALREADY STORED IN THE LINE BUFFER
;	TCHPS(R5) = THE CURRENT HORIZONTAL LINE POSITION.
;	   (LEFT MARGIN = 0)
;	TCVPS(R5) = THE CURRENT VERTICAL PAGE POSITION.
;	   (TOP OF PAGE = 0)
;
; ON RETURN:
;
;	TCHPS(R5) AND TCVPS(R5) ARE UPDATED.
;	C IS SET IF WE RAN OUT OF CHUNKS, CLEAR IF NOT.
;
XLHDBG:	STOPCD	DBG		;FOR DEBUGGING
XLHSPR:	CMPB	R1,#' 		;COMPARE CHAR WITH BLANK
	BHIS	12$		;GRAPHIC, SPACE OR DEL OR GARBAGE.
	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		;;++BS- ALLOW A DELETE BUT NOTHING BIGGER
	BLOS	XLHDBG		;DONT SEND GARBAGE TO PRINTER
	BIT	#TCLBK,TCST2(R5) ;NO, IS PREVIOUS LINE BROKEN?
	BNE	15$		;YES, GRAPHIC OR SPACE AFTER LINE BREAK
	CMP	TCHPS(R5),#132.	;NO, BEYOND END OF LINE?
	BNE	13$		;NO.
	MOV	R1,-(SP)	;YES, SAVE CHARACTER
	MOV	#12,R1		;GIVE FREE LF (= CRLF)
	JSR	PC,XLHSPR	;THIS WILL BREAK THE LINE
	BCS	25$		;OUT OF BUFFER SPACE
	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
	JSR	PC,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$:	JSR	PC,XHSNDL	;SEND LINE
	BCS	25$		;OUT OF BUFFER SPACE
	BR	12$		;APPEND TO BUFFER
;
; HERE ON A FORM FEED OR A VERTICAL MOTION CHARACTER WHICH
;  HAS NO STOPS BELOW THE CURRENT VERTICAL POSITION.
;  GO TO THE TOP OF THE NEXT PAGE.
;
16$:	JSR	PC,XLHSTF	;TOP OF FORM
	BCS	25$		;OUT OF CHUNKS
	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$:	JSR	PC,XLHSSF	;SINGLE SPACE THE PRINTER
	BCS	25$		;OUT OF CHUNKS
	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
	JSR	PC,XLHSSF	;YES, GIVE SINGLE SPACE
	BCS	25$		;OUT OF CHUNKS
	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
	JSR	PC,XLHSPR	;OUTPUT IT
	BCS	25$		;CONTINUE LATER IF BUFFER FULL.
	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$:	RTS	PC		;RETURN.
;
;
; SUBROUTINE TO SKIP THE PRINTER TO THE TOP OF THE NEXT PAGE.
;
;  NOTE: CALLER SETS TCLBK ON RETURN TO FORCE THE BUFFER OUT
;   ON THE NEXT CHARACTER.  WE COULD CALL 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.
	JSR	PC,XHSNDL	;NO, FINISH OFF THAT LINE
	BCS	13$		;OUT OF CHUNKS, TRY AGAIN LATER.
;
; HERE AFTER MAKING SURE THE CURRENT LINE SPECIFIES NO SPACING.
;  CHANGE TO "TOP OF FORM".
;
11$:	MOV	TCBFP(R5),R3	;POINT TO LINE BUFFER
	MOVB	#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$:	RTS	PC		;RETURN.
;
;
; SUBROUTINE TO SPACE THE PRINTER VERTICALLY BY ONE.
;  ESCALATE CARRIAGE CONTROL FROM NO SPACING THROUGH
;  1, 2 AND 3 SPACES IF POSSIBLE BEFORE RELEASING THE LINE.
;
;  NOTE: CALLER TAKES RESPONSIBILITY FOR SETTING TCLBK ON RETURN.
;
;
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
	JSR	PC,XHSNDL	;NO, SEND THE LINE
	BCS	15$		;OUT OF CHUNKS
	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$:	RTS	PC		;RETURN.
;
;
; SUBROUTINE TO TRANSLATE A CHARACTER FROM ASCII TO CARD PUNCH
;  OR CARD READER EBCDIC.
;
;  R1 = CHARACTER TO BE TRANSLATED
;  TCHPS(R5) = CURRENT HORIZONTAL POSITION
;
; ON RETURN:
;
;	TCHPS(R5) IS UPDATED
;	C IS SET IF WE ARE OUT OF CHUNKS.  THE CHARACTER
;	  SHOULD BE RE-SENT.
;
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),#80.	;IS LINE FULL?
	BEQ	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
	JSR	PC,XLAPBF	;STORE IN LINE BUFFER
13$:	CLC			;INDICATE SUCCESS
14$:	RTS	PC		;RETURN.
;
;
; HERE ON LINE FEED.  THIS MARKS THE END OF THE CARD.
;
15$:	JSR	PC,XHSNDL	;SEND THE CARD, BLOCKING WITH
				; PREVIOUS IF POSSIBLE
	BCS	14$		;OUT OF CHUNKS, GIVE ERROR RETURN.
	CLR	TCHPS(R5)	;NOW BACK TO COL. ZERO
	BR	13$		;GIVE SUCCESS RETURN.
;
; HERE ON HORIZONTAL TAB.  CONVERT TO THE PROPER NUMBER OF
;  SPACES.
;
16$:	MOV	#' ,R1		;SPACE
	JSR	PC,XLHSCD	;OUTPUT IT
	BCS	14$		;OUT OF CHUNKS, RE-ISSUE THE TAB
	BIT	#7,TCHPS(R5)	;ARE WE AT A MULT. OF 8 ?
	BEQ	13$		;YES, GIVE SUCCESS RETURN.
	CMP	TCHPS(R5),#80. ;NO, AT END OF CARD?
	BEQ	13$		;YES, WE ARE ALL DONE.
	BR	16$		;NO, GIVE ANOTHER SPACE.
;
;
; 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.
	MOV	#160.,R0	;SIZE OF COMPRESSED DATA BUFFER
	JSR	PC,GETSTG	;GET STORAGE
	BCS	11$		;OUT OF STORAGE
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	#159.,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
	JSR	PC,XLHSON	;MAKE A SIGNON MESSAGE
11$:	RTS	PC		;AND 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
; CONTINUED ON NEXT PAGE
;
;
; 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
;
; CONTINUED ON NEXT PAGE
;
;
; 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
	RTS	PC		;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
	RTS	PC		;AND 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
	RTS	PC		;RETURN
;
14$:	ADD	TCCSCB(R5),R2	;FORM THE SCB
	MOVB	R2,@TCPSCB(R5)	;AND FILL IN THE SCB
	BR	10$		;JOIN THE MAIN LOOP
;
;
; THIS SUBROUTINE MAKES AMESSAGE 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.		;REACHED 80 ?
	BEQ	13$		;YES.
	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
	RTS	PC		;AND RETURN
;
;
; SUBROUTINE TO SEND THE LINE BUFFER TO THE BSC TASK.  BUILD
;  IT INTO A MESSAGE.
;
; R0 POINTS TO THE LAST USED POSITION OF THE BUFFER.
;
; ON RETURN:
;  C IS SET IF OUT OF CHUNKS.  OTHERWISE, C IS CLEAR AND:
;	THE LINE BUFFER (AND R0 AND R2, WHICH REFER TO IT)
;	CONTAINS 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
	JSR	PC,HSCMPS	;COMPRESS THE LINE BUFFER
	BCS	21$		;ERRROR IN COMPRESSION
	TST	R3		;EMPTY BUFFER
	BEQ	18$		;YES
12$:	MOV	TCMSG(R5),R0	;POINT TO PARTIAL MESSAGE
	BNE	14$		;THERE IS ONE.
13$:	JSR	PC,XHMSTP	;NONE, SET UP A MESSAGE
	BCS	20$		;OUT OF CHUNKS
	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
	JSR	PC,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
	JSR	PC,MSGAPC	;APPEND TO MESSAGE
	BCS	21$		;OUT OF CHUNKS
	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$:	JSR	PC,XLAPBF
	MOVB	#200,R1		;SECOND CHARACTER IS SRCB
	JSR	PC,XLAPBF
19$:	CLC			;SIGNAL ALL OK
20$:	MOV	(SP)+,R1	;RESTORE CHARACTER
	RTS	PC		;RETURN
;
; HERE IF CHUNKS ARE DEPLETED WHILE APPENDING TO
;  THE MESSAGE.  THIS SHOULD NOT HAPPEN SINCE THE CHUNKS ARE
;  PRE-ALLOCATED.
;
21$:	STOPCD	XMB		;XLATOR MESSAGE BUILDING PROBLEMS
;
;
; 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$:	

	.IF NE,DEBUG		;;++BS-3(007)

	TST	TCMSG(R5)	;;++BS-IS THERE A MESSAGE ? 3(007)
	BNE	30$		;;++BS-YES, ALL OK 3(007)
	TRAP			;;++BS-NO, FATAL ERROR WITH DEBUG 3(007)
30$:				;;++BS-3(007)

	.ENDC ;.IF NE,DEBUG	;;++BS-3(007)

	JSR	PC,MSGAPE	;RETURN UNUSED CHUNKS
	MOV	TCLCB(R5),R4	;POINT TO LCB
	MOV	LB.TC1(R4),R1	;POINT TO BSC DRIVER
	JSR	PC,QUEMSG	;SEND IT THE MESSAGE
	CLR	TCMSG(R5)	;WE NO LONGER HAVE A MESSAGE
	INC	LB.MSC(R4)	;ONE MORE MESSAGE FOR BSC TASK TO TRANSMIT
	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
13$:	MOV	#EBTIME!EBWAIT,(R5) ;WAIT A MOMENT
	MOV	#1,TCTIM(R5)	; TO AVOID EATING ALL THE CPU
	JSR	PC,WAIT
12$:	CLC			;SUCCESS
	RTS	PC		;RETURN.
;
23$:	MOV	TCDEV(R5),R1	;GET DEV #
	ADD	#220,R1		;MAKE RCB
	MOV	R1,TCCTP(R5)	;FIX THE RCB
	BR	13$		;BACK TO MAIN PATH
;
;
; 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:	JSR	PC,XHSNDL	;SEND THE CURRENT LINE
	MOV	R0,-(SP)	;SAVE LINE BUFFER POSITION
	MOV	R2,-(SP)	; AND COUNT
	MOV	TCMSG(R5),R0	;IS THERE A MESSAGE WAITING?
	BEQ	11$		;NO.
	MOV	TCLCB(R5),R1	;POINT TO LCB
	MOV	LB.MLR(R1),MSGNLR(R0) ;YES, PRETEND IT IS FULL...
	JSR	PC,XHSNDM	; AND SEND IT.
11$:	BIS	#TCOTC,TCFG1(R5) ;OUTPUT COMPLETE FOR THIS DEVICE
12$:	MOV	#EBTIME!EBINTR!EBWAIT,(R5)
	MOV	#7,TCTIM(R5)	;WAIT A SHORT WHILE
	JSR	PC,WAIT
	BIT	#TCOAB,TCFG2(R5) ;IS STREAM ABORTED?
	BNE	14$		;YES, RETURN IMMEDIATELY.
	BIT	#TCOTC,TCFG1(R5) ;OUTPUT DUMPED?
	BNE	12$		;NOT YET
13$:	BIC	#TCDMP,TCFG1(R5) ;YES, CLEAR "DUMPING" FLAG
	MOV	(SP)+,R2	;RESTORE LINE BUFFER COUNT
	MOV	(SP)+,R0	; AND POSITION
	CLC			;INDICATE NOT ABORT
	RTS	PC		;RETURN.
;
; HERE IF THE STREAM IS ABORTED.
;
14$:	MOV	(SP)+,R2	;RESTORE LINE BUFFER COUNT
	MOV	(SP)+,R0	; AND POSITION
	SEC			;FLAG STREAM ABORTED
	RTS	PC		;RETURN.
;
;
; SUBROUTINE TO SET UP A MESSAGE.  ALL THE LEADING BSC STUFF
;  IS PLACED IN THE DATA PORTION.
;
; ON RETURN, C IS SET IF WE ARE OUT OF CHUNKS.
;  OTHERWISE, R0 POINTS TO THE FIRST CHUNK OF THE MESSAGE.
;
XHMSTP:	MOV	CHLST,R0	;GET LAST CHUNK ON THE FREE LIST
	JSR	PC,GETCHK	;REMOVE IT FROM THE LIST
	BCS	19$		;OUT OF CHUNKS.
	MOV	R0,MSGLCH(R0)	;FIRST CHUNK IS LAST CHUNK
	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.
;
	MOV	R0,-(SP)	;SAVE POINTER TO MESSAGE
	MOV	#400.,R0	;THIS IS THE MAX MESSAGE LENGTH
	MOV	R0,-(SP)	;MAX MESSAGE LENGTH
14$:	CMP	CHFREC,#CHLXLT	;PLENTY OF CHUNKS LEFT?
	BLE	17$		;NO, SUSPEND TRANSLATION.
	MOV	CHLST,R0	;YES, GET A CHUNK
	JSR	PC,GETCHK
	BCS	17$		;OUT OF CHUNKS
	MOV	2(SP),R1	;POINT R1 AT MESSAGE
15$:	TST	(R1)		;IS THIS THE LAST CHUNK?
	BEQ	16$		;YES, APPEND NEW CHUNK HERE
	MOV	(R1),R1		;NO, GO ON TO NEXT CHUNK
	BR	15$		;
;
; CONTINUED ON NEXT PAGE
;
;
; HERE WHEN WE HAVE FOUND THE LAST CHUNK.  APPEND THE NEW
;  CHUNK HERE.
;
16$:	MOV	R0,(R1)		;APPEND NEW CHUNK
	SUB	#CHDATL,(SP)	;WE HAVE ROOM FOR THAT MANY MORE CHARS
	BGT	14$		;NEED MORE ROOM
	MOV	(SP)+,R0	;DISCARD DEPLETED COUNT
	MOV	(SP)+,R0	;RESTORE POINTER TO MESSAGE
	CLC			;SIGNAL OK
	RTS	PC		;RETURN.
;
; HERE IF WE RUN OUT OF CHUNKS WHILE DOING PRE-ALLOCATION.
;
17$:	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.
;
18$:	MOV	TCIDLE,R1	;POINT TO IDLE TASK
	JSR	PC,QUEMSG	;SEND IT THE MESSAGE TO FREE
	SEC			;SIGNAL ERROR
19$:	RTS	PC		;RETURN.
;
;
; 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
	JSR	PC,XHSNDL	;COMPRESS AND SEND LINE TO BUFFER
	BCS	13$		;OUT OF CHUNKS
11$:	MOV	TCMSG(R5),R0	;POINT TO CURRENT MESSAGE
;3(007)	CMPB	#RCBCTL,TCCTP(R5) ;CHECK FOR SIGNON
;3(007)	BEQ	16$		;DONT SEND EOF TO IBM
	TST	R0		;DO WE HAVE A MESSAGE?
	BNE	12$		;THERE IS ONE.
	JSR	PC,XHMSTP	;NONE, BUILD ONE.
	BCS	13$		;OUT OF CHUNKS.
	MOV	R0,TCMSG(R5)	;WE NOW HAVE A MESSAGE
12$:	MOV	TCCTP(R5),R1	;GET THE RCB
	BEQ	14$		;TROUBLE
	CMP	#RCBCTL,R1	;IS IT SIGNON?
	BEQ	16$		;YES, DONT SEND EOF
	CMP	#221, R1	;;++BS- IS IT CONSOLE OUTPUT ? 3(005)
	BEQ	16$		;;++BS- YES, DO NOT SEND EOF 3(005)
	CMP	#222, R1	;;++BS- IS IT CONSOLE INPUT ? 3(005)
	BEQ	16$		;;++BS- YES, DO NOT SEND EOF 3(005)
15$:	JSR	PC,MSGAPC	;APPEND TO MESSAGE
	BCS	14$		;OUT OF CHUNKS
	MOV	#200,R1		;SRCB FOR NO-SPACE
	JSR	PC,MSGAPC	;APPEND TO MESSAGE
	BCS	14$		;OUT OF CHUNKS
	CLR	R1		;SCB OF ZERO, MEANS ZERO LENGTH RECORD
	JSR	PC,MSGAPC	;APPEND SCB TO MESSAGE
	BCS	14$		;OUT OF CHUNKS
	INC	TCCEOF(R5)	;COUNT EOF'S SENT
16$:	MOV	TCLCB(R5),R1	;POINT TO LCB
	MOV	LB.MLR(R1),MSGNLR(R0) ;PRETEND MESSAGE FULL
	JSR	PC,XHSNDM	;SEND DEVICE EOF WITH MESSAGE
	BCS	14$		;FAILED
	BIS	#TCOTC,TCFG1(R5) ;COMPLETE THE OUTPUT
	CLC			;SIGNAL SUCCESS
13$:	RTS	PC		;RETURN.
;
;
; HERE IF WE RUN OUT OF CHUNKS APPENDING CHARACTERS TO THE
;  MESSAGE.  THIS SHOULD NOT HAPPEN SINCE THE MESSAGE
;  SPACE IS PRE-ALLOCATED.
;
14$:	STOPCD	XMB		;TRANSLATOR MESSAGE BUILDING TROUBLE
;
;
; 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
	MOV	(R0),R0		;GET POINTER TO DATA CHUNK
	BNE	XLHMSR		;FOR NON-ZERO MESSAGES
	JMP	XLHINL		;IGNORE NULL MESSAGES
XLHMSR:	MOV	CHLST,R0	;GET A CHUNK
	JSR	PC,GETCHK
	BCC	11$		;GOT ONE
	JMP	XHIMEC		;NONE AVAILABLE
;
; WE HAVE THE HEADER CHUNK FOR THE ASCII MESSAGE
;
11$:	MOV	(SP),R2		;POINT TO EBCDIC MESSAGE
	MOV	R0,MSGLCH(R0)	;BUILD FIRST (HEADER) CHUNK OF 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),R2		;POINT TO EBCDIC MESSAGE
	MOV	(R2)+,TCXPCH(R5) ;SAVE POINTER TO NEXT DATA CHUNK
	MOV	(R2)+,R3	;GET COUNT OF BYTES IN THIS CHUNK
	CMPB	#RCBCTL,MSGID(R0) ;IS IT SIGNON?
	BNE	14$		;NO.
	JMP	XLDSON		;TAKE CARE OF SIGNON MESSAGE
14$:	JSR	PC,XHGTC	;GET RCB FOR THE RECORD
	BCS	XHIMSE		;DONE WITH MESSAGE
	JSR	PC,XHGTC	;GET SRCB
	BCS	XHIMSE		;DONE WITH MESSAGE
	MOVB	R1,TCCCI(R5)	;SAVE SRCB FOR CARRIAGE CONTROL
	JSR	PC,XHGTC	;GET SCB FOR THE STRING
	BCS	XHIMSE		;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
;
;
; THE DECOMPRESSION OF A RECORD STARTS HERE
; R1 MUST HAVE THE SCB FOR THE STRING
;
31$:	JSR	PC,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

;;++4(011) - CHECK FOR TRANSMISSION ABORT SCB

	CMPB	#100, R1	;IS THIS A TRANSMISSION ABORT SCB ? ;;++4(011)
	BEQ	45$		;YES, TREAT AS END OF FILE ;;++4(011)
	TSTB	R1		;NO, CHECK FOR LEGAL SCB ;;++4(011)

;;++4(011) - END OF CODE TO CHECK FOR TRANSMISSION ABORT 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$:	JSR	PC,XHGTC	;GET CHARACTER FROM MESSAGE
	BCS	XHIMSE		;DONE WITH CHUNK
	JSR	PC,XLDPCM	;TRANSLATE AND DEPOSIT CHAR IN MSG
	BCS	XLHMEA		;OUT OF CHUNKS
	SOB	R4,33$		;LOOP TILL DONE WITH STRING
	BR	31$		;GET NEXT SCB
;
36$:	JSR	PC,XLHEOR	;PROCESS EOR
	BCS	XLHMEA		;OUT OF CHUNKS
	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	42$		;BUT COUNT AS DUP CHAR
40$:	JSR	PC,MSGAPC	;XLATE AND DEPOSIT CHAR
	BCS	XLHMEA		;OUT OF CHUNKS
	INC	TCHPS(R5)	;COUNT IN HORZ POS
42$:	SOB	R4,40$		;LOOP TILL DONE WITH DUP CHARS
	BR	31$		;GET NEXT STRING'S SCB
41$:	JSR	PC,XHGTC	;GET THE CHARACTER
	BCS	37$		;MUST NEVER FINISH IN MIDDLE
	MOVB	EBCASC(R1),R1	;TRANSLATE THE CHAR
	BR	39$		;JOIN THE LOOP
;

;
;;++4(011) - SET END OF FILE FOR TRANSMISSION ABORT SCB

45$:	BIS	#TCIEF, TCFG2(R5) ;SET END OF FILE ;;++4(011)
	BR	31$		;NEXT SCB = 0 ;;++4(011)

;;++4(011) - END OF CODE TOSET END OF FILE FOR TRANSMISSION ABORT SCB

;
;
; HERE ON EOR
;
XLHEOR:	CMPB	#4,TCDEV(R5)	;DEVICE LPT?
	BNE	12$		;NO, TREAT AS CARD DEVICE
	JSR	PC,XHIPRS	;YES, PROCESS EOR FOR LPT
	BCS	13$		;OUT OF CHUNKS
	RTS	PC		;RETURN
;
11$:	MOV	#40,R1		; stuff spaces to end of card record
	JSR	PC,MSGAPC
	BCS	13$		; chunkless
	INC	TCHPS(R5)	; advance the horzpos!
12$:	CMP	#80.,TCHPS(R5)	; do we have a well padded card?
	BGT	11$		; so pad it!

	MOV	#15,R1		;PUT CR AND LF IN MESSAGE
	JSR	PC,MSGAPC	;PUT IN MESSAGE
	BCS	13$		;OUT OF CHUNKS
	MOV	#12,R1		;LF
	JSR	PC,MSGAPC	;IN MESSAGE
	BCS	13$		;OUT OF CHUNKS
	INC	TCVPS(R5)	;WE HAVE DONE A LINE
	CLC			;SUCCESS
13$:	RTS	PC		;RETURN
;
;
; HERE WHEN WE RUN OUT OF CHUNKS TO EXTEND THE MESSAGE.  FREE THE
;  PARTIALLY BUILT MESSAGE, RESTORE VARIABLES TO ENTRY VALUES,
;  WAIT A WHILE, AND TRY AGAIN.
;
XLHMEA:
XLHMEB:	MOV	TCIDLE,R1	;SEND MSG TO BACKGROUND TASK
	JSR	PC,QUEMSG	; WHICH WILL FREE IT
	MOV	(SP)+,R0	;GET OLD TCST2
	MOV	(SP)+,TCHPS(R5) ;RESTORE HPOS
	MOV	(SP)+,TCVPS(R5)	;RESTORE VPOS
	MOV	(SP)+,TCCCI(R5)	;RESTORE CARRIAGE CONTROL CHAR
XHIMEC:	MOV	#EBTIME!EBWAIT,(R5) ;WAIT A WHILE
	MOV	#JIFSEC+4,TCTIM(R5)
	JSR	PC,WAIT
	JMP	XLHMSR		;TRY AGAIN TO TRANSLATE THE MSG
;
; HERE WHEN PROCESSING IS COMPLETE.  SEND THE ASCII MESSAGE
;  TO THE DL10 DRIVER TASK AND THE EBCDIC MESSAGE TO THE
;  IDLE TASK TO BE FREED.
;
XHIMSE:

;;++BS-SET THE DEVICE ACTIVE BIT FOR HASP INPUT

	JSR	PC, HSSAVR	;SAVE THE REGISTERS
	MOVB	MSGID(R0), R1	;GET RCB-DEVICE NUMBER
	BIC	#177400,R1	;CLEAR JUNK
	MOVB	MSGID+1(R0), R0	;GET LINE NUMBER
	BIC	#177770, R0	;CLEAR JUNK
	CMP	R1, #360	;IS THIS A SIGNON MESSAGE ?
	BEQ	1$		;YES IT IS
	MOV	R1, R2		;TEMPORARY STORAGE OF RCB
	BIC	#177770, R2	;ISOLATE LOWER 3 BITS
	TST	R2		;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$:	JSR	PC, HSACMP	;SET DEVICE ACTIVE BIT
3$:	JSR	PC, HSRESR	;RESTORE THE REGISTERS

;;++BS-END OF CODE TO SET DEVICE ACTIVE BIT FOR HASP INPUT

	CMPB	#360, MSGID(R0)	;;++BS-IS THIS A SIGNON ?
	BNE	4$		;;++BS-NO, CONTINUE
	MOVB	#223, MSGID(R0)	;;++BS-YES, POINT THE MESSAGE TO CDR0
4$:


	MOV	(R0),R1		;GET POINTER TO CHUNK
	MOV	R1,MSGLCH(R0)	;SAVE IT IN MESSAGE HEADER
	ADD	#CHDAT,R1	;POINT TO THE DATA CHAR
	MOV	R1,MSGPTR(R0)	;SAVE IN MESSAGE HEADER
	MOV	TCDLDR,R1	;POINT TO DTE20 TASK
	JSR	PC,QUEMSG	;SEND IT THE ASCII MSG
	MOV	(SP)+,R0	;DISCARD OLD TCST2
	MOV	(SP)+,R0	;DISCARD OLD TCHPS
	MOV	(SP)+,R0	;DISCARD OLD TCVPS
	MOV	(SP)+,R0	;DISCARD OLD TCCCI
XLHINL:	MOV	(SP)+,R0	;GET BACK EBCDIC MESSAGE
	MOV	TCIDLE,R1	;POINT TO IDLE TASK
	JSR	PC,QUEMSG	;SEND IT THE EBCDIC MESSAGE
	CLC			;SIGNAL ALL OK
	RTS	PC		;RETURN.
;
;
;
XLDPCM:	MOVB	EBCASC(R1),R1	;TRANSLATE CHARACTER FROM EBCDIC TO ASCII
	BEQ	11$		;IGNORE UNTRANSLATABLES
	INC	TCHPS(R5)	;ADD TO HOR POS
	JSR	PC,MSGAPC	;PUT CHAR IN MESSAGE
	BCS	12$		;OUT OF CHUNKS
11$:	CLC			;SUCCESS
12$:	RTS	PC		;RETURN
;
;
; 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
	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$:	JSR	PC,XLIPSP	;SPACE ONCE
	BCS	17$		;OUT OF CHUNKS
;
; HERE ON DOUBLE SPACE
;
12$:	JSR	PC,XLIPSP	;SPACE ONCE
	BCS	17$		;OUT OF CHUNKS
;
; HERE ON SINGLE SPACE
;
13$:	JSR	PC,XLIPSP	;SPACE ONCE
	BCS	17$		;OUT OF CHUNKS
	BR	16$		;PROCESS NEXT CHARACTER
;
;
; HERE ON OVERPRINT REQUEST
;
14$:	JSR	PC,XLIPCR	;JUST SEND CARRIAGE RETURN
	BCS	17$		;OUT OF CHUNKS
	BR	16$		;PROCESS NEXT CHARACTER
;
; HERE ON TOP OF FORM
;
15$:	JSR	PC,XLIPTF	;GO TO TOP OF NEXT PAGE
	BCS	17$		;OUT OF CHUNKS
;	BR	16$		;PROCESS NEXT CHARACTER
;
; HERE TO GIVE SUCCESSFUL RETURN.  WORRY ABOUT EATING ALL OF CPU.
;
16$:	JSR	PC,XLCPUT	;WAIT UNTIL OTHER TASKS RUN
	CLC			;INDICATE NO ERROR
17$:	RTS	PC		;RETURN.
;
; SUBROUTINE TO DIRECT SIGNON MESSAGE TO CARD READER STREAM
;
XLDSON:	
	CLR	TCHCNT(R5)	;CLEAR THE CHAR COUNT
	JSR	PC,XHGTC	;IGNORE RCB
	JSR	PC,XHGTC	;AND SRCB FOR SIGNON
11$:	JSR	PC,XHGTC	;GET CHAR FROM EBCDIC MESSAGE
	BCS	12$		;PROCESSING COMPLETE FOR MESSAGE
	MOVB	EBCASC(R1),R1	;TRANSLATE THE CHARACTER
	BEQ	11$		;IGNORE UNTRANLATABLES
	JSR	PC,MSGAPC	;APPEND TO MESSAGE
;	BCS	XLHMEA		;OUT OF CHUNKS
	BCS	13$		;;++BS-OUT OF CHUNKS
	INC	TCHCNT(R5)	;COUNT CHARS RECEIVED
	CMP	#80.,TCHCNT(R5) ;REACHED 80 FOR SIGNON
	BEQ	12$		;YES, INDICATE EOF
	BR	11$		;LOOP FOR NEXT CHAR
;
12$:	JSR	PC,XLHEOR	;SEND EOR (CR/LF)
	BIS	#TCIEF,TCFG2(R5) ;INDICATE EOF FOR SIGNON CARD
	JMP	XHIMSE		;END OF MESSAGE
;
13$:	JMP	XLHMEA		;;++BS-OUT OF CHUNKS
;
;
; 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
	RTS	PC		;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
	RTS	PC		;RETURN
;