Google
 

Trailing-Edge - PDP-10 Archives - BB-4157D-BM - sources/outmod.bli
There are 26 other files named outmod.bli in the archive. Click here to see a list.


!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: F. INFANTE/MD/DCE/JNG
MODULE OPMOD(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4,GLOROUTINES)=
BEGIN

SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE REQREL.BLI;
SWITCHES LIST;

GLOBAL BIND OPMOV = 5^24 + 1^18 + 72;		!VERSION DATE: 9-AUG-77
%(
REVISION HISTORY
44	-----	-----	MODIFY "PROCEQUIV" TO TURN OFF THE "BOUNDS" FLAG
			WHEN ARRXPN IS CALLED FOR AN EQUIVALENCE STMNT
45	-----	-----	MOVE DECLARATIONS OF LOADER BLOCK TYPES TO A
			REQUIRE FILE.
46	-----	-----	REMOVE THE ROUTINES "ZOUTBLOCK" (WHICH
			HAS MOVED TO THE MODULE "RELBUF") AND "ZDMPBLK"
			(WHICH IS NO LONGER NEEDED)
			ALSO REMOVE THE ROUTINE "DATAOUT" AND CHANGE "OUTDATA"
			TO CALL "ZOUTBLOCK" RATHER THAN "DATAOUT". ALSO
			CHANGE OUTDATA TO CALL "DMPRLBLOCK" OF "MAINRLBF"
			WHEN THE BUFFER DOESNT HAVE ENOUGH ROOM RATHER
			THAN CALLING "ZDMPBLK".
47	-----	-----	REMOVE DEFINITIONS OF CBLK AND ZDATCNT AND ALL
			REFERENCES TO THEM.
			ALSO, REMOVE ALL REFERENCES TO "RELOCPTR" AND
			"RELBLOCK".
48	-----	-----	MODIFY "RELINIT" TO CALL "INITRLBUFFS" TO INITIALIZE
			THE REL FILE BUFFERS.
49	-----	-----	DELETE THE ROUTINE "DMPRELONLS"
50	-----	-----	DELETE THE ROUTINES:
				ZOUTMSG,ZOUTSYM,ZOUTOCT,RADIX50,ZOUDECIMAL,
				ZOUOFFSET
51	-----	-----	MISSPELLED "INIRLBUFFS" (IN "RELINIT")
			THESE HAVE BEEN MOVED TO THE MODULE "RELBUFF"
52	-----	-----	TAKE OUT THE DEF OF THE ROUTINE "CRLF" - IT IS
			NOW A MACRO DEFINED IN THE REQUIRE FILE
			"REQREL"
53	-----	-----	IN "OUTDATA", CALL "DMPMAINRLBF" TO CLEAR THE MAIN
			REL FILE BUFFER RATHER THAN CALLING "DMPRLBLOCK"
			DIRECTLY (SINCE DMPRLBLOCK DOES NOT REINIT THE BUFFER)
54	-----	-----	IN "DMPFORMAT", CALL "DMPMAINRLBF" RATHER THAN
			DMPRLBLOCK
55	-----	-----	TAKE OUT UNUSED ROUITNE ROUIMFUN
56	-----	-----	CHANGE THE CHECKS IN VARIABLE ALLOCATION TTO
			WORK PROPERLY

			PUT IN LISTING HEADING CHECKS
			PUT OUT A VALID ENTRY NAME BLOCK

57	-----	-----	IN "OUTDATA" PUT A CHECK FOR WHETHER A REL FILE
			IS BEING PRODUCED (SINCE WANT TO EXECUTE
			THE MAIN DATA STMNT PROCESSOR FOR ERROR
			DETECTION EVEN IF NO REL FILE IS PRODUCED)
58	----	----	GRPSCAN - MAKE IT PUT THE COMMON VARIABLE IN AN
			EQUIVALENCE GROUP FIRST IN THE LIST SO ITS
			DISPLACEMENT WILL BE CALCULATED FIRST IF IT WAS
			DELAYED.

			ALSO CHECK FOR TWO COMMON VARIABLES IN EQUVALENCE

			PROCEQUIV - CHECK TO BE SURE THAT AT LEAST IN THE
			SINGLE SUBSCRIPT CASE THE EQUIVALENCE IS AN INTEGER
			CONSTANT.   NO VARIABLES OR EXPRESSIONS

59	-----	----	CHECK POSITIVE AND NEGATIVE RANGE LIMITS
			OF EQUIVALENCE SUBSCRIPTS
60	-----	-----	IN "ALLFORM", PUT THE ADDRESS OF THE FORMAT
			INTO THE SNUMBER TABLE ENTRY FOR ITS LABEL
61	-----	-----	SET THE GLOBAL "ENDSCAA" TO THE ADDR AFTER END
			OF ALL ARRAYS AND SCALARS
62	-----	-----	LISTSYM - SUBPROGLIST - ALLSCA
			OUTPUT A WARNING PREFIX CHARACTER AFTER
			VARIABLES, ARRAYS WHICH WERE NEVER EXPLICITLY
			DEFINED OR WERE EXPLICITLY DEFINED BUT NEVER
			REFERENCED

			* - NOT EXPLICITLY DEFINED
			PERCENT SIGN - DEFINED BUT NOT REFERENCED

63	236	14654	EQUIVALENCE ARRAY1-ARRAY2 FAILS AFTER ARRAY1-SCALAR

64	241	-----	CORRECT HIGH SEG START ADDR FOR LINK
			IF LOW SEG SIZE IS GREATER THAN 128K
65	337	17305	ROUND UP IMMEDIATE CONSTANTS CORRECTLY
66	364	18251	CORRECT EQUIVALENCE PROCESSING
67	436	19427	DON'T ALLOW 2 BLOCK COMMON VARIABLES TO
			BE EQUIVALENCED IF BLOCKS ARE DIFFERENT
68	470	20744	MAKE SURE HIGH SEG STARTS AT LEAST 1000 LOCS
			ABOVE END OF LOW SEG
69	472	20494	IF COMMON ITEM IS LAST IN GROUP,
			MOVE IT TO BEGINNING CORRECTLY
70	473	20478	SCALARS AND ARRAYS LISTING TOO WIDE
71	474	20479	SHOULD GIVE CRLF AFTER COMMON BLOCK NAMES

***** BEGIN VERSION 5A *****

72	604	23425	FIX LISTING OF COMMON BLOCK ELEMENTS
	)%

EXTERNAL ZOUTMSG,ZOUTSYM,ZOUTOCT,RADIX50,ZOUDECIMAL,ZOUOFFSET;
EXTERNAL ZOUTBLOCK;
EXTERNAL  STRNGOUT,CHAROUT;
EXTERNAL RDATWD,LSTOUT,FATLERR,RELDATA,RELBLOCK,HILOC,RELOCWD,RELOUT;
FORWARD ALLFORM,PROCCOM,PROCEQUIV;
EXTERNAL  HEADCHK;

GLOBAL ROUTINE OUTDATA(SYMADDR,SYMVALUE,SYMPT)=
BEGIN
%
ROUTINE INSTRUCTS LOADER ABOUT INITIALIZATION OF LOW SEG DATA AS SPECIFIED
IN DATA STATEMENTS.  SYMPT IS PTR TO SYMBOL BEING INITIALIZED.
SYMVALUE IS VALUE TO USE IN ITIALIZATION. SYMADDR IS THE ALLOCATED
ADDRESS OF THE SYMBOL
%
EXTERNAL DMPMAINRLBF;	!ROUTINE TO OUTPUT THE CONTENTS OF THE MAIN
			! REL FILE BUFFER AND REIINITIALIZE IT
EXTERNAL MAINRLBF;	!MAIN REL FILE BUFFER
MAP RELBUFF MAINRLBF;
MAP BASE R2:SYMPT;
BIND RDATBLK = #21;	!LOADER BLOCK TYPE FOR DATA FIXUP

	IF NOT .FLGREG<OBJECT> THEN RETURN;	!IF NO REL FILE IS TO BE PRODUCED
	IF .SYMPT[IDATTRIBUT(INCOM)]
	THEN BEGIN	!DO SPECIAL BLOCK 1 FIXUP
		IF .MAINRLBF[RDATCNT] GTR RBLKSIZ-5	!NO ROOM LEFT IN BUFFER FOR NEXT
						!  3 WDS
		THEN DMPMAINRLBF();
		R2 _ .SYMPT[IDCOMMON]; !PTR TO COMMON BLOCK NODE
		R2 _ .R2[COMNAME];
		RDATWD _ RGLOBREQ + RADIX50();
		ZOUTBLOCK(RDATBLK,RELN);
		RDATWD _ (1^18) + .SYMADDR<RIGHT>;
		ZOUTBLOCK(RDATBLK,RELN);
		RDATWD _ .SYMVALUE;
		ZOUTBLOCK(RDATBLK,RELN);
	     END
	ELSE BEGIN
		IF .MAINRLBF[RDATCNT] GTR RBLKSIZ-4
		 THEN DMPMAINRLBF(); !NO ROOM LEFT IN BUFFER FOR 2 WORDS
		RDATWD _ (1^18)+.SYMADDR<RIGHT>;
		ZOUTBLOCK(RDATBLK,RELRI);
		RDATWD _ .SYMVALUE;
		ZOUTBLOCK(RDATBLK,RELN);
	     END;
END;	!OF OUTDATA
ROUTINE LISTSYM(PTR)=
BEGIN
EXTERNAL LSTOUT,ZOUTSYM,ZOUTOCT,ZOUTMSG,PROGNAME;
EXTERNAL CHAROUT;
MAP BASE PTR;
LABEL BLNK;
     		R2 _ .PTR[IDSYMBOL];
		% NOTE INSTANCES OF  NO EXPLICIT DEFINITION %
		BLNK:BEGIN
			IF NOT .PTR[IDATTRIBUT(INTYPE)]
			THEN	IF  .PTR[OPRSP1]  NEQ  ARRAYNM1
				THEN
					IF .R2<30,6>  NEQ  SIXBIT"."	!FORGET COMPLER DEFINED VARS
					THEN	( CHAROUT( "*" ); LEAVE BLNK );
			CHAROUT( " " );
		END;	%BLNK%
		ZOUTSYM();
		CHR _ #11; LSTOUT(); !TAB
		R2<LEFT> _ .PTR[IDADDR]; ZOUTOCT();
		CHR_#11;LSTOUT();!TAB
END;
ROUTINE SUBPROGLIST=
BEGIN
!
!LISTS CALLED SUBPROGRAMS ON LIST DEVICE IN ALLOCATION SUMMARY
!
EXTERNAL LSTOUT,ZOUTSYM,ZOUTMSG,PROGNAME;
EXTERNAL HEADCHK;	!CHECKS FOR END OF LISTNG PAGE
LOCAL BASE SYMPTR,COUNT;
EXTERNAL HEADING,PAGELINE;

IF ( PAGELINE_.PAGELINE-4) LEQ 0 
THEN	( HEADING(); PAGELINE_.PAGELINE-4);
STRNGOUT(PLIT'?M?J?M?JSUBPROGRAMS CALLED?M?J?M?J?0');
DECR I FROM SSIZ-1 TO 0 DO
BEGIN
	IF (SYMPTR _ .SYMTBL[.I]) NEQ 0
	THEN DO BEGIN
			IF .SYMPTR[OPRSP1] EQL FNNAME1
			THEN IF NOT .SYMPTR[IDATTRIBUT(NOALLOC)]
				THEN BEGIN
					R2 _ .SYMPTR[IDSYMBOL];  ZOUTSYM();
					IF (COUNT _ .COUNT+1) GTR 5
					THEN (COUNT _ 0; CRLF; HEADCHK())
					ELSE (C _ #11; LSTOUT());
				     END;
		END WHILE (SYMPTR _ .SYMPTR[CLINK]) NEQ 0;
END;
CRLF;
HEADCHK();
END;	!OF ROUTINE SUBPROGLIST
ROUTINE ALLSCAA=	!ALLOCATES STORAGE TO LOCAL SCALARS AND 
				!ARRAYS (NOT IN COMMON AND NOT IN EQUIVALENCE LISTS)
				!SEARCHES SYMTBL
				!ASSUMES ALL FIXUPS AND ALLOCATION  FOR COMMON AND EQUIVALENCE
				!HAVE ALREADY BEEN DONE.
BEGIN
OWN PTR,SCNT;
EXTERNAL LSTOUT,LOWLOC,ZOUTSYM,ZOUTOCT,ZOUTMSG,PROGNAME;
EXTERNAL ENDSCAA;
LOCAL BASE ARRAPT;
LABEL L1,L2;
MAP BASE PTR;
	SCNT_0;
	IF .FLGREG<LISTING>
	THEN
	BEGIN
		EXTERNAL HEADING,PAGELINE;
		IF ( PAGELINE_.PAGELINE-4) LEQ 0
		THEN	( HEADING(); PAGELINE_ .PAGELINE-4);
		STRNGOUT(PLIT '?M?JSCALARS AND ARRAYS [ "*" NO EXPLICIT DEFINITION - "%" NOT REFERENCED ]?M?J?M?J');
	END;
	DECR I FROM SSIZ-1 TO 0 DO
	BEGIN
	  IF (PTR _ .SYMTBL[.I]) NEQ 0
	  THEN	BEGIN
		DO BEGIN
		L1: IF NOT  .PTR[IDATTRIBUT(INCOM)]
			AND NOT .PTR[IDATTRIBUT(NAMNAM)]
			AND NOT .PTR[OPERSP]  EQL  FNNAME
				%ALLOCATE SPACE FOR FORMAL FUNCTIONS%
			THEN
			IF NOT .PTR[IDATTRIBUT(NOALLOC)]
			THEN(  IF NOT .PTR[IDATTRIBUT(INEQV)]
					%EQUIVALENCED VARS ARE LISTED BUT NOT ALLOCATED HERE%
			     THEN
			     L2:BEGIN
			!
			!ALLOACATE AN ADDRESS ONLY IF ALL ABOVE TESTS PASSED
			!
				PTR[IDADDR] _ .LOWLOC;
				IF .PTR[OPRSP1] EQL ARRAYNM1 !IS IT AN ARRAY?
				 THEN(  ARRAPT _ .PTR[IDDIM]; !PTR TO DIMENSION NODE
					 IF NOT .PTR[IDATTRIBUT(DUMMY)]
					       THEN (
							LOWLOC _ .LOWLOC+ .ARRAPT[ARASIZ];
							LEAVE L2;
					            )
						ELSE IF NOT .ARRAPT[ADJDIMFLG]
							THEN (LOCAL BASE PTRVAR;
								PTRVAR _ .ARRAPT[ARADDRVAR];
								PTRVAR[IDADDR] _ .LOWLOC;
							     );
						LOWLOC _ .LOWLOC + 1;
						LEAVE L2
					);
				  IF .PTR[DBLFLG] !IS THE VARIABLE DOUBLE LENGTH?
					THEN LOWLOC _ .LOWLOC + 2
					ELSE LOWLOC _ .LOWLOC + 1
			     END;
			     IF .FLGREG<LISTING>
				THEN
				BEGIN
					LISTSYM(.PTR);
	!**;[473], ALLSCAA @3440, DCE, 8-OCT-76
	!**;[473], LISTING FOR SCALARS AND ARRAYS IS A BIT TOO WIDE
	%[473]%				IF .SCNT LSS 4 THEN SCNT _ .SCNT+1 ELSE (SCNT _ 0; CRLF; HEADCHK());
				END;
			)
			ELSE
			BEGIN
			  IF .FLGREG<LISTING>
			  THEN
			  BEGIN
				%NOTE NAMES WHICH HAVE BEEN DECLARED
				 BUT NEVER REFERENCED  AND THUS NEVER
				  ALLOCATED%
				IF .PTR[OPRSP1]  EQL ARRAYNM1
				  OR  .PTR[IDATTRIBUT(INTYPE)]
				  OR  .PTR[IDATTRIBUT(DUMMY)]
				THEN
				BEGIN
					R2_.PTR[IDSYMBOL];
					CHAROUT("%");
					ZOUTSYM();
					CHAROUT(#11);	!TAB
					CHAROUT(#11);	!TAB
	!**;[473], ALLSCAA @3461, DCE, 8-OCT-76
	!**;[473], LISTING FOR SCALARS AND ARRAYS IS A BIT TOO WIDE
	%[473]%				IF .SCNT LSS 4 THEN SCNT _ .SCNT+1 ELSE (SCNT _ 0; CRLF; HEADCHK());
				END
			  END
			END;

		    END WHILE (PTR _ .PTR[CLINK]) NEQ 0
	   END
	END;
	IF .FLGREG<LISTING>  THEN  (CRLF; HEADCHK() );

	ENDSCAA_.LOWLOC;	!LOC AFTER LAST ARRAY/SCALAR
END;
!THE ROUTINES IN THIS MODULE ARE FOR THE PURPOSE
!OF GENERATING THE FOLLOWING THINGS:
%	THE CORRECT ALLOCATION OF ADDRESSES TO THE VARIABLES,ARRAYS
	CONSTANTS,STRINGS ETC., IN THE SUBPROGRAM BEING COMPILED
	.THE STATISTICS LISTING OF THE SCALARS,ARRAYS ,COMMON,
	 CONSTANTS,TEMPORARIES ETC. THAT THE SUBPROGRAM DEFINES.
%
!
ROUTINE ALLCOM=
BEGIN
%ROUTINE ALLOCATES RELATIVE ADDRESSES TO ALL VARIABLES DECLARED IN COMMON.
THE ADDRESSES OF THE VARIABLES / ARRAYS IN A COMMON BLOCK ARE ARLATIVE TO THE 
BEGINNING OF THE BLOCK IN WHICH THEY ARE DECLARED. EACH BLOCK HAS AN ORIGIN
OF ZERO. AT LOAD TIME THE LOADER WILL ASSIGN ACTUAL LOCATIONS TO 
COMMON BLOCKS BASED ON THEIR SIZES AND ORDER OF
APPEARANCE TO LOADER. IN THE RLOACTABLE BINARY, REFERENCES TO
COMMON VARIABLES WILL USE ADDITIVE GLOBAL FIXUPS.

THE CALL TO THIS ROUTINE OCCURS AFTER ANY EQUIVALENCE RELATIONS 
HAVE BEEN PROCESSED BY ROUTINE PROCEQUIV
%
REGISTER ICNT;
EXTERNAL COMBLKPTR,EQVPTR;
REGISTER BASE CSYMPTR;
LOCAL BASE CCOMPTR;
MACRO COMBLOK=#20$;

ICNT _ 0;
IF .FLGREG<LISTING>
THEN 
BEGIN
		EXTERNAL HEADING,PAGELINE;
		IF ( PAGELINE_.PAGELINE-4) LEQ 0
		THEN	( HEADING(); PAGELINE_ .PAGELINE-4);
		 STRNGOUT(PLIT'?M?J?M?JCOMMON BLOCKS?M?J?0');
END;
CCOMPTR _ .FIRCOMBLK; !PTR TO FIRST COMMON BLOCK DECLARED
WHILE 1 DO  %1%
BEGIN
	!START BY OUTPUTTING NAME OF BLOCK
	IF .FLGREG<LISTING> THEN
	BEGIN
	  CRLF;
	  HEADCHK();
	  CHR_"/";LSTOUT();
	R2 _ .CCOMPTR[COMNAME]; ZOUTSYM();
	  CHR _ "/"; LSTOUT();
	  CHR _ "("; LSTOUT(); R1 _ .CCOMPTR[COMSIZE]; ZOUOFFSET(); CHR _ ")"; LSTOUT();
	END;
	!RELOCATABLE BINARY IF NECESSARY
	IF .FLGREG<OBJECT>
	THEN (R2 _ .CCOMPTR[COMNAME]; !FOR RADIX 50 CONVERSION
		RDATWD_RGLOBDEF+RADIX50(); ZOUTBLOCK(COMBLOK,RELN);
		RDATWD_ .CCOMPTR[COMSIZE]; ZOUTBLOCK(COMBLOK,RELN);
	     );
	!NOW LIST THE SYMBOLS IN THE BLOCK

		IF .FLGREG<LISTING> THEN
		BEGIN
			CSYMPTR _ .CCOMPTR[COMFIRST];
		CRLF;!CR/LF
		HEADCHK();
		WHILE 1 DO %2%
		BEGIN
		R2 _ .CSYMPTR[IDSYMBOL]; ZOUTSYM();
		CHR _ #11; LSTOUT();	!TAB
		R1 _ .CSYMPTR[IDADDR]; ZOUOFFSET();
	!**;[474], ALLCOM @3540, DCE, 11-OCT-76
	!**;[474], BE SURE TO OUTPUT CRLF AFTER LAST COMMON BLOCK NAME
	%[474]%	IF (CSYMPTR _ .CSYMPTR[IDCOLINK]) EQL 0 THEN
	!**;[604], ALLCOM @3565, DCE, 9-AUG-77
	!**;[604], RESET ICNT SO THAT WE DO NOT GET LINE WITH SINGLE
	!**;[604], ELEMENT BY ACCIDENT!
	%[604][474]%		(IF .ICNT NEQ 0 THEN (ICNT_0; CRLF; HEADCHK());
	%[474]%			EXITLOOP);
		IF (ICNT _ .ICNT +1) EQL 5
		THEN (ICNT _ 0; CRLF; HEADCHK()) ELSE (CHR _ #11; LSTOUT() %TAB% );
		END; !OF %2%
	END;

	IF (CCOMPTR _ .CCOMPTR[NEXCOMBLK]) EQL 0 THEN RETURN;
END
END;	!OF ALLCOM ROUTINE
ROUTINE ALLOCAT=
BEGIN
%ALOCATES RELATIVE ADDRESSES TO ALL VARIABLES AND STORAGE
 IN THE LOW SEGMENT,EXCEPT TEMPORARIES WHICH ARE ALLOCATED AFTER
 CODE GENERATION.
THIS ROUTINE CONTROLS THE ALLOCATION BY CALLING THE ACTUAL ROUTINES
THAT DO THE ALLOCATION AND PROCESSING OF VARIABLES,COMMON BLOCKS,EQUIVALENCE
 GROUPS ,DATA FIXUPS ETC.
%

EXTERNAL LSTOUT,FATLERR,FORMPTR,COMBLKPTR,EQVPTR,
	LOWLOC,	!LOW SEG AVAILABLE ADDRESS
	COMSIZ;	!CURRENT TOTAL SIZE OF COMMON INCLUDING BLANK

COMSIZ _ 0;
IF .COMBLKPTR NEQ 0 THEN COMSIZ _ PROCCOM(); ! PROCESS COMMON BLOCKS
IF .EQVPTR NEQ 0 THEN PROCEQUIV();	!PROCESS EQUIVALENCE GROUPS
IF .COMBLKPTR NEQ 0 THEN ALLCOM(); !ALLOCATE COMMON NOW
!
!NOW ALLOCATE AND LIST ALL VARIABLES,ARRAYS ETC.
!
!LIST SUBPROGRAMS CALLED IF ANY
!
IF .FLGREG<LISTING> THEN SUBPROGLIST();
ALLSCAA();	!ALLOCATE SCALARS AND ARRAYS

IF .FORMPTR NEQ 0 THEN ALLFORM();	!ALLOCATE FORMAT STRINGS

END;
ROUTINE DMPFORMAT=
BEGIN
!
!DUMPS FORMAT STRING DEFINITIONS  TO REL FILE AFTER ALL LOWSEG
!ALLOCATION HAS BEEN DONE
!
LOCAL SAVHILOC;
REGISTER BASE ZFORPTR;
EXTERNAL LOWLOC,FORMPTR,HILOC,DMPMAINRLBF;
ZFORPTR _ .FORMPTR<LEFT>;	!PTR TO FIRST FORMAT STRING
SAVHILOC _ .HILOC; HILOC _ .ZFORPTR[FORADDR]; !TO PUT DATA BLOCK IN LOWSEG
DO
BEGIN
	INCR I FROM 0 TO .ZFORPTR[FORSIZ]-1 DO
	 (RDATWD _ .(.ZFORPTR[FORSTRING])[.I]<FULL>;
	  ZOUTBLOCK(RCODE,RELN);
	   HILOC _ .HILOC+1;	!INCREMENT FOR POSSIBLE USE IN ZOUTBLOCK
	 );
END WHILE (ZFORPTR _ .ZFORPTR[FMTLINK]) NEQ 0;
DMPMAINRLBF();	!DUMP OUT THE CODE BLOCK IMMEDIATELY
HILOC _ .SAVHILOC;
RETURN .VREG
END;
ROUTINE ALLFORM=
BEGIN
%ALLOCATES LOW SEG STORAGE ADDRESS TO FORMAT STRINGS
BUT DOES NOT TELL THE LOADER YET
%
REGISTER BASE ZFORPTR;
EXTERNAL LOWLOC,FORMPTR,HILOC;
ZFORPTR _ .FORMPTR<LEFT>;	!PTR TO FIRST FORMAT STRING
WHILE 1 DO
BEGIN
	REGISTER BASE SNUMENTRY;
	SNUMENTRY_.ZFORPTR[SRCLBL];
	ZFORPTR[FORADDR] _ .LOWLOC;
	SNUMENTRY[SNADDR]_.LOWLOC;	!SET ADDRESS OF THE LABEL
	LOWLOC _ .LOWLOC+.ZFORPTR[FORSIZ];
	IF .ZFORPTR[FMTLINK] EQL 0
	THEN EXITLOOP
	ELSE ZFORPTR _ .ZFORPTR[FMTLINK]
END;
RETURN .VREG
END;
ROUTINE PROCCOM=
BEGIN
%ROUTINE MAKES A FAST PASS THRU THE LINKED LISTS OF COMMON BLOCKS
AND ASSOCIATED SYMBOL TABLE ENTRIES COMPUTING THE DECLARED SIZE OF EACH
BLOCK AND ASSIGNING A TEMPORARY ADDRESS TO THE VARIABLES IN EACH
BLOCK RELATIVE TO THE BEGINNING OF THE BLOCK
%
EXTERNAL COMBLKPTR;
MACRO CBLKSIZ = R1$,	!SIZE OF CURRENT BLOCK
	TCOMSIZ = R2$;
REGISTER BASE CSYMPTR;
LOCAL BASE CCOMPTR;
!
XTRAC;
!
TCOMSIZ _ 0;
CCOMPTR _ .FIRCOMBLK;	!PTR TO FIRST COMMON BLOCK

WHILE 1 DO	%1% !LOOP ON LINKED LIST
BEGIN
	CSYMPTR _ .CCOMPTR[COMFIRST];	!PTR TO FIRST SYMBOL ENTRY IN BLOCK
	CBLKSIZ _ 0;
	WHILE 1 DO %2% !LOOP ON LINKEDLIST OF SYMBOLS IN BLOCK
	BEGIN
	  CSYMPTR[IDADDR] _.CBLKSIZ;
	  IF .CSYMPTR[IDDIM] NEQ 0
	  THEN (LOCAL BASE DIMPTR;
		DIMPTR _ .CSYMPTR[IDDIM];
		CBLKSIZ _ .CBLKSIZ + .DIMPTR[ARASIZ];
		)
	  ELSE (IF .CSYMPTR[VALTYPE] GTR REAL
		THEN CBLKSIZ _ .CBLKSIZ + 2
		ELSE CBLKSIZ _ .CBLKSIZ + 1
		);
	  IF .CSYMPTR[IDCOLINK] EQL 0 THEN EXITLOOP
		ELSE CSYMPTR _ .CSYMPTR[IDCOLINK];
	END;! OF %2% LOOP
  !NOW UPDATE TOTAL SIZE OF COMMON
	CCOMPTR[COMSIZE] _ .CBLKSIZ;
	TCOMSIZ _ .TCOMSIZ + .CBLKSIZ;
	IF .CCOMPTR[NEXCOMBLK] EQL 0
	  THEN EXITLOOP
	  ELSE CCOMPTR _ .CCOMPTR[NEXCOMBLK];
END; !OF %1% LOOP
RETURN .TCOMSIZ
END; !OF ROUTINE
ROUTINE EQERRLIST(GROUP)=
BEGIN
!LIST THE GROUP OF EQUIVALENCE VARIABLES IN CONFLICT
!
EXTERNAL LSTOUT,ZOUTMSG,ISN,E49;
MAP BASE GROUP:R2;
LOCAL BASE SYMPTR;
	SYMPTR _ .GROUP[EQVFIRST];
	FATLERR(.ISN,E49<0,0>);	!SAME MSG AS BELOW
	IF NOT .FLGREG<LISTING> THEN RETURN;
	HEADCHK();
	STRNGOUT(PLIT '?M?J	CONFLICTING VARIABLES( ?0');
	WHILE 1 DO(	R2 _ .SYMPTR[EQLID];
			R2 _ .R2[IDSYMBOL]; ZOUTSYM();
			IF (SYMPTR _ .SYMPTR[EQLLINK]) EQL 0 THEN( STRNGOUT(PLIT')?M?J'); HEADCHK();  EXITLOOP)
				ELSE (C _ ","; LSTOUT());
		   );
END;	!OF EQERRLIST
ROUTINE GROUPTOCOMMON(COMSYM,NEWGRP,ELIM,GRPDISPL)=
BEGIN
!COMSYM POINTS TO SYMBOL ALREADY IN COMMON
!NEWGRP POINTS TO NEW EQV GROUP GOING TO COMMON
!ELIM IS THE EQVLIMIT OF GROUP TO WHICH COMSYM BELONGS
!GRPDISPL IS THE DISPLACEMENT OF THE MATCH ITEM IN NEWGRP
!
MAP BASE COMSYM :NEWGRP;
LOCAL BASE COMBLPTR :LASCOMSYM :DIMPTR :NEWSYM :NEWITEM;
LOCAL SYMSIZ;
NEWITEM _ .NEWGRP[EQVFIRST];	!FIRST ITEM IN NEW GROUP
WHILE 1 DO
BEGIN
   NEWSYM _ .NEWITEM[EQLID]; !PTR TO SYMBOL TABLE NODE
   IF .COMSYM NEQ .NEWSYM
   THEN IF NOT .NEWSYM[IDATTRIBUT(INCOM)]
	THEN
	BEGIN
		IF (NEWSYM[IDADDR] _ .COMSYM[IDADDR] + .NEWITEM[EQLDISPL] - .GRPDISPL) LSS 0
		   THEN
			BEGIN
				EXTERNAL FATLERR,ISN,E33;
				COMBLPTR _ .COMSYM[IDCOMMON];
				RETURN FATLERR(COMBLPTR[COMNAME],.ISN,E33<0,0> );
			END;
		NEWSYM[IDATTRIBUT(INCOM)] _ 1; !PUT SYMBOL INCOMMON
		COMBLPTR _ .COMSYM[IDCOMMON];
		LASCOMSYM _ .COMBLPTR[COMLAST]; !LAST SYMBOL IN COMMON BLOCK
		LASCOMSYM[IDCOLINK] _ .NEWSYM; !POINT TO NEW SYMBOL
		NEWSYM[IDCOLINK] _ 0;
		NEWSYM[IDCOMMON] _ .COMBLPTR; !SYMBOL POINTS TO COMMON BLOCK
		COMBLPTR[COMLAST] _ .NEWSYM;
		SYMSIZ _ IF .NEWSYM[IDDIM] NEQ 0
			 THEN (DIMPTR _ .NEWSYM[IDDIM]; .DIMPTR[ARASIZ])
			 ELSE IF .NEWSYM[DBLFLG] THEN 2 ELSE 1;
		IF (.NEWITEM[EQLDISPL] + .SYMSIZ) GTR .ELIM
		THEN ELIM _ (.NEWITEM[EQLDISPL] + .SYMSIZ);
		IF .COMBLPTR[COMSIZE] LSS ( .NEWSYM[IDADDR] + .SYMSIZ)
		THEN
			COMBLPTR[COMSIZE] _ (.NEWSYM[IDADDR] + .SYMSIZ);
	END
	ELSE IF (.NEWSYM[IDADDR] - .NEWITEM[EQLDISPL])
		  NEQ (.COMSYM[IDADDR] - .GRPDISPL)
		THEN ( EQERRLIST(.NEWGRP);
			NEWGRP[EQVAVAIL] _ 3; RETURN -1
		     );
   IF .NEWITEM[EQLLINK] EQL 0
	THEN RETURN .ELIM
	ELSE NEWITEM _ .NEWITEM[EQLLINK];
END;  !OF WHILE 1
END;  !OF SUBROUTINE GROUPTO COMMON
ROUTINE LINKGROUPS(GROUP1,GROUP2,G1SYM)=
BEGIN
!LINK ITEMS IN GROUP2 INTO GROUP1 WHEN EITHER GROUP IS IN COMMON
!TO ALLOW FOR FURTHER SEARCHING OF GROUP1 BY LATER GROUPS
!
MAP BASE GROUP1 :GROUP2 :G1SYM;
LOCAL BASE G1ITEM :G2ITEM :NEXG2ITEM;
G2ITEM _ .GROUP2[EQVFIRST];
WHILE 1 DO
BEGIN
	NEXG2ITEM _ .G2ITEM[EQLLINK];
	IF .G1SYM NEQ .G2ITEM[EQLID]
	THEN (G1ITEM _ .GROUP1[EQVLAST];
		G1ITEM[EQLLINK] _ .G2ITEM;
		GROUP1[EQVLAST] _ .G2ITEM;
		G2ITEM[EQLLINK] _ 0;
	      );
	IF (G2ITEM _ .NEXG2ITEM) EQL 0 THEN RETURN .VREG;
END;  !OF WHILE 1
END;  !OF LINKGROUPS
ROUTINE ELISTSRCH(ECLASS,EGROUP)=
BEGIN
%SEARCH EACH ITEM IN GROUP POINTED TO BY EGROUP AGAINST ALL ITEMS IN 
CLASS POINTED TO BY ECLASS. WHEN MATCH IS FOUND IF AT ALL, THEN LINK
ITEMS IN EGROUP INTO ECLASS IF NEITHER EGROUP NOR ECLASS IS IN COMMON.
 IF EITHER (BUT NOT BOTH)ARE IN COMMON THEN ADD NEW ITEMS
NOT IN COMMON INTO COMMON BLOCK OF WHICH ECLASS OR EGROUP ITEMS ARE MEMBERS.
 ERRORS OCCUR IF BOTH ECLASS AND EGROUP ARE IN COMMON.
%
LABEL ELIS1,ELIS2;
LOCAL	EGSYM,	!SYMBOL BEING SEARCHED IN GROUP
	EGSYMPTR,	!PTR TO SYMBOL TABLE OF SYMBOL BING SEARCHED
	EGITEM,	!PTR TO CURRENT EQUIVLIST ITEM IN GROUP
	CITEM,	!PTR TO LIST ITEM IN CLASS ECLASS
	CSYMPTR;	!PTR TO SYMBOL TABLE OF ITEM IN ECLASS

MAP BASE ECLASS :EGROUP :EGSYMPTR :CITEM :CSYMPTR :EGITEM;
!
XTRAC;	!FOR DEBUGGING TRACE
!
EGITEM _ .EGROUP[EQVFIRST];	!FIRST LIST ITEM IN EGROUP

IF 
ELIS1: (WHILE 1 DO
       BEGIN
	!SEARCH FOR MATCH OF ITEM IN ECLASS WITH ITEM IN EGROUP
	EGSYMPTR _ .EGITEM[EQLID]; EGSYM _ .EGSYMPTR[IDSYMBOL]; !GET THE SYMBOL
	CITEM _  .ECLASS[EQVFIRST]; !THE PTR TO FIRST LIST ITEM IN ECLASS
 ELIS2: WHILE 1 DO %2%
	BEGIN
		CSYMPTR _ .CITEM[EQLID]; !SYMBOL TABLE PTR
		IF .EGSYM EQL .CSYMPTR [IDSYMBOL]
		THEN LEAVE ELIS1 WITH (-1);
		IF .CITEM[EQLLINK] EQL 0
		THEN LEAVE ELIS2
		ELSE CITEM _ .CITEM[EQLLINK];
	END; !OF %2%
	IF .EGITEM[EQLLINK] EQL 0
	THEN LEAVE ELIS1 WITH  (0)
	ELSE EGITEM _ .EGITEM[EQLLINK];
       END !OF WHILE %1%
  )  EQL 0 THEN RETURN 0; !RETURN 0 IF NO MATCH BETWEEN ECLASS AND EGROUP
!
!WE GET HERE IF AN ITEM IN EGROUP MATCHES AN ITEM IN ECLASS
!CITEM POINTS TO THE ITEM IN ECLASS AND EGITEM POINTS TO THE
!ITEM IN EGROUP. WE NOW CHECK FOR COMMON EQUIVALENCE INTERACTION
!AND DECIDE WHETHER TO LINK THE NEW ITEMS INTO ECLASS OR TO ADD NEW ITEMS TO
!THE COMMON BLOCK OF WHICH ECLASS OR EGROUP (BUT NOT BOTH) IS A PART
!
BEGIN LOCAL EGDISPL,ELIM,ECDISPL;
	IF .CSYMPTR[IDATTRIBUT(INCOM)] THEN IF NOT .ECLASS[EQVINCOM]
	THEN BEGIN
		ECLASS[EQVINCOM] _ 1;
		IF
		ECLASS[EQVLIMIT] _ GROUPTOCOMMON(.CSYMPTR,.ECLASS,.ECLASS[EQVLIMIT],.CITEM[EQLDISPL])
		LSS 0 THEN RETURN -1
	     END;
!
!CSYMPTR CONTAINS PTR TO MATCHED SYMBOL IN ECLASS
!EGSYMPTR CONTAINS PTR TO MATCHED SYMBOL IN EGROUP
!
ELIM _ .ECLASS[EQVLIMIT];	!LIMIT OF GROUP
EGDISPL _ .EGITEM[EQLDISPL];
ECDISPL _ .CITEM[EQLDISPL];
EGITEM _ .EGROUP[EQVFIRST];
EGSYMPTR _ .EGITEM[EQLID]; !SET PTR TO FIRST ITEM IN GROUP 

!
!TEST FOR GROUP OR CLASS IN COMMON
!
IF .ECLASS[EQVINCOM] OR .EGROUP[EQVINCOM]
  THEN
   BEGIN
	EXTERNAL ISN,FATLERR,E48;
!	IF .ECLASS[EQVINCOM] AND .EGROUP[EQVINCOM]
!	THEN ( IF .ECLASS[EQVHEAD] NEQ .EGROUP[EQVHEAD]
!		 THEN (FATLERR(.ISN,E48<0,0>); RETURN -1;); !TWO COMMON ITEMS EQUIVALENCED
!	     )
!	ELSE
	 IF .EGROUP[EQVINCOM]
	  THEN( !ASSIGN COMMON ADDRESSES TO ECLASS
		ELIM _ .EGROUP[EQVLIMIT];
		EGDISPL _ .CITEM[EQLDISPL]; ECDISPL _ .EGITEM[EQLDISPL];
		CSYMPTR _ .EGITEM[EQLID];
		EGITEM _ .ECLASS[EQVFIRST]; EGSYMPTR _ .EGITEM[EQLID];
	      );
	WHILE 1 DO %1%
	BEGIN
  !NOW CHECK NEW COMMON ADDRESS NOW AND LINK NEW ITEM INTO EXISTING COMMON BLOCK
	IF .CSYMPTR NEQ .EGSYMPTR
	THEN
	  IF NOT (.ECLASS[EQVINCOM] AND .EGROUP[EQVINCOM])
	  THEN IF NOT .EGSYMPTR[IDATTRIBUT(INCOM)]
	     THEN
	        BEGIN LOCAL BASE CLCOMPTR :GPCOMPTR :COMSYM :ESYM;
			LOCAL EGSYMSIZ;
			EXTERNAL FATLERR,E33,ISN;
		  IF (EGSYMPTR[IDADDR] _ .CSYMPTR[IDADDR] + .EGITEM[EQLDISPL] -.EGDISPL) LSS 0
			THEN (MAP BASE R1;
				R1 _ .CSYMPTR[IDCOMMON];
				RETURN FATLERR(R1[COMNAME],.ISN,E33<0,0>)
		     );
			 !ERROR EQUIVALENCE ITEM EXTENDS COMMON BACKWARD
	
		  EGSYMPTR[IDATTRIBUT(INCOM)] _ 1; !MAKE SYMBOL IN COMMON
		  CLCOMPTR _ .CSYMPTR[IDCOMMON]; !PTR TO COMMON BLOCK HDR
		  COMSYM _ .CLCOMPTR[COMLAST];	!PTR TO LAST SYMBOL IN BLOCK
		  COMSYM[IDCOLINK] _ .EGSYMPTR; !LINK IN NEW SYMBOL
		  CLCOMPTR[COMLAST] _ .EGSYMPTR;
		  EGSYMPTR[IDCOLINK] _ 0; !NEW END OF LINK
		  EGSYMPTR[IDCOMMON] _ .CLCOMPTR; !SYMBOL TO POINT TO BLOCK
	!  COMPUTE NEW BLOCK SIZE
	!  
		  EGSYMSIZ _ IF .EGSYMPTR[IDDIM] NEQ 0
				THEN (ESYM _ .EGSYMPTR[IDDIM]; .ESYM[ARASIZ])
				ELSE IF .EGSYMPTR[DBLFLG] THEN 2 ELSE 1;
		  IF (.EGITEM[EQLDISPL] + .EGSYMSIZ)  GTR .ELIM
			THEN ELIM _ (.EGITEM[EQLDISPL] + .EGSYMSIZ);
		  IF .CLCOMPTR[COMSIZE] LSS (R1 _ .EGSYMPTR[IDADDR] + .EGSYMSIZ)
		   THEN CLCOMPTR[COMSIZE] _ .R1;
	       END
	    ELSE IF (.EGSYMPTR[IDADDR]-.EGITEM[EQLDISPL])
			NEQ (.CSYMPTR[IDADDR]-.EGDISPL)
			THEN (EQERRLIST(.EGROUP); EGROUP[EQVAVAIL] _ 3; RETURN -1);
!
!TESTING FOR END OF CHAIN OF GROUP GOING INTO COMMON
	  IF .EGITEM[EQLLINK] NEQ 0
	   THEN (EGITEM _ .EGITEM[EQLLINK]; EGSYMPTR _ .EGITEM[EQLID])
	   ELSE (
		  LINKGROUPS(.ECLASS,.EGROUP,.CSYMPTR);
		  ECLASS[EQVINCOM] _ 1;
	!**;[364], ELISTSRCH @3888, DCE, 31-MAR-76
	!**;[364], THIS IS A SUCCESSFUL TRIP - RETURN 1!
	%[364]%	  EGROUP[EQVAVAIL] _ 2; EGROUP[EQVINCOM]_1;RETURN 1
		);
	END; !OF LOOP%1%
   END; !END OF IF INCOMMON
!
!HERE IF NEITHER GROUP NOR CLASS IN COMMON
!LINK ITEMS IN EGROUP INTO ECLASS, MARK EACH GROUP UNAVAILABLE
!CHECK FOR ERRORS OF FORM
! EQUIVALENCE (A(5),B(2)),(C(2),B(2)),(C(2),A(4))
!
EGITEM _ .EGROUP[EQVFIRST];
WHILE 1 DO
BEGIN LOCAL ENEXITEM,NEWDISPL;
	ENEXITEM _ .EGITEM[EQLLINK];  !PTR TO NEXT ITEM IN GROUP TO BE LINKED TO CLASS
	EGSYMPTR _ .EGITEM[EQLID];
	EGSYM _ .EGSYMPTR[IDSYMBOL];

!NOW SEARCH FOR EGSYM IN ECLASS
!
	CITEM _ .ECLASS[EQVFIRST];	!PTR TO FIRST ITEM IN CLASS
	NEWDISPL _ .ECDISPL + .EGITEM[EQLDISPL] -.EGDISPL;
	IF WHILE 1 DO
	   BEGIN   %2%
		CSYMPTR _ .CITEM[EQLID];
		IF .EGSYM EQL .CSYMPTR[IDSYMBOL]
		  THEN EXITLOOP (-1);
		IF .CITEM[EQLLINK] EQL 0
		  THEN EXITLOOP (0)
		  ELSE CITEM _ .CITEM[EQLLINK]
	   END  !OF %2%
	NEQ 0
	  THEN	!MAKE SURE DISPLACEMENTS OF MATCHING ITMES ARE OK
	    (	IF .NEWDISPL NEQ .CITEM[EQLDISPL]
		  THEN (EQERRLIST(.EGROUP); !INCONSISTENT OR CONFLICTING EQUIVALENCES
			EGROUP[EQVAVAIL] _ 3; RETURN -1
		       );
	    )
	  ELSE	(CITEM[EQLLINK] _ .EGITEM;
		);
	EGITEM[EQLLINK] _ 0;	!CLEAR LINK
	EGITEM[EQLDISPL] _ .NEWDISPL;
	IF .NEWDISPL LSS .ECLASS[EQVADDR]
	  THEN ECLASS[EQVADDR] _ .NEWDISPL;
!
!NOW COMPUTE NEW EQVLIMIT
!
	BEGIN LOCAL BASE ESYM, EQSIZ;
	  EQSIZ _ IF .EGSYMPTR[IDDIM] NEQ 0
			THEN (ESYM _ .EGSYMPTR[IDDIM]; .ESYM[ARASIZ])
			ELSE IF .EGSYMPTR[DBLFLG] THEN 2 ELSE 1;
	  IF (.EGITEM[EQLDISPL] + .EQSIZ) GTR .ECLASS[EQVLIMIT]
		THEN ECLASS[EQVLIMIT] _ (.EGITEM[EQLDISPL] + .EQSIZ);
	END;
	IF .ENEXITEM EQL 0 THEN RETURN 1  !GOOD RETURN (ALLITEMS IN EGROUP LINKED TO ECLASS)
		 ELSE EGITEM _ .ENEXITEM;
END; !OF %1%
END;
END;	!OF ROUTINE ELISTSRCH
ROUTINE EQCALLOC(ECLASS)=
BEGIN
%
ALLOCATE RELOCATABLE ADDRESSES TO AN EQUIVALENCE CLASS (ECLASS)
%
EXTERNAL LOWLOC;	!THE LOW SEG AVAILABLE LOCATION
MAP BASE ECLASS;
LOCAL BASE CITEM :CSYMPTR;
LOCAL TLOC;
OWN CNT;
%
THE ADDRESS OF ANITEM IN ECLASS IS COMPUTED AS FOLLOWS
 ADDR _ .LOWLOC + (RELATIVE DISPLACEMENT OF ITEM IN ECLASS (CITEM[EQLDISPL] 
		- SMALLEST RELATIVE DISPLACEMENT IN ECLASS (ECLASS[EQVADDR])
%
CNT _ 0;
IF .FLGREG<LISTING> THEN( HEADCHK();  STRNGOUT(PLIT '?M?J( ?0'));
TLOC _ .LOWLOC - .ECLASS[EQVADDR];
CITEM _ .ECLASS[EQVFIRST];
WHILE 1 DO
BEGIN
	CSYMPTR _ .CITEM[EQLID];	!PTR TO SYMBOL
	CSYMPTR[IDADDR] _ .CITEM[EQLDISPL] + .TLOC;
	IF .FLGREG<LISTING>
	THEN(LISTSYM(.CSYMPTR);
	     IF .CNT LSS 5 THEN CNT _ .CNT+1
		ELSE (CNT _ 0; CRLF; HEADCHK());
	    );
	IF .CITEM[EQLLINK] EQL 0
	  THEN( IF .FLGREG<LISTING> THEN STRNGOUT(PLIT')?M?J'); HEADCHK();  EXITLOOP) ELSE CITEM _ .CITEM[EQLLINK];
END;
LOWLOC _ .LOWLOC + .ECLASS[EQVLIMIT] - .ECLASS[EQVADDR];
!
!LOWLOC + SPAN OF THE CLASS
!
END;	!OF EQCALOC
ROUTINE GRPSCAN=
BEGIN
!
!SCAN ALL GROUPS FOR ITEMS IN COMMON BUT GROUP WAS NOT FLAGGED
!
EXTERNAL EQVPTR;
LOCAL BASE ECLASS :ELIST :EITEM : LAST;
ECLASS _ .EQVPTR<LEFT>;
WHILE 1 DO
BEGIN
	LAST _ ELIST _ .ECLASS[EQVFIRST];
	IF NOT .ECLASS[EQVINCOM] 
	THEN
	UNTIL  .ELIST  EQL  0
	DO
	BEGIN
		EITEM _ .ELIST[EQLID];
		IF .EITEM[IDATTRIBUT(INCOM)]
		THEN 
		BEGIN
			EXTERNAL E48,FATLERR;
			% CHECK FOR MORE THAN ONE COMMON VAR%
			IF .ECLASS[EQVINCOM]  
			THEN	( FATLERR(.ISN,E48<0,0>); EXITLOOP );
			ECLASS[EQVINCOM] _ 1;
			ECLASS[EQVHEAD] _ .ELIST;
			IF .LAST NEQ .ELIST
			THEN
			BEGIN
				%MOVE IT TO TOP OF THE LIST%
				LAST[EQLLINK] _ .ELIST[EQLLINK];
				ELIST[EQLLINK] _ .ECLASS[EQVFIRST];
	!**;[472], GRPSCAN @4014, DCE, 6-OCT-76
	!**;[472], IF THE COMMON ELEMENT WAS THE LAST ONE IN THE GROUP,
	!**;[472], THEN THE PTR TO IT [EQVLAST] MUST BE CHANGED TOO
	%[472]%			ECLASS[EQVFIRST] _ .ELIST;
	%[472]%			IF .ECLASS[EQVLAST] EQL .ELIST
	%[472]%			THEN ECLASS[EQVLAST]_.LAST
			END
		END;
		LAST _ .ELIST;
		ELIST _ .ELIST[EQLLINK]
	END;
	IF (ECLASS _ .ECLASS[EQVLINK]) EQL 0 THEN RETURN .VREG;
END;
END;
ROUTINE PROCEQUIV=
BEGIN
%PROCESSES EQUIVALNCE GROUPS AS DECLARED IN THE SOURCE -N RESOLVING
IMPLICIT EQUIVALENCES AND EQUIVALENCES INTO COMMON. CHECKS FOR
ALLOCATION ERRORS DUE TO IMPROPER EQUIVALENCES. ASSIGNS TEMPORARY
ADDRESSES TO EQUIVALENCE VARIABLES AND NEW VARIABLES EQUIVALENCED INTO COMMON.
%
EXTERNAL EQVPTR,	!PTR TO FIRST AND LAST EQUIVALENCE GROUPS
	ARRXPN,	!FOR EXPANDING ARRAY REFERENCES IN EQUIVALENCE ITEMS
	ZOUTMSG,	!MESSAGE OUTPUTTER
	ELISTSRCH,	!ROUTINE THAT SEARCHES FOR A MATCH OF ONE ITEM
			!IN A CLASS IN ANY AVAILABLE GROUP
	EQCALLOC;	!ALLOCATION OF EQUIVALENCE CLASSES
LOCAL BASE EQVCPTR,	!PTR TO CURRENT EQUIV CLASS HEADER
	ECOMMPTR,	!PTR COMMON ITEM IF GROUP IS IN COMMON
	ECOMMHDR,	!PTR TO COMMON BLOCK HDR
	LCLHD;	!PTR TO LOCAL HEAD OF A GROUP FOR ALLOCATION PURPOSES
REGISTER BASE EQLPTR;
LABEL COMN1,LOOP2;
LOCAL SAVEBOUNDSFLG;	!TO SAVE THE VALUE OF THE "BOUNDS" SWITCH WHILE
			! PROCESSING EQUIVALENCE STMNTS


	SAVEBOUNDSFLG_.FLGREG<BOUNDS>;	!SAVE THE VALUE OF THE "BOUNDS" SWITCH
					! (THAT SPECIFIES WHETHER ARRAY BOUNDS
					! CHECKING IS TO BE PERFORMED)
	FLGREG<BOUNDS>_0;	!TURN OFF THE BOUNDS FLAG WHILE PROCESSING
				! EQUIVALENCE STATEMENTS


!
!THE FIRST STEP IS TO COMPUTE RELATIVE DISPLACEMENTS OF EACH ITEM IN
!AND EQUIVALENCE GROUP. THIS IS SIMPLY 1 MINUS THE SUBSCRIPT
!VALUE OF EACH ITEM IN THE GROUP.
!I.E A(1) HAS DISPLACEMENT 0 AND A(4) HAS DISPLACEMENT -3
!
IF .FLGREG<LISTING>
THEN
BEGIN
		EXTERNAL HEADING,PAGELINE;
		IF ( PAGELINE_.PAGELINE-4) LEQ 0
		THEN	( HEADING(); PAGELINE_ .PAGELINE-4);
		  STRNGOUT(PLIT'?M?JEQUIVALENCED VARIABLES?M?J?M?J?0');
END;
!
!SCAN GROUPS FOR IN COMMON ITEMS
!
GRPSCAN();
!
EQVCPTR _ .EQVPTR<LEFT>;	!PTR TO FIRST GROUP
WHILE 1 DO	%1%
BEGIN
	ISN _ .EQVCPTR[EQVISN];	!SET ISN INCASE OF ERRORS
	ECOMMPTR _ 0;	!INITIALIZING
	!IF GROUP IS IN COMMON THEN FIND THE ELEMENT IN COMMON
    COMN1: IF .EQVCPTR[EQVINCOM]
	THEN(	LOCAL BASE COMPTR;
			EQLPTR _ .EQVCPTR[EQVHEAD]; !PTR TO LIST ITEM THAT IS IN COMMON
			COMPTR_ .EQLPTR[EQLID];
			ECOMMPTR _ .EQLPTR; !PTR TO COMMON ITEM EQL LIST ITEM
			ECOMMHDR _ .COMPTR[IDCOMMON];
			LCLHD _ .EQLPTR[EQLID];
	     )
	ELSE LCLHD _ 0;
    EQLPTR _ .EQVCPTR[EQVFIRST];