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

;<ENDERIN>DP.MAC.3,  8-Dec-76 18:53:23, Edit by ENDERIN

;NAME:	DP
;====

;VERSION:	4	[13,40,144,176,210,215,225]
;=======

;AUTHOR:	KIM WALDEN
;======		CLAES WIHLBORG
;		Lars Enderin (DPEXT modifications)

;PURPOSE:	DP PROCESSES THE DECLARATION LIST, DC,
;=======	MADE AVAILABLE BY SD, AND MERGES IT WITH
;		SYSTEM CLASSES AND VARIABLES.
;		IT CONTAINS TWO SUBMODULES:
;		DPSYS, WHICH PROCESSES SYSTEM RECORDS, AND
;		DPEXT, WHICH PROCESSES EXTERNAL CLASSES AND PROC'S.

;ENVIRONMENT:	DP IS CALLED BY:	EXEC DP
;===========	AND EXITS BY:		RETURN

	SALL
	SEARCH	SIMMC1,SIMMAC,SIMMCR
	CTITLE	DP (DECLARATION PROCESSING)
	SUBTTL	PROLOGUE
	MACINIT
	TWOSEG
	RELOC	400000

	INTERN	DP,DPEXT	;[144]

	EXTERN	O1DFOP,O1DF1,O1DFCL
	EXTERN	O1RL,O1RLR,O1RLS,O1RLUNR
	EXTERN	YBHEXT,YBREAK
	EXTERN	I1RX50	;[144]
	EXTERN	O1EXT,O1EXCL,O1EXNP,O1EXRQ	;[144]
	EXTERN	O1EXTB	;[225]
	EXTERN	YDPD,YMAXFX
	EXTERN	SH,SYS1,SDALLOC
	EXTERN	YDPZQQ,YDPSOL,YDPLIN,YDPATH
	EXTERN	YDPZUC,YDPFUN,YDPLUN,YDPUNR
	EXTERN	T1AB,ZSE1,ZSE2
	EXTERN	YELIN1,YELIN2,YESEM
	EXTERN	YELEXT,YEXZQU,YRQHEAD,YZQUGLO	;[144]
	EXTERN	YATRDEV,YATRFN,YATRPPN,YATROFS	;[144]

	SUBTTL	MACRO and OP DEFINITIONS

OPDEF	XEC	[PUSHJ	XPDP,]
OPDEF	GENABS	[XEC	O1RL]
OPDEF	GENREL	[XEC	O1RLR]
OPDEF	GENSYMB	[XEC	O1RLS]

DEFINE	APPEND<SETOFA YZSE>	;ALLOW NEW ENTRIES IN SYMBOL TABLE

DEFINE	NOAPPEND<SETONA YZSE>	;FORBID NEW ENTRIES IN SYMBOL TABLE

DEFINE	TOGETHER(A,B,C,D)<
	IF
	IFN C-D,<JUMPE	C,FALSE>
	THEN
		IF	JUMPN	B,FALSE
		THEN
			L	A,C
		ELSE
			SF	C,ZDELNK(B)
		FI
		L	B,D
	FI
>

DEFINE	ZOUT(N)
<	IRP N	<L XDPOUT,N(XPTR)
		PUTDF1	XDPOUT>
>

DEFINE	ERROR(NO,TYP,MESSAGE)<
	LF	,ZQUTEM(XZQU)
	ST	YELIN1
	ST	YELIN2
	CLEARM	YESEM
	ERR'TYP	QT,Q1DP.T+NO
;	IFN QDEBUG,<OUTSTR [ASCIZ/
;MESSAGE
;/]>
>


DF(ZUCFUN,0,36,35)
DF(ZUCLUN,1,36,35)
DF(ZUCLID,2,18,17)

;;;; [144] ;;;;

OPDEF	XEC		[PUSHJ	XPDP,]
OPDEF	findemall	[XEC	DPEXFA]
OPDEF	findmodules	[XEC	O1EXFM##]
OPDEF	zquremove	[XEC	DPEXRM]
OPDEF	getdevice	[XEC	DPEXGD]
OPDEF	openext		[JSP	O1EX.O##]
OPDEF	lookitup	[XEC	O1EXLU##]
OPDEF	filespec	[XEC	DPEXFS]
OPDEF	skipoverhead	[XEC	O1EXSO##]

 DF ZQUR50,3+OFFSET(ZHBUNR),36,35	;Radix50 name of external module

;SWITCHES
;========
	DSW	(TYPZHB,0,\QZHB,X1)

;ACCUMULATOR ASSIGNMENTS:
;=========== ===========

	XZHEOF==2
	XTAG==3
	XPTR==4
	XP==XTAG
	XSTA==5
	XSTM==7
	XEDA==12
	XEDM==11
	XID==X1ID1
	XIDNO==X1NXT
	XID2==X1ID2
	XA==14
	XB==15
	XZQU==4
	XZHB==7
	XZHE==4
	XTYP==5
	XKND==4
	XMOD==1
	XSUS==11
	XSUL==12
	XATS==7
	XATL==13
	XC==12
	XD==13
	XE==11
	XZRQ==X2	;[144]

	SUBTTL	DPSYS

DPSYS:	PROC

	NOAPPEND
	LI	XPTR,SYS1
	EXEC	DPSYSC
	TOGETHER(XSTM,XEDM,XSTA,XEDA)
	LF	X2,ZHSSTR(,YDPD)
	LF	X3,ZHSEND(,YDPD)
	IF	JUMPE	X2,FALSE	;[176]
	THEN
		L	[3,,3]
		EXEC	SDALLOC
		L	[BYTE	(3)QQZHE,QRBLOCK(12)0(18)-2]
		ST	(XALLOC)
		TOGETHER(XSTM,XEDM,XALLOC,XALLOC)
		TOGETHER(XSTM,XEDM,X2,X3)
	FI
	LF	X2,ZHSSTR(,YDPD+3)
	LF	X3,ZHSEND(,YDPD+3)
	TOGETHER(XSTM,XEDM,X2,X3)
	LF	X2,ZHSSTR(,YDPD+4)
	LF	X3,ZHSEND(,YDPD+4)
	TOGETHER(XSTM,XEDM,X2,X3)
	L	XPTR,XSTM

	RETURN
	EPROC

	SUBTTL	DPSYSC (APPEND SYSTEM CLASSES)

DPSYSC:	PROC
	CLEARB	XSTM,XEDM
	CLEARB	XSTA,XEDA
	GOTO	DPL1
DPL2:	LF	XPTR,ZQUFIX(XPTR)
	WHILE
DPL1:		SKIPN	X14,(XPTR)
		GOTO	FALSE
	DO
		LD	XID,2(XPTR)
		EXEC	SH
		JUMPE	XIDNO,DPL2	;IF COMPONENT NOT IN PROGRAM
		L	X0,[XWD 3,3]	;CREATE ZQU-RECORD
		EXEC	SDALLOC
		ST	X14,(XALLOC)
		LF	,ZQUIND(XPTR)
		ST	1(XALLOC)
		SF	XIDNO,ZQULID(XALLOC)
		TOGETHER(XSTM,XEDM,XALLOC,XALLOC)
		LF	X1,ZQUTYP(XPTR)
		LF	X2,ZQUKND(XPTR)
		IF
			CAIN	X1,QREF
			GOTO	TRUE
			CAIE	X2,QCLASS
			GOTO	FALSE
		THEN	;GET QUALIFICATION
			LD	XID,4(XPTR)
			EXEC	SH
			SF	XIDNO,ZQUQID(XALLOC)
			ADDI	XPTR,2
		FI
		ADDI	XPTR,4
		L	X1,(XPTR)
		IFOFFA	TYPZHB
		GOTO	DPL1
		L	X0,[XWD 4,4]	;CREATE ZHB-RECORD
		EXEC	SDALLOC
		LD	X2,1(XPTR)
		STD	X1,(XALLOC)
		ST	X3,3(XALLOC)
		TOGETHER(XSTA,XEDA,XALLOC,XALLOC)
		LF	X14,ZHBNRP(XPTR,-1)
		LF	X13,ZHETYP(XPTR)
		LI	X15,QLOWID-1
		ADDI	XPTR,3
		WHILE
			SOJL	X14,FALSE
		DO	;CREATE ZQU-RECORDS FOR FORMAL PARAMETERS
			L	X0,[XWD 3,3]
			EXEC	SDALLOC
			ADDI	X15,1
			L	(XPTR)
			ST	(XALLOC)
			ANDI	77
			SF	,ZQUIND(XALLOC)
			SF	XALLOC,ZDELNK(XEDA)
			L	XEDA,XALLOC
			SF	X15,ZQULID(XALLOC)
			LF	X0,ZQUTYP(XPTR)
			IF
				CAIE	QREF
				GOTO	FALSE
			THEN	;GET QUALIFICATION
				LD	XID,1(XPTR)
				EXEC	SH
				SF	XIDNO,ZQUQID(XALLOC)
				ADDI	XPTR,2
			FI
			ADDI	XPTR,1
		OD
		IF
			CAIE	X13,QCLASB
			GOTO	FALSE
		THEN	;APPEND CLASS ATTRIBUTES
			STACK	XSTM
			STACK	XEDM
			STACK	XSTA
			STACK	XEDA
			EXEC	DPSYSC
			TOGETHER(XSTM,XEDM,XSTA,XEDA)
			UNSTK	XEDA
			UNSTK	XSTA
			TOGETHER(XSTA,XEDA,XSTM,XEDM)
			UNSTK	XEDM
			UNSTK	XSTM
		FI
	OD
	ADDI	XPTR,1
	RETURN
	EPROC

	SUBTTL	DPEXT

	EXTERN	YRQDEV,YRQFIL,YRQPPN,YEXNAM	;[13]

DPEXT::	PROC
	SAVE	<XPTR,XZHEOF>

	LF	,ZQUTEM(XZQU)
	ST	YDPLIN	;LINE NO WHERE EXTERNAL WAS DECLARED
	LI	XZHB,3(XZQU)
	skipoverhead	;[144]
;GET ATR HEADER
	GETEXT
	ST	YDPATH
	ST	YDPFUN
;CHECK AND MODIFY ZQU
	GETEXT
	XOR	(XZQU)
	TLNE	-1
	GOTO	XER1	;TYPE AND/OR KIND ERROR
	GETEXT	XB
	GETEXT	XID
	GETEXT	XID2
	NOAPPEND
	EXEC	SH
	LF	X1,ZQULID(XZQU)
	CAME	X1,XIDNO
	GOTO	XER2	;NAMES DO NOT CORRESPOND
	ADDM	XB,1(XZQU)
	LF	XTYP,ZQUKND(XZQU)
	GETEXT	XID
	GETEXT	XID2
	IF
		JUMPE	XID,FALSE
	THEN
		APPEND
		EXEC	SH
		IF
			CAIE	XTYP,QPROCE
			GOTO	FALSE
		THEN
			LF	,ZQUQID(XZQU)
			CAME	XIDNO
			GOTO	XER3	;QUALIFICATION ERROR
		FI
		SF	XIDNO,ZQUQID(XZQU)
	FI
	AOS	XID2,YMAXFX
	SF	XID2,ZQUIND(XZQU)
;CHECK AND MODIFY ZHB
	LF	,ZHESOL(XZHB)
	SUBI	1
	MOVSM	YDPSOL
	GETEXT	XA
	ADD	XA,YDPSOL
	XOR	XA,(XZHB)
	TRNE	XA,-1
	SKIPN	YDPSOL
	SKIPA
	GOTO	XER4	;DLV ERROR
	XORM	XA,(XZHB)
	GETEXT	XA
	ST	XA,1(XZHB)
	SF	XID2,ZHEFIX(XZHB)
	GETEXT
	GETEXT	XA
	LF	,ZHBSBL(XZHB)
	ST	XA,3(XZHB)
	SF	,ZHBSBL(XZHB)
	GETEXT	XID
	SF	XID,ZHBUNR(XZHB)
	CAIE	XTYP,QCLASS
	ST	XID,YDPFUN

	L	[2,,2]	;Put unique number info on a chain
	EXEC	SDALLOC
	ST	XID,(XALLOC)
	L	YDPUNR
	ST	1(XALLOC)
	ST	XALLOC,YDPUNR

	EXEC	DPEXDF
	IF	;[4] Quick calling sequence procedure
		LF	XA,ZHETYP(XZHB)
		CAIE	XA,QPROCE
		GOTO	FALSE
		LF	XA,ZHBMFO(XZHB)
		CAIE	XA,QEXMQI
		GOTO	FALSE
	THEN	;[4] Change ZQQ just created
		L	XA,YDPZQQ
		L	XID,YDPATH	;Procedure entry
		SF	XID,ZQQUNR(XA)
	FI	;[4]
	LF	XA,ZDELNK(XZHB)
	STACK	XZHB
	STACK	XA
;READ ATTRIBUTES
	LI	XATL,(XATS)
	CLEARB	XSUS,XSUL
	EXEC	DPEXTC
	UNSTK	XA
	IF
		JUMPE	XSUS,FALSE
	THEN
		SF	XSUS,ZDELNK(XATL)
		SF	XA,ZDELNK(XSUL)
	ELSE
		SF	XA,ZDELNK(XATL)
	FI
	UNSTK	XZHB
;CREATE ZHE(QQUACH)
	LI	XZHE,5(XZHB)
	LF	XA,ZDELNK(XZHE)
	APPEND
	HLL	XB,(XZHE)
	WHILE
		GETEXT	X1
		JUMPE	X1,FALSE
	DO
		L	[3,,3]
		EXEC	SDALLOC
		SF	XALLOC,ZDELNK(XZHE)
		LI	XZHE,(XALLOC)
		ST	XB,(XZHE)
		GETEXT	X1
		SF	X1,ZHEUNR(XZHE)
		GETEXT	XID
		GETEXT	XID2
		EXEC	SH
		SF	XIDNO,ZHELID(XZHE)
	OD
	SF	XA,ZDELNK(XZHE)
;CREATE ZUC-RECORD
	LI	XZQU,-3(XZHB)
	L	[3,,3]
	EXEC	SDALLOC
	LF	,ZQULID(XZQU)
	SF	,ZUCLID(XALLOC)
	L	YDPFUN
	SF	,ZUCFUN(XALLOC)
	L	YDPLUN
	SF	,ZUCLUN(XALLOC)
	L	YDPZUC
	SF	,ZDELNK(XALLOC)
	ST	XALLOC,YDPZUC
;APPEND CODE TO REL.TMP
	IF
		SKIPN	YDPSOL
		GOTO	FALSE
	THEN	;EXTERNAL IS COPIED
		LF	,ZHETYP(XZHB)
		IF
			CAIE	QCLASB
			GOTO	FALSE
		THEN	;DEFINE ZCPSBL FOR THE CLASS
			LI	X1,0
			L	X2,YDPATH
			TLO	X2,40K
			LF	X3,ZHBSBL(XZHB)

			MOVN	X3,X3
			GENSYMB
		ELSE	;PROCEDURE
			LF	XA,ZHBMFO(XZHB)	;[4]
			IF	;MACRO (not QUICK) or FORTRAN procedure
				JUMPE	XA,FALSE	;[4]
				CAIN	XA,QEXMQI	;[4]
				GOTO	FALSE		;[4]
			THEN	;[4] Generate symbol table, map, prototype
				EXEC	DPSYMT
				EXEC	DPMAP
				EXEC	DPPROT
	FI	FI	FI	;[4]
	RETURN
	EPROC	;DPEXT

	SUBTTL	DPSYMT, GENERATE SYMBOL TABLE

DPSYMT:	PROC	;[4]
	LI	X0,0
	GENABS

	IF	;FORTRAN procedure
		CAIGE	XA,QEXFOR	;[4]
		GOTO	FALSE
	THEN	;Define entry point
		MOVSI	X1,40K
		L	X2,YDPATH
		TLO	X2,600K
		L	X3,YBREAK
		SUBI	X3,1
		TLO	X3,600K
		GENSYMB	;ENTRY OF FORTRAN PROCEDURE
	FI

;GENERATE NAME OF PROCEDURE

	LF	X2,ZQULID(XZQU)
	L	X0,YZSE1(X2)
	GENABS
	L	X0,YZSE2(X2)
	GENABS

	L	XB,YBREAK	;SAVE START ADDRESS OF SYMBOL TABLE

	MOVSI	X0,(<QMEXT>B3)
	CAIL	XA,QEXFOR	;[4]
	MOVSI	X0,(<QFEXT>B3)
	HRRI	1(XB)
	GENREL

	LI	XE,0
	LF	XC,ZHBNRP(XZHB)

	IF
		JUMPE	XC,FALSE
	THEN	;PROCEDURE HAS FORMAL PARAMETERS
		LF	XD,ZDELNK(XZHB)

		LOOP	;FOR EACH PARAMETER
			LF	X0,ZQUIND(XD)
			LF	X1,ZQUTMK(XD)
			HRL	X0,X1
			LF	X1,ZQULID(XD)
			SKIPE	YZSE2(X1)
			TLO	X0,400K
			GENABS
			L	X0,YZSE1(X1)
			GENABS
			L	X0,YZSE2(X1)
			SKIPE	X0
			GENABS
			LF	X1,ZQUQID(XD)
			SKIPE	X1
			EXEC	DPEXCR
			LF	,ZQUMOD(XD)
			CAIN	QNAME
			ADDI	XE,1
			LF	XD,ZDELNK(XD)
		AS
			SOJG	XC,TRUE
		SA
	FI
	RETURN	;[4]
	EPROC	;[4] DPSYMT

	SUBTTL	DPMAP, GENERATE MAP

DPMAP:	PROC	;[4]
	L	XC,YBREAK	;SAVE START ADDRESS OF MAP

	LI	X0,0	;THIS IS ALSO END OF SYMBOL TABLE
	GENABS

	IF
		CAIL	XA,QEXFOR	;[4]
		GOTO	FALSE
	THEN	;MACRO PROCEDURE (HAS NO LOCAL VARIABLES)
		GENABS
		GENABS
		LF	XD,ZHELEN(XZHB)
		IFON	ZHBNCK(XZHB)	;[4]
		ADDI	XD,^D31*2	;Max 31 parameters, all mode name
	ELSE	;FORTRAN PROCEDURE
		; A FORTRAN PROCEDURE HAS 2 AREAS OF LOCAL VARIABLES.
		; THE 1:ST AREA CONTAINS INTERMEDIATE LOCATIONS FOR PARAMETERS
		; CALLED BY NAME (NO RELOCATION). THE 2:ND AREA
		; CONTAINS THE ARGUMENT LIST (RELOCATED)
		LF	X0,ZHELEN(XZHB)
		ASH	XE,1
		MOVN	X1,XE
		HRL	X0,X1
		TLNN	X0,-1
		LI	X0,0
		GENABS
		LF	X0,ZHELEN(XZHB)
		ADDI	X0,1(XE)
		LF	XD,ZHBNRP(XZHB)
		MOVN	X1,XD
		HRL	X0,X1
		GENABS
		ADD	XD,X0
		LI	XD,1(XD)
	FI
	SETZ		;[215]
	GENABS
	RETURN	;[4]
	EPROC	;[4] DPMAP

	SUBTTL	DPPROT, Generate prototype

DPPROT:	PROC	;[4]
	MOVSI	X1,40K
	LF	X2,ZHBUNR(XZHB)
	TLO	X2,40K
	L	X3,YBREAK
	GENSYMB	;GENERATE PROTOTYPE ENTRY

	MOVSI	X0,(XD)
	HRR	X0,XC
	GENREL
	LF	X1,ZHEEBL(XZHB)
	MOVSI	X0,(X1)
	MOVN
	HRR	X0,XB
	GENREL

	LF	XB,ZHBNRP(XZHB)
	L	XC,OFFSET(ZHBNCK)(XZHB)	;[4]
	IFONA	ZHBNCK(XC)	;[4]
	LI	XB,^D31	;IF NOCHECK
	MOVSI	X0,(XB)
	HRRI	X0,2(X1)
	GENABS	;ZPCNRP,,ZPCDLE


	L	X3,YBREAK

	LF	X0,ZQUTYP(XZQU)
	ROT	X0,-6
	SKIPE	XB
	SETONA	ZPCPAR
	IFONA	ZHBNCK(XC)	;[4]
	SETONA	ZPCNCK
	CAIN	XA,QEXF40	;[4]
	SETONA	ZPCF40
	GENABS

	MOVSI	X1,40K
	L	X2,YDPATH
	CAIL	XA,QEXFOR	;[4] FORTRAN or F40
	L	X2,[RADIX50 0,.PHFO]
	TLO	X2,600K
	GENSYMB	;RELOCATE ZPCCAD

;OUTPUT ZFP FOR PARAMETERS

	IF	;NOCHECK procedure
		IFOFFA	ZHBNCK(XC)	;[4]
		GOTO	FALSE
	THEN	;Describe 31 integers by name
		LI	X1,^D31
		LF	X0,ZHELEN(XZHB)
		HRLI	X0,(BYTE (6)QINTEGER(3)QNAME,QSIMPLE(24)0)
		LOOP
			GENABS
			ADDI	X0,2
		AS
			SOJG	X1,TRUE
		SA
	ELSE	;Describe all parameters
		LF	XC,ZDELNK(XZHB)
		WHILE
			SOJL	XB,FALSE
		DO
			LF	X0,ZQUIND(XC)
			LF	X1,ZQUTMK(XC)
			SF	X1,ZFPTMK
			GENABS
			LF	X1,ZQUQID(XC)
			SKIPE	X1
			EXEC	DPEXCR
			LF	XC,ZDELNK(XC)
		OD
	FI
	RETURN	;[4]
	EPROC	;[4] DPPROT

	SUBTTL	findemall (DPEXFA)	[144]

Comment;
1)	Finds all separate ATR files corresponding to external declarations.
	If a separate file x.atr corresponding to EXTERNAL ... x is found,
	the corresponding ZQU is taken off the chain starting with YEXZQU,
	and the information is read and processed by DPEXT.
	If the external spec was definite, i.e. of the form x=<file spec>,
	the specified file is looked up. On lookup failure, ZQUIND is set to
	-1, leaving the message till later???.
2)	If ZQU records now remain on the YEXZQU chain, any libraries on the
	SEARCH list are tried in order. The first index block is read in, and
	each name in the block is checked against the ZQU list. As soon as a
	matching name is found, the corresponding module is read in and
	processed by DPEXT. This goes on as long as there are index blocks
	and libraries left and the ZQU list contains entries.
	This processing order ensures that no unnecessary I/O positioning
	has to be done, and each file is read only once (except if a library
	is given to the right of an = sign in an external specification).
;

DPEXFA::PROC
	SAVE	<XZQU,XZHB>
	SETOM	YRQDEV		;No channel open yet
	HRRZS	XZQU,YEXZQU	;Start of chain of unsatisfied external ref's
	WHILE	;List contains more
		JUMPE	XZQU,FALSE
	DO
		LF	,ZQUTEM(XZQU)
		ST	YDPLIN	;Declaration line no
		LI	XZHB,3(XZQU)
		getdevice
		EXCH	YRQDEV	;Open only if necessary
		CAME	YRQDEV
		openext
		filespec
		LF	,ZQUIND(XZQU)
		STACK
		IF	;found
			lookitup
			GOTO	FALSE
		THEN
			IF	;Non-specific request
				SKIPE	YRQPPN
				GOTO	FALSE
			THEN	;Process directly
			L1():!	zquremove
				IF	;Global ZQU
					CAIE	XZQU,YZQUGLO
					GOTO	FALSE
				THEN	;Just note where old module found
					SETZ		;No offset
					EXEC	O1EXNP
				ELSE	;External, read and process it
					EXEC	O1EXTB	;[225] Read first block
					AOS	YBHEXT+2	;Adjust count
				L2():!	EXEC	O1EXRQ
					;Note for output
					MOVSI	(1B<%ZRQOUT>)
					IORM	(X2)
					IORM	YRQHEAD
					EXEC	DPEXT
				FI
			ELSE	;Specific file requested, check for library
				EXEC	DPRX50	;RADIX50 name
				SETZ	XZRQ,	;Just one module sought
				findmodules
				CAIN	XZQU,YZQUGLO
				JUMPE	XZRQ,L1	;Was no library
				IF	;External module, not library file
					JUMPN	XZRQ,FALSE
				THEN	;Back up byte pointer
					SOS	YBHEXT+1
					GOTO	L2
				FI
				IF	;Failed to find module in a library
					JUMPG	XZRQ,FALSE
				THEN	;Error
					LF	X1,ZQULID(XZQU)
					LF	X2,ZHBXID(XZQU,3)
					ERROR(3,I2,Module not found in library)
					BRANCH	DPAB
				FI
			FI
			EXEC	O1EXCL
			SETOM	YRQDEV
		ELSE	;Not found, error if specific request
			EXEC	DPRX50	;Note RADIX50 form of name
			IF	;Request was specific
				SKIPN	YRQPPN
				GOTO	FALSE
			THEN	;Error unless it was the global ZQU
				zquremove
				IF	;Not Global
					CAIN	XZQU,YZQUGLO
					GOTO	FALSE
				THEN
					EXEC	DPEXER
				FI
			ELSE	;Remember as previous ZQU
				SKIPE	YEXZQU
				HRLM	XZQU,YEXZQU
		FI	FI
		UNSTK	XZQU
	OD

;;;;; Now try search list with remaining names ;;;;;

	L	XZRQ,YRQHEAD
	IF	;Names remain and search list contains any libraries
		SKIPE	YEXZQU
		IFOFFA	ZRQSRC(XZRQ)
		GOTO	FALSE
	THEN	;Try all remaining names with each library
		HRRZS	XZRQ	;Clear flag bits
		LOOP	;Through ZRQ list
			IF	;File belongs to search list
				IFOFF	ZRQSRC(XZRQ)
				GOTO	FALSE
			THEN	;Try remaining names with this file
				LF	,ZRQDEV(XZRQ)
				EXCH	YRQDEV
				CAME	YRQDEV
				openext
				LF	,ZRQFIL(XZRQ)
				ST	YRQFIL
				LF	,ZRQPPN(XZRQ)
				ST	YRQPPN
				IF	;found
					lookitup
					GOTO	FALSE
				THEN
					findmodules
					EXEC	O1EXCL
				FI
			FI
		AS	;Long as neither list is empty
			LF	XZRQ,ZRQZRQ(XZRQ)
			SKIPE	YEXZQU
			JUMPN	XZRQ,TRUE
		SA
	FI
	HRRZS	XZQU,YEXZQU
	WHILE	;Chain not empty (unsatisfied externals)
		JUMPE	XZQU,FALSE
	DO	;Generate error message
		CAIE	XZQU,YZQUGLO	;Unless it is the global ZQU
		EXEC	DPEXER		;(May return in later releases)
		HRLM	XZQU,YEXZQU
		LF	XZQU,ZQUIND(XZQU)
	OD
	RETURN
	EPROC


DPRX50:	PROC
	LF	X1,ZQULID(XZQU)
	L	YZSE1(X1)
	EXEC	I1RX50
	SF	,ZQUR50(XZQU)
	RETURN
	EPROC

DPEXER::PROC	;[144]
	LF	X1,ZHBXID(XZQU,3)
	L	YZSE1(X1)
	ST	YELEXT
	LF	,ZHBPPN(XZQU,3)
	ST	YELEXT+3
	LI	X1,YELEXT
	L	YLSLLS
	ST	YELIN1
	ST	YELIN2
	UNSTK	(XPDP)
	ERRT	QT,256	;Name of file in message
	BRANCH	DPAB
	EPROC

	SUBTTL	getdevicename (DPEXGD), filespec (DPEXFS)	[144]

Comment;
Finds out device name from ZHBDEV(XZHB). If zero, return 'DSK', otherwise
1st word of dictionary entry, in X0.
;

DPEXGD::PROC
	LF	X1,ZHBDEV(XZHB)
	MOVSI	'DSK'	;Default device
	IF	;Valid id no
		JUMPE	X1,FALSE
	THEN	;Use dictionary entry
		L	YZSE1(X1)
	FI
	RETURN
	EPROC


;***************************************


Comment;	Filespec:
Put file name in YRQFIL, PPN in YRQPPN;

DPEXFS::PROC
	LF	X1,ZHBXID(XZHB)
	L	YZSE1(X1)
	ST	YRQFIL
	LF	,ZHBPPN(XZHB)
	ST	YRQPPN
	RETURN
	EPROC

	SUBTTL	zquremove (DPEXRM)	[144]

Comment;
Remove XZQU record from chain starting in YEXZQU.
If chain becomes empty, clear YEXZQU.
;

DPEXRM::PROC
	SAVE	<X2>
	HLRZ	X2,YEXZQU	;Previous ZQU or zero
	LF	,ZQUIND(XZQU)
	IF	;No previous ZQU in chain
		JUMPN	X2,FALSE
	THEN	;Change YEXZQU ptr
		HRRM	YEXZQU
		IF	;List is now exhausted
			JUMPN	FALSE
		THEN
			SETZM	YEXZQU
		FI
	ELSE	;Take out of chain
		SF	,ZQUIND(X2)
	FI
L9():!	RETURN
	EPROC

	SUBTTL	DPEXTC	APPEND EXTERNAL ATTRIBUTES TO DC1-LIST

DPEXTC:

	WHILE
		GETEXT	XA
		JUMPE	XA,FALSE
	DO
		LF	XTYP,ZQUTYP(,XA)
		LF	XKND,ZQUKND(,XA)
		LF	XMOD,ZQUMOD(,XA)
		IF
			CAIE	XKND,QCLASS
			CAIE	XMOD,QDECLARED
			GOTO	FALSE
		THEN
			NOAPPEND
		ELSE
			APPEND
		FI
		GETEXT	XB
		GETEXT	XID
		GETEXT	XID2
		EXEC	SH
		IF
			JUMPE	XIDNO,FALSE
		THEN	;OBJECT APPENDED
			L	[3,,3]
			EXEC	SDALLOC
			SF	XALLOC,ZDELNK(XATL)
			LI	XATL,(XALLOC)
			HRR	XA,YDPLIN
			STD	XA,(XALLOC)
			SF	XIDNO,ZQULID(XALLOC)
			GETEXT	XID
			GETEXT	XID2
			IF
				CAIN	XTYP,QREF
				GOTO	TRUE
				JUMPE	XID,FALSE
				CAIE	XKND,QCLASS
				GOTO	FALSE
			THEN
				APPEND
				EXEC	SH
				SF	XIDNO,ZQUQID(XALLOC)
			FI
			LF	XMOD,ZQUMOD(XALLOC)
			IF
				CAIE	XMOD,QDECLARED
				GOTO	FALSE
			THEN	;NOT PARAMETER
				IF	;LABEL
					CAIE	XTYP,QLABEL
					GOTO	FALSE
				THEN	;LABEL
					AOS	XID2,YMAXFX
					SF	XID2,ZQUIND(XALLOC)
					EXEC	DPEXDF
				ELSE
				IF
					CAIN	XKND,QPROCEDURE
					GOTO	TRUE
					CAIE	XKND,QCLASS
					GOTO	FALSE
				THEN	;CLASS OR PROCEDURE
					AOS	XID2,YMAXFX
					SF	XID2,ZQUIND(XALLOC)
					L	[5,,5]
					EXEC	SDALLOC
					IF
						JUMPE	XSUL,FALSE
					THEN
						SF	XALLOC,ZDELNK(XSUL)
					ELSE
						L	XSUS,XALLOC
					FI
					L	XSUL,XALLOC
					STACK	XATS
					STACK	XATL
					L	XATS,XSUS
					L	XATL,XSUL
					CLEARB	XSUS,XSUL
					GETEXT	XA
					GETEXT	XB
					ADD	XA,YDPSOL
					STD	XA,(XALLOC)
					SF	XID2,ZHEFIX(XALLOC)
					GETEXT
					GETEXT	XA
					ST	XA,3(XALLOC)
					GETEXT	XID
					SF	XID,ZHBUNR(XALLOC)
					EXEC	DPEXDF
					EXEC	DPEXTC
					IF
						JUMPE	XSUS,FALSE
					THEN
						SF	XSUS,ZDELNK(XATL)
					ELSE
						L	XSUL,XATL
					FI
					L	XSUS,XATS
					UNSTK	XATL
					UNSTK	XATS
				FI FI
			FI
		ELSE	;SKIP THIS OBJECT
			GETEXT	X1
			GETEXT
			IF	;LABEL
				CAIE	XTYP,QLABEL
				GOTO	FALSE
			THEN	;STORE UNIQUE NUMBER
				ST	X1,YDPLUN
			ELSE
			IF
				CAIE	XKND,QPROCEDURE
				GOTO	FALSE
			THEN	;SKIP FORMAL PARAMETERS
				GETEXT
				GETEXT
				GETEXT
				GETEXT
				GETEXT
				ST	YDPLUN	;SET LAST UNIQUE NUMBER
				WHILE
					GETEXT	X1
					JUMPE	X1,FALSE
				DO
					GETEXT
					GETEXT
					GETEXT
					GETEXT
					GETEXT
				OD
			FI FI
		FI
	OD
	RETURN

	SUBTTL	DPEXDF	(DEFINE EXTERNAL NAME OF FIXUP)

DPEXDF:	PROC
	SAVE	<XA,XALLOC>
;CREATE A ZQQ-RECORD

	L	[2,,2]
	EXEC	SDALLOC
	L	XA,YDPZQQ
	ST	XALLOC,YDPZQQ
	SF	XA,ZQQLNK(XALLOC)
	SF	XID2,ZQQFIX(XALLOC)
	SF	XID,ZQQUNR(XALLOC)
	ST	XID,YDPLUN
	RETURN
	EPROC

	SUBTTL	DPEXCR	(CREATE REQUEST OF EXTERNAL SYMBOL)

DPEXCR:	PROC

; CHECK IF QUA IS EXTERNAL PROCEDURE
	LI	X2,5(XZHB)
	WHILE	;[176]
		LF	X2,ZDELNK(X2)
		JUMPE	X2,FALSE
		WHENNOT	X2,ZHE
		GOTO	FALSE
		IFNEQF	(X2,ZHETYP,QQUACH)
		GOTO	FALSE
		SKIPGE	1(X2)
		GOTO	FALSE
	DO
		LF	,ZHELID(X2)
		IF
			CAME	X1,X0
			GOTO	FALSE
		THEN
			L	X3,YBREAK
			LI	X0,0
			GENABS
			MOVSI	X1,40K
			LF	X2,ZHEUNR(X2)
			TLO	X2,600K
			GENSYMB
			RETURN
		FI
	OD
;QUA IS SYSTEM CLASS
ASSERT<;[176]
	CAIL	X1,QIDTXT
	RFAIL	NOT SYSTEM-ID AT DPEXCR
>
	L	X2,[IOIN
		IOOU
		IODF
		IOPF
		RADIX5	60,.SSST
		RADIX5	60,.SUSI
		RADIX5	60,.SSLG
		RADIX5	60,.SSLK
		RADIX5	60,.SSHD
		RADIX5	60,.SUPS]-QIDINF(X1)
	IF
		TLNE	X2,-1
		GOTO	FALSE
	THEN	;PROTOTYPE IN HISEG
		L	X0,X2
		GENABS
	ELSE	;PROTOTYPE IN LOWSEG
		L	X0,0
		L	X3,YBREAK
		GENABS
		MOVSI	X1,40K
		GENSYMB
	FI
	RETURN
	EPROC

	SUBTTL	MAIN PROCEDURE

DP:	PROC

	EXEC	O1DFOP	;OPEN DF1

;OUTPUT LEADING ZHB FOR BASICIO

	L	XDPOUT,[BYTE	(3)QQZHB,QPBLOC(12)0(18)-2]
	PUTDF1	XDPOUT
	L	XDPOUT,YMAXFX
	PUTDF1	XDPOUT
	ADDI	XDPOUT,5
	ST	XDPOUT,YMAXFX
	LI	XDPOUT,0
REPEAT 3,<PUTDF1	XDPOUT>
;MERGE SYSTEM COMPONENTS WITH DC1-LIST

	EXEC	DPSYS
	SETZM	YDPZQQ
	findemall	;[144] (the ATR modules)
;CLEAR OFFSET COUNTER
	LI	XZHEOF,5
LOOP	;OUTPUT DC1-LIST TO FILE DF1
	LF	(XTAG) ZDETYP(XPTR)
	IF
		CAIE	XTAG,QQZHE
		GOTO	FALSE
	THEN		;(ZHE-RECORD FOUND)
;			===================
		IF
			LF	,ZHETYP(XPTR)
			CAIE	QQUACH
			GOTO	TRUE
			SKIPG	1(XPTR)
			GOTO	FALSE	;SKIP THIS RECORD IF EMPTY QQUACH
		THEN
			LD	X0,(XPTR)
			PUTDF1
			PUTDF1	X1
		FI
		LF	(XPTR) ZDELNK(XPTR)	
;NEXT RECORD WILL HAVE OFFSET RELATIVE TO START OF THIS ZHE
		LI	XZHEOF,2	
	ELSE
	IF
		CAIE	XTAG,QQZHB
		GOTO	FALSE
	THEN		;(ZHB-RECORD FOUND)
;			===================
		LF	,ZHETYP(XPTR)
		CAIE	QINSPEC
		CAIN	QPBLOCK
		SETZ	XZHEOF,		;CLEAR OFFSET COUNTER
					;IN CASE OF PREFIXED BLOCK
		LF	,ZHEDLV(XPTR)
		MOVN	
		SF	,ZHBSTD(XPTR)
		LD	(XPTR)
		PUTDF1
		PUTDF1	X1
;OUTPUT WORD 2 (FROM PREV ZQU)
		ZOUT	<-1>
		ZOUT	3		;OUTPUT WORD 3
;OUTPUT WORD 4, AND STEP OFFSET COUNTER
		SETZ	XDPOUT,	
		IFON	ZHBEXT(XPTR)
		LF	XDPOUT,ZHBUNR(XPTR)
		PUTDF1	XDPOUT		
		LF	XPTR,ZDELNK(XPTR)	
		ADDI	XZHEOF,5	
	ELSE		;(ZQU-RECORD FOUND)
;			===================
;OUTPUT WORD 0 (WITH ZQUZHE=0)
		HLLZ	XDPOUT,(XPTR)	
		SETOFA	ZQUTPT(XDPOUT)	;[40]
		PUTDF1	XDPOUT		
;OUTPUT WORD 1 (WITH UNUSED PART=0)
		ZOUT	1
;OUTPUT WORD 2 (=ZQUQID,,0)
		HLLZ	XDPOUT,2(XPTR)	
		PUTDF1	XDPOUT		
;OUTPUT WORD 3 (=0,,ZQULNE OR SYSTEM-FLAGS,,0)
		LF	XDPOUT,ZQUTEM(XPTR)
		IFON	ZQUSYS(XPTR)
		MOVS	XDPOUT,XDPOUT
		LF	X1,ZQULID(XPTR)
		IF
			SKIPN	YZSE2(X1)
			GOTO	FALSE
		THEN	;IDENTIFIER MORE THAN SIX CHAR
			SETONA	ZQULO(XDPOUT)
		FI
		IFON	ZQUTPT(XPTR)	;[40]
		SETONA	ZQUPTD(XDPOUT)	;[40]
		PUTDF1	XDPOUT		
;STORE OFFSET FOR THIS ZQU, TO BE USED BY CORRESPONDING ZHB (IF ANY)
		L	XP,XPTR
		LF	XPTR,ZDELNK(XPTR)
		HRLZM	XZHEOF,2(XP)
		ADDI	XZHEOF,4	
	FI FI
AS
	JUMPG	XPTR,TRUE
SA

;OUTPUT A DUMMY ZHE-RECORD TO STOP READING BY CARL

	L	XDPOUT,[BYTE	(3)QQZHE,QRBLOC(30)0]
	PUTDF1	XDPOUT
	LI	XDPOUT,0
	PUTDF1	XDPOUT
;OUTPUT ZQQ-RECORDS (IF EXTERNALS ARE REFERENCED IN PROGRAM)

	L	X1,YDPZQQ
	WHILE
		JUMPE	X1,FALSE
	DO	;OUTPUT A RECORD
		LF	X2,ZQQFIX(X1)
		PUTDF1	X2
		LF	X2,ZQQUNR(X1)
		PUTDF1	X2
		LF	X1,ZQQLNK(X1)
	OD
	PUTDF1	X1	;OUTPUT END MARKER
	EXEC	O1DFCL

;IF MAIN PROG OUTPUT COMMENT IN REL FILE CONTAINING USED EXTERNALS

	IFONA	YSWEMP
	EXEC	O1RLUNR

;CHECK IF CONFLICT BETWEEN UNIQUE NUMBER OF EXTERNALS (IF ANY)

	L	X3,YDPZUC
	WHILE	;EXTERNALS EXIST
		JUMPE X3,FALSE
	DO
		LI	X4,(X3)
		LF	X5,ZUCFUN(X3)
		LF	X11,ZUCLUN(X3)
		WHILE	;EVEN MORE EXTERNALS EXISTS
			LF	X4,ZDELNK(X4)
			JUMPE	X4,FALSE
		DO	;TEST CONFLICT
			LF	X7,ZUCFUN(X4)
			LF	X10,ZUCLUN(X4)
			IF
				CAML	X11,X5
				CAMGE	X10,X7
				GOTO	TRUE
				CAML	X11,X7
				CAMGE	X10,X5
				GOTO	FALSE
			THEN	IF
				CAMGE	X10,X5
				CAML	X11,X7
				GOTO	TRUE
				CAMGE	X11,X5
				CAML	X10,X7
				GOTO	FALSE
			THEN	;CONFLICT
				LF	,YLSLLIN
				ST	YELIN1
				ST	YELIN2
				SETZM	YESEM
				LF	X1,ZUCLID(X3)
				LF	X2,ZUCLID(X4)
				IF
					CAMN	X1,X2
					CAME	X5,X7
					GOTO	FALSE
					CAME	X11,X10
					GOTO	FALSE
				THEN	;SAME EXTERNAL DECLARED TWICE
					ERRI1	QE,Q1DP.E+1
				ELSE	;CONFLICT BETWEEN DIFFERENT EXTERNALS
					ERRI2	QE,Q1DP.E
				FI
			FI FI

		OD
		LF	X3,ZDELNK(X3)
	OD

	RETURN
	EPROC

	SUBTTL	ERROR ROUTINES

XER1:XER3:
	LF	X1,ZQULID(XZQU)
	ERROR(0,I1,TYPE AND-OR KIND OF EXTERNAL DOES NOT CORRESPOND)
	BRANCH	DPAB

XER2:
	ERROR(1,I1,NAME OF EXTERNAL DOES NOT CORRESPOND)
	BRANCH	DPAB

XER4:
	LF	X1,ZQULID(XZQU)
	LF	X2,ZHEDLV(XZHB)
	TRC	X2,-1
	SUBI	X2,1
	ERROR(2,I2,EXTERNAL COMPILED ON WRONG BLOCK LEVEL)
	BRANCH	DPAB

DPAB:	EXEC	O1EXCL	;[144]	To be able to go on
	BRANCH	T1AB

	LIT
	END