.TITLE	GAB
	.IDENT	/XX01/
;
; STEPHEN F. SHIRRON	03-JUL-80
;
; PROGRAM TO CONNECT LOGICALLY TWO TERMINALS;  ALL INPUT FROM EITHER
; TERMINAL IS ECHOED TO BOTH TERMINALS
;
; SYNTAX:	GAB DDN:
;
;		GAB N
;
; IN EITHER CASE, CONNECT THE USER'S TI: WITH DDN:
;

	.MCALL	ALUN$,GMCR$,GLUN$,QIOW$,DIR$,CLEF$S,EXIT$S
	.MCALL	WTSE$S,SETF$S,ASTX$S,MRKT$

	.ENABL	LC

ATT:	QIOW$	IO.ATA,,7,,,,<AST>
ATTDET:	QIOW$	,2,,,IOSTAT
ALUN1:	ALUN$	1,TI,0
ALUN2:	ALUN$	2,TT
GLUN:	GLUN$	,LUNB
MRKT:	MRKT$	7,1,2
GMCR:	GMCR$
IOSTAT:	.BLKW	2
LUNB:	.BLKW	6
OUT:	QIOW$	IO.WLB,,7,,,,<,,0>
GABMSG:	.ASCII	<15><12><12><7>"Gabbing with "
TTN:	.ASCII	"TTNNN:"
TTNEND:	.ASCII	<15><12><12>
GABL=.-GABMSG
ENDMSG:	.ASCII	<15><12><7>"End gabbing..."<15><12>
ENDL=.-ENDMSG
GAGMSG:	.ASCII	<15><12><12><7>"Terminal is gagged, try later"<15><12>
GAGL=.-GAGMSG
RUBOUT:	.ASCII	<10>" "<10>
CTRLC:	.ASCII	"^C"<15><12>
CHAR:	.BYTE	0,12
FLAG:	.BLKB	2
	.EVEN

ERROR:	EXIT$S			; LET'S GO...

START:	DIR$	#GMCR		; GET A COMMAND LINE
	BCS	ERROR		; IF CS, EXIT IMMEDIATELY
	MOVB	$DSW,R5		; GET NUMBER OF BYTES IN COMMAND
	CMP	R5,#5		; VALID COMMAND?
	BLO	ERROR		; IF LO, NO -- JUST QUIT
	DIR$	#ALUN1		; ASSIGN UNIT 1
	MOV	#ALUN2,R4	; SET UP TO ASSIGN UNIT 2
	MOV	#GMCR+G.MCRB,R0	; GET ADDRESS OF COMMAND LINE
1$:	CMPB	#' ,(R0)+	; SPACE?
	BEQ	2$		; IF EQ, YES
	SOB	R5,1$		; CHECK THEM ALL
	BR	ERROR		; SYNTAX ERROR
2$:	MOV	R0,R5		; SAVE POINTER
	CALL	$COTB		; CONVERT THE UNIT NUMBER
	DEC	R0		; CORRECT IT
	CMP	R5,R0		; POINTER CHANGE?
	BEQ	3$		; IF EQ, COMMAND INCLUDES DEVICE NAME
	MOV	R1,A.LUNU(R4)	; SET UNIT NUMBER
	BR	4$		; JOIN COMMON CODE
3$:	MOVB	(R0)+,A.LUNA(R4) ; MOVE OVER THE DEVICE NAME
	MOVB	(R0)+,A.LUNA+1(R4) ; (BOTH CHARACTERS)
	CALL	$COTB		; CONVERT UNIT NUMBER
	MOV	R1,A.LUNU(R4)	; COPY UNIT NUMBER
	CMPB	#':,R2		; CORRECT SYNTAX?
	BNE	ERROR		; IF NE, NO
	MOVB	(R0)+,R2	; GET NEXT CHARACTER
4$:	CMPB	#15,R2		; END OF COMMAND?
	BEQ	1000$		; IF EQ, GOOD
	CMPB	#33,R2		; MAYBE, CHECK AGAIN
	BNE	ERROR		; IF NE, INVALID COMMAND
1000$:	DIR$	R4		; DO THE ASSIGN
	BCS	ERROR		; IF CS, BLOW UP AT THE CLOWN
	MOV	#ATTDET,R4	; TRY NOW TO ATTACH UNIT 2
	MOV	#IO.ATT,Q.IOFN(R4) ; SET I/O FUNCTION
	DIR$	R4		; TRY THE ATTACH
	BCS	ERROR		; IF CS, DON'T BOTHER WAITING
111$:	DIR$	#MRKT		; MARK TIME FOR ONE SECOND
	WTSE$S	#7		; WAIT AROUND
	TSTB	IOSTAT		; ATTACH WORK?
	BNE	112$		; IF NE, YES
	MOV	#IO.KIL,Q.IOFN(R4) ; KILL THE ATTACH FUNCTION
	DIR$	R4		;
	MOV	#OUT,R4		; PRINT ERROR MESSAGE
	MOV	#1,Q.IOLU(R4)	;
	MOV	#GAGMSG,Q.IOPL(R4) ;
	MOV	#GAGL,Q.IOPL+2(R4) ;
	DIR$	R4		;
	JMP	ERROR		;
112$:	MOV	#IO.DET,Q.IOFN(R4) ; DETACH UNIT 2
	DIR$	R4		;
	MOV	#OUT,R3		; GET READY TO PRINT MESSAGE
	MOV	#GABMSG,Q.IOPL(R3) ; SET BUFFER ADDRESS
	MOV	#GABL,Q.IOPL+2(R3) ; SET MESSAGE LENGTH
	MOV	#GLUN,R5	; GET ADDRESS OF GLUN$ DPB
	MOV	G.LUBA(R5),R4	; GET LUNB ADDRESS
	MOV	#2,G.LULU(R5)	; SET TO READ UNIT 2
	DIR$	R5		; DO IT
	BIT	#4,G.LUCW(R4)	; TERMINAL DEVICE?
	BNE	113$		; IF NE, YES
	JMP	ERROR		; BOMB
113$:	MOV	#TTN,R0		; GET OUTPUT AREA ADDRESS
	MOVB	G.LUNA(R4),(R0)+ ; GET FIRST BYTE
	MOVB	G.LUNA+1(R4),(R0)+ ; THEN THE NEXT BYTE
	MOVB	G.LUNU(R4),R1	; AND UNIT NUMBER
	CLR	R2		; NO LEADING ZEROS
	CALL	$CBTMG		; CONVERT TO OCTAL
	MOVB	#':,(R0)+	; TERMINATE IT
1001$:	CMP	#TTNEND,R0	; PADDED TO THE END YET?
	BEQ	1002$		; IF EQ, YES
	MOVB	#' ,(R0)+	; PAD SOME MORE
	BR	1001$		;
1002$:	MOV	#1,Q.IOLU(R3)	; SET UP THE LOGICAL UNIT
	DIR$	R3		; PRINT MESSAGE
	MOV	#1,G.LULU(R5)	; NOW DO UNIT 1
	DIR$	R5		; DO IT
	MOV	#TTN,R0		; GET OUTPUT AREA ADDRESS
	MOVB	G.LUNA(R4),(R0)+ ; GET FIRST BYTE
	MOVB	G.LUNA+1(R4),(R0)+ ; THEN THE NEXT BYTE
	MOVB	G.LUNU(R4),R1	; AND UNIT NUMBER
	CLR	R2		; NO LEADING ZEROS
	CALL	$CBTMG		; CONVERT TO OCTAL
	MOVB	#':,(R0)+	; TERMINATE IT
1011$:	CMP	#TTNEND,R0	; PADDED TO THE END YET?
	BEQ	1012$		; IF EQ, YES
	MOVB	#' ,(R0)+	; PAD SOME MORE
	BR	1011$		;
1012$:	MOV	#2,Q.IOLU(R3)	; SET UP THE LOGICAL UNIT
	DIR$	R3		; PRINT MESSAGE
	CLEF$S	#3		; CLEAR AN EVENT FLAG
	CLRB	FLAG+1		; INDICATE JUST STARTING UP
	MOV	#CHAR,Q.IOPL(R3) ; SET TO PRINT A SINGLE CHARACTER
	MOV	#ATT,R5		; GET ADDRESS OF QIOW$ DPB
	MOV	#1,Q.IOLU(R5)	; DO UNIT 1
	MOV	#1,Q.IOPL+2(R5)	;
	DIR$	R5		; ATTACH THE FIRST TERMINAL
	MOV	#2,Q.IOLU(R5)	; AND UNIT 2
	MOV	#2,Q.IOPL+2(R5)	;
	DIR$	R5		; ATTACH THE OTHER TERMINAL
	WTSE$S	#3		; WAIT FOR CONTROL-Z
	MOV	#ENDMSG,Q.IOPL(R3) ; SET TO PRINT TERMINATING MESSAGE
	MOV	#ENDL,Q.IOPL+2(R3) ;
	MOV	#1,Q.IOLU(R3)	; PRINT TO UNIT 1
	DIR$	R3		;
	MOV	#2,Q.IOLU(R3)	; THEN TO UNIT 2
	DIR$	R3		;
	EXIT$S			; WASN'T THAT FUN!!

AST:	MOVB	1(SP),FLAG	; GET WHO TYPED THE CHARACTER
	MOVB	(SP)+,CHAR	; GET THE BYTE TYPED
	MOV	R3,-(SP)	; SAVE R3
	MOV	#OUT,R3		; GET ADDRESS OF QIOW$ DPB
	MOV	#CHAR,Q.IOPL(R3) ; SET ADDRESS OF BYTE TO PRINT
	MOV	#1,Q.IOPL+2(R3)	; ASSUME ONE CHARACTER
	TSTB	FLAG+1		; DOES ANYONE HAVE CONTROL?
	BNE	1$		; IF NE, YES -- LOCK OTHER GUY OUT
	MOVB	FLAG,FLAG+1	; INDICATE THIS GUY HAS CONTROL
	BR	2$		; SKIP TESTS
1$:	CMPB	#3,CHAR		; CONTROL-C (GRABS CONTROL)?
	BNE	11$		; IF NE, NO
	MOVB	FLAG,FLAG+1	; GIVE THIS GUY CONTROL NOW
	MOV	#CTRLC,Q.IOPL(R3) ; PRINT OUT "^C"
	MOV	#4,Q.IOPL+2(R3)	;
	BR	10$		; PRINT IT OUT
11$:	CMPB	FLAG,FLAG+1	; LEGAL FOR THIS GUY TO TYPE?
	BNE	30$		; IF NE, NO -- IGNORE CHARACTER
2$:	CMPB	#177,CHAR	; RUBOUT?
	BNE	1000$		; IF NE, NO
	MOV	#RUBOUT,Q.IOPL(R3) ; SET RUBOUT SEQUENCE
	MOV	#3,Q.IOPL+2(R3) ; AND LENGTH
	BR	10$		; GO PRINT IT
1000$:	CMPB	#32,CHAR	; IS IT CONTROL-Z?
	BEQ	20$		; IF EQ, YES
	CMPB	#15,CHAR	; IS IT A CARRIAGE RETURN?
	BNE	10$		; IF NE, NO
	INC	Q.IOPL+2(R3)	; OTHERWISE, PRINT TWO CHARACTERS
	CLRB	FLAG+1		; CONTROL IS NOW UP FOR GRABS
10$:	MOV	#1,Q.IOLU(R3)	; SET LOGICAL UNIT
	DIR$	R3		; PRINT CHARACTER
	MOV	#2,Q.IOLU(R3)	;
	DIR$	R3		;
	BR	30$		; JUMP OUT
20$:	SETF$S	#3		; SET THE EVENT FLAG
30$:	MOV	(SP)+,R3	; RETRIEVE R3
	ASTX$S			; EXIT...

	.END	START