.TITLE	OUTPUT
	.GLOBL	USED,SRCSYM,LINCTR,NOLINE,GETLIN,ERRCNT,SNAME,VARTYP
	.GLOBL	VAR,PRSTAT,ENTCTR,NAMCTR,PAGE,HIGPT,LOWPT,NMAIN
	.GLOBL	OUTPUT,VRSTPT,RAD50U,PRTLIN,DECOUT,HIGHAV,DOFLOW
	.GLOBL	LOWAV,HIGPTR,LOWPTR,$ZZ,DUMP,LINENO,CHRWD,VNM50
	.GLOBL	ENDLIN,BLNK,SNGCOM,SAVSUP,SUPER,PNAME,GLOB,STOFLO
;
;
;+001	R B FRENCH	MARCH 1981	ADD CHANGES TO "MERGE" CROSS REFERENCE
;					OUTPUT WITH F4P LISTING FILE.
;
;+002	R B FRENCH	APRIL 1981
;+002
;+002 - MODIFICATIONS MADE TO IDENTIFY CALLS TO FUNCTION-TYPE SUBROUTINES
;+002 - (AS OPPOSED TO ARRAY REFERENCES). FUNCTION SUBROUTINE NAMES WILL
;+002 - BE IDENTIFIED IN CROSS REFERENCE LISTINGS BY A TRAILING ASTERICK.
;
;
	.IF	NDF,RSX
	.MCALL	.PRINT,.RCTRLO
	.IFF
	.MCALL	QIOW$S
	.ENDC
	.PSECT	OUT,I,RO,GBL
	.PAGE
;
; THIS ROUTINE IS ENTERED WHEN A FORTRAN "END" STATEMENT IS ENCOUNTERED
; (OR THE SYMBOL TABLE OVERFLOWS), TO GENERATE A CROSS REFERENCE LISTING.
; IT WILL ALSO SAVE ENTRY POINT/SUPER INDEX DATA IF THE APPROPRIATE
; SWITCHES WERE SPECIFIED.
;
;
	.MCALL	GET$,PUT$	;+001
;
F4PERR:	.BYTE	15,12		;+001 - ERROR MSG FOR NON-F4P LISTINGS
	.ASCII	/LIST FILE NOT F4P FORMAT/
	.EVEN
;
OUTPUT:
;
; +001 - THESE CHANGES WILL COPY THE F4P LISTING FILE, SEARCHING FOR THE
; +001 - STRING "TOTAL SPACE ALLOCATED" (ALWAYS APPEARS NEAR THE END OF
; +001 - THE SYMBOL TABLE). IT WILL THEN CONTINUE UNTIL IT ENCOUNTERS A NEW
; +001 - PAGE (FORM FEED) OR AN END OF FILE, AT WHICH POINT THE CROSS
; +001 - REFERENCE LISTING WILL BE INSERTED.
;
	TST	APND		;+001 - MERGED OUTPUT ?
	BEQ	50$		;+001 - IF NOT, PROCEED NORMALLY
10$:	GET$	#MRGLST		;+001 - GET A RECORD FROM INPUT LISTING
	BCC	20$		;+001 - SHOULDN'T BE ANY ERRORS
	INC	ERRCNT		;+001 - OOPS,INCREMENT ERROR COUNT
	QIOW$S	#IO.CCO,#9.,#1,,,,<#F4PERR,#26.,#0> ;+001 WRITE ERROR MSG
	BR	50$		;+001 - AND BAG IT
20$:	MOV	MRGLST+F.NRBD,LSTFIL+F.NRBD ;+001 - PUT IN BYTE COUNT
	PUT$	#LSTFIL		;+001 - WRITE OUT THE RECORD
	CMP	LBUFF,#"TO	;+001 - WAS IT 'TOTAL SPACE ALLOCATED' ?
	BNE	10$		;+001 - IF NOT, KEEP GOING
30$:	MOV	#MRGLST,R0	;+001 - FDB TO R0
	JSR	PC,.MARK	;+001 - MARK THIS RECORD
	GET$	#MRGLST		;+001 - READ ANOTHER RECORD
	BCS	50$		;+001 - ASSUME EOF ON ERROR
	CMPB	LBUFF,#14	;+001 - WAS THERE A FORM FEED ?
	BEQ	40$		;+001 - YUP
	MOV	MRGLST+F.NRBD,LSTFIL+F.NRBD ;+001 - PUT IN BYTE COUNT
	PUT$	#LSTFIL		;+001 - WRITE OUT THE RECORD
	BR	30$		;+001 - AND KEEP GOING
40$:	MOV	#MRGLST,R0	;+001 - FDB TO R0
	JSR	PC,.POINT	;+001 - BACK UP ONE RECORD
50$:	INC	SRCSYM
	CLR	LINCTR
	MOV	#NOLINE,R0
	JSR	PC,PRTLIN		; INT HEADER
	MOV	#VRSTPT-4,R4		; SET UP FOR OUTPUT
VARLB:	MOV	4(R4),R4		; GET NEXT VAR NAM ELEMNT
	BNE	71$
	JMP	OUTDNE			; IF ZERO DONE
71$:	MOV	6(R4),R5		; GET 1ST USE ELEMENT
	TST	DOFLOW
	BNE	19$
	TST	SNGCOM			; LIST ALL ??
	BEQ	1$			; NO A SUBSET
	MOV	10(R4),R0		; GET LAST USE
	CMP	#"CM,-2(R0)		; IS ITS LAST USE IN COMMON BLOCK
	BEQ	4$			; IF YES SKIP TO NEXT VARIABLE
	CMP	#"BY,-2(R0)
	BEQ	4$			; IS IT A TYPE ONLY DECLARARTION
	CMP	#"CH,-2(R0)		; CHARACTER
	BEQ	4$
	CMP	#"LG,-2(R0)
	BEQ	4$
	CMP	#"IN,-2(R0)
	BEQ	4$
	CMP	#"RL,-2(R0)
	BEQ	4$
	CMP	#"DP,-2(R0)
	BEQ	4$
	CMP	#"CX,-2(R0)
	BEQ	4$
	CMP	#"EQ,-2(R0)		;TREAT EQIVALENCE  SAME AS TYPE DEC
	BEQ	4$
;+002
	CMP	#"DI,-2(R0)	;+002 - DON'T FORGET DIMENSION
	BEQ	4$
	CMP	#"DA,-2(R0)	;+002 - AND DATA
	BEQ	4$
;+002
;	WE HAVE A VAR THAT IS USED IN PROGRAM, IS IT TO BE INDEXED
	TST	SNGCOM
	BGT	1$			; IF GT 0 THEN YES
	BR	VARLB			; ELSE NO
4$:	TST	SNGCOM			; DECLARED BUT UNUSED-IS IT TO BE INDEXED
	BGE	VARLB			; NO
1$:	TST	GLOB			; GLOBALS ???
	BEQ	16$			; NOTHING SPECIAL
	MOV	R5,R0			; GET FIRST HOW USED
17$:	CMP	#"CM,-2(R0)		; DEFINED IN COMMON?
	BEQ	18$			; YES
	CMP	#"CN,-2(R0)		; COMMON NAMES ALSO??
	BEQ	18$			; YES
	MOV	(R0),R0			; NEXT HOW USED
	BNE	17$			; REPEAT UNTILL FIND COMMON OR
					; COMMON NAME OR NO MORE HOW USED
					; VARIABLE IS NAME THAT DOES NOT
					; APPEAR IN COMMON AS VAR OR COMMON NAME
	TST	GLOB			; INDEX LOCAL??
	BGE	VARLB			; NO
	BR	16$			; YES
18$:	TST	GLOB			; TEST TO SEE IF GLOBAL NAME TO BE 
					; INDEXED
	BLE	VARLB			; NO
16$:	TST	SUPER			; SUPER INDEX THIS VAR NAME
	BEQ	2$			; NO
19$:	JSR	PC,SAVSUP		; YES-SAVE VARIABLE
	TST	DOFLOW
	BNE	VARLB
2$:	MOV	#VAR,R0			; SET UP TO CONVERT RAD 50 VAR NM RO ASCII
	MOV	R4,R1
	JSR	PC,RAD50U
	ADD	#2,R1
	JSR	PC,RAD50U
;+002
	MOV	FNCALL,R2	;+002 - GET FUNCTION CALL POINTER
	BEQ	40$		;+002 - IF ZERO, FORGET IT
10$:	CMP	(R2),R4		;+002 - MATCH ?
	BEQ	15$		;+002 - THEN IT'S AN FUNCTION CALL
	MOV	-2(R2),R2	;+002 - GET NEXT ONE
	BNE	10$		;+002 - HAVE WE CHECKED 'EM ALL ?
	BR	40$		;+002 - YUP
15$:	MOV	#6,R2		;+002 - 6 BYTES TO SCAN
20$:	CMPB	#' ,-(R0)	;+002 - SCAN BACK FOR 1ST NON-BLANK
	BNE	30$		;+002 - FOUND IT
	SOB	R2,20$		;+002
	BR	40$		;+002 - WE SHOULDN'T EVER GET HERE
30$:	INCB	R0		;+002 - STEP BACK TO 1ST BLANK
	MOVB	#'*,(R0)	;+002 - MARK IT AS A FUNCTION CALL
40$:	MOV	R0,-(SP)	;+002 - SAVE CURRENT R0
;+002
	MOV	#VAR,R0			; PRINT OUT VAR NAME
	JSR	PC,PRTLIN
;+002
	MOV	(SP)+,R0	;+002 - GET R0 POINTER
	MOVB	#' ,(R0)	;+002 - AND CLEAR IT
;+002
	BR	OUTUSED
USELB:	MOV	#BLNK,R0		; FOR CASES WHERE HOWUSEDS DONT FIT ON
					; ONE OUTPUT LINE-FILL IN WHERE VAR NAME WOULD GO
					; WITH BLANK
	JSR	PC,PRTLIN
OUTUSED: MOV	CHRWD,-(SP)		; SET COUNTER
					; FOR THE NUMBER OF HOW USED TO PUT ON LINE
					; 7 FOR TTY OR 13 FOR LP-SET BY SWITCH IN OPEN
USELB2:	MOV	-4(R5),R0		; GET LINE NUMBER FROM USE ELEMENT
	MOV	R4,-(SP)
	JSR	PC,DECOUT		; PRINT IT OUT
	MOV	(SP)+,R4
	MOV	-2(R5),USED		; GET HOW USED NEMONIC
	MOV	#USED,R0
	JSR	PC,PRTLIN		; PRINT OUT NEMONIC OF HOW USED
	MOV	(R5),R5			; GET NEXT ELEMENT
	BEQ	DNEVAR			; IF ZERO-ALL ELEMNTS FOR VARNAME OUTPUTED
	DEC	(SP)			; DEC CTR
	BNE	USELB2;IF NOT 0 GET ANOTHER ELEMENT
	CLR	(SP)+
	MOV	#ENDLIN,R0
	JSR	PC,PRTLIN		; <CR><LF>
	BR	USELB
DNEVAR:	MOV	#ENDLIN,R0
	JSR	PC,PRTLIN		; <CR><LF>
	CLR	(SP)+
	JMP	VARLB			; START ON NEW VARIABLE
OUTDNE:	MOV	HIGPTR,HIGPT
	MOV	LOWPTR,LOWPT
	MOV	HIGHAV,HIGPTR		; RESET POINTERS FOR EMPTY TABLE
	MOV	LOWAV,LOWPTR
	CLR	ARRAY		;+002 - CLEAR ARRAY
	CLR	LSTARR		;+002 - AND LAST ARRAY
	CLR	FNCALL		;+002 - CLEAR FUNCTION CALLS
	CLR	LSTFNC		;+002 - AND LAST ONE
	CLR	VRSTPT
	CLR	SRCSYM
	CLR	LINCTR
	RTS	PC
BLNK:	.ASCII	/        /
	.BYTE	200
	.EVEN
ENDLIN:	.WORD	0
	.PAGE
$ZZ:	JSR	PC,OUTPUT
	CLR	LINENO			; RESET LINE NUMBER IN CASE MANY SOURCES
					; COCATONATED IN ONE FILE
	TST	PRSTAT			; PRINT STATISTICS???
	BEQ	EXIT
	CLR	LINCTR
	MOV	#-1,SRCSYM
	MOV	#NOLINE,R0
	JSR	PC,PRTLIN
	MOV	#SIZ,R0
	JSR	PC,PRTLIN
	MOV	HIGHAV,R0
	SUB	LOWAV,R0
	ASR	R0
	BIC	#100000,R0
	JSR	PC,DECOUT
	MOV	#UNUSD,R0
	JSR	PC,PRTLIN
	MOV	HIGPT,R0
	SUB	LOWPT,R0
	ASR	R0
	BIC	#100000,R0
	JSR	PC,DECOUT
	MOV	#UNM,R0
	JSR	PC,PRTLIN
	MOV	NAMCTR,R0
	JSR	PC,DECOUT
	MOV	#NOTIM,R0
	JSR	PC,PRTLIN
	MOV	ENTCTR,R0
	JSR	PC,DECOUT
	MOV	#ENDLIN,R0
	JSR	PC,PRTLIN
	CLR	LINCTR
EXIT:	TST	DOFLOW
	BEQ	6$
	CMP	PNAME,NMAIN
	BNE	6$
	CMP	PNAME+2,NMAIN+2
	BNE	6$
	MOV	NMAIN,VNM50
	MOV	NMAIN+2,VNM50+2
	MOV	#"PG,VARTYP
	CALL	STOFLO
6$:	MOV	#PNAME,R1
	MOV	#PNM,R0
	JSR	PC,RAD50U
	MOV	#PNAME+2,R1
	MOV	#PNM+3,R0
	JSR	PC,RAD50U
	MOV	ERRCNT,R1
	BIC	#100000,R1
	MOV	#P10,R2
	CLR	R4
	MOV	#ERCT,R5
1$:	MOVB	#'0,R0
5$:	SUB	(R2),R1
	BLT	2$
	INC	R0
	BR	5$
2$:	ADD	(R2)+,R1
	TST	R4
	BNE	3$
	CMPB	#'0,R0
	BNE	4$
	MOVB	#' ,R0
	BR	3$
4$:	INC	R4
3$:	MOVB	R0,(R5)+
	TST	(R2)
	BNE	1$
	ADD	#60,R1
	MOVB	R1,(R5)
	.IF	NDF,RSX
	.RCTRLO
	.PRINT	#BERRM
	.IFF
	QIOW$S	#IO.CCO,#9.,#1,,,,<#BERRM,#36.,#0>
	.ENDC
	CLR	ERRCNT
	CLR	SRCSYM
	CLR	ENTCTR
	CLR	PAGE
	CLR	NAMCTR
	MOV	NMAIN,PNAME
	MOV	NMAIN+2,PNAME+2
	JSR	PC,GETLIN
	RTS	PC
P10:	.WORD	10000.,1000.,100.,10.,0
BERRM:	.ASCII	<15><12>/'/
PNM:	.ASCII	/      /
	.ASCII	/' ERRORS DETECTED: /
ERCT:	.ASCII	/      /<15><12><200>
SIZ:	.BYTE	15,12,12
	.ASCII	/     BUFFER SIZE /
	.BYTE	200
	.EVEN
UNUSD:	.ASCII	/ WORDS/
	.BYTE	15,12
	.ASCII	/     UNUSED BUFFER SPACE /
	.BYTE	200
	.EVEN
UNM:	.ASCII	/ WORDS/
	.BYTE	15,12
	.ASCII	?     VARIABLES/LABELS DEFINED ?
	.BYTE	200
	.EVEN
NOTIM:	.BYTE	15,12
	.ASCII	/     HOW USED ENTRIES /
	.BYTE	200
	.EVEN
	.PAGE
DUMP:	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	R5,-(SP)
	INC	SRCSYM
	MOV	#MSGOVL,R0		; STORE REGISTERS SO OPS IN ACTION
					; USEING REGISTERS ARE NOT DITERBED
	JSR	PC,PRTLIN		; INFORM USER OF OVERFLOW
	JSR	PC,OUTPUT
	MOV	#NOLINE,R0
	JSR	PC,PRTLIN
	.IF	NDF,RSX
	BISB	#4,@#53
	.PRINT	#MSGOVL
	.IFF
	QIOW$S	#IO.CCO,#9.,#1,,,,<#MSGOVL+2,#39.,#40>
	.ENDC
	INC	ERRCNT
	MOV	(SP)+,R5
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RTS	PC
MSGOVL:	.BYTE	15,12
	.ASCII	/        INDEX         SYMBOL TABLE FULL-/
	.ASCII	/PARTIAL CROSS REFERENCE LISTING/
	.BYTE	15,12,200
	.EVEN
	.END