perm filename DP.MAC[SIM,SYS] blob sn#460041 filedate 1979-07-22 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00016 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002
C00005 00003		SUBTTL	MACRO DEFINITIONS
C00007 00004	SWITCHES
C00008 00005		SUBTTL	DPSYS
C00009 00006		SUBTTL	DPSYSC (APPEND SYSTEM CLASSES)
C00012 00007		SUBTTL	DPEXT
C00018 00008		SUBTTL	DPSYMT, GENERATE SYMBOL TABLE
C00020 00009		SUBTTL	DPMAP, GENERATE MAP
C00022 00010		SUBTTL	DPPROT, Generate prototype
C00024 00011		SUBTTL	DPEXTC	APPEND EXTERNAL ATTRIBUTES TO DC1-LIST
C00028 00012		SUBTTL	DPEXDF	(DEFINE EXTERNAL NAME OF FIXUP)
C00029 00013		SUBTTL	DPEXCR	(CREATE REQUEST OF EXTERNAL SYMBOL)
C00031 00014		SUBTTL	MAIN PROCEDURE
C00037 00015		SUBTTL	ERROR ROUTINES
C00038 00016		LIT
C00039 ENDMK
C⊗;

;NAME:	DP
;====

;VERSION:	13
;=======

;AUTHOR:	KIM WALDEN
;======		CLAES WIHLBORG

;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	MC1,SIMMAC,SIMMCR
	CTITLE	DP (DECLARATION PROCESSING)
	SUBTTL	PROLOGUE
	MACINIT
	TWOSEG
	RELOC	400000

	INTERN	DP

	EXTERN	O1DFOP,O1DF1,O1DFCL
	EXTERN	O1RL,O1RLR,O1RLS,O1RLUNR
	EXTERN	YBHEXT,YBREAK
	EXTERN	O1EXOP,O1EXT,O1EXCL
	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
	SUBTTL	MACRO DEFINITIONS

DEFINE	GENABS<EXEC	O1RL>
DEFINE	GENREL<EXEC	O1RLR>
DEFINE	GENSYMB<EXEC	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)
;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
	SUBTTL	DPSYS

DPSYS:	PROC

	NOAPPEND
	LI	XPTR,SYS1
	EXEC	DPSYSC
	LF	X2,ZHSSTR(,YDPD)
	LF	X3,ZHSEND(,YDPD)
	TOGETHER(XSTM,XEDM,X2,X3)
	TOGETHER(XSTM,XEDM,XSTA,XEDA)
	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)
;OPEN ATR-FILE
	MOVSI	X1,'DSK'
	LF	X2,ZHBDEV(XZHB)
	SKIPE	X2
	L	X1,YZSE1(X2)
	ST	X1,YRQDEV	;[13]
	LF	X3,ZQULID(XZQU)	;[13] internal id
	L	X3,YZSE1(X3)
	ST	X3,YEXNAM	;[13]
	LF	X2,ZHBXID(XZHB)	;External id
	L	X2,YZSE1(X2)	;[13]
	ST	X2,YRQFIL	;[13] Save as file name for lookups
	LF	,ZHBPPN(XZHB)	;[13]
	ST	YRQPPN		;[13]
	EXEC	O1EXOP
;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)
		SETON	ZQUSYS(XZQU)	;Treat like system proc for checking purposes
	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]
	EXEC	O1EXCL	;Close ATR file
	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)
		LI	X0,0
	FI
	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	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

	IF
		CAIG	X1,QIDTXT
		GOTO	FALSE
	THEN	;QUA IS EXTERNAL PROCEDURE
		LI	X2,5(XZHB)
		LOOP
			LF	X2,ZDELNK(X2)
			LF	,ZHELID(X2)
		AS
			CAME	X1,X0
			GOTO	TRUE
		SA
		L	X3,YBREAK
		LI	X0,0
		GENABS
		MOVSI	X1,40K
		LF	X2,ZHEUNR(X2)
		TLO	X2,600K
		GENSYMB
	ELSE	;QUA IS SYSTEM CLASS
		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
	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
;CLEAR OFFSET COUNTER
	LI	XZHEOF,5
	SETZM	YDPZQQ
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)
;			===================
		IFON	ZQUEXT(XPTR)
		EXEC	DPEXT	;MERGE THE CONTENTS OF THE ATR-FILE WITH THE DC1-LIST
;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	T1AB

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

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	T1AB
	LIT
	END