Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/comp/ex.mac
There are 2 other files named ex.mac in the archive. Click here to see a list.
COMMENT *
VERSION: 4 [7,34,40,173,244]
AUTHOR: STEFAN ARNBORG
Contents: EXQC Check external qualifications
EXDF Read and define external fixups
EXAT Make and output the intermediate attribute file
*
SEARCH SIMMAC,SIMMC2
SALL
CTITLE EX
SUBTTL Handle external classes and procedures
INTERNAL EXAT,EXDF,EXQC
EXTERNAL O2ATR,YBHATR,YEXENT
EXTERNAL O2D1GW,O2DFOU,O2ATR
EXTERNAL YCAPLE,YCAVRT,YDCSTB,YDICTB,YFXTAB,YLINE,YELIN1,YELIN2,YO2DFW
EXTERNAL YO2IQI,YOLINE,YSTATM,YUNDEC,YBHATR
TWOSEG
RELOC 400K
MACINIT
SUBTTL EXAT
Comment/
Purpose: Make a skeleton atr file and output
it to an intermediate file
Entry: EXAT
Function: Find global ZQU
zquout
return
setpref:
if not zhb, return
find zhbzhb, if none return
ycaple:=zhbzhb.zhelen
ycavrt:=zhbzhb.zhbvrt
zhelen:=zhelen-ycaple
zhbvrt:=zhbvrt-ycavrt
resetpref:
opposite to setpref
zquout:(exzq)
update zquind and zquqid
write zqu
if zquzb not none, listout
return
listout:(exlo)
save ycaple,ycavrt
setpref
write zhb
for succeeding zqu:s, zquout
resetpref
zeroout
return
/
DEFINE STEPZDE(X)=
<LF ,ZDETYP(X)
CAIN ,ZHB%V
STEP X,ZHB
CAIN ,ZQU%V
STEP X,ZQU
CAIN ,ZHE%V
STEP X,ZHE
>
DEFINE SETPREF=<
LF X3,ZHBZHB(X2)
IF JUMPE X3,FALSE
THEN
LF ,ZHELEN(X3)
ST YCAPLE
LF ,ZHBVRT(X3)
ST YCAVRT
LF ,ZHELEN(X2)
SUB YCAPLE
SF ,ZHELEN(X2)
LF ,ZHBVRT(X2)
SUB YCAVRT
SF ,ZHBVRT(X2)
ELSE
SETZM YCAPLE
SETZM YCAVRT
FI
>
DEFINE RESETPREF=<
LF ,ZHELEN(X2)
ADD YCAPLE
SF ,ZHELEN(X2)
LF ,ZHBVRT(X2)
ADD YCAVRT
SF ,ZHBVRT(X2)
>
DEFINE ZEROOUT=<
SETZ X0,
PUTATR X0
>
OPDEF ZQUOUT [XEC EXZQ]
OPDEF LISTOUT [XEC EXLO]
EXAT: PROC
LI X1,ZHB%S
ADDB X1,YDCSTB
LOOP
STEPZDE X1
AS WHENNOT X1,ZQU
GOTO TRUE
IFOFF ZQUGLO(X1)
GOTO TRUE
SA
; GLOBAL ZQU IN X1
SETOFF ZQUGLO(X1)
SETON ZQUEXT(X1)
;OUTPUT ATR-HEADER
;IF MACRO OR FORTRAN THEN YEXENT ELSE 0
edit(7)
LF ,ZQUKND(X1) ;[7]
IF ;[7] procedure
CAIE QPROCEDURE
GOTO FALSE
THEN LF X2,ZQUZB(X1)
LF ,ZHBMFO(X2) ;[7] MACRO or FORTRAN?
IF JUMPE FALSE ;[7]
THEN ;Handle QUICK proc, output YEXENT
IF ;QUICK procedure
CAIE QEXMQI
GOTO FALSE
THEN ;Adjust block length to show ac's needed
LF X3,ZHELEN(X2)
SUBI X3,2
LF ,ZQUTYP(X1)
CAIE QNOTYPE
SUBI X3,1
CAIE QTEXT
CAIN QLREAL
SUBI X3,1 ;[244]
edit(244)
SF X3,ZHELEN(X2)
IF ;Too many ac's
CAIG X3,QNAC
GOTO FALSE
THEN ;Issue error message
EXCH X1,X3 ;Number of ac's asked
edit(34)
ERRI1 QE,<Q2.ERR+66> ;[34]
EXCH X1,X3
FI FI
L YEXENT
FI
ELSE
SETZ
FI ;[7]
PUTATR X0
;Output attributes
ZQUOUT
;Create ZHE(QQUACH) for externals declared before this ZQU
L X2,YDCSTB
LOOP
STEPZDE X2
AS
WHENNOT X2,ZQU
GOTO TRUE
IFOFF ZQUEXT(X2)
GOTO TRUE
CAMN X1,X2
GOTO FALSE ;WHEN GLOBAL REACHED
LF X3,ZQULID(X2)
TLO X3,(<ZHE%V>B<%ZDETYP>+<QQUACH>B<%ZHETYP>)
PUTATR X3
LF X3,ZQUZB(X2)
LF X3,ZHBUNR(X3)
PUTATR X3
ZEROOUT
ZEROOUT
GOTO TRUE
SA
ZEROOUT ;OUTPUT END MARKER
RETURN
EPROC
SUBTTL EXZQ, output ZQU
EXZQ: PROC ; Output ZQU at (X1)
SAVE <X2,X1>
LF X2,ZQUKND(X1)
IF LF ,ZQUMOD(X1)
CAIN QVALUE
GOTO TRUE
CAIN QREFERENCE
GOTO TRUE ; PARAMETERS WITH OFFSET IN ZQUIND
CAIN QNAME
GOTO TRUE
CAIN X2,QARRAY
GOTO TRUE
CAIN QVIRTU
GOTO FALSE
CAIE X2,QSIMPLE
GOTO FALSE
LF ,ZQUTYP(X1)
CAIN QLABEL
GOTO FALSE
THEN ;OFFSET TO UPDATE IN ZQUIND
LF ,ZQUIND(X1)
SUB YCAPLE
SF ,ZQUIND(X1)
ELSE
IF LF ,ZQUMOD(X1)
CAIE QVIRTU
GOTO FALSE
LF ,ZQUNSB(X1)
JUMPE ,TRUE ; VIRTUAL SPEC
;VIRTUAL MATCH IS RESET TO DECLARED
LI QDECLARE
SF ,ZQUMOD(X1)
SETZ
SF ,ZQUNSB(X1)
GOTO FALSE
THEN ; UPDATE VIRTUAL INDEX
LF ,ZQUIND(X1)
SUB YCAVRT
SF ,ZQUIND(X1)
ELSE
edit(40)
IF LF ,ZQUMOD(X1) ;[40]
CAIL ,QHDN ;[40]
GOTO FALSE ;[40] HIDDEN SPECIFICATION
THEN ; FIXUP IN ZQUIND
LF ,ZQUIND(X1)
ADD YFXTAB
L @
LF ,ZFXVAL()
SF ,ZQUIND(X1)
FI
FI
FI
; SET ZQUQID
IF CAIE X2,QCLASS
GOTO FALSE
THEN
LF X2,ZQUZB(X1)
LF X2,ZHBZHB(X2) ; PREFIX
JUMPE X2,L1
LF X2,ZHBZQU(X2)
LF X2,ZQULID(X2)
ELSE ; QUALIF LID TO QID
LF X2,ZQUZQU(X1)
JUMPE X2,L1 ; NOT REF OF UNIVERSAL QUALIF
LF X2,ZQULID(X2)
FI
L1(): SF X2,ZQUQID(X1)
ZF ZQUZHE(X1)
edit(40)
IF IFOFF ZQUPTD(X1) ;[40]
GOTO FALSE ;[40]
THEN SETON ZQUTPT(X1) ;[40]
FI ;[40]
; OUTPUT ZQU
HRLI X1,-ZQU%S
LOOP
L (X1)
PUTATR X0
AS AOBJN X1,TRUE
SA
ZEROOUT
ZEROOUT
SUBI X1,ZQU%S
LF X2,ZQUZB(X1)
SKIPE X2
LISTOUT
RETURN
EPROC
SUBTTL EXLO, output decl sublist (listout)
EXLO: PROC
SAVE<X4,X3>
STACK YCAPLE
STACK YCAVRT
setpref
LF X3,ZHBZHB(X2)
LF X4,ZHBZQU(X2)
ZF ZHBZHB(X2)
ZF ZHBZQU(X2)
SETF 0,ZHEFIX(X2)
HRLI X2,-ZHB%S
LOOP
L X0,(X2)
PUTATR X0
AS AOBJN X2,TRUE
SA
L X1,X2
SUBI X2,ZHB%S
SF X3,ZHBZHB(X2)
SF X4,ZHBZQU(X2)
WHILE RECTYPE(X1) IS ZQU
GOTO FALSE
DO
ZQUOUT
STEP X1,ZQU
OD
RESETPREF
ZEROOUT
UNSTK YCAVRT
UNSTK YCAPLE
RETURN
EPROC
SUBTTL EXDF, read and define external fixups
COMMENT/
PURPOSE: READ EXTERNAL FIXUPS FROM DF1 (FIX NO AND RADIX50)
AND PASS THEM ON TO IC2 IN TYPE 2 BLOCK
AS CHAINED GLOBAL REQUESTS
ENTREY EXDF
FUNCTION: ALL ZQQ RECORDS IN DF1(FOLLOWED BY ZERO WORD)
ARE READ. THE FIXUP FIELD ZQQFIX IS USED TO
ACCESS THE END OF CHAIN AND ZQQUNR IS THE RADIX50
NAME OF THE FIX. O2DFOUT IS USED TO OUTPUT IN A
TYPE 2 BLOCK
CALLED FROM O2IC2T
/
EXDF: PROC
SAVE<X5,X6,X3>
EXEC O2D1GW ; SECOND WORD OF DUMMY ZHE
EXEC O2D1GW ; FIRST WORD OF ZQQ
WHILE JUMPE X4,FALSE
DO LF X1,ZQQFIX(,X4)
ADD X1,YFXTAB
L X5,(X1)
TLZ X5,(777B8)
EXEC O2D1GW ; GET RADIX50 OF EXTERNAL IDENTIFIER
L X6,X4
L X3,YO2IQI
TLO X6,600K ; SET FLAGS FOR CHAINED GLOBAL REQUEST
EXEC O2DFOUT
EXEC O2D1GW ; FIRST WORD OF NEXT ZQQ OR ZERO
OD
RETURN
EPROC
SUBTTLE EXQC, check external qualifications
COMMENT/
PURPOSE: CHECK QUALIFICATIONS OF EXTERNAL QUANTITIES
ENTRY: EXQC
FUNCTION: ALL CONSECUTIVE ZHE RECORDS WITH ZHETYP=QQUACH ARE READ
FOR EACH RECORD,THE QUANTITY ZHELID IS USED TO ACCESS A ZHB
RECORD THROUGH THE DICTIONARY AND A ZQUZB LINK.
ZHBUNR OF THIS ZHB IS CHECKED AGAINST ZHEUNR OF THE RECORD
READ.
CALLED BEFORE EXIT FROM CARL
/
EXQC: PROC
WHILE L X4,YO2DFW
LF ,ZHETYP(,X4)
CAIE QQUACH
GOTO FALSE
DO ; CHECK A NEW RECORD
L X1,X4
EXEC O2D1GW ; NEW WORD TO X4
L X2,X4
EXEC O2D1GW
ST X4,YO2DFW
; RECORD IN X1,X2
LF X3,ZHELID(,X1)
LF X4,ZDCZQU(X3,YDICTB)
edit(173)
SETZ X5, ;[173] No line number known
IF
JUMPE X4,TRUE
CAIN X4,YUNDEC
GOTO FALSE ; DOUBLY DECLARED
IFON ZQUGLO(X4)
GOTO FALSE
LF X5,ZQULNE(X4)
LF X4,ZQUZB(X4)
JUMPE X4,TRUE
IFOFF ZHBEXT(X4)
GOTO TRUE
LF ,ZHBUNR(X4)
CAMN OFFSET(ZHEUNR)+X1
GOTO FALSE
THEN ; INVALID ACCESS TO EXTERNAL
LF X2,ZHEOID(,X1)
LF X1,ZHELID(,X1)
ST X5,YELIN2
EXCH X5,YELIN1
SETZM YSTATM
ERRI2 QE,Q2.ERR+57
ASSERT< NOP [ASCIZ/INVALID EXTERNAL ACCES/]
>
L YELIN1
ST YELIN2
ERRLI
EXCH X5,YELIN1
FI
OD
RETURN
EPROC
END