Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/12/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