; 	XOUT  -  Output routing routine for VTAM
;
;	Copyright [c] Noel Alaska Systems Technology, 1983.

	SEARCH	SYS			; AMOSL libraries
	SEARCH	SYSSYM
	SEARCH	TRM
	SEARCH	VTAMEQ			; VTAM libraries

	INTERN	XOUT

	AUTOEXTERN

XOUT:	SAVE	A0-A5,D0-D5
	MOV	JVCNT(A5),D0		; are we in middle of ctl seq?
	JEQ	XOUT3			;    NO
	BITL	#FUNSEQ,JSTAT(A5)	; are we in middle of fun seq?
	BEQ	1$			;    NO
	CALL	VFUNC2
	JMP	XOUT6
1$:	LEA	A2,JVCHR(A5)		; put ctl char where it goes
	ADD	D0,A2
	MOVB	D1,@A2
	INC	JVCNT(A5)		; incr ctl seq count

XOUTA:	CMPB	JVCHR(A5),#33		; is this maybe an AB special?
	JNE	XOUTB			;    NO
	CMP	JVCNT(A5),#2		; could it be the line 25 leadin?
	JNE	1$			;    NO
	MOVB	JVCHR+1(A5),D1
	ANDB	#177,D1
	CMPB	D1,#'f
	JNE	XOUTB			;    YES - its msg line leadin
	MOVB	#234,JVCHR(A5)		; 	   cvt to CRT 255.,128.
	MOVB	#234,JVCHR+1(A5)
	MOVW	#255.*256.+128.,JVCHR+2(A5)	
	CLR	JVCNT(A5)
	CALL	FAKCRT
	JMP	XOUT6
1$:	CMP	JVCNT(A5),#3		; could it be function key progm?
	JNE	XOUTB			;    NO
	MOVB	JVCHR+1(A5),D1
	ANDB	#177,D1
	CMPB	D1,#'|
	BNE	3$
	BITL	#CUR,JSTAT(A5)		;    YES - its function key setup
	BEQ	2$
	BITL	#CTLMOD,JSTAT(A4)
	BNE	2$
	BITL	#DETACH,JSTAT(A4)
	BNE	2$
	CLRB	JVCHR+3(A5)
	TTYL	JVCHR(A5)
2$:	MOVB	JVCHR+2(A5),D1
	CALL	VFUNC1
3$:	JMP	XOUT6
XOUTB:	NOP
	CMP	JVCNT(A5),#5		; got them all?
	JLO	XOUT6			;    NO
	CLR	JVCNT(A5)		; clear count
	LEA	A2,JVCHR+2(A5)		; point to unpacked D1 value
	MOVB	(A2)+,D1		; pick up low 6 bits
	BTST	#7,D1			; make sure high bit set
	BNE	1$
	JMP	XOUT6
1$:	AND	#77,D1			; remove high bits
	MOVB	(A2)+,D0		; pick up middle 6 bits
	BTST	#7,D0			; make sure high bit set
	BNE	2$
	JMP	XOUT6
2$:	AND	#77,D0			; remove high bits
	ROLW	D0,#6.			; shift up
	OR	D0,D1			; now have 12 bits
	MOVB	(A2)+,D0		; pick up high 4 bits
	BTST	#7,D0			; make sure high bit set
	BNE	3$
	JMP	XOUT6
3$:	AND	#17,D0			; remove all but 4 bits
	RORW	D0,#4.			; shift up
	OR	D0,D1			; now have all the bits
	MOVW	D1,JVCHR+2(A5)		; save back in buffer...
	CMPB	JVCHR+1(A5),#234	; TCRT?
	BNE	XOUT2			;    NO  - handle as ECHO
	CALL	FAKCRT			;    YES - fake tcrt call
	JMP	XOUT6
XOUT2:	CMMB	#377,JVCHR+1(A5)	; is this a rubout?
	BEQ	1$			;    YES
	CMMB	#225,JVCHR+1(A5)	; is this a ^U?
	JNE	XOUT6			;    NO  - invalid sequence
1$:	CALL	FAKBKU			; handle rubs/^U by fake backups
	JMP	XOUT6

XOUT3:	CMPB	D1,#234			; is this start of ctl seq?
	BNE	XOUT3A			;    NO
	MOV	#1,JVCNT(A5)		;    YES - set count to 1
	MOVB	D1,JVCHR(A5)		; 	   save init char
	JMP	XOUT6
XOUT3A:	CMPB	D1,#211			; is this the "compressed" tab?
	BNE	1$			;    NO
	MOVB	#11,D1			;    YES - expand it
	BR	XOUT3B
1$:	CMPB	D1,#33			; is this AB televideo escape code
	BNE	XOUT3B			;    NO
	MOV	#1,JVCNT(A5)		;    YES - set count to 1
	MOVB	D1,JVCHR(A5)		; 	   save init char
	JMP	XOUT6
XOUT3B:	BITL	#CUR,JSTAT(A5)		; is this the current job?
	BEQ	XOUT3C			;    NO
	BITL	#CTLMOD,JSTAT(A4)	; is real screen in ctl mode?
	BNE	XOUT3C			;    YES
	BITL	#DETACH,JSTAT(A4)	; am I detached?
	BNE	XOUT3C			;    YES
	CMPB	D1,#11			; is this a TAB?
	BNE	2$			;    NO
	CALL	DOTAB			;    YES
	BR	XOUT3C
2$:	TOUT
XOUT3C:	BITL	#LOGOP,JSTAT(A5)	; is there a LOG file?
	BEQ	XOUT4			;    NO
	BITL	#LINPT,JSTAT(A5)	;    YES - is it input
	BNE	XOUT4			;	   YES
	CALL	BYTOUT			;	   NO  - to log now...
XOUT4:	BITL	#AUXON,JSTAT(A5)	; is there an auxillary terminal?
	BEQ	XOUT5			;    NO
	MOV	AUXTRM(A5),A3		; address new trmdef
	CALL	ASSGN			; switch terminals
	PUSH	A1			; save old term address
	CMPB	D1,#11			; is it a tab?
	BNE	1$			;    NO
	CALL	DOTAB			;    YES - send spaces
	BR	2$			;	 - leave
1$:	TOUT				; send all others
2$:	POP	A3			; restore old terminal address
	CALL	ASSGN			; switch back...
XOUT5:	BITL	#VCON,JSTAT(A5)		; is there a virtual console?
	BEQ	XOUT6			;    NO
	CALL	VOUT
XOUT6:	REST	A0-A5,D0-D5
	RTN

FAKCRT:
	MOVW	JVCHR+2(A5),D1		; get command
	BPL	1$
	BEQ	1$
	CMPB	D1,#7.			; is it KB lock?
	JEQ	XOUT8B			;    YES - ignore
	CMPB	D1,#8.			; is it KB unlock?
	JEQ	XOUT8B			;    YES - ignore
	CMPB	D1,#79.			; is it print screen?
	BEQ	2$			;    YES - bypass real crt
1$:	BITL	#CUR,JSTAT(A5)		; is this the current job?
	BEQ	2$			;    NO
	BITL	#CTLMOD,JSTAT(A4)	; is real screen in ctl mode?
	BNE	2$			;    YES
	BITL	#DETACH,JSTAT(A4)	; am I detached?
	BNE	2$			;    YES
	MOVW	JVCHR+2(A5),D1		;    NO	 - send TCRT
	TCRT
2$:	BITL	#VCON,JSTAT(A5)		; is there a virtual console?
	BEQ	XOUT7			;    NO
	MOVW	JVCHR+2(A5),D1
	CALL	VTCRT
	MOVW	JVCHR+2(A5),D1		; get command
	BPL	XOUT7
	BEQ	XOUT7
	CMPB	D1,#79.			; is it print screen?
	JEQ	XOUT8B			;    YES - bypass other stuff
XOUT7:	BITL	#LOGOP,JSTAT(A5)	; is there a log file?
	BEQ	XOUT8			;    NO
	BITL	#MOVIE,JSTAT(A5)	; is it a movie?
	BEQ	XOUT8			;    NO
	CMMW	#[TRM],JDDB+D.DEV(A5)	; is movie to a terminal?
	BNE	2$			;    NO
0$:	TST	JDDB+D.IDX(A5)		;    YES - wait for all my output
	BEQ	1$			;	   to complete...
	CALL	BYTOTR
	BR	0$
1$:	MOV	JDDB+D.WRK(A5),A3	; pick up terminal address
	CALL	ASSGN			; switch terminals
	PUSH	A1			; save old terminal address
	MOVW	JVCHR+2(A5),D1		; pick up TCRT code and send it
	TCRT
	POP	A3			; recover old terminal address
	CALL	ASSGN			; switch back...
	BR	XOUT8
2$:	MOVB	JVCHR(A5),D1		; MOVIE is not to terminal
	CALL	BYTOUT			;  so just send the normal
	MOVB	JVCHR+1(A5),D1		;  escape sequence from the TDV
	CALL	BYTOUT			;  escape sequence from the TDV
	MOVB	JVCHR+2(A5),D1
	CALL	BYTOUT
	MOVB	JVCHR+3(A5),D1
	CALL	BYTOUT
XOUT8:	BITL	#AUXON,JSTAT(A5)	; is there an auxillary terminal?
	BEQ	XOUT8B			;    NO
	MOV	AUXTRM(A5),A3		;    YES - address it
	CALL	ASSGN			; switch terminals
	PUSH	A1			; save old terminal address
	MOVW	JVCHR+2(A5),D1		; get tcrt sequence and send it
	TCRT
	POP	A3			; recover old terminal addr
	CALL	ASSGN			; switch back...
XOUT8B:	RTN

FAKBKU:	CLR	D0			; preclear loop control
	BITL	#VCON,JSTAT(A5)		; is there a virtual console?
	BEQ	XOUT15			;    NO
	MOVW	JVCHR+2(A5),D0		; get backup count
XOUT10:	MOV	#10,D1			; get a backspace
	CALL	VOUT			; pump them out to vcon
	SOB	D0,XOUT10
	MOVW	JVCHR+2(A5),D0		; get backup count
XOUT11:	MOV	#40,D1			; get a space
	CALL	VOUT			; pump them out to vcon
	SOB	D0,XOUT11
	MOVW	JVCHR+2(A5),D0		; get backup count
XOUT12:	MOV	#10,D1			; get a backspace
	CALL	VOUT			; pump them out to vcon
	SOB	D0,XOUT12

XOUT15:	BITL	#LOGOP,JSTAT(A5)	; is there a LOG file?
	BEQ	XOUT23			;    NO
	MOVW	JVCHR+2(A5),D0
XOUT16:	MOV	#10,D1			; get a backspace
	CALL	BYTOUT			; pump them out to LOG
	SOB	D0,XOUT16
	MOVW	JVCHR+2(A5),D0		; get backup count
XOUT17:	MOV	#40,D1			; get a space
	CALL	BYTOUT			; pump them out to LOG
	SOB	D0,XOUT17
	MOVW	JVCHR+2(A5),D0		; get backup count
XOUT18:	MOV	#10,D1			; get a backspace
	CALL	BYTOUT			; pump them out to LOG
	SOB	D0,XOUT18

XOUT23:	BITL	#CUR,JSTAT(A5)		; is this the current job?
	BEQ	XOUT27			;    NO
	BITL	#CTLMOD,JSTAT(A4)	; is real screen in ctl mode?
	BNE	XOUT27			;    YES
	BITL	#DETACH,JSTAT(A4)	; am I detached?
	BNE	XOUT27			;    YES
	MOVW	JVCHR+2(A5),D0		; get backup count
XOUT24:	MOV	#10,D1			; get a backspace
	TOUT	
	SOB	D0,XOUT24		; pump them out
	MOVW	JVCHR+2(A5),D0		; get backup count
XOUT25:	MOV	#40,D1			; get a space
	TOUT	
	SOB	D0,XOUT25		; pump them out
	MOVW	JVCHR+2(A5),D0		; get backup count
XOUT26:	MOV	#10,D1			; get a backspace
	TOUT	
	SOB	D0,XOUT26		; pump them out
XOUT27:	BITL	#AUXON,JSTAT(A5)	; is there an auxillary terminal?
	BEQ	4$			;   NO
	MOV	AUXTRM(A5),A3		;   YES - address it
	CALL	ASSGN			; switch terminals
	PUSH	A1			; save old terminal address
	MOVW	JVCHR+2(A5),D0		; get backup count
1$:	MOV	#10,D1			; get a backspace
	TOUT	
	SOB	D0,1$			; pump them out
	MOVW	JVCHR+2(A5),D0		; get backup count
2$:	MOV	#40,D1			; get a space
	TOUT	
	SOB	D0,2$			; pump them out
	MOVW	JVCHR+2(A5),D0		; get backup count
3$:	MOV	#10,D1			; get a backspace
	TOUT	
	SOB	D0,3$			; pump them out
	POP	A3			; recover old terminal address
	CALL	ASSGN			; switch back...
4$:	RTN

DOTAB:	SAVE	A0,D0-D1		; routine to send a tab...
	MOV	JTRM(A4),A0		; point to my TRMDEF
	BITL	#VCON,JSTAT(A5)		; is there a VCON ?
	BEQ	0$			;   NO  - do slow way
	MOV	COL(A5),D0		;   YES - use its 'POO'
	DEC	D0			;	  (much faster 'cause
	MOV	D0,D1			;	   no need to wait)
	BISL	#7,D0
	INC	D0
	SUB	D1,D0
	BR	1$
0$:	SLEEP	#100.
	BITW	#T$OIP,@A0		; is it still busy?
	BNE	0$			;   YES - wait for it
	TST	T.OQX(A0)		; is output queued?
	BNE	0$			;   YES - wait for it
	CLR	D0
	MOVW	T.POO(A0),D0		; get correct position
	MOV	D0,D1			; save position in D1
	BISL	#7,D0			; move out to mod 8 position
	INC	D0
	SUB	D1,D0			; compute # spaces to output
1$:	MOVB	#40,D1			; send them out to vcon
	TOUT
	SOB	D0,1$
	REST	A0,D0-D1
	RTN

ASSGN:	VLOK
	JOBIDX	A0			; A0 -> my  JCB
	MOV	JOBTRM(A0),A1		; A1 -> my  TRMDEF (null?)
;					; A3 -> his TRMDEF
	MOV	T.JLK(A3),A2		; A2 -> his JCB    (null?)
	MOV	A2,D7			; is there another job?
	BEQ	2$			;    NO
	MOV	A1,JOBTRM(A2)		;    YES - he gets my terminal
2$:	MOV	A1,D7			; do I really have a terminal?
	BEQ	3$			;    NO
	MOV	A2,T.JLK(A1)		;    YES - complete linkup
3$:	MOV	A3,JOBTRM(A0)		; I get his terminal
	MOV	A0,T.JLK(A3)
	VUNLK
	RTN

; setup for function key definition processing
VFUNC1:
	BISL	#FUNSEQ,JSTAT(A5)	; note in sequence
	BICL	#FUNCTP,JSTAT(A5)	; note next char not escaped
	RTN

; process char of function key definition
VFUNC2:	AND	#177,D1			; strip parity
	MOV	JSTAT(A5),D7		; save FUNCTP state
	AND	#~FUNCTP,JSTAT(A5)	; clear FUNCTP
	AND	#FUNCTP,D7		; was it set?
	BNE	2$			;   YES 
	CMPB	D1,#31			; is this a ^Y ?		
	BNE	1$			;   NO
	BICL	#FUNSEQ,JSTAT(A5)	;   YES - sequence is done
	CLR	JVCNT(A5)		;	- (both kinds)
	BR	13$
1$:	CMPB	D1,#20			; is this a ^P ?
	BNE	2$			;   NO
	BISL	#FUNCTP,JSTAT(A5)	;   YES - next char escaped
	BR	13$
2$:	NOP				; save the char
13$:	BITL	#CUR,JSTAT(A5)		; is this the current job?
	BEQ	14$			;    NO
	BITL	#CTLMOD,JSTAT(A4)	; is real screen in ctl mode?
	BNE	14$			;    YES
	BITL	#DETACH,JSTAT(A4)	; am I detached?
	BNE	14$			;    YES
	TOUT				; send char to read terminal
14$:	RTN

	EVEN
	END