Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SUBTTL SIMXRF
	COMMENT;
	AUTHOR:		STEPHAN OLDGREN
	REVISED:	TO BE ADAPTED TO PASS 3 BY ELISABETH $LUND
			UPDATED AT ACADIA UNIVERSITY FOR KA10
	VERSION:	3A [13,104]

	PURPOSE:	TO CREATE A CROSS REFERENCE LISTING
			FROM THE XRF FILE PRODUCED BY THE 
			SIMULA COMPILER
	CONTENTS:	HEADMAKE,LINE,NEWLINE
			OUTC,OUTL,OUTX,PRINT
	ENTRY:		SIMXRF
	RESTRICTIONS:	AS THIS MODULE ORIGINALLY WAS A SEPARATE PROGRAM OUTSIDE THE 
			COMPILER, THE STANDARD CONVENTIONS ARE NOT FOLLOWED IN THE 
			FOLLOWING CASES:	REG ASSIGNMENTS, NAMES OF GLOBAL VARIABLES
			CERTAIN ROUTINES SHOULD LOGICALLY BE PLACED IN OTHER MODULES
;	

	SEARCH SIMMAC

	CTITLE	SIMXRF

	SEARCH	SIMMC3	;[104]
	MACINIT
	P3INIT	;[104]
	SALL

	;EXTERNAL SUBROUTINES

	EXTERN	I3X		;OPEN ETC XRF.TMP
	EXTERN	T3X		;CLOSE XRF.TMP
	EXTERN	E3PAGE		;OUTPUT PAGE HEADER
	EXTERN	E3BD		;CONVERT BIN DEC ASCII
	EXTERN	O3LS3		;OUTPUT LIST BUFFER
	EXTERN	YE3PGN		;PAGE NUMBER
	EXTERN	YE3PNO		;NUMBER OF LINES LEFT ON CURRENT PAGE
	EXTERN	YBHLS3		;BUFFER HEADER LS3
	EXTERN	YBHXRF		;BUFFER HEADER XRF
	EXTERN	YELXRF		;LOOKUP BLOCK FILE XRF
	EXTERN	YE3NRU
	EXTERN	YE3RUB		;HEADER CROSS REF
	EXTERN	YMAXID		;HIGHEST ID NUMBER
	EXTERN	ZSE		;SYMBOL TABLE
	EXTERN	T3T3		;ERROR EXIT
	
	;MODULE ENTRY
	INTERN SIMXRF


	TWOSEG
	RELOC	400000


;REGISTER ASSIGNMENTS
	A=1
	B=2
	C=3
	D=4
	E=5
	F=6
	I=7
	NR=8
	REFIND=9

DEFINE PUTLS3(A)<
	SOSGE	YBHLS3+2
	EXEC	O3LS3
	IDPB	A,YBHLS3+1
>

	SUBTTL HEADMAKE


	COMMENT;
	PURPOSE:	TO CREATE THE HEADING FOR EACH PAGE IN
			THE OUTPUT LISTING
	ENTRY:		HEADMAKE
	INPUT ARGUMENT:	NONE
	NORMAL EXIT:	RETURN
	ERROR EXIT:	NONE
	OUTPUT ARGUMENTS:	YE3RUB CONTAINING HEADLINE,
				YE3NRU NUMBER OF CHARACTERS IN HEADLINE
	CALL FORMAT:	EXEC HEADMAKE
	;

HEADMAKE: PROC
	;STORE TEXT HEADER TO YE3NRU
	SETONA	YE3LST			;GENERATE LIST
	LI	X0,5
	ST	X0,YE3NRU
	HLRZ	X0,YE3PGN
	ADDI	X0,1
	MOVSM	X0,YE3PGN
	LI	X1,YE3RUB
	HRLI	X1,X3CRF
	BLT	X1,YE3RUB+4
	RETURN
	EPROC

	SUBTTL LINE
	COMMENT;
	PURPOSE:	TO WRITE LINE NUMBERS IN THE OUTPUT FILE
	ENTRY:		LINE
	INPUT ARGUMENT:	REG A IS AN INDEX TO REF TABLE TAKEN FROM 
			ZIDLR OR ZREFL
	NORMAL EXIT:	RETURN
	ERROR EXIT:	NONE
	OUTPUT ARGUMENTS: NONE
	CALL FORMAT:	EXEC LINE
	USED SUBROUTINES: LINE,NEWLINE,OUTL
	;

LINE:	PROC
	SAVE	<B>
	;REG B POINTS TO EL. IN REF CONTAINING HIGHEST LINENUMBER OF CURRENT ID.
	;REF IS LINKED FORWARD HOWEVER LAST EL POINTS TO FIRST EL OF CURRENT ID

	LF	B,ZREFL(A,REF)
	SETF	0,ZREFL(A,REF)
LOOP
	IF		;MORE THAN TEN LINE NUMBERS IN ONE LINE?
		CAIGE	E,12
		AOJA	E,FALSE
	THEN		;YES, NEW LINE
		EXEC	NEWLINE
		LI	X0,QHT
		PUTLS3	X0
		PUTLS3	X0
		LI 	E,1
	FI
	LI	X0," "
	;INSERT SPACE


	PUTLS3	X0
	LF	(C) ZREFN(B)
	EXEC	OUTL
	LI	D,2
	LF	X0,ZREFS(B,REF)
	IF
		JUMPE	X0,FALSE
	THEN
		;INFORMATION AFTER LINE
		IF
			IFOFF	ZREFT(B)
			GOTO	FALSE
		THEN
			LI	X0,"M"
			PUTLS3	X0	;IF OCCURS MORE THAN ONCE INSERT A "M"
			SUBI	D,1
		FI
		IF
			IFOFF	ZREFD(B)
			GOTO	FALSE
		THEN
			LI	X0,"D"
			PUTLS3	X0	;IF DEFINED INSERT A "D"
			SUBI	D,1
		FI
		IF
			IFOFF	ZREFE(B)
			GOTO	FALSE
		THEN
			LI	X0,"E"
			PUTLS3	X0	;IF EXTERNAL INSERT A "E"
			SOJL	D,LINE1
		FI
	FI
	LI	X0," "
	LOOP


		PUTLS3	X0
	AS
		SOJGE	D,TRUE
	SA
	LF	B,ZREFL(B,REF)
AS
	JUMPN	B,TRUE
SA
LINE1:
	RETURN
	EPROC

	SUBTTL NEWLINE
	COMMENT;
	PURPOSE:	TO INSERT LINE FEED AND CARRIGE RETURN
			IN THE OUTPUT FILE WHEN REQUESTED
	ENTRY:		NEWLINE
	INPUT ARGUMENT:
	NORMAL EXIT:	RETURN
	ERROR EXIT:	NONE
	OUTPUT ARGUMENT:
	CALL FORMAT:	EXEC NEWLINE
	USED SUBROUTINE: E3PAGE
	;

NEWLINE:PROC
	IF			;IF MORE THAN 55 LINES IN THE PAGE
				;OUTPUT NEW HEADER
		SOSL	YE3PNO
		GOTO	FALSE
	THEN
		;SAVE A (NEEDED BY CALLING ROUTINE) WHICH IS DESTROYED BY E3PAGE
		L	F,A
		AOS	YE3PGN
		EXEC	E3PAGE
		L	A,F
	FI
	LI	X0,QCR
	PUTLS3	X0	;INSERT A CARRIGE RETURN
	LI	X0,QLF
	PUTLS3	X0	;INSERT A LINE FEED
	RETURN
	EPROC

	SUBTTL	OUTL


	COMMENT;
	PURPOSE:	TO CONVERT NUM FROM BINARY TO DECIMAL ASCII
			AND OUTPUT 5 CHARACTERS
	ENTRY:		OUTL
	INPUT ARGUMENT:	REG C CONTAINING BINARY LINE NUMBER
	NORMAL EXIT:	RETURN
	ERROR EXIT:	NONE
	OUTPUT ARGUMENT: NONE
	CALL FORMAT:	EXEC OUTL
	;

OUTL:	PROC	
	L	X0,C
	;CONVERT NUMBER TO DEC ASCII WITH LEADING SPACE
	EXEC	E3BD
LOOP
	;OUTPUT LINE NUMBER TO LIST FILE
	LSHC	X0,7


	PUTLS3	X0
AS
	JUMPN	X1,TRUE
SA
	RETURN
	EPROC

	SUBTTL	OUTX


	COMMENT;
	PURPOSE:	TO CONVERT IDENTIFIER IN ZSE FROM SIXBIT TO ASCII
			AND OUTPUT TO LIST FILE
	ENTRY:		OUTX
	INPUT ARGUMENT:	REG B COMTAINING IDENTIFIER NUMBER
	NORMAL EXIT:	RETURN
	ERROR EXIT:	NONE
	OUTPUT ARGUMENT: IDENTIFIER IN LIST
	CALL FORMAT:	EXEC OUTX
	;

OUTX:	PROC	
	SAVE	<F,B>
	;COMPUTE INDEX OF ZSE
	;INDEX=(ID NO-2000)*2
	LSH	B,1
	L	C,ZSE-4000(B)
	LI	F,^D12
	LOOP			;CONVERT EACH CHARACTER TO ASCII BY 
				;ADDING OCTAL 40 AND OUTPUT THEM
		LI	D,0
		ROTC	C,6
		ADDI	D,40

		PUTLS3	D
	AS			;CONTINUE UNTIL ALL CHRACTERS ARE CONV
		SOJLE	F,FALSE
		JUMPN	C,TRUE
		CAIL	F,6
		SKIPE	C,ZSE+1-4000(B)			;LAST 6 CHARACTERS IN ID
		JUMPN	C,TRUE
		;OUTPUT BLANKS
		LI	X0," "
		LOOP
			PUTLS3	X0
		AS
			SOJG	F,TRUE
		SA
	SA
	LI	X0,QHT


	PUTLS3	X0
	RETURN
	EPROC

	SUBTTL	PRINT
	COMMENT;
	PURPOSE:	TO WRITE LINES IN THE OUTPUT FILE FOR
			EACH IDENTIFIER
	ENTRY:		PRINT
	INPUT ARGUMENT:	REG A IS IDENTIFIER NUMBER
	NORMAL EXIT:	RETURN
	ERROR EXIT:	NONE
	OUTPUT ARGUMENT: NONE
	CALL FORMAT:	EXEC PRINT
	USED SUBROUTINES: PRINT,NEWLINE,OUTX,LINE
	;

PRINT:	PROC
	SAVE	<B>
	L	B,A
;	CHECK BINARY TREE LOWER TO GET FIRST ID TO BE WRITTEN
	LF	(A) ZIDRR(B)
	SKIPE	A
	EXEC	PRINT
;	CHECK IF ID HAS ANY LINE NUMBERS
	LF	(A) ZIDLR(B)
	IF
		JUMPE	A,FALSE
	THEN	;WRITE ID AND LINE NUMBERS AFTER NEWLINE
		EXEC	NEWLINE
		EXEC	OUTX
		LI	E,0
		EXEC	LINE
	FI
;	CHECK BINARY TREE HIGHER TO GET NEXT ID TO BE WRITTEN
	LF	(A) ZIDRL(B)
	SKIPE	A
	EXEC	PRINT
	RETURN
	EPROC
	LIT

	SUBTTL	READ
	COMMENT;
	PURPOSE:	INPUT BUFFER FROM XRF.TMP
	ENTRY:		READ
	INPUT ARGUMENT:	NONE
	NORMAL EXIT:	RETURN
	ERROR EXIT:	IF EOF RETURN AND SKIP
	OUTPUT ARGUMENT: NONE
	CALL FORMAT:	EXEC  READ
	USED SUBROUTINES: NONE
	;

X3READ:
	PROC
	SKIPN	YELXRF
	GOTO	XRF1		;WHEN FILE IN CORE IT MUST BE EOF
	IN	QCHXRF,
	SOSGE	YBHXRF+2
	SKIPA
	RETURN
	STATZ	QCHXRF,1B22
	GOTO	XRF1
	L	X1,[ASCIZ	/XRF/]
	ERR	QT,Q3.TER+6
	GOTO	T3T3
XRF1:
	;RETURN AND SKIP AT END OF FILE
	AOS	(XPDP)
	RETURN
	EPROC

	SUBTTL	MAJORPROG
	COMMENT;
	PURPOSE:	TO CREATE A CROSS REFERENCE LISTING FROM
			THE .XRF FILE PRODUCED BY THE SIMULA
			COMPILER
	ENTRY:		SIMXRF
	USED SUBROUTINES: HEADMAKE,PRINT
	;

SIMXRF:
	BEGIN
;	MOVE ZEROES TO IDL AND IDR TABLES
	SETZM	IDL
	LI	F,IDL+1
	HRLI	F,IDL	
	BLT	F,REF-1
	EXEC	HEADMAKE	;MAKE HEADLINE
	EXEC	I3X		;OPEN XRF

;	INPUT REFERENCE RECORD
	LI	REFIND,0
	HRRZ	E,.JBREL##
	IFG QTRACE,<EXTERN	YTRPAS
		   IFON	YTRSW
		   LI	E,YTRACC##-1
			>
	SUBI	E,REF
	WHILE
		SOSGE	YBHXRF+2
		GOTO	FALSE
XRF2:
	DO
		ILDB	YBHXRF+1
		SF	,ZIN
		LF	(A) ZINI
		LF	(B) ZIDLR(A)
		IF			;IF LINE NUMBER ALREADY IN TABLE
					;SET SWITCH ZREFT
			JUMPE	B,FALSE
			LF	(C) ZINN
			LF	(D) ZREFN(B)
			CAME	C,D
			GOTO	FALSE
		THEN
			SETON	ZREFT(B)
		ELSE			;STORE REFERENCE RECORD IN
					;REF TABLE
			IF	;CHECK IF CORE MUST BE EXPANDED
				CAIE	REFIND,-1(E)
				AOJA	REFIND,FALSE
			THEN
				ADDI	REFIND,1
				ADDI	E,1000
				LI	X0,REF+1000(E)
				IFG QTRACE,<IFOFF	YTRSW>
				CORE	X0,
				CAIA
				GOTO	FALSE
				ERRT	QT,560
				BRANCH	T3T3
			FI
			L	C,ZINA
			ST	C,REF(REFIND)
			IF
				JUMPN	B,FALSE
			THEN
				;FIRST LINENUMBER
				SF	REFIND,ZREFL(REFIND,REF)
			ELSE
				LF	C,ZREFL(B,REF)
				SF	REFIND,ZREFL(B,REF)
				SF	(C) ZREFL(REFIND,REF)
			FI
			SF	(REFIND) ZIDLR(A)
		FI
	OD
	EXEC	X3READ
	GOTO	XRF2		;CORRECT RETURN
	;RETURN AT EOF

	L	NR,YMAXID			;HIGHEST ID NO
	LI	I,2000
	L	F,[POINT	11,A,10]	;[13] USE THE FIRST 11 BITS
						; TO SORT #,$,@ IN THE SAME WAY
						; AS SORTED IN SIMULA

	LOOP	;TREAT ONE IDENTIFIER
;***AUBEG
;USE DIFFERENT AC FOR INDEX SO LD MACRO WILL WORK
		L	B,I
		LSH	B,1
		LD	A,ZSE-4000(B)
;***AUEND
		;COMPUTE HASH VALUE
		LDB	C,F
		IF			;IF HASH LINK = 0
			IFNEQF	(C,ZIDLL,0)
			GOTO	FALSE
		THEN			;MOVE I TO HASH LINK
			SF	(I) ZIDLL(C)
		ELSE
;	IF NEW ID IS GREATER THAN OLD ID WITH THE SAME HASH VALUE
;	MOVE ID NUMBER TO LINK BINARY TREE HIGHER (=ZIDRL) ELSE
;	MOVE ID NUMBER TO LINK BINARY TREE LOWER (=ZIDRR)
			LF	(D) ZIDLL(C)

L5():			L	C,D
			LSH	D,1
;***AUBEG
;USE DIFFENT AC FOR INDEX SO LD MACRO WILL WORK
			LI	E,(D)
			LD	D,ZSE-4000(E)
;***AUEND
			IF
				CAMLE	A,D
				GOTO	FALSE
				CAME	A,D
				GOTO	TRUE
				JUMPE	B,TRUE
				CAML	B,E
				GOTO	FALSE
			THEN
				;NEW ID LESS THAN OLD ONE
				LF	(D) ZIDRR(C)
					;CHECK IF LINK IS EMPTY
				JUMPN	D,L5
					;MOVE ID NUMBER TO LINK LOWER
				SF	(I) ZIDRR(C)
			ELSE
				;NEW ID GREATER THAN OLD ONE
				LF	(D) ZIDRL(C)
					;CHECK IF LINK IS EMTY
				JUMPN	D,L5
					;MOVE ID NUMBER TO LINK HIGHER
				SF	(I) ZIDRL(C)
			FI
		FI
	AS
		CAMGE	I,NR	;END OF NAME RECORD ?
		AOJA	I,TRUE
	SA

	LI	F,0
	MOVSI	I,-4000
	EXEC	E3PAGE	;WRITE HEADLINE
	LOOP	;WRITE OUTPUT LINES FOR EACH ID IN THIS HASH LINK
		LF	(A) ZIDLL(I)
		;CHECK IF HASH LINK IS EMPTY
		SKIPE	A
		EXEC	PRINT
	AS
		AOBJN	I,TRUE
	SA
	EXEC	T3X		;CLOSE XRF
	RETURN
X3CRF:	ASCIZ	/	CROSS REFERENCE TABLE/
	LIT
	END