Google
 

Trailing-Edge - PDP-10 Archives - AP-D480B-SB_1978 - srca.bli
There are 12 other files named srca.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) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: F. INFANTE/HPW/NEA/DCE/SJW
MODULE SERVICE(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4,GLOROUTINES)=
BEGIN

GLOBAL BIND SRCAV = 5^24 + 1^18 + 51;	!VERSION DATE: 24-MAY-77


%(
REVISION HISTORY

41	-----	-----	REWRITE CORMAN TO ALLOCATE IN PAGES OR
			K DEPENDING UPON PROCESSOR 
			REWRITE CORMAN TO ELIMINATE REFERENCES
			TO BREG
			MAKE ERROUT EXTERNAL IN NEWENTRY
42	-----	-----	FIX NEWENTRY TO USE OPERSP INSTEAD OF SRCID
			IN I/O LIST NODES
43	-----	-----	TAKE OUT 42
44	----	-----	PUNT
45	-----	-----	PUNT + 1
46	-----	-----	ADD MAKEPR TO THIS MODULE

47	-----	-----	HAVE NEWENTRY SET THE NOALLOC BIT FOR SYMBOL
			TABLE ENTRIES GENERATED WHILE IN PHASE 1

48	----	-----	CHANGE THE NAME OF LIBSRCH TO SRCHLIB ( JUST TO
			GET ALL REFERENCES) AND ITS PARAMETER TO A
			SYMBOL TABLE POINTER RATHER THAN A NAME.
			THEN REJECT AND NAMES THAT HAVE BEEN TYPED WITH
			A CONFLICTING TYPE EVEN THOUGH THEY ARE LIBRARY
			FUNCTION NAMES
49	355	18132	ALLOCATE MORE THAN ONE CORE BLOCK AT A TIME

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

50	543	NONE	FIX THE BINARY SEARCH FOR LIBRARY FUNCTIONS
51	574	NONE	REWRITE BINARY SEARCH IN SRCHLIB TO WORK AFTER
			  EDIT 543

)%		! END OF REVISION HISTORY

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

FORWARD
	ADDLOOP(1),
	TBLSEARCH,
	THASH,
	NEWENTRY,
	TESTENTRY,
	SAVSPACE(2),
	CORMAN;
GLOBAL ROUTINE ADDLOOP(LEVEL)=	!AD DO LOOP NODE TO TREE
!THIS ROUTINE BUILDS A TREE THAT DESCRIBES THE DOLOOPS OF A PROGRAM
!SEE THE DO TREE NODE DESCTIPTION IN FIRST.BLI
!THE TREE IS BINARY IN THE SENSE THAT POINTS TO ONLY
!ONE PARALLEL LOOP AND ONE LOOP AT A DEEPER LEVEL
!
BEGIN
	EXTERNAL LASLVL0,DLOOPTREE,CORMAN;
	LABEL OUT;
	OWN TEM1;
	REGISTER BASE DONODE; MAP BASE SORCPTR;
	XTRAC;	!FOR DEBUGGING TRACE
	SIZOFENTRY _ DONODESIZ;
	TEM1 _ CORMAN();	!RESERVE SPACE FOR ENTRY
			!.FF IS ADDR OF ENTRY
	IF .DLOOPTREE EQL 0
	THEN BEGIN
		DONODE _ .TEM1;
		DLOOPTREE _  .DONODE;
		LASLVL0 _ .DONODE;
		DONODE[LEVL] _ 1;
		SORCPTR[INNERDOFLG] _ 1;
		RETURN (DONODE[DOSRC] _ .LASTSRC; .DONODE)
	     END;
	DONODE _ .LASLVL0<RIGHT>;	!SET UP SEARCH
	OUT:
	WHILE 1 DO
	BEGIN
	  WHILE .DONODE[PARLVL] NEQ 0 DO DONODE _ .DONODE[PARLVL];
	  IF .DONODE[LEVL] EQL .LEVEL
		THEN	!EQUAL LEVEL OF DO
			!FIRST TIME THRU .LEVEL MUST EQUAL 0 TO
			!EXECUTE THE THEN PART
		  BEGIN
			DONODE[PARLVL] _ .TEM1; ! THE PARALLEL LEVEL
			DONODE _ .TEM1;
			DONODE[LEVL] _ .LEVEL; !SET LEVEL
			IF .LEVEL EQL 1 THEN LASLVL0 _ .DONODE;  !NEW LAST LEVEL 0 FOR NEXT SEARCH
			SORCPTR[INNERDOFLG]_1;
			DONODE[NEXTDO] _ 0; !0 NEXT DO LEVEL
			LEAVE OUT;
		  END;
	 DO
	  BEGIN
	   WHILE .DONODE[PARLVL] NEQ 0 DO DONODE _ .DONODE[PARLVL];
	   IF .DONODE[NEXTDO] EQL 0
	   THEN
		BEGIN
			LOCAL BASE DOFATHER;
			DOFATHER _ .DONODE[DOSRC];
			DOFATHER[INNERDOFLG]_ 0;
		DONODE[NEXTDO] _ .TEM1; !DEEPER LEVEL OF DO
		DONODE _ .TEM1; ! NEW PTR TO DEEPEST NODE 
		SORCPTR[INNERDOFLG] _ 1;
		DONODE[LEVL] _ .LEVEL;
		LEAVE OUT;
		END;
	   DONODE _ .DONODE[NEXTDO]
	   END
	  WHILE .DONODE[LEVL] LSS .LEVEL;
!
	END;	!END OF WHILE 1 DO
!PLACE WHERE LEAVE STATEMENTS SHOULD BRING THE CODE
!OUT:
	RETURN (DONODE[DOSRC] _ .LASTSRC; .DONODE)
END;	!END OF ADDLOOP ROUTINE
GLOBAL ROUTINE TBLSEARCH=
!
!THE ROUTINE TBLSEARCH DOES ALL THE LOOKUPS TO THE
!THE VARIOUS DYNAMIC TABLES
!THE ROUTINE ALSO MAKES ENTRIES INTO TABLES FOR NEW ENTRIES
!AND RETURNS A POINTER TO THE TABLE ENTRY JUST MADE OR
!FOUND AND ALSO SETS A FLAG (FLAG) IF THE ENTRY WAS ALREADY IN
!THE TABLE, THE VALUE OF FLAG IS SET TO -1, IF THE ENTRY WAS NOT
!ALREADY IN THE TABLE THE VALUE IS SET TO  0.
!
!THE PARMETERS FOR THIS ROUTINE ARE TWO GLOBAL VARIABLES NAME AND ENTRY
!NAME CONTAINS THE TABLE NUMBER INTHE RIGHT HALF AND THE ENTRY SIZE IN LEFT HALF
!ENTRY IS THE ADDRESS OF THE FIRST WORD OF THE TABLE
!ARGUMENT TO BE LOOKED UP AND/OR ENTERED IN A TABLE.
!.ENTRY IS THE VALUE OF THE FIRST WORD OF THE ARGUMENT
!
BEGIN
LOCAL I;
EXTERNAL JOBREL,STTTYP,CORMAN,QUEUE,CHAR,NAME,ENTRY,THASH,TESTENTRY,
	NEWENTRY,LITERL,PUTMSG,DELETPTR;
MAP BASE DELETPTR;
BIND LISTX = PLIT(SYMTBL,CONTBL,EXPTBL,LABTBL,SRCTBL,
			DIMTBL,DATTBL,NAMTBL,LITTBL);
BIND ITEM = .LISTX[.NAME<RIGHT>]<RIGHT>;
!
	XTRAC;	!FOR DEBUGGING TRACE
	IF .NAME<RIGHT> GTR 12
	THEN RETURN ;
	IF .NAME<RIGHT> GTR 3 THEN
		( NEWENTRY(); RETURN(FLAG _ 0; .BASEPOINT));
		!NEWENTRY RESETS BASEPOINT
	I _ THASH();
	BASEPOINT _ .ITEM[.I];	!GET HASH TABLE ENTRY VALUE
	IF .BASEPOINT EQL 0	!IF 0 THEN A UNIQUE HASH AND A NEW ENTRY
	THEN
	  BEGIN
		NEWENTRY();	!INIT BASEPOINT AND SETUP DATA
		 ITEM[.I] _ .BASEPOINT;
		BASEPTR[CLINK] _ 0;
		RETURN (FLAG_0; .BASEPOINT);
	  END
	ELSE
!
!SEE IF AN ENTRY IS IN THE LINKED LIST FOR THE HASH I
!
	BEGIN
	WHILE 1 DO
		BEGIN
		IF TESTENTRY()
		THEN (FLAG _ -1; RETURN .BASEPOINT)
		ELSE
		  IF .BASEPTR[CLINK] NEQ 0
		  THEN BASEPOINT _ .BASEPTR[CLINK]
		  ELSE
		  BEGIN
			  NEWENTRY();
			BASEPTR[CLINK] _ .ITEM[.I]<RIGHT>;
			ITEM[.I]<RIGHT> _ .BASEPOINT;
			RETURN (FLAG _ 0; .BASEPOINT)
		  END;
		END;
	END
END;
GLOBAL ROUTINE THASH=	!DEVELOPS HASH CODE FROM POSSIBLE ENTRY
		!USING .NAME TO DEFINE THE TABLE NEEDED
BEGIN
EXTERNAL NAME,ENTRY;
	XTRAC;	!FOR DEBUGGING TRACE
	RETURN ABS(CASE .NAME OF SET
!
!0-SYMBOL TABLE
!
	.ENTRY MOD SSIZ;
!
!1-CONSTANT TABLE
!
	(.(ENTRY+1) XOR .ENTRY) MOD CSIZ;
!
!2-EXPRESSION TABLE
!
	BEGIN END;
!
!3-STATEMENT NUMBER TABLE
!
	IF .ENTRY GEQ LASIZ THEN .ENTRY MOD LASIZ ELSE .ENTRY;
!
	TES)
END;
GLOBAL ROUTINE  SRCHLIB (NODE) =
BEGIN
!**[574] SRCHLIB @3347  SJW  24-MAY-77
![574] REPLACE ENTIRE BINARY SEARCH ROUTINE WITH ONE GUARANTEED TO WORK

!	ROUTINE SEARCHES THE LIBRARY FUNCTION TABLE FOR THE SIXBIT
!	    NAME IN NODE [IDSYMBOL] = PARAM
!	  IF FOUND THEN RETURNS A PTR TO THE TABLE ENTRY
!	  IF NOT FOUND THEN RETURNS -1
![574]	BINARY SEARCH IS ALGORITHM B IN 6.2.1 OF KNUTH VOL 3

MAP BASE  NODE;
EXTERNAL  LIBFUNTAB, LIBATTRIBUTES;
MAP LIBATTSTR  LIBATTRIBUTES;

OWN  TOP, BOTTOM;
REGISTER  PARAM, CENTER;

	PARAM _ .NODE [IDSYMBOL];		! GET CANDIDATE NAME
	TOP _ LIBFUNTAB<0,0>;			! 1ST TABLE ENTRY
	BOTTOM _ (ONEAFTERLIB - 2)<0,0>;	! LAST TABLE ENTRY (SINCE ONEAFTERLIB IS COUNTED PLIT)

	WHILE  TRUE
	  DO BEGIN
	    IF .BOTTOM LSS .TOP
	      THEN RETURN -1;			! PARAM NOT FOUND
	    CENTER _ (.TOP + .BOTTOM) / 2;	! FIND MID-POINT
	    IF .PARAM EQL @@CENTER
	      THEN BEGIN
!	REJECT NAME WHICH IS DECLARED IN A CONFLICTING TYPE STATEMENT
		IF .NODE [IDATTRIBUT (INTYPE)]
		  THEN
		  IF .NODE [VALTYPE] NEQ
		     .LIBATTRIBUTES [.CENTER<RIGHT> - LIBFUNTAB<0,0>, ATTRESTYPE]
		    THEN RETURN -1;		! NAME NOT THE LIB FUNC
		RETURN .CENTER<RIGHT>;		! PTR TO TABLE ENTRY
	      END;
	    IF .PARAM GTR @@CENTER
	      THEN TOP _ .CENTER + 1		! NEW TOP: IGNORE OLD TOP THRU CENTER
	      ELSE BOTTOM _ .CENTER - 1;	! NEW BOTTOM: IGNORE CENTER THRU OLD BOTTOM
	  END;					! OF WHILE TRUE DO
END;						! OF SRCHLIB
GLOBAL ROUTINE NEWENTRY=
!THIS ROUTINE NEWENTRY ENTERS A NEW ITEM INTO THE TABLE DEFINED
!BY THE RIGHT HALF OF NAME
!
BEGIN
	MACRO BP = BASEPTR$;
	MACRO XADUMP(X,Y) = (XAREA0<LEFT> _ X;
					XAREA0<RIGHT> _ Y;
					XAREA())$;
EXTERNAL CORMAN,IOLSPTR,TABSPACE;
	MACRO PARAM = ENTRY$;
	OWN TOP,BOTTOM;
!
	XTRAC;	!FOR DEBUGGING TRACE
	BP _ CORMAN();	!GET SOME SPACE NEEDED
			!SIZOFENTRY DEFINES THE NUMBER OF WORDS
			!CORMAN ZEROES THE SPACE BEFORE RETURNING
!
!	TABSPACE[.NAME] _ .TABSPACE[.NAME]+.SIZOFENTRY; !KEEP COUNT OF TABLES SPACE BEING USED
	CASE .NAME OF SET
!
!0-SYMBOL ENTRY
!
	BEGIN
	EXTERNAL SEGINCORE;
	BP[VALTYPE] _ .SYMTYPE;
	BP[IDSYMBOL]_ .ENTRY;
	BP[OPRCLS] _ DATAOPR;
	BP[OPERSP] _ VARIABLE;	!NODE IS A VARIABLE
	IF .SEGINCORE EQL  1
	THEN
		BP[IDATTRIBUT(NOALLOC)] _ 1;	!SET THE NOALLOCATE BIT UNTIL THE NAME IS REFERENCED
					!IT WILL BE CLEARED BY NAMSET/REF
	END;
!
!1-CONSTANT
!
	BEGIN
	BP[CONST1] _ .ENTRY;
	BP[CONST2] _ .ENTRY[1];
	BP[OPRCLS] _ DATAOPR;
	BP[VALTYPE] _ .SYMTYPE;
	BP[OPERSP] _ CONSTANT;
	END;
!
!2-(NOT USED NOW)COMMON SUB-EXPRESSION
!  USING CXPTAB LOADED INTO NAME FOR CALL TO NEWENTRY
!
	BEGIN
	END;
!
!3-STATEMENT NUMBER
!
	BEGIN
	BP[SNUMBER] _ .ENTRY;
	BP[OPRCLS] _ LABOP;
	BP[SNREF] _ 1;	!INITS SNHDR TO 0 AND SNREFNO TO 1
		% NOTE THAT THIS MAKES THE REFERENCE COUNT 1
		  LARGER THAN IT ACTUALLY IS - FOR UNFORTUNATE HISTORICAL
	 	  REASONS   %
	END;
!
!4-COMMON BLOCK
!
	BEGIN
	IF .LASCOMBLK EQL 0
	THEN LASCOMBLK _ FIRCOMBLK _  .BASEPOINT
	ELSE ( MAP BASE COMBLKPTR;
		COMBLKPTR[NEXCOMBLK] _ .BASEPOINT;
		LASCOMBLK _ .BASEPOINT);
	BP[COMNAME] _ .ENTRY;	!STORE NAME
	END;
!
!5-EXECUTABLE SOURCE TREE ENTRIES
!
	BEGIN MAP BASE SORCPTR:IOLSPTR;
		IF .SORCPTR NEQ 0
		 THEN SORCPTR[CLINK] _ .BASEPOINT
		 ELSE !MAKE A DUMMY CONTINUE STATEMENT NODE AS FIRST STATEMENT
		  BEGIN
			FIRSTSRC _ LASTSRC _ .BASEPOINT;
			BP[SRCID] _ CONTID;
			BP[SRCISN] _0;
			BP[OPRCLS] _ STATEMENT;
			BASEPOINT _ CORMAN();	!NEW NODE FOR FIRST STSEMENT
			SORCPTR[CLINK] _ .BASEPOINT; !LINK TO DUMMY
		  END;
		LASTSRC _ .BASEPOINT;
		BP[SRCISN]  _ .ISN;	!INTERNAL SEQ NO.
		BP[SRCID]  _ .IDOFSTATEMENT;
		BP[OPRCLS] _ STATEMENT;
		IF (.IDOFSTATEMENT<RIGHT> GEQ STOPID) AND (.IDOFSTATEMENT<RIGHT> LEQ OPENID)
			AND (.IDOFSTATEMENT<RIGHT> NEQ ENDID)
		     THEN IF .IOFIRST EQL 0
			THEN IOFIRST _ IOLAST _ .BP
			ELSE ( IOLSPTR[IOLINK] _ .BP; !LINKIN NEW IO STAEEMENT
				IOLAST _ .BP;
			     );
		BEGIN
			MAP BASE LABLOFSTATEMENT;
			BP[SRCLBL] _ .LABLOFSTATEMENT;	!IF ANY
		IF .LABLOFSTATEMENT NEQ 0 THEN
			LABLOFSTATEMENT[SNHDR] _ .BP
		END;
	END;
!
!6-DIMENSIONS ENTRIES FOR ARRAYS
!
	BEGIN END;
!
!7-EXPRESSIONS NOT HASHED
! CALL NEWENTRY DIRECTLY; EXPTAB SHOULD BE LOADED INTO NAME
!
	BEGIN
	BP[ARG1PTR] _ .ENTRY;
	BP[ARG2PTR] _ .ENTRY[1];	!SECOND OPERAND
	BP[TARGET] _ 0;
	BP[VALTYPE] _ .SYMTYPE;
	END;
!
!8-IO LIST NODE OR DATA INTIALIZATION
!
	BEGIN
	BP[SRCID] _ .IDOFSTATEMENT;
	END;
!
!9-LITERAL
!
	BEGIN
	MACRO FIRLIT=LITPOINTER<LEFT>$, LASTLIT=LITPOINTER<RIGHT>$;
		IF .FIRLIT EQL 0
			THEN FIRLIT_LASTLIT_.BASEPTR
			ELSE ( MAP BASE LITPOINTER;
				LITPOINTER[CLINK]_.BASEPTR;
				LASTLIT _ .BASEPTR
			     );
	END;
!
!10-SEARCH FOR LIBRARY FUNCTION IN LIB TABLE
!
	BEGIN
	!
		EXTERNAL CGERR;
		CGERR();
	 END;
!
!11- EQUIVALENCE GROUP (CLASS) ENTRY
!
	BEGIN
		IF .EQVPTR EQL 0
		THEN EQVPTR<LEFT>_EQVPTR<RIGHT>_.BP
		ELSE ( MAP BASE EQVPTR;
			EQVPTR[EQVLINK]_.BP; !LINK IN NEW GROUP
			EQVPTR<RIGHT>_.BP	!FILL IN PTR TO LAST GROUP MADE
		    );
		BP[EQVFIRST]_BP[EQVLAST]_.ENTRY; !ENTRY HAS POINTER TO FIRST EQV ITEM MADE BY CASE 12 FOR CURRENT EQV GROUP
	END;
!
!12- EQUIVALENCE LIST ENTRY
!
	BEGIN END;
!
!13- DATA GROUP NODES FOR DATA STATEMENTS
!
	BEGIN
	IF .DATASPTR EQL 0
	  THEN DATASPTR<LEFT>_ DATASPTR<RIGHT> _.BP
	  ELSE (
		MAP BASE DATASPTR;
		DATASPTR[DATALNK] _ .BP; !POINT TO LAST

		DATASPTR<RIGHT> _ .BP;
		);
	END;
!
!14- NAMELIST LLIST HEADER
!
	BEGIN
	EXTERNAL NAMLPTR;
	IF .NAMLPTR EQL 0
	THEN NAMLPTR<LEFT> _ NAMLPTR<RIGHT> _ .BP
	ELSE ( MAP BASE NAMLPTR;
		NAMLPTR[CLINK] _ .BP;
		NAMLPTR<RIGHT> _ .BP;
	     );
	END;
!***************END OF CASES****
	TES;
!   IF DEBUG THEN XADUMP(.SIZOFENTRY,.BASEPOINT<RIGHT>);
	RETURN .BASEPTR
END;
GLOBAL ROUTINE TESTENTRY=
!THIS ROUTINE TEST THE CURRENT TABLE ENTRY AGAINST THE SEARCH
!ARGUMENT TO SEE IF THERE IS A MATCH
!RETURNS TRU IF MATCH
BEGIN
MACRO TRU = -1$,
      BP = BASEPTR$;
!
	XTRAC;	!FOR DEBUGGING TRACE
	RETURN
	CASE .NAME OF SET
!
!0-SYMBOL TEST
!
	BEGIN
	IF .BASEPTR[IDSYMBOL] EQL .ENTRY THEN TRU ELSE 0
	END;
!
!1-CONSTANT TEST
!
	BEGIN
	IF .SYMTYPE EQL .BP[VALTYPE] THEN
	BEGIN
		IF .BP[VALTP1] NEQ INTEG1
		THEN(IF .BP[CONST1] EQL .ENTRY
			THEN IF .BP[CONST2] EQL .(ENTRY+1)
				THEN TRU ELSE 0
		    )
		ELSE IF .BP[CONST2] EQL .(ENTRY+1)
			THEN TRU ELSE 0
	END
	END;
!
!2-EXPRESSION
!
	BEGIN
	END;
!
!3- STATEMENT NUMBER
!
	BEGIN
	IF .BASEPTR[SNUMBER] EQL .ENTRY
	THEN (BP[SNREF] _ .BP[SNREF]+1;TRU) ELSE 0
	END;
!
	TES;
END;
GLOBAL ROUTINE SAVSPACE(SIZ,POINTER)=	!ADDS TO FREE SPACE LIST
BEGIN
EXTERNAL FREELIST;	!10 WORD VECTOR - ELEMENTS POINT TO LINKED LISTS OF SAVED CORE OF SIZE .SIZ
MACRO FSLFIRST = FREELIST[.SIZ]<LEFT>$,
	FSLLAST = FREELIST[.SIZ]<RIGHT>$;
OWN FREETOTAL[10];
EXTERNAL TTOTAL;
!
	XTRAC;	!FOR DEBUGGING TRACE
	SIZ _ .SIZ+1;	!SIZES ARE RELATIVE 0, O SIZE MEANS 1 ETC.
	IF .SIZ GEQ 9
	THEN ( (@POINTER)<RIGHT> _ .FREELIST[9];
		FREELIST[9] _ @POINTER;
		!FREETOTAL[9] _ .FREETOTAL[9]+.SIZ;
	     )
	ELSE  (
		(@POINTER)<RIGHT> _ .FSLLAST;	!FOR END OF CHAIN
		FSLLAST _ .POINTER;
		!FREETOTAL[.SIZ] _ .FREETOTAL[.SIZ]+.SIZ;
	     );
	!TTOTAL _ .TTOTAL +.SIZ;
	.VREG
END;
GLOBAL ROUTINE CORMAN=	!MANAGES FREE SPACE FOR COMPILER
BEGIN
MACRO BLKSIZ = SIZOFENTRY$;
EXTERNAL NAME,CORERR,JOBFF,JOBREL,SPACEFREE,FREELIST,TTOTAL;
!OWN BLKLIM;	!LIMIT OF AREA TO BE RETURNED
!THE NEXT LINE IS FOR DEBUGGING AND PERFORMANCE ANAYLSIS
!OWN BLKS[10];
REGISTER BASE BLTPTR;
LABEL COR1,COR2;
!
!
	XTRAC;	!FOR DEBUGGING TRACE
!
!	USE UP LO SEG FREE STORAGE


% NOTE THAT THE LITERAL BUILD PROCESS DEPENDS UPON CORMAN ALLOCATING
  >10 WORDS FROM FREE STORAGE AND THAT SUCCESSIVE SUCH CALLS
  WILL ADD TO THE AREA   %


!THE NEXT LINE IS FOR DEBUGGING AND PERFORMANCE ANALYSIS
!IF .BLKSIZ LEQ 9 THEN BLKS[.BLKSIZ]_ .BLKS[.BLKSIZ]+1;
COR1:
  BEGIN
	COR2: IF .BLKSIZ GTR 9
		THEN LEAVE COR2
		ELSE
		  (    IF (VREG _.FREELIST[.BLKSIZ]<RIGHT>) NEQ 0
			THEN  (
				FREELIST[.BLKSIZ]<RIGHT>_@.VREG;
				!TTOTAL _ .TTOTAL-.BLKSIZ;
				LEAVE COR1
			      );
		  );
	VREG _ .JOBFF;	!FOR RETURN
	IF (SPACEFREE _ .JOBREL -(JOBFF _ .JOBFF + .BLKSIZ)) LSS 0
	  THEN
	    BEGIN
	    VREG _ .JOBREL;
	!**;[355], CORMAN @3694, DCE, 2-MAR-76
	!**;[355], MAY HAVE TO ALLOCATE MORE THAN 1 CORE BLOCK
		VREG_.VREG-.SPACEFREE; ![355] ALLOCATE ALL YOU NEED
		IF .VREG GTR #400000 THEN CORERR();
	    CALLI(VREG,#11);	!ALLOCATE CORE
	    CORERR();
	    SPACEFREE _ .JOBREL - .JOBFF;
	    VREG _ .JOBFF-.BLKSIZ;
	    END;
  END;
	(.VREG)<0,36>_0;	!CLEAR FIRST WORD IN BLOCK
	IF .BLKSIZ NEQ 1 THEN
	BEGIN
		BLTPTR<LEFT>_#0[.VREG]<0,0>;
		BLTPTR<RIGHT>_#1[.VREG]<0,0>;
		BLT(BLTPTR,(.BLKSIZ-1)[.VREG])
	END;
	.VREG

END;




GLOBAL ROUTINE GENLAB=
BEGIN
%(*********************************************
	ROUTINE TO CREATE A LABEL TABLE ENTRY FOR
	A NEW INTERNAL LABEL. ILABIX IS INITIALIZED TO
	100000 TO DISTINGUISH INTERNAL LABELS FROM
	FORTRAN PROGRAM LABELS
***********************************************************)%
	EXTERNAL ILABIX,TBLSEARCH;
	ENTRY_.ILABIX;
	NAME_LABTAB;
	ILABIX_.ILABIX+1;
	TBLSEARCH()
END;

GLOBAL ROUTINE MAKEPR(CLAS,SPECFI,VTYPE,A1PTR,A2PTR) =
BEGIN
!MAKE AN EXPRESSION NODE FOR PHASE 2 SKELETON AND PHASE 2
REGISTER T;
MAP PEXPRNODE T;
	NAME<LEFT> _ 4;		!ENTRY IS 4 WORDS LONG
	T_CORMAN();		!GET CORE FOR ENTRY
	T[FIRSTWORD] _ 0;		!FIRST WORD IS ZERO
	T[EXPFLAGS] _ 0;	!FLAGES ARE ZERO
	T[OPRCLS] _ .CLAS;	!OPERATOR CLASS
	T[OPERSP] _ .SPECFI;	!SPECIFIC OPERATOR
	T[VALTYPE] _ .VTYPE;	!VALUR TYPE
	T[TARGET] _ 0;		!ZERO TARGET WORD
	T[ARG1PTR] _ .A1PTR;	!ARGUMENT ONE

	T[ARG2PTR] _ .A2PTR;	!ARGUMENT TWO
	.T
END;
!
!

GLOBAL ROUTINE MAKPR1(PARPTR,CLAS,SPECFI,VTYPE,A1PTR,A2PTR) =
!MAKE AN EXPRESSION NODE FOR PHASE 1 ARRAY EXPANSION, AND VALUE-TYPE
!  ANALYSIS - ALSO FOR PHASE 2 SKEL AND PHASE 2

!SETS VALFLGS AND PUTS IN PARENT PTRS
BEGIN
	MAP PEXPRNODE A1PTR:A2PTR;
	REGISTER PEXPRNODE T;
	NAME<LEFT> _ 4;		!ENTRY IS 4 WORDS LONG
	T_CORMAN();		!GET CORE FOR ENTRY
	T[FIRSTWORD] _ 0;		!FIRST WORD IS ZERO
	T[EXPFLAGS] _ 0;	!FLAGES ARE ZERO
	T[OPRCLS] _ .CLAS;	!OPERATOR CLASS
	T[OPERSP] _ .SPECFI;	!SPECIFIC OPERATOR
	T[VALTYPE] _ .VTYPE;	!VALUR TYPE
	T[TARGET] _ 0;		!ZERO TARGET WORD
	T[ARG1PTR] _ .A1PTR;	!ARGUMENT ONE

	T[ARG2PTR] _ .A2PTR;	!ARGUMENT TWO
	T[PARENT]_.PARPTR;	!PARENT-PTR FIELD OF THIS NODE
!
	IF .A1PTR NEQ 0
	THEN
	BEGIN
		IF .A1PTR[OPRCLS] EQL DATAOPR OR .A1PTR[OPRCLS] EQL CMNSUB
		THEN T[A1VALFLG]_1
		ELSE
		A1PTR[PARENT]_.T;
	END;


	IF .A2PTR NEQ 0
	THEN
	BEGIN
		IF .A2PTR[OPRCLS] EQL DATAOPR OR .A2PTR[OPRCLS] EQL CMNSUB
		THEN T[A2VALFLG]_1
		ELSE A2PTR[PARENT]_.T;
	END;

	.T
END;
END		!MODULE
ELUDOM