.TITLE	TXTSET
	.IDENT	/11N/
;
; SUBROUTINE TXTSET.MAC
; TO SET UP AND PERFORM A SINGLE DISASSEMBLY
;
; GLOBALS DEFINED HERE
	.GLOBL	TXTSET	RLDFIN
;
; GLOBALS DEFINED ELSEWHERE
	.GLOBL	FLWORD	DS.NRL	DS.NTX	DS.RLD	DS.TXT
	.GLOBL	DS.TCN	DS.RCN	TXTBUF	TXTLEN	BLNKIT
	.GLOBL	PCLOAD	PCCURR	PCREQD	PCOLD	LBUF
	.GLOBL	TXTPTR	FORLST	DISASS	WCOUNT	TXTOLD
	.GLOBL	DISOUT	RECFIL	TXTBUF	RLDBUF	BUFTRN
	.GLOBL	RLDPTR	RLDLEN	PCINST	WRDFIN	TYPRLD
	.GLOBL	INDRLD	WRDOUT	WRDPRC
;
; MACROS DEFINED HERE
	.MACRO	FERR,X,P1,P2,P3,P4
.IIF NB <P1>,	MOV	P1,ARGBLK	;Arguments for insertion
.IIF NB <P2>,	MOV	P2,ARGBLK+2
.IIF NB <P3>,	MOV	P3,ARGBLK+4
.IIF NB <P4>,	MOV	P4,ARGBLK+6
	MOV	#I.'X,R1			;Address of Error String
	JMP	FERR
	.ENDM
	.MACRO	DIAG,X,P1,P2,P3,P4
.IIF NB <P1>,	MOV	P1,ARGBLK
.IIF NB <P2>,	MOV	P2,ARGBLK+2
.IIF NB <P3>,	MOV	P3,ARGBLK+4
.IIF NB <P4>,	MOV	P4,ARGBLK+6
	MOV	#I.'X,R1
	CALL	DIAG
	.ENDM
	.MACRO	BLNKLN	ADD,LEN
	MOV	ADD,R0
	MOV	LEN,R1
	JSR	PC,BLNKIT
	.ENDM	BLNKLN
;
; MAIN BODY OF SUBROUTINE
;
TXTSET:	JSR	PC,RECFIL		;FILL IN RECORD BUFFERS
	BIT	#DS.TXT!DS.TCN,FLWORD	;ANY TEXT TO PROCESS?
	BNE	1$		;IF SO, BRANCH TO STACK SETUP
	JMP	STRLD1		;JUMP TO SETUP FOR PROCESS OUT
1$:	BIT	#DS.TCN,FLWORD	;CONTINUATION?
	BNE	DISPRC		;IF SO, BRANCH
	MOV	PCLOAD,PCCURR	;IF NOT SET UP CURRENT PC
DISPRC:	BLNKLN	#LBUF,#54.	;BLANK OUT ASCII BUFFERS
	MOV	PCCURR,PCINST	;SET INSTRUCTION PC
	MOV	TXTPTR,TXTOLD	;SAVE START POINTER FOR FUTURE USE
	BIT	#1,PCINST	;IS THIS AN EVEN LOC
	BNE	1$		;IF NE, NO - OUTPUT BYTE
	MOV	RLDPTR,R3	;RLD POINTER IN R3
	JSR	PC,TYPRLD	;GET TYPE
	BVS	1$		;IF UPPER BYTE, DO .WORD
	BEQ	2$		;IF NONE, PROCEED NORMALLY
	BCC	2$		;IF NO MATCH, NORMAL
	MOV	TXTPTR,R0	;GET INSTRUCTION POINTER IN R0
	INC	R0		;POINT TO HIGH BYTE
	MOVB	(R0),R0		;GET HIGH BYTE
	BIC	#1,R0		;CLEAR OUT BIT 8
	CMP	R0,#177610	;IS IT TRAP OR EMT
	BEQ	2$		;IF SO, DO NORMAL DIS.
1$:	JSR	PC,WRDPRC	;PROCESS OUT THE WORD
	BR	EVEN02		;GO FINISH UP
2$:	MOV	TXTPTR,FORLST+2	;UPDATE TEXT BUFFER POINTER
	MOV	#FORLST,R5	;INIT FORTRAN PARAM LIST
	JSR	PC,DISASS	;PERFORM DISASSEMBLY
	MOV	WCOUNT,R4	;WORD COUNT IN R4
	ASL	R4		;NOW BYTE COUNT IN R4
	ADD	R4,TXTPTR	;UPDATE TEXT POINTER
	MOV	#TXTBUF,R5	;ADD BYTE PAST END OF LINE
	ADD	TXTLEN,R5	;IN R5
	CMP	TXTPTR,R5	;WHERE IN LINE ARE WE
	BGT	UNEVEN		;IF PAST END, DO UNEVEN FINISH
	BEQ	EVEN		;IF AT END, DO EVEN FINISH
	BIT	#DS.TCN,FLWORD	;ARE WE CONT FROM PREVIOUS TEXT
	BNE	TXTCON		;IF SO, BRANCH THERE
	JSR	PC,DISOUT	;PERFORM OUTPUT
	BR	DISPRC		;AND GO DO ANOTHER ONE
TXTCON:	CMP	PCREQD,PCLOAD	;IS NEXT RECORD PC WHAT'S NEEDED
	BNE	TXTC01		;IF NOT, DO WORD ROUTINE
	BIT	#DS.TXT,FLWORD	;IS MORE TEXT THERE
	BEQ	TXTC01		;IF NOT DO WORD ROUTINE
	JSR	PC,DISOUT	;WRITE OUT INSTRUCTION
TXTC02:	JSR	PC,RLDCON	;FINISH CONTINUED RLD RECORDS
	BIC	#DS.TCN,FLWORD	;CLEAR TEXT CONT. FLAG
	BIT	#DS.TXT,FLWORD	;DO WE HAVE TEXT TO PROCESS?
	BEQ	TXTSET		;IF NOT, GET NEW RECORD
	BR	DISPRC		;GO BACK AND DO SOME MORE
TXTC01:	MOV	TXTOLD,TXTPTR	;RESET TEXT POINTER
	JSR	PC,WRDFIN	;PUT OUT SOME WORDS
	MOV	PCLOAD,PCCURR	;SET NEW PC
	BR	TXTC02		;AND FINISH UP
EVEN:	BIT	#DS.TCN,FLWORD	;ARE WE IN CONTINUATION?
	BEQ	1$		;IF EQ NO
	CMP	PCREQD,PCLOAD	;DID WE GET WHAT WE NEED?
	BNE	TXTC01		;IF NE NO, DO WORD
1$:	JSR	PC,DISOUT	;PERFORM OUTPUT
EVEN02:	MOV	#TXTBUF,R5	;WE MAY NOT HAVE FINISHED
	ADD	TXTLEN,R5	;ALL WORDS, SO CHECK
	CMP	TXTPTR,R5	;IF NOT, GO AROUND AGAIN
	BLT	DISPRC
EVEN01:	MOV	#TXTBUF,TXTPTR	;RE-ESTABLISH TEXT POINTER
	BIC	#DS.TCN,FLWORD	;JUST BE SURE ABOUT CONTIN. BIT
STRLD1:	BIT	#DS.RLD,FLWORD	;ANY RLD TO FINISH?
	BEQ	1$		;IF NOT, SKIP FINISH
	JSR	PC,RLDFIN	;FINISH UP RLD OUTPUT
1$:	BIC	#DS.RLD!DS.RCN,FLWORD ;INDICATE ALL IS CLEAR
FINOUT:	BIC	#DS.TXT,FLWORD	;CLEAR TEXT FLAG
	JMP	TXTSET		;GO PROCESS MORE
UNEVEN:	MOV	TXTPTR,R3	;TEXT POINTER IN R3
	SUB	R5,R3		;NO. OF BYTES OVER IN R3
	SUB	R3,R4		;NO. OF BYTES TO SAVE IN R4
	BIT	#1,R4		;IS NO. OF BYTES ODD?
	BEQ	3$		;PROCEED IF NOT
	INC	R4		;OTHERWISE, DO .WORD
	ASR	R4		;FOR RIGHT NO. OF WORDS
	MOV	#TXTBUF,R0	;GET POSITION
	ADD	RLDLEN,R0	;PAST END OF TEXT
	CLRB	(R0)		;AND CLEAR IT
	MOV	TXTOLD,TXTPTR	;RE-ESTABLISH TEXT POINTER
4$:	MOV	R4,-(SP)	;KEEP TRACK OF COUNT ON STACK
	JSR	PC,WRDOUT	;WHILE OUTPUTTING WORDS
	MOV	PCCURR,PCINST	;RESET PC
	MOV	TXTPTR,TXTOLD	;RESET TEXT POINTER
	MOV	(SP)+,R4	;GET BACK COUNT
	SOB	R4,4$		;AND KEEP GOING TILL DONE
	BR	EVEN01		;FINISH AS THOUGH EVEN ENDING
3$:	MOV	#TXTBUF,R0	;START OF SAVE ADDRESS
	SUB	R4,R0		;IN R0
	MOV	R0,TXTPTR	;THIS WILL BE NEW TEXT POINTER
	MOV	R5,R1		;PAST END OF LINE IN R1
	SUB	R4,R1		;START OF TEXT TO XFER IN R1
	MOV	R4,R2		;COUNT IN R2
	JSR	PC,BUFTRN	;DO TRANSFER
	MOV	PCINST,PCCURR	;SET UP PC COUNTERS APPROPRIATELY
	MOV	PCINST,PCREQD
	ADD	R4,PCREQD
	BIS	#DS.TCN,FLWORD	;SET TEXT CONT. FLAG
	BIT	#DS.RLD,FLWORD	;ARE THERE RLD RECORDS
	BEQ	FINOUT		;IF NOT, WE'RE DONE
	MOV	RLDPTR,R1	;POSITION IN BUFFER IN R1
	MOV	#RLDBUF,R2	;JPE IN R2
	ADD	RLDLEN,R2
	CMP	R1,R2		;ARE WE DONE?
	BLT	1$		;IF NOT, BRANCH
2$:	BIC	#DS.RLD,FLWORD	;CLEAR THE FLAG
	BR	FINOUT		;AND FINISH UP
1$:	MOV	#RLDBUF,R0	;JPE OF CON BUFF IN R0
	SUB	R1,R2		;NO. OF BYTES TO XFER IN R2
	SUB	R2,R0		;BEGINNING OF CON BUFFER IN R0
	MOV	R0,RLDPTR	;UPDATE RLD POINTER
	JSR	PC,BUFTRN	;GO DO XFER
	BIS	#DS.RCN,FLWORD	;INDICATE CONTINUATION
	CLR	RLDLEN		;0 LEN IN CASE NO NEW RLD RECORD
	MOV	PCLOAD,PCOLD	;SAVE LOAD PC
	BR	2$		;AND FINISH UP
RLDFIN:	MOV	RLDPTR,R3	;SET UP RLD POINTER
RLDFN2:	JSR	PC,TYPRLD	;GET TYPE AND ADDRESS
	BEQ	RLDFN1		;IF NO MORE, BRANCH TO END
	JSR	PC,RLDCN1	;OTHERWISE PUT OUT COMMAND
	BR	RLDFN2		;DO IT AGAIN
RLDCN1:	CMP	R0,#7		;IS TYPE IN INDEP
	BGE	1$		;RANGE
	FERR	RLF,R0
1$:	CMP	R0,#11		;7 TO 11 (OCTAL)
	BLE	2$		;IF NOT, ERROR
	FERR	RLF,R0
2$:	JSR	PC,INDRLD	;ELSE, PROCESS OUT
RLDFN1:	RTS	PC
RLDCON:	MOV	RLDPTR,R3	;SET UP RLD POINTER
2$:	CMP	R3,#RLDBUF	;ARE WE AT END OF CONTIN.
	BGE	1$		;IF SO, FINISH
	JSR	PC,TYPRLD	;GET TYPE AND ADDRESS
	JSR	PC,RLDCN1	;IF NOT, OUTPUT RLD COMMAND
	BR	2$		;GO SEE IF ANY MORE
1$:	MOV	R3,RLDPTR	;SAVE RLD POINTER
	BIC	#DS.RCN,FLWORD	;CLEAR CONTIN. FLAG
	RTS	PC
	.END