.TITLE	PRTOUT
	.IDENT	/11N/
;
; SUBROUTINE FILE PRTOUT.MAC
; SET OF SUBROUTINES TO PROCESS OUT DISASSEMBLED
; RECORDS.
;
; GLOBALS DEFINED HERE
	.GLOBL	DISOUT	WRDOUT	WRDFIN	INDRLD	TYPRLD
	.GLOBL	TXTRAN	WRDPRC	TOFC
;
; GLOBALS DEFINED ELSEWHERE
	.GLOBL	RLDPTR	FLWORD	DS.RCN	WCOUNT
	.GLOBL	BUFTRN	RLDBUF	HBUF1	HBUF2	HBUFL
	.GLOBL	PCLOAD	PCOLD	DISRLD	OUTBUF	$CBOMG
	.GLOBL	NBUF	LBUF3	LBUF	WCOUNT	RLDST2
	.GLOBL	RLDLN2	RLDST3	RLDLN3	WRDPTR	LBUF2
	.GLOBL	PCINST	LBUF1	TXTOLD	TXTPTR	WORDAS
	.GLOBL	PCCURR	DS.TCN	TXTBUF	RLDLEN	DS.RLD
	.GLOBL	DS.NRL	RECFIL	OUTFDB	LINEC	LINEP
;
; GLOBAL TRAP SYMBOLS
	.GLOBL	TE.RAM	TE.URL
;
; MACROS CALLED
	.MCALL	PUT$	FDOF$L
;
; MACROS DEFINED HERE
;
; MACRO TO PERFORM A QIO ON A BUFFER
	.MACRO	QIOEXE	ADD,LEN
	PUT$	#OUTFDB,ADD,LEN
	CALL	TOFC
	.ENDM	QIOEXE
;
; MACRO TO CALL A ROUTINE TO CHECK FOR NON BLANK STRING
	.MACRO	BLNKCH	ADD,LEN
	MOV	ADD,R0
	MOV	LEN,R1
	JSR	PC,BLKCHK
	.ENDM	BLNKCH
;
; MACRO TO CALL A BLANK TRUNCATION ROUTINE
	.MACRO	TRNCBL	ADD,LEN
	MOV	ADD,R0
	MOV	LEN,R1
	JSR	PC,TRCBLK
	.ENDM	TRNCBL
;
; MACRO FOR OFFSET TRANSFER OF ONE BUFFER TO ANOTHER
	.MACRO	BUFTRA	LENO,ADDO,LENI,ADDI,OFF
	MOV	ADDO,R0
	MOV	ADDI,R1
	MOV	LENI,R2
	SUB	OFF,R2
	ADD	OFF,R1
	MOV	R2,LENO
	JSR	PC,BUFTRN
	.ENDM	BUFTRA
;
; MACRO TO SET UP AND CALL A CONVERSION ROUTINE
	.MACRO	CBASCL	ADR,NUM,FLAG,ROUTIN
	MOV	ADR,R0
	.IF IDN	<R1>,<NUM>
	.IFF
	.IF IDN	<$CBTMG>,<ROUTIN>
	MOVB	NUM,R1
	.IFF
	MOV	NUM,R1
	.ENDC
	.ENDC
	MOV	FLAG,R2
	JSR	PC,ROUTIN
	.ENDM	CBASCL
;
; DEFINE VARIOUS SYMBOLS LOCALLY
FDOF$L
;
; SUBROUTINES USED BY MAIN CODE
;
; SKPNUM
; ROUTINE TO INCREMENT R4 INDEX TO FIRST NON-NUMERIC CHAR IN LINE
; ON CALL:
;	R4 POINTS TO 1ST NUMERIC CHAR
; ON RETURN:
;	R4 POINTS TO 1ST NON-NUMERIC CHAR PAST ORIGINAL
; OTHER REGISTERS USED: R2
SKPNUM:	MOVB	(R4),R2
	CMPB	R2,#60
	BLT	1$
	CMPB	R2,#71
	BGT	1$
	INC	R4
	BR	SKPNUM
1$:	RTS	PC
;
; ROUTINE TO CHECK FOR NON-BLANK STRING
; ON CALL:
;	R0 CONTAINS ADDRESS
;	R1 CONTAINS LENGTH
; ON RETURN:
;	R0 POINTS TO NEXT CHAR PAST END OF STRING
;	R1 CONTAINS ORIG LEN - NO. OF BLANK CHARACTERS
;	'Z' SET IF BLANK, CLEAR OTHERWISE
BLKCHK:	CMPB	(R0)+,#40
	BNE	1$
	SOB	R1,BLKCHK
	SEZ
	RTS	PC
1$:	CLZ
	RTS	PC
;
; ROUTINE TO TRUNCATE TRAILING BLANKS BY RETURNING
; A NON TRAILING BLANK CHAR COUNT.
; ON CALL:
;	R0 CONTAINS ADDRESS OF STRING
;	R1 CONTAINS TOTAL LENGTH
; ON RETURN:
;	R0 SAME
;	R1 CONTAINS NON-TRAILING COUNT
TRCBLK:	MOV	R0,-(SP)
	ADD	R1,R0
2$:	CMPB	-(R0),#40
	BNE	1$
	SOB	R1,2$
1$:	MOV	(SP)+,R0
	RTS	PC
;
; ROUTINE TO CHECK FOR A NUMBER SPEC IN ASCII BUFFER
; ON CALL:
;	R0 CONTAINS ADDRESS
; ON RETURN:
;	'Z' SET IF NUMBER SPEC NOT PRESENT
;	R0 POINTS TO FIRST NUM. CHAR (IF PRESENT)
; OTHER REGISTERS USED: R1
NMBCHK:	MOVB	(R0),R1
	CMPB	R1,#'@
	BNE	3$
	INC	R0
	MOVB	(R0),R1
3$:	CMPB	R1,#'#
	BNE	1$
	INC	R0
	MOVB	(R0),R1
1$:	CMPB	R1,#60
	BLT	2$
	CMPB	R1,#71
	BGT	2$
	CLZ
	RTS	PC
2$:	SEZ
	RTS	PC
; TYPRLD
; ON CALL:
;	R3 POINTS TO NEXT RLD COMMAND
; ON RETURN:
;	R0 HAS TYPE - 0 INDICATES NO RLD RECORD AVAILABLE
;	R1 HAS ADDRESS
; CONDITION CODES SET AS FOLLOWS:
;	Z - NO RLD RECORD AVAILABLE
;	V - HIGH BYTE MATCH WITH EVEN PCCURR
;	C - BYTE/WORD MATCH WITH PCCURR
;	N - BYTE RLD
TYPRLD:	BIT	#DS.RCN,FLWORD	;ARE WE IN RLD CONTIN.?
	BEQ	3$		;IF NOT, BRANCH
	CMP	R3,#RLDBUF	;THEN ARE WE AT END OF CONT. BUFFER
	BLT	4$		;IF NOT, THEN CONTINUE
	BIC	#DS.RCN,FLWORD	;IF SO, CLEAR FLAG
3$:	BIT	#DS.RLD,FLWORD	;DO WE HAVE REGULAR RLD BUFFER?
	BEQ	5$		;IF NOT, CAN WE GET IT?
	MOV	#RLDBUF,R0	;IF SO, SEE
	ADD	RLDLEN,R0	;IF WE ARE PAST
	CMP	R0,R3		;END OF IT
	BLE	6$		;IF SO, CAN WE GET A NEW ONE?
4$:	MOVB	(R3),R0		;TYPE BYTE IN R0
	BIC	#177600,R0	;CLEAR OUT GARBAGE
	MOVB	1(R3),R1	;ADDRESS BYTE IN R1
	SUB	#4,R1		;SUBTRACT OFF FUDGE
	BIT	#DS.RCN,FLWORD	;ARE WE IN CONTINUATION
	BNE	1$		;IF SO, BRANCH
	ADD	PCLOAD,R1	;ADD IN LOAD PC
	BR	2$		;AND KEEP GOING
1$:	ADD	PCOLD,R1	;ADD IN OLD LOAD PC
2$:	MOV	#260,13$	;PROTOTYPE SCC
	CMP	R1,PCCURR	;DO WE HAVE OUTRIGHT MATCH
	BNE	9$		;IF NOT, TRY FOR UPPER BYTE
	BIS	#1,13$		;SET "C" IN STATUS FOR MATCH
	BR	11$		;SKIP UPPER BYTE CHECK
9$:	BIT	#1,PCCURR	;IS PC EVEN?
	BNE	11$		;IF NOT, SKIP
	DEC	R1
	CMP	R1,PCCURR	;MATCH WITH UPPER BYTE?
	BNE	10$		;IF NOT, SKIP
	BIS	#2,13$		;SET "V" FOR UPPER BYTE MATCH
10$:	INC	R1		;RESTORE ADDRESS
11$:	BITB	#200,(R3)	;DOES THIS RLD INSTRUCTION REFER TO BYTE
	BEQ	12$		;IF NOT, SKIP
	BIS	#10,13$		;SET "N" FOR BYTE RLD
12$:	CCC			;CLEAR ALL CC
13$:	SCC			;SET APPROPRIATE BITS
	RTS	PC		;RETURN WITH COND CODES
6$:	BIC	#DS.RLD,FLWORD	;INDICATE BUFFER EMPTY
5$:	BIT	#DS.NRL,FLWORD	;IS RLD RECORD WAITING?
	BEQ	7$		;IF NOT, OUT OF LUCK
	JSR	PC,RECFIL	;IF SO, GO GET IT
	MOV	RLDPTR,R3	;R3 HAS NEW RLD POINTER
	BR	TYPRLD		;MAKE ANOTHER TRY
7$:	CLR	R0		;CLEAR R0
	CLR	R1		;AND R1 TO INDICATE NO RLD
	RTS	PC
;
; INDRLD SUBROUTINE
; TO PROCESS RLD COMMANDS THAT ARE INDEPENDENT OF TEXT
; ON CALL:
;	R3 CONTAINS POINTER TO RLD
; OTHER REGISTERS USED: R0,R1,R2,R4,R5
INDRLD:	JSR	PC,DISRLD	;GET APPROPRIATE STRING
	MOV	#OUTBUF,R0	;GET SET TO FILL BUFFER
	MOV	PCCURR,R1	;ADDRESS IN R1
	MOV	#1,R2		;NO ZERO SUPPRESS
	JSR	PC,$CBOMG	;PERFORM ADDRESS CONVERSION
	MOV	#4,R2		;PUT 4 TABS
1$:	MOVB	#11,(R0)+	;IN OUTPUT LINE
	SOB	R2,1$
2$:	MOVB	(R5)+,(R0)+	;MOVE IN MESSAGE
	SOB	R4,2$
	SUB	#OUTBUF,R0	;GET NO. OF BYTES IN R0
	MOV	R0,R5		;USE R5 IN DIRECTIVE (R0 DESTROYED)
	QIOEXE	#OUTBUF,R5	;AND OUTPUT LINE
	RTS	PC
;
; SUBROUTINE BUFCNT
; TO COUNT NUMBER OF BUFFERS  IN USE
;
BUFCNT:	MOV	#3,NBUF		;ASSUME 3 USED
	BLNKCH	#LBUF3,#12.	;IS 3RD BLANK?
	BNE	1$		;IF NOT WE'RE DONE
	DEC	NBUF		;COUNT DOWN TO 2
	BLNKCH	#LBUF2,#12.	;IS 2ND BLANK?
	BNE	1$		;IF NOT, DONE
	DEC	NBUF		;COUNT DOWN TO 1
1$:	RTS	PC
;
; SUBROUTINE SETRLD
; TO SET UP BUFFERS WITH RLD STRINGS
SETRLD:	CMP	NBUF,#2		;DO WE HAVE AT LEAST TWO BUFFERS
	BGE	1$		;IF SO BRANCH
	TRAP	TE.RAM		;BUT ONE IS ERROR IF RLD
1$:	CMP	NBUF,WCOUNT	;NO. OF BUFFERS >= NO. OF WORDS?
	BGT	2$		;OK, IF YES
	BEQ	3$
	TRAP	TE.RAM		;IF NOT, ERROR
2$:	MOV	#LBUF2,R0	;THIS IS POSSIBLE FOR 3 BUF, 2 WORD
	JSR	PC,NMBCHK	;SEE IF NUM SPEC IN 2ND BUFFER
	BEQ	4$		;CHECK 3RD WORD IF NOT
	CLR	-(SP)		;CLEAR FLAG ON STACK
	JSR	PC,TYPRLD	;GET NEXT RLD STATUS IN STATUS BITS
	BPL	21$		;IF FULL WORD, LEAVE FLAG ZERO
	DEC	(SP)		;IF BYTE, LEAVE -1 FLAG
21$:	JSR	PC,DISRLD	;GET RLD STRING
	BUFTRA	RLDLN2,#RLDST2,R4,R5,#0 ; AND XFER INTO BUFFER
	TST	(SP)+		;DID WE HAVE BYTE RLD?
	BEQ	22$		;IF NOT, SKIP THE NONSENSE
	JSR	PC,BYTRLD	;OTHERWISE CHECK FOR HIGH BYTE RLD
22$:	RTS	PC
4$:	MOV	#LBUF3,R0	;PERFORM CHECK ON
	JSR	PC,NMBCHK	;3RD BUFFER
	BNE	6$		;ERROR IF NO NUMBER THERE
	TRAP	TE.RAM
6$:	JSR	PC,DISRLD	;GET RLD STRING
	BUFTRA	RLDLN3,#RLDST3,R4,R5,#0 ;AND XFER
	RTS	PC
3$:	CMP	WRDPTR,#2	;2ND OR 3RD WORD?
	BGT	4$		;IF 3RD, BRANCH
	MOV	#LBUF2,R0	;OTHERWISE 2ND BUFFER
	JSR	PC,NMBCHK	;IS THERE NUM SPEC?
	BNE	11$		;IF NONE, ERROR
	TRAP	TE.RAM
11$:	JSR	PC,DISRLD	;GET RLD STRING
	BUFTRA	RLDLN2,#RLDST2,R4,R5,#0 ;AND XFER
	CMP	WCOUNT,#3	;FOR 3 WORDS,CHECK NEXT
	BEQ	7$		;RLD FOR A COMMAND
8$:	RTS	PC		;ELSE RETURN
7$:	BIT	#DS.RCN,FLWORD	;IS RLD CONTINUED?
	BEQ	10$		;IF NOT BRANCH
	CMP	R3,#RLDBUF	;ARE WE STILL IN OVERFLOW BUFFER
	BLT	10$		;IF SO, OK
	BIC	#DS.RCN,FLWORD	;OTHERWISE CLEAR FLAG
10$:	JSR	PC,TYPRLD	;GET TYPE AND ADDRESS
	CMP	R0,#7		;SEE IF AN IND.
	BLT	9$		;TYPE
	CMP	R0,#11		;IF SO, RETURN
	BLE	8$		;OTHERWISE, CHECK
9$:	MOV	PCINST,R0	;ON ADDRESS
	ADD	#4,R0		;IF ADDRESS
	CMP	R0,R1		;IS NOT FOR
	BNE	8$		;3RD INSTR. WORD, RETURN
	BR	4$		;AND SET UP BUFFER
;
; ROUTINE TO CHECK FOR LOW AND HIGH BYTE RLD'S ON ONE WORD WHICH
; IS AN OPERAND FOR AN INSTRUCTION.
;
BYTRLD:	SUB	#2,PCCURR	;LOOK AT SECOND WORD OF INSTRUCTION
	JSR	PC,TYPRLD	;GET NEXT RLD TYPE
	BVC	2$		;IF NO HIGH BYTE MATCH, DO THINGS NORMAL
	JSR	PC,DISRLD	;OTHERWISE GET RLD TEXT
	BUFTRA	RLDLN3,#RLDST3,R4,R5,#0 ;STORE IT
	MOV	R3,RLDPTR	;UPDATE RLD POINTER
	ADD	#2,PCCURR	;RESTORE CURRENT PC
	MOV	RLDLN3,-(SP)	;SAVE HIGH BYTE RLD TEXT LENGTH
	CLR	RLDLN3		;CLEAR IT IN PREPARATION FOR OUTPUT
	MOV	RLDLN2,-(SP)	;DO THE SAME FOR LOW BYTE RLD
	CLR	RLDLN2
	MOV	#LBUF2,R0	;CLEAR OUT SECOND
	MOV	#12.,R1		;TEXT BUFFER FOR
	JSR	PC,BLNKIT	;INSTRUCTION
	MOV	#"(P,LBUF2	;NOW PUT IN EXPLICIT PC
	MOV	#"C),LBUF2+2	;REFERENCE
	MOVB	#'+,LBUF2+4
	JSR	PC,PRTOUT	;AND PRINT THE LINE
	MOV	#OUTBUF,R0	;NOW BLANK OUT
	MOV	#132.,R1	;THE WHOLE INSTRUCTION
	JSR	PC,BLNKIT	;BUFFER
	MOV	#5,R1		;SET UP TO PUT IN FIVE
	MOV	#OUTBUF,R5	;TABS
1$:	MOVB	#11,(R5)+	;IN A LOOP
	SOB	R1,1$
	MOV	#BYTASC,R0	;NOW TRANSFER IN MACRO
	MOV	#6,R1		;.BYTE DIRECTIVE TEXT
	JSR	PC,TXTRAN
	MOV	#RLDST2,R0	;NOW GET TEXT FOR LOW BYTE
	MOV	(SP)+,R1	;GET SAVED LENGTH IN R1
	JSR	PC,TXTRAN	;AND TRANSFER IT IN
	MOVB	#',,(R5)+	;PUT IN COMMA DELIMITER
	MOV	#RLDST3,R0	;SET UP FOR HIGH BYTE TEXT
	MOV	(SP)+,R1	;SAVED LEN IN R1
	JSR	PC,TXTRAN
	SUB	#OUTBUF,R5	;TOTAL OUTPUT LENGTH IN R5
	QIOEXE	#OUTBUF,R5	;PRINT NEW LINE
	CMP	(SP)+,(SP)+	;CLEAR OFF TWO RETURN POINTERS
	RTS	PC		;AND RETURN TO ORIGINAL CALL OF DISOUT
2$:	ADD	#2,PCCURR	;RESTORE CURRENT PC
	RTS	PC		;AND RETURN NORMALLY
;
; MAIN SUBROUTINE TO TAKE A DISASSEMBLED INSTRUCTION AND
; PRINT IT OUT WITH APPROPRIATE RLD STRINGS SUBSTITUTED
; FOR NUMBERS
TXTRAN:	TST	R1		;ANYTHING TO XFER
	BEQ	1$		;IF NOT, JUST RETURN
	MOVB	(R0)+,(R5)+	;SUBROUTINE TO XFER
	BEQ	2$		;IF ZERO BYTE ENCOUNTERED, JUMP OUT
	SOB	R1,TXTRAN	;TEXT INTO OUTPUT BUFFER
1$:	RTS	PC
2$:	DEC	R5		;BACK UP OUTPUT POINTER
	RTS	PC
DISOUT:	MOV	RLDPTR,R3	;SET UP RLD POINTER IN R3
	JSR	PC,BUFCNT	;SET UP BUFFER COUNT
	JSR	PC,TYPRLD	;GET TYPE AND ADDRESS
	TST	R0		;ANY RLD COMMANDS?
	BEQ	PRTOUT		;IF NOT, OUTPUT LINE
	MOV	#1,WRDPTR	;NOW AT FIRST WORD
	MOV	PCINST,R2	;GET INSTR. PC IN R2
	CMP	R1,R2		;COMPARE WITH RLD PC
	BNE	1$		;IF SAME, CHECK FOR IND. TYPE
	CMP	R0,#7		;IF NOT
	BLT	8$		;INDEPENDENT
	CMP	R0,#11		;DO .WORD
	BGT	8$		;ELSE DO
	BR	9$		;INDEP. SUBROUTINE
8$:	JSR	PC,TRPCHK	;CHECK ON TRAP INSTRUCTIONS
	BNE	10$		;IF NOT, DO .WORD
	JSR	PC,SETRLD	;GO DO RLD DISASSEMBLY
	MOV	R3,RLDPTR	;SAVE NEW RLD POINTER
	BR	PRTOUT		;NOW PRINT IT OUT
10$:	JMP	WRDPRC		;ROUTINE
1$:	BGT	2$		;IF .GT. MORE CHECKING
	CMP	R0,#7		;IS TYPE OF
	BGE	11$		;RLD AN INDEPENDENT TYPE?
	TRAP	TE.URL
11$:	CMP	R0,#10		;IF PSECT OR LOCATION
	BLE	PRTOUT		;COUNTER, WAIT
	CMP	R0,#11		;IF NOT .LIMIT 
	BLE	9$		;REPORT ERROR
	TRAP	TE.URL
9$:	JSR	PC,INDRLD	;ELSE OUTPUT NOW
	BIT	#DS.RCN,FLWORD
	BEQ	3$
	CMP	R3,#RLDBUF	;ARE WE THROUGH WITH
	BLT	3$		;CONTIN.
	BIC	#DS.RCN,FLWORD	;TURN OFF FLAG
3$:	MOV	R3,RLDPTR	;SAVE RLD POINTER
	BR	DISOUT		;TRY AGAIN
2$:	DEC	R1		;SEE IF IT REFERS TO NEXT BYTE
	CMP	R1,R2
	BEQ	10$		;IF SO, DO BYTE OUT
	INC	R1		;RESTORE R1 IF NOT
	CMP	WCOUNT,#2	;WERE THERE 2 WORDS AT LEAST
	BGE	4$		;IF SO, CONTINUE CHECKING
	BR	PRTOUT		;ELSE PRINT OUT INSTRUCTION
4$:	ADD	#2,R2		;SEE IF RLD FOR 2ND WORD
	INC	WRDPTR		;NOW AT 2ND WORD
	CMP	R1,R2		;MATCHES INSTRUCTION
	BGT	5$		;KEEP CHECKING
	BEQ	6$		;THIS IS IT
5$:	DEC	R1
	CMP	R1,R2
	BEQ	10$
	INC	R1
	CMP	WCOUNT,#3	;ARE THERE 3 WORDS
	BLT	PRTOUT		;NO, GO PRINT
7$:	ADD	#2,R2		;ADD 2 TO PC COUNTER
	INC	WRDPTR		;INCREMENT TO 3RD WORD
	CMP	R1,R2		;DOES IT MATCH RLD PC
	BGT	12$		;IF GREATER, GO CHECK FOR UPPER BYTE
	BGE	6$		;IF LESS, ERROR
	TRAP	TE.URL
12$:	DEC	R1
	CMP	R1,R2
	BEQ	10$
	BR	PRTOUT		;IF NOT UPPER BYTE, GO PRINT OUT
6$:	TSTB	(R3)		;IS THIS A BYTE ADDRESS
	BMI	10$		;IF MI YES
	JSR	PC,SETRLD	;SET UP RLD STRING POINTERS
	MOV	R3,RLDPTR	;SAVE CURRENT RLD POINTER
PRTOUT:	MOV	#OUTBUF,R5	;R5 HAS OUTPUT BUFFER POINTER
	CBASCL	R5,PCINST,#1,$CBOMG ;CONVERT ADDRESS TO ASCII
	MOV	R0,R5		;RE-ESTABLISH OUT BUFFER PTR
	MOVB	#11,(R5)+	;PUT IN TAB
	CLRB	BYTEFG		;MARK THIS AS NO BYTE
	JSR	PC,FILDAT	;FILL IN DATA WORDS
	MOVB	#11,(R5)+	;SKIP OVER ADDRESS FIELD
	TRNCBL	#LBUF1,#12.	;GET RID OF TRAILING BLANKS
	JSR	PC,TXTRAN	;AND TRANSFER IN TEXT
	MOVB	#11,(R5)+	;PUT IN TAB
	MOV	R5,R3
	CMP	NBUF,#2		;HOW MANY BUFFERS
	BLT	1$		;IF ONE, PRINT OUT BUFFER
	JSR	PC,FILLUP	;FILL IN FIRST ARG
	CMP	NBUF,#3		;ARE THERE 3 BUFFERS
	BLT	1$		;IF NOT, PRINT LINE
	MOVB	#',,(R5)+	;IF SO, PUT IN COMMA
	JSR	PC,FILLUP	;AND 2ND ARG
1$:	ADD	#39.,R3		;COMPUTE PAD CHARS
	SUB	R5,R3
	ASH	#-3,R3		;GET NUMBER OF TABS NEEDED
	BGT	2$		;IF GT, IT'S A SHORT LINE
	MOV	#1,R3		;DO ONE TAB ONLY
2$:	MOVB	#11,(R5)+
	SOB	R3,2$
	MOV	WCOUNT,R4
	CALL	ASCR50
	SUB	#OUTBUF,R5	;R5 HAS NO. OF CHARS
	QIOEXE	#OUTBUF,R5	;DO IT
	CLR	RLDLN2		;CLEAR RLD LENGTH
	CLR	RLDLN3		;COUNTERS
	RTS	PC		;AND RETURN
FF=14
TOFC:	INC	LINEC		;COUNT THIS LINE
	CMP	LINEC,LINEP	;ARE WE AT END OF PAGE
	BLE	1$		;IF LE, NO
	PUT$	#OUTFDB,#HBUF2,#1
	PUT$	#OUTFDB,#HBUF1,HBUFL
	CLR	LINEC		;RESET LINE COUNT
1$:	RTS	PC
ASCR50:	MOV	R5,R0		;COPY BUFFER LOCATION
	MOV	R4,R5		;NUMBER OF WORDS TO PRINT
	MOVB	#11,(R0)+	;START WITH A TAB
	MOVB	#';,(R0)+	;COMMENT FLAG
	MOV	TXTOLD,R3	;START OF BINARY WORDS
	MOVB	#40,(R0)+	;FIRST A SPACE
1$:	MOV	#2,R1		;NUMBER OF ASCII CHARS PER WORD
	TSTB	BYTEFG		;ARE WE DOING A BYTE?
	BEQ	2$		;IF EQ, NO
	DEC	R1		;BYTE - DO 1 BYTE ONLY
2$:	MOVB	(R3)+,R2	;NEXT CHARACTER
	BIC	#200,R2		;CONVERT TO 7-BIT ASCII
	CMPB	#40,R2		;IS IT A CONTROL?
	BLE	3$		;IF GE, NO
	MOV	#40,R2		;SUBSTITUTE A SPACE
3$:	CMPB	#136,R2		;IS IT A NON-PRINTABLE
	BGE	4$		;IF LE, NO
	MOV	#40,R2		;SUBSTITUTE A SPACE
4$:	MOVB	R2,(R0)+	;MOVE INTO OUTPUT BUFFER
	SOB	R1,2$		;DO REST OF CHARS
	SOB	R5,1$		;DO REST OF WORDS
	MOV	#4,R5		;COMPUTE PADS NEEDED
	SUB	R4,R5
7$:	MOV	#3,R3
6$:	MOVB	#40,(R0)+
	SOB	R3,6$
	SOB	R5,7$
	MOV	TXTOLD,R3	;RESET START OF BINARY WORDS
	TSTB	BYTEFG		;ARE WE DOING A BYTE?
	BNE	8$		;IF NE, YES - NO R50
	MOVB	#40,(R0)+	;SEPARATE WITH A SPACE
5$:	CLR	R1
	BISB	(R3)+,R1	;GET LOW BYTE
	SWAB	R1		;SAVE IN HIGH BYTE
	BISB	(R3)+,R1	;GET HIGH BYTE
	SWAB	R1		;POSITION HIGH BYTE
	CALL	$C5TA		;CONVERT FROM R50 TO ASCII
	SOB	R4,5$		;GET NEXT WORD
8$:	MOV	R0,R5		;RESTORE BUFFER POINTER
	RTS	PC
FILDAT:	MOV	TXTOLD,R4	;FIRST INST WORD POINTED TO BY R4
	MOV	WCOUNT,R3	;NO. OF WORDS IN R3
	MOV	#1,R2		;DON'T TRUNC. LEADING ZEROES
	MOV	R5,R0		;ADDRESS FOR XFER IN R0
1$:	CLR	R1		;SET UP FOR BIS
	BISB	(R4)+,R1	;INST BYTE IN R1
	TSTB	BYTEFG		;ARE WE DOING A BYTE?
	BNE	4$		;IF NE, YES
	SWAB	R1		;SAVE IN HIGH POSITION
	BISB	(R4)+,R1	;GET HIGH BYTE
	SWAB	R1		;POSITION HIGH BYTE
	JSR	PC,$CBOMG	;CONVERT TO ASCII IN BUFFER
	BR	5$
4$:	JSR	PC,$CBTMG	;CONVERT TO ASCII (BYTE)
5$:	MOVB	#11,(R0)+	;INSERT TAB
	SOB	R3,1$		;CONVERT ALL THE WORDS
	MOV	R0,R5		;RE-ESTABLISH OUT BUFF PTR
	MOV	#3,R3		;GET NO. OF
	SUB	WCOUNT,R3	;TABS TO FILL
	BEQ	3$		;SKIP IF ZERO
2$:	MOVB	#11,(R5)+	;FILL IN
	SOB	R3,2$		;TABS
3$:	RTS	PC
WRDPRC:	MOV	#1,WCOUNT	;LET WORD COUNT BE 1
	MOV	TXTOLD,TXTPTR	;MOVE TEXT POINTER BACK
	JSR	PC,WRDOUT	;DO A .WORD
	BIT	#DS.TCN,FLWORD	;WAS THIS TEXT CONTIN.
	BEQ	1$		;IF NOT, SKIP
	CMP	TXTPTR,#TXTBUF	;INTO TEXT BUFFER YET?
	BLT	1$		;IF NOT SKIP
	BIC	#DS.TCN,FLWORD	;IF SO, CLEAR FLAG
1$:	RTS	PC
FILLUP:	CMPB	-1(R5),#11	;IS THIS FIRST OR 2ND
	BNE	1$		;IF NOT TAB, THEN 2ND
	MOV	#LBUF2,R4	;2ND ASCII BUFF ADD IN R4
	MOV	R4,-(SP)	;SAVE ORIGINAL ON STACK
	MOV	#RLDST2,R0	;RLD BUFFER ADDRESS IN R0
	MOV	RLDLN2,R1	;NO. OF RLD CHARS IN R1
	BR	2$		;GO CONTINUE
1$:	MOV	#LBUF3,R4	;SAME AS ABOVE BUT
	MOV	R4,-(SP)	;SAVE ORIGINAL ON STACK
	MOV	#RLDST3,R0	;FOR 3RD ASCII BUFFER
	MOV	RLDLN3,R1	;
2$:	TST	R1		;CHECK NO OF RLD CHARS
	BEQ	3$		;IF NONE DON'T PUT IN
6$:	MOVB	(R4),R2		;1ST CHAR OF ASCII BUFF IN R2
	CMPB	R2,#'#		;IS FIRST CHAR "#"
	BEQ	4$		;IF SO PUT IN
	CMPB	R2,#'@		;OR "@"
	BNE	5$		;IF NEITHER, SKIP
4$:	MOVB	R2,(R5)+	;PUT CHAR IN OUTPUT
	INC	R4		;AND ACCOUNT FOR IT
	BR	6$		;CHECK FOR "@#"
5$:	JSR	PC,SKPNUM	;SKIP REMAINING DIGITS
	JSR	PC,TXTRAN	;FILL IN RLD STRING
3$:	MOV	R4,R0		;STARTING ADDRESS IN R0
	MOV	#12.,R1		;ORIGINAL LEN IN R1
	SUB	(SP)+,R4	;NO. GONE IN R4
	SUB	R4,R1		;NO. LEFT IN R1
	MOV	R0,R4		;CURR. POS. BACK IN R4
	JSR	PC,TRCBLK	;GET NO. OF NON-BLANK CHARS IN R1
	JSR	PC,TXTRAN	;AND TRANSFER TO OUTPUT
	RTS	PC
;
; WRDOUT
; ROUTINE TO PROCESS 1 WORD AS A .WORD INSTRUCTION.
; ON ENTRY:
;	PCINST MUST BE PC FOR WORD PRINTED
;	RLDPTR MUST BE CURRENT
;	TXTPTR POINTS TO WORD PRINTED
; ON RETURN:
;	PCCURR POINTS TO NEXT WORD
;	WCOUNT = 1
;	RLDPTR UPDATED
;	TXTPTR UPDATED
BYTFLG:	.BYTE	0		;FLAG FOR BYTE WITH NEXT BYTE GLOBAL
BYTEFG:	.BYTE	0		;BYTE FLAG
WRDOUT:	CLRB	BYTFLG
	CLRB	BYTEFG
	MOV	#OUTBUF,R5	;INIT R5 WITH START OF OUT BUFF
	MOV	PCINST,PCCURR	;CURRENT PC IS INSTRUCTION PC
	CBASCL	R5,PCINST,#1,$CBOMG ;CONVERT IT INTO OUT BUFF
	MOV	R0,R5		;RE-ESTABLISH R5
	MOVB	#11,(R5)+	;PUT IN TAB
	MOV	#1,WCOUNT	;WORD COUNT IS ONE
	JSR	PC,FILDAT	;DO DATA WORD FILL ROUTINE
	MOVB	#11,(R5)+	;PUT IN ANOTHER TAB
	MOV	#WORDAS,R0	;ADDRESS FOR .WORD IN R0
	MOV	#6,R1		;ITS LENGTH IN R1
	JSR	PC,TXTRAN	;TRANSFER IT
	MOV	R5,-(SP)
	MOV	RLDPTR,R3	;RLD POINTER IN R3
	JSR	PC,TYPRLD	;GET TYPE AND ADDRESS
	BCS	6$		;IF C SET, OUTRIGHT MATCH
	BVS	9$		;IF V SET, MATCH ON HIGH BYTE
	BIT	#1,PCCURR	;IS PC ODD?
	BNE	9$		;IF NE, YES
	MOV	#TXTBUF,R2	;FIND ADDR OF LAST BYTE
	ADD	TXTLEN,R2	;
	DEC	R2
	CMP	TXTPTR,R2	;ARE WE THERE?
	BNE	1$		;IF NE, NO - DO WORD
9$:	INCB	BYTFLG		;INDICATE OUR SITUATION
	BR	7$
6$:	BPL	4$		;IF N RESET, NOT BYTE
7$:	INCB	BYTEFG		;REMEMBER THAT WE'RE DOING A BYTE
	MOV	#OUTBUF+7,R5	;RESET TO CONTENTS FIELD
	JSR	PC,FILDAT	;REWRITE DATA IN BYTE FORMAT
	MOVB	#11,(R5)+	;INSERT A TAB
	MOV	#6,R1		;SET UP FOR XFER OF '.BYTE'
	MOV	#BYTASC,R0
	JSR	PC,TXTRAN	;OVERWRITE WITH '.BYTE'
	MOV	R5,(SP)		;RESET POSITION FOR TAB FILL
	TSTB	BYTFLG		;WAS LAST BYTE LOCAL OR GLOBAL?
	BNE	11$		;IF LOCAL, BRANCH
4$:	MOV	R5,-(SP)	;SAVE R5
	MOV	RLDPTR,R3	;RESET RLD POINTER
	JSR	PC,DISRLD	;GET RLD TEXT
	MOV	R5,R0		;ADD OF TEXT IN R0
	MOV	R4,R1		;LEN IN R1
	MOV	(SP)+,R5	;RESTORE R5
	JSR	PC,TXTRAN	;TRANSFER IN RLD TEXT
	MOV	R3,RLDPTR	;SAVE NEW RLD POINTER
	BR	2$		;AND GO OUTPUT LINE
11$:	CBASCL	R5,@TXTPTR,#1,$CBTMG
	BR	10$
1$:	MOV	TXTPTR,R3	;GET NEXT WORD POINTER
	CLR	R1		;SET UP FOR BIS
	BISB	1(R3),R1	;GET HIGH BYTE
	SWAB	R1		;POSITION HIGH BYTE
	BISB	(R3),R1		;GET LOW BYTE
	CBASCL	R5,R1,#1,$CBOMG ;PUT IN LOCAL VALUE
10$:	MOV	R0,R5		;RE-ESTABLISH R5 POINTER
2$:	MOV	(SP)+,R3
	ADD	#39.,R3
	SUB	R5,R3
	ASH	#-3,R3
	BGT	8$
	MOV	#1,R3
8$:	MOVB	#11,(R5)+
	SOB	R3,8$
	MOV	#1,R4
	CALL	ASCR50
	SUB	#OUTBUF,R5	;GET LEN OF OUTPUT BUFFER IN R5
	QIOEXE	#OUTBUF,R5	;PERFORM OUTPUT
	INC	PCCURR		;UPDATE CURRENT PC
	INC	TXTPTR		;AND TEXT POINTER
	TSTB	BYTEFG		;DID WE DO A BYTE
	BNE	5$		;IF NE, YES
	INC	PCCURR		;STEP TO NEXT WORD
	INC	TXTPTR		;STEP TO NEXT WORD
5$:	BIT	#DS.RCN,FLWORD	;IN CONT. RLD RECORD?
	BEQ	3$		;IF NOT, SKIP
	CMP	RLDPTR,#RLDBUF	;HAS POINTER MOVED INTO MAIN BUFFER?
	BLT	3$		;IF NOT, SKIP
	BIC	#DS.RCN,FLWORD	;CLEAR THE FLAG
3$:	RTS	PC
BYTASC:	.ASCII	/.BYTE	/
WRDFIN:	MOV	#TXTBUF,R1	;CALCULATE NUMBER OF WORDS
	SUB	TXTPTR,R1	;TO PROCESS OUT AS
	ASR	R1		;.WORD INSTRUCTIONS
1$:	MOV	R1,-(SP)	;SAVE VALUE ON STACK
	JSR	PC,WRDOUT	;DO 1 WORD
	MOV	(SP)+,R1	;RESTORE COUNT
	SOB	R1,1$		;AND DO TILL DONE
	RTS	PC
TRAPAS:	.ASCII	/TRA/
EMTASC:	.ASCII	/EMT/
TRPCHK:	MOV	#TRAPAS,R1	;ASCII ADDRESS IN R1
	JSR	PC,1$		;SEE IF 3 CHAR MATCH
	BEQ	2$		;IF SO, DONE
	MOV	#EMTASC,R1	;TRY FOR EMT
	JSR	PC,1$
2$:	RTS	PC		;RETURN WITH 'Z' BIT CLEAR IF MATCH
1$:	MOV	#LBUF1,R0	;START OF FIRST BUFFER IN R0
	MOV	#3,R2		;COUNT OF 3 IN R2
4$:	CMPB	(R0)+,(R1)+	;MATCH?
	BNE	3$		;FAIL IF NOT
	SOB	R2,4$		;TRY AGAIN IF SO
3$:	RTS	PC		;RETURN ('Z' BIT INDICATES SUCCESS OR FAIL)
	.END