Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/comp/simxrf.mac
There are 2 other files named simxrf.mac in the archive. Click here to see a list.
SUBTTL SIMXRF
COMMENT;
AUTHOR: STEPHAN OLDGREN
REVISED: TO BE ADAPTED TO PASS 3 BY ELISABETH $LUND
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
L A,I
LSH A,1
LD A,ZSE-4000(A)
;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
LD D,ZSE-4000(D)
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