.TITLE	VAXIO
;
;	This is the I/O setup for Bonner Lab Runoff
;		VAX-VMS native version
;
; AUTHOR: C. SANDMANN  7-5-85  RICE U. CHEM ENG DEPT
;
;
;	Data structures used to access the CLI information
;
	.CONST				;NONWRITEABLE DATA
VAL1:	.ASCID	/P1/			;PARAMETER 1 (INPUT FILE)
VAL2:	.ASCID	/OUTP/			;QUALIFIER (OUTPUT FILE)
VAL3:	.ASCID	/TOC/			;QUALIFIER (TOC FILE)
	.ALIGN LONG
QUALT:	.ASCID	/NOFF/			;TABLE OF DESCRIPTORS
	.ALIGN LONG			;DESCRIPTOR TAKES 2 LONGWORDS
	.ASCID	/HYPH/			;AND ACTUAL TEXT 1 LONG (OR LESS)
	.ALIGN LONG			;ALIGNMENT MAKES EACH ONE TAKE 3 LONG
	.ASCID	/WAIT/			;SO THEY CAN BE INDEXED BY THAT
	.ALIGN LONG			;EACH QUALIFIER IS IN THE ORDER IT
	.ASCID	/SPOO/			;IS FOUND IN THE BIT MASK $SWTCH
	.ALIGN LONG
	.ASCID	/UC/
	.ALIGN LONG
	.ASCID	/CR/
	.ALIGN LONG
	.ASCID	/EVEN/
	.ALIGN LONG
	.ASCID	/ODD/
	.ALIGN LONG
	.ASCID	/DEBU/
	.ALIGN LONG
	.ASCID	/TT/
	.ALIGN LONG
	.ASCID	/2P/
	.ALIGN LONG
	.ASCID	/WR/
	.ALIGN LONG
	.ASCID	/EP/
	.ALIGN LONG
;
ULCVAL:	.ASCID	/UL/		;ULCVAL: ULSWT(ASCII)
RIGVAL:	.ASCID	/RIGH/		;RIGVAL: RIGSHI
PSVAL:	.ASCID	/PS/		;PSVAL:  PNLPG,PRMRG
PAGUAL:	.ASCID	/PAGE/		;PAGUAL: LOWPAG,HGHPAG
FFVAL:	.ASCID	/NOFF/		;FFVAL:	 LPPG
APNUAL:	.ASCID	/AP/		;APNUAL: LOWAPN,HGHAPN
CHPUAL:	.ASCID	/CH/		;CHPUAL: LOWCHP,HGHCHP
;
OPRTXT:	.ASCID	<7>/Adjust page & press "return"/<7>	; Wake up text
	.VARS
QUALB:	.ASCID	/        /	;BUFFER TO HOLD QUALIFIER VALUE
QUALV:	.LONG
	.LONG
;
GVALF:	.LONG	2		;CALL FRAME FOR GETTING VALUES
	.LONG	FFVAL
	.LONG	QUALB
;
FNDES:	.LONG	80
	.LONG	FILENM
FILENM:	.BLKB	80
	.LONG	0		;RESERVED FOR .DOC IF FILENM TOO LONG
FNODES:	.LONG	80
	.LONG	FILENMO
FILENMO:.BLKB	80
;
;	LUN4	DATA INPUT
;	LUN5	DATA INPUT
;	LUN6	DATA INPUT
;	LUN7	DATA INPUT
;	LUN8	DATA INPUT
;
;	TTBLK	SCREEN OUTPUT (ERRORS)
;	LSTBLK	OUTPUT FILE
;	TOCBLK	TABLE OF CONTENTS
;
;	Defines which LUNS in use
;
LUNSTK:		.BYTE	0,4				; Defines luns in use
;
		.ALIGN	LONG
LUNSTK_A:	.ADDRESS	LUN4,LUN5,LUN6,LUN7,LUN8
LUNSTK_AR:	.ADDRESS	LUN4_R,LUN5_R,LUN6_R,LUN7_R,LUN8_R
;
LUN4:		$FAB	DNM=<.RNO>
LUN4_R:		$RAB	FAB=LUN4
LUN5:		$FAB	DNM=<.RNO>
LUN5_R:		$RAB	FAB=LUN5
LUN6:		$FAB	DNM=<.RNO>
LUN6_R:		$RAB	FAB=LUN6
LUN7:		$FAB	DNM=<.RNO>
LUN7_R:		$RAB	FAB=LUN7
LUN8:		$FAB	DNM=<.RNO>
LUN8_R:		$RAB	FAB=LUN8
;
TTBLK:		$FAB	FNM=<SYS$OUTPUT:>,RAT=CR
TTBLK_R:	$RAB	FAB=TTBLK
;
LSTBLK:		$FAB
LSTBLK_R:	$RAB	FAB=LSTBLK
;
TOCBLK:		$FAB	RAT=CR
TOCBLK_R:	$RAB	FAB=TOCBLK
;
	.CODE
;
;	The start of RUNOFF
;
$START::MOVL	SP,SPSAV			; SAVE INITIAL STACK POINTER
	$CREATE		FAB=TTBLK		; SCREEN OUTPUT FOR ERRORS
	$CONNECT	RAB=TTBLK_R
	RETURN
;
;	Section executed after initialization, before processing
;	Only excuted once for VAX/VMS
;
RESTRT::
;
;	Initialize traceback buffer
;
	MOV	#TRCBUF+4,R0			; Initial traceback address
	MOV	R0,TRCBUF			; And save it
	CLR	(R0)+				; No line number
	CLR	(R0)				; No file name
;
;	Get command line info (switches and file name)
;
	PUSHAL	FNDES
	PUSHAL	VAL1
	CALLS	#2,G^CLI$GET_VALUE		;GET INPUT FILE NAME
	MOVAL	LUN4,R11			;OPEN FAB BLOCK LOCATION
	MOVB	#80,FAB$B_FNS(R11)		;LENGTH OF BUFFER (BLANK PAD)
	MOVAL	FILENM,FAB$L_FNA(R11)		;ADDRESS OF FILE NAME BUFFER
	$OPEN		FAB=(R11)		;OPEN THE INPUT FILE
	BLBS	R0,17$				;IF NOT OPEN ERROR EXIT
	$EXIT_S	R0
17$:	$CONNECT	RAB=LUN4_R		;CONNECT THE RECORD STREAM
	MOVAL	FILENM,R6			;ADDRESS OF FILENAME
	CALL		TRCGET			;SETUP TRACEBACK INFO
	MOVB	#1,CSMOR			;FLAG WE MIGHT HAVE MORE FILES
;
;	Now check switches and set values as necessary
;
	MOVAL	QUALT,R9			;QUALIFIER TABLE LOCATION
	MOVL	$SWTCH,R8			;PUT ORIGINAL CONTENTS IN R8
	MOVL	#12,R11				;NUM OF SWITCHES-1
171$:	MULL3	R11,#3,R10			;3 LONGWORD PER STRUCTURE
	PUSHAL	(R9)[R10]			;PUSH QUAL DESCRIP ON STACK
	CALLS	#1,G^CLI$PRESENT		;WAS IT THERE?
	BLBC	R0,172$				;IF NOT GO CLEAR
	BBSS	R11,R8,180$			;SET THE BIT
	BRB	180$
172$:	BBCC	R11,R8,180$			;CLEAR THE BIT
180$:	SOBGEQ	R11,171$			;DO THE NEXT ONE
;
	MOVL	R8,R9				;MAKE COPY
	MOVL	#<EVESW!ODDSW!WARSW!FFDSW>,R6	;SWITCHES THAT MUST BE CLEAR
	MOVL	#^C<EVESW!ODDSW!WARSW!FFDSW>,R7	;AND COMPLEMENT
	BICL2	R6,R8				;CLEAR IN ORIGINAL
	BICL2	R7,R9				;CLEAR SET IN COPY
	BICL2	R9,R6				;COMPLEMENT IN R6 NOW FOR CL
	BISL2	R6,R8				;AND UPDATE IN R8
;
;	Bits are set in $SWTCH properly, so now set other values
;
	MOVL	R8,$SWTCH			; FINISHED SO RESTORE IT
	CLR	R1				; SET TO CLEAR CASE SHIFT
	BITEQ	#UPCSW,$SWTCH,140$		; NO UPPER CASE REQUIRED?
	MOV	#401,R1				; REQUIRED UPPER	
140$:	MOV	R1,CASE				; SET CASE		
	BITNE	#HYPSW,$SWTCH,150$		; HYPHENATION SWITCH?
	MOVB	#-1,$HYPSW			; SET IT PERMENANTLY OFF
150$:
;
	MOVL	#1,R11				;HOW MANY VALUES TO GET
	CALLG	GVALF,G^CLI$GET_VALUE		;FIRST CALL IS DEFAULT FF
	BLBC	R0,182$				;NONE THERE?
	JSB	TRANSV				;TRANSLATE TO NUMBERS
	TSTL	QUALV				;IS FIRST VALUE 0?
	BEQL	182$				;IF SO WE GOT NOTHING OF USE
	MOVL	QUALV,LPPG			;SO PUT LINES PER PAGE
182$:
	ASL	LPPG				;MAKE IT 1/2 LINES
	MOVAL	RIGVAL,GVALF+4
	CALLG	GVALF,G^CLI$GET_VALUE
	BLBC	R0,184$
	JSB	TRANSV
	TSTL	QUALV
	BEQL	184$
	MOVL	QUALV,RIGSHI
184$:
	MOVAL	ULCVAL,GVALF+4
	CALLG	GVALF,G^CLI$GET_VALUE
	BLBC	R0,186$
	CMPB	#32,QUALB+8
	BEQL	186$
	BICB3	#32,QUALB+8,ULSWT		; Make upper case if nec
186$:
	MOVB	#^A/_/,$ULCH			; Underline char as underscore
	MOVB	ULSWT,R0			; Get underline char
	BEQ	130$				; No underline switch
	CMPNEB	#^A/L/,R0,110$			; NOT Line mode ?
	COMB	$ULMSW				; SET Line mode
	BR	130$
110$:	CMPNEB	#^A/S/,R0,120$			; NOT SIMULATE MODE?
	INCB	$ULMSW				; SET SIMULATE SWITCH
	MOVB	#^A/-/,$ULCH			; Set underline char to hyphen
	BR	130$
120$:	CMPNEB	#^A/N/,R0,125$			; Not No mode ?
	COMB	$UNLSW				; SET NO UNDERLINE SWITCH
	BR	130$
125$:	CMPEQB	#^A/B/,R0,130$			; Backspace mode ?
	MOV	#38.,R0				; Bad switch
	JMP	ILINP				; Tell user
130$:
	MOVL	#2,R11
	MOVAL	PSVAL,GVALF+4
	CALLG	GVALF,G^CLI$GET_VALUE
	BLBC	R0,188$
	JSB	TRANSV
	TSTL	QUALV
	BEQL	188$
	MOVL	QUALV,PNLPG
	ASL	PNLPG
	MOV	PNLPG,NLPG
	TSTL	QUALV+4
	BEQL	188$
	MOVL	QUALV+4,PRMRG
	MOV	PRMRG,RMARG
188$:
	MOVAL	PAGUAL,GVALF+4
	CALLG	GVALF,G^CLI$GET_VALUE
	BLBC	R0,190$
	JSB	TRANSV
	TSTL	QUALV
	BEQL	190$
	MOVL	QUALV,LOWPAG
	TSTL	QUALV+4
	BNEQ	189$
	MOVL	QUALV,QUALV+4			;DEFAULT END IS START
189$:	MOVL	QUALV+4,HGHPAG
190$:
	MOVAL	APNUAL,GVALF+4
	CALLG	GVALF,G^CLI$GET_VALUE
	BLBC	R0,192$
	JSB	TRANSV
	TSTL	QUALV
	BEQL	192$
	MOVL	QUALV,LOWAPN
	TSTL	QUALV+4
	BNEQ	191$
	MOVL	QUALV,QUALV+4
191$:	MOVL	QUALV+4,HGHAPN
192$:
	MOVAL	CHPUAL,GVALF+4
	CALLG	GVALF,G^CLI$GET_VALUE
	BLBC	R0,194$
	JSB	TRANSV
	TSTL	QUALV
	BEQL	194$
	MOVL	QUALV,LOWCHP
	TSTL	QUALV+4
	BNEQ	193$
	MOVL	QUALV,QUALV+4
193$:	MOVL	QUALV+4,HGHCHP
194$:	
;
;	Section to open output file
;
	MOVAL	LSTBLK,R11
	BITNE	#CRSW,$SWTCH,161$
	MOVB	#2,FAB$B_RAT(R11)
161$:	PUSHAL	VAL2
	CALLS	#1,G^CLI$PRESENT		;is /out present?
	BLBC	R0,165$
	PUSHAL	FNODES
	PUSHAL	VAL2
	CALLS	#2,G^CLI$GET_VALUE
	MOVB	#80,FAB$B_FNS(R11)
	MOVAL	FILENMO,FAB$L_FNA(R11)
165$:	MOVAL	FILENM,R6
	LOCC	#^A/:/,#80,(R6)			;GET RID OF DEVICE
	BEQL	162$
	ADDL3	#1,R1,R6			;START OF DIR/FILE
	DECL	R0
	BRB	163$
162$:	MOVL	#80,R0
163$:	MOVL	R0,R7
	LOCC	#^A/]/,R7,(R6)			;AND DIRECTORY
	BEQL	166$
	ADDL3	#1,R1,R6			;START OF FILENM
	DECL	R0				;NUM OF CHARS LEFT
	BRB	164$
166$:	MOVL	R7,R0
164$:	MOVL	R6,FAB$L_DNA(R11)
	LOCC	#^A/./,R0,(R6)			;EVEN IF WE FAIL, R1 IS 1 PAST.
	MOVL	#^A/.DOC/,(R1)
	MOVL	R1,R7				;SAVE FOR TOC IF NEEDED: R7=END
	SUBL	R6,R1				;R6=START
	ADDL3	#4,R1,R8			;R8=LENGTH
	MOVB	R8,FAB$B_DNS(R11)
	$CREATE		FAB=(R11)
	BLBS	R0,170$
	$EXIT_S	R0
170$:	$CONNECT	RAB=LSTBLK_R
;
;	section to open TOC file if necessary
;
	PUSHAL	VAL3
	CALLS	#1,G^CLI$PRESENT
	BLBC	R0,169$
	MOVAL	TOCBLK,R11
	PUSHAL	FNODES
	PUSHAL	VAL3
	CALLS	#2,G^CLI$GET_VALUE
	MOVB	#80,FAB$B_FNS(R11)
	MOVAL	FILENMO,FAB$L_FNA(R11)
	MOVL	R6,FAB$L_DNA(R11)
	MOVB	R8,FAB$B_DNS(R11)
	MOVL	#^A/.RNT/,(R7)
	$CREATE		FAB=(R11)
	BLBS	R0,168$
	$EXIT_S	R0
168$:	$CONNECT	RAB=TOCBLK_R
	CLRB	$TOCSW
	MOVAL	#^A/.TOC/,R1
	MOVL	#4,R2
	CALL	OUTTOC
169$:
;
;	Now finish up details and go process
;
	MOV	HFOUT,HFOUT+8			; SET CHAR COUNTER IN OUT BUFF
	MOV	#OUBUF,HFOUT+4			; AND ADDRESS
	MOV	BUFADD,R3			; GET INPUT BUFFER
	CALL	CLRBF				; Get first line
	JMP	LGO				; AND INTO MAIN LOOP
;
;	Routine to translate the ascii strings to numbers
;
TRANSV:
	PUSHL	#3
	PUSHL	#4
	PUSHAL	QUALV
	PUSHAL	QUALB
	CALLS	#4,G^OTS$CVT_TI_L		;CONVERT NUMBER IN BUFF
	BLBS	R0,3$				;BAD VALUE ?
2$:	$EXIT_S	R0
3$:	CMPL	#1,R11
	BEQL	1$
	CALLG	GVALF,G^CLI$GET_VALUE		;SECOND VALUE, CALL AGAIN
	BLBC	R0,4$				;NONE THERE?
	PUSHL	#3
	PUSHL	#4
	PUSHAL	QUALV+4
	PUSHAL	QUALB
	CALLS	#4,G^OTS$CVT_TI_L		;CONVERT NUMBER IN BUFF
	BLBC	R0,2$				;BAD VALUE ?
1$:	RSB
4$:	CLRL	QUALV+4
	RSB
;
;	End of input file routine
;
ENDFIL::TSTB	CSMOR
	BNEQ	5$
	MOVL	#1,R0				;NO MORE FILES, EXIT
	$EXIT_S	R0
5$:	PUSHAL	FNDES
	PUSHAL	VAL1
	CALLS	#2,G^CLI$GET_VALUE
	BLBS	R0,10$
	CLRB	CSMOR
	MOVB	#-1,EOFSW
	JMP	LGO
10$:	MOVAL	LUN4,R11
	MOVB	#80,FAB$B_FNS(R11)
	MOVAL	FILENM,FAB$L_FNA(R11)
	$OPEN		FAB=(R11)			;FILE NAME
	BLBS	R0,17$
	$EXIT_S	R0
17$:	$CONNECT	RAB=LUN4_R
	MOVAL	FILENM,R6			; ADDRESS OF FILENAME
	CALL	TRCGET
40$:	CLRB	EOFSW				; Set no end of file
	MOV	BUFADD,R3			; Get input buffer
	CALL	CLRBF				; Get first line
	JMP	LGO				; More input
;
;	REQUIRE command
;
REQUR::	MOVZBL	LUNSTK,R11	; GET POINTER	
	CMPB	R11,LUNSTK+1	; AT END OF STACK?
	BHIS	50$		; YES		
	CALL	GETFIL		; Get input file
	INCL	R11		; new unit location
	MOVL	LUNSTK_A[R11],R10	;ADDRESS OF FAB
	MOVB	R1,FAB$B_FNS(R10)	;LENGTH OF FILE NAME
	MOVL	R0,FAB$L_FNA(R10)	;ADDRESS OF FILE NAME
	MOVL	R0,R6			;AND SAVE FOR TRCGET
	$OPEN	FAB=(R10)
	BLBC	R0,BADOP
	MOVL	LUNSTK_AR[R11],R10
	$CONNECT	RAB=(R10)
	BLBC	R0,BADOP
10$:	MOVB	R11,LUNSTK	; SAVE CURRENT STACK
	MOV	BUFADD,R3	; Current buffer address
	CALL	CLRBF		; CLEAR THE BUFFER
	MOV	#CR,R1		; GET CARRIAGE RET TO SIGNAL END OF LINE
	CALL	PBYT		; INTO BUFFER
	MOV	#LF,R1		; PUT LF INTO BUFFER AS END LINE
	CALL	PBYT		; INTO BUFFER
	CALL	BEGBF		; SET TO TOP OF BUFFER
	ADD	#TRCLN,TRCBUF	; Next traceback buffer
	CALL	TRCGET		; Set up traceback
	RETURN
50$:	CALL	GETLIT		; Skip the literal
	MOV	#20.,R0		; Too many nested .REQ
	JMP	ILCMA
BADOP:	MOV	#18.,R0		; Open failure
	JMP	ILCMA
;
;	REQUIRE BINARY
;
REQBIN::CALL	(R4)		; Get number
	CALL	CVSP		; Get half line count
	MOV	R3,-(SP)	; Save it for later
	MOV	R3,R5		; Vertical spacing
	CLR	R4
	CALL	PARTS		; Check if space available
	SUB	(SP),LINEC1	; Subtract from spacing
	SUB	(SP),LINEC2	; ""
	SUB	(SP)+,LINEC3	; ""
	CALL	REQUR		; Get input file
	MOVZBL	LUNSTK,R6	; Save current lun
10$:	CALL	FIN		; Get input line
	CMPNEB	LUNSTK,R6,50$	; No longer in required file ?
	MOV	BUFADD,R3	; Buffer address
	SUB	#2,BF.MAX(R3)	; Skip CR/LF
	SUB	#2,BF.CNT(R3)	; Skip CR/LF
20$:	CALL	GBYT		; Get single byte of input
	BCS	30$		; No more this buffer
	CALL	FOUT		; Output it
	BR	20$		; And more ...
30$:	CALL	OUTPUT		; End the line
	BR	10$
50$:	RETURN
;
;	Subroutine to set up input file
;
GETFIL:	CALL	GETLIT		; GET LITERAL (R0=ADDRESS,R1=LENGTH)
	BCS	30$		; NONE TO GET	
	RETURN
30$:	JMP	ILCM		; ILLEGAL COMMAND
;
;	Subroutine to set up traceback info
;	R6 contains Address of Filename
;	All registers are destroyed
;
TRCGET:	MOVL	TRCBUF,R3			; Buffer to save in
	CLRL	(R3)+				; Set line count
	MOVL	#TRCLN-$WORDL,R4		; Maximum number of bytes
10$:	MOVZBL	(R6)+,R7
	BEQL	20$				; END WITH NULL...
	CMPB	#32.,R7				; IT IS ENDED WITH A SPACE
	BEQL	20$
	MOVB	R7,(R3)+
	BRB	10$
20$:	CLRB	(R3)
	RETURN
;
;	Source file input routine
;	  Get 1 line from current source file
;
FIN::	MOV	BUFADD,R1	; Current buffer
	MOV	R1,BUFAD	; Reset subst stack to input buffer
	CLRB	SUBSTK		; At bottom of substitute stack
	TSTB	EOFSW
	BEQL	2$
	BRW	40$
2$:	MOVZBL	LUNSTK,R11	; GET STACK POINTER
	MOVL	LUNSTK_AR[R11],R11	; ADDRESS OF RAB
	MOV	BF.CAD(R1),R1	; ACTUAL BUFFER
	ADD	#BFLNK+1,R1	; SKIP OVER LINKS
	MOVL	R1,RAB$L_UBF(R11)
	MOVW	#IBFSZ,RAB$W_USZ(R11)
1$:	INC	@TRCBUF		; Next line number
	BEQ	1$		; Zero ?
	$GET	RAB=(R11)
	BLBS	R0,20$
	CMPL	R0,#RMS$_EOF
	BEQL	10$
	MOV	#11.,R0			; Input error message
	CALL	ERMSG
	TSTNEB	LUNSTK,10$	; Is logical unit stack ok?
	JMP	WRERR3		; NO
10$:	MOVZBL	LUNSTK,R11	; LETS CLOSE THE UNIT WITH EOF
	MOVL	LUNSTK_A[R11],R10
	$CLOSE	FAB=(R10)	
	TSTB	R11		; MORE LUNS IN STACK?
	BGTR	12$
	BRW	40$		; NO MORE	
12$:	SUB	#TRCLN,TRCBUF	; Backup to previous file
	DECB	LUNSTK
	BR	30$
20$:	MOV	BUFADD,R1	; BUFFER HEADER ADDRESS
	MOVZWL	RAB$W_RSZ(R11),BF.CNT(R1) ;GET BYTE COUNT OF LINE
	MOV	BF.CAD(R1),R0	; AND GET THE BUFFER ADDRESS
	ADD	#BFLNK,R0	; Set up buffer address
	MOV	R0,BF.ADD(R1)	; SAVE ADDRESS
	INC	R0
	ADD	BF.CNT(R1),R0	; ADVANCE POINTER TO END OF CHARACTERS
	MOVB	#CR,(R0)+	; SET CR/LF AT END OF LINE 
	MOVB	#LF,(R0)+	; 
	ADD	#2,BF.CNT(R1)	;AND ADJUST BYTE COUNT	
	MOV	BF.CNT(R1),BF.MAX(R1) ; AND BUFFER SIZE
	CLR	BF.FUL(R1)	; SET POINTER TO BOTTOM OF BUFFER
	CLR	BF.SPC(R1)	; Reset traceback params
	CLR	BF.VSP(R1)	; "	"
	CLR	BF.HED(R1)	; "	"
	BITEQ	#DEBSW,$SWTCH,30$; No debug ?
	.if	DEFINED	$DEBUG
	MOVW	#1,TTBLK_R+RAB$W_RSZ
	MOVAL	SPACE,TTBLK_R+RAB$L_RBF
	$PUT	RAB=TTBLK_R			; Another blank line
	.endc
	CALL	TTINOU		; Output whole input line
	.if	DEFINED	$DEBUG
	MOVW	#1,TTBLK_R+RAB$W_RSZ
	MOVAL	SPACE,TTBLK_R+RAB$L_RBF
	$PUT	RAB=TTBLK_R			; Another blank line
	.endc
30$:	CLC
	RETURN
40$:	MOVB	#-1,EOFSW	; SET EOF
	MOV	R3,R11
	MOV	BUFADD,R3	; Set nothing in buffer
	CALL	CLRBF		; Clear it
	MOV	R11,R3
	MOV	#LF,R1		; AND OUTPUT END OF LINE
	SEC
	RETURN
;
;	Output 1 character
;		R1 = character
;
FOUT::	TSTNEB	$OUTSW,10$	; No output?
	MOVB	R1,@HFOUT+$WORDL	; STORE CHARACTER IN BUFFER
	INC	HFOUT+$WORDL		; INCREMENT BUFFER POINTER
	DEC	HFOUT+8		; ANY MORE ROOM IN BUFFER?
	BEQ	OUTPUT		; IF EQ NO
10$:	RETURN			; 
;
; THIS ROUTINE OUTPUTS THE CURRENT CONTENTS OF THE LINE BUFFER (RSX)
;
OUTPUT::MOVZWL	HFOUT,R10		; CALCULATE LENGTH OF LINE TO OUTPUT
	SUB	HFOUT+8,R10
	BNE	10$			; Not empty ?
	BITNE	#CRSW,$SWTCH,30$	; CRLF output?
10$:	TSTNEB	$OUTSW,20$		; No output?
	MOVAL	LSTBLK_R,R11
	MOVW	R10,RAB$W_RSZ(R11)
	MOVAL	OUBUF,RAB$L_RBF(R11)
	$PUT	RAB=(R11)
	BLBC	R0,WRERR3
20$:	MOV	HFOUT,HFOUT+8
	MOV	#OUBUF,HFOUT+$WORDL
30$:	RETURN
WRERR3:	$EXIT_S	R0
;
;	Output table of contents
;		R1	= STRING ADDRESS
;		R2	= LENGTH
;
OUTTOC::MOVAL	TOCBLK_R,R11
	MOVL	R1,RAB$L_RBF(R11)
	MOVW	R2,RAB$W_RSZ(R11)
	$PUT	RAB=(R11)
	RETURN
;	
; TERMINAL I/O ROUTINES
;
;
;	CALL	EROUT
;	   Input:
;		R0= ASCIZ string address
;
;	CALL	TTOUT
;	   Input:
;		R0	= STRING ADDRESS
;		R1	= LENGTH
;
EROUT::	MOV	R0,-(SP)
1$:	MOV	(SP)+,R0	; String address
	MOV	R0,R1		; DITTO
10$:	CMPNEB	(R1),#CR,20$	; Not carriage return ?
	INC	R1
	MOV	R1,-(SP)	; Next sub string
	INC	(SP)		; Skip CR,LF
	MOV	#1$,-(SP)	; Next return
	BR	30$
20$:	TSTB	(R1)+		; FIND END OF STRING
	BNE	10$		; NOT FOUND
30$:	SUB	R0,R1		; LENGTH OF STRING
	DEC	R1
TTOUT::	TST	R1		; Check string length
	BLE	10$		; None ?
;
	MOVAL	TTBLK_R,R11
	BITNEB	#SW.DIS,$OUTSW,5$	; No output file ?
	BITEQ	#EROSW,$SWTCH,5$	; Output to terminal ?		
	MOVAL	LSTBLK_R,R11
5$:	MOVW	R1,RAB$W_RSZ(R11)
	MOVL	R0,RAB$L_RBF(R11)
	$PUT	RAB=(R11)
;
10$:	RETURN
;
;	This routine types out the whole input line
;
TTINOU::MOV	#IBUF1,R0			; Buffer header
	MOV	BF.FUL(R0),R1			; Bytes processed
	ADD	BF.CNT(R0),R1			; Plus remaining count
	SUB	#2,R1				; Remove carriage control
	MOV	BF.CAD(R0),R0			; Actual buffer
	ADD	#BFLNK+1,R0			; Skip over links
	JMP	TTOUT
;
;	Wait for operator to adjust forms
;
OPRWAT::	
	BITEQ	#PAUSW,$SWTCH,10$	; DON'T WAIT FOR NEW PAPER?
	PUSHAL	OPRTXT
	PUSHAL	QUALB
	CALLS	#2,G^LIB$GET_INPUT
10$:	RETURN				; RETURN	
;
;$DEBUG=1			; FOR DEBUGGING
;
	.IF DF	$DEBUG
;
;	The following debugging routines are designed to ouput
;	useful information when debugging new features
;
;	If $DEBUG is defined each input line is automatically output.
;	In addition a call to CHROUT will output the character in R1.
;	Control characters are enclosed in <>,
;
CHROUT::TSTW	QIOB+8		;IS CHAN IN BLK?
	BNEQ	1$		;IF YES CONTINUE
	$ASSIGN_S	CHAN=QIOB+8,DEVNAM=TTDES
1$:	MOVL	R1,TEMP
	MOVZBL	R1,R1		;CLEAR EXTRA BITS
	BIC	#177600,R1	; clear extra bits
	CMPNE	R1,#CR,10$	; NOT CARRIAGE RET
	MOVL	#4.,QIOB+32
	MOVAL	CRM,QIOB+28
	$QIOW_G	QIOB
	BR	100$
10$:	CMPNE	R1,#LF,20$	; NOT LINE FEED
	MOVL	#4.,QIOB+32
	MOVAL	LFM,QIOB+28
	$QIOW_G	QIOB
	BR	100$
20$:	CMPNE	R1,#TAB,30$
	MOVL	#4.,QIOB+32
	MOVAL	TBM,QIOB+28
	$QIOW_G	QIOB
	BR	100$
30$:	CMP	R1,#32.		; PRINTABLE? (> SPACE)
	BGE	40$		; YES
	MOVB	R1,CTM+1	; NO
	BISB	#64.,CTM+1
	MOVL	#3.,QIOB+32
	MOVAL	CTM,QIOB+28
	$QIOW_G	QIOB
	BR	100$
40$:	MOVL	#1.,QIOB+32
	MOVAL	TEMP,QIOB+28
	$QIOW_G	QIOB
100$:	MOVL	TEMP,R1		; Restore
	RETURN
	.VARS
TEMP:	.LONG	0
CRM:	.ASCII	/<CR>/
LFM:	.ASCII	/<LF>/
TBM:	.ASCII	/<TB>/
CTM:	.ASCII	/<@>/
SPACE:	.ASCII	/ /
QIOB:	$QIO	FUNC=IO$_WRITEVBLK!IO$M_NOFORMAT
TTDES:	.ASCID	/TT:/
	.ENDC
	.END