Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - regutl.bli
There are 12 other files named regutl.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) DIGITAL EQUIPMENT CORPORATION 1974, 1983
!AUTHORS: NORMA ABEL AND SARA MURPHY/HPW/TFV/AHM

MODULE REGUTL(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4,GLOROUTINES)=
BEGIN

GLOBAL BIND REGUTV = 7^24 + 0^18 + #1552;	! Version Date: 6-Jun-82


%(

***** Begin Revision History *****

17	-----	-----	CREATE MODULE
18	-----	-----	TAKE LASTONE OUT AND PUR IT BACK IN UTIL
19	-----	-----	MAKE ALODIMCONSTS ALLOCATE CONSTANTS FOR PROTECTED
			ARRAYS WHEN "DEBUG" SWITCH NOT SET
20	-----	-----	MODIFY ALODIMCONSTS TO ALLOCATE CONSTS FOR
			ARRAY DIMENSIONS WHEN EITHER THE "BOUNDS" SWITCH
			OR THE "DEBUG" SWITCH IS SET (WE NO LONGER PROTECT
			INDIVIDUAL ARRAYS - ONLY ALL ARRAYS)
21	-----	-----	CHANGE REF TO THE FLAG "DEBUG" TO REF TO "DBGDIMN"

***** Begin Version 7 *****

22	1274	TFV	20-Oct-81	------
	Rewrite NXTTMP, its arg is now the size of the .Qnnnn variable to 
	allocate.  Write NEWQTMP to generate a new .Qnnnn variable.

1552	AHM	6-Jun-82
	Make NEWQTMP set the  IDPSECT and IDPSCHARS  fields of the  .Q
	temp being  created to  PSDATA  so that  we can  generate  the
	address of the .Q temp in HSDDESC in OUTMOD.

***** End Revision History *****

)%

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

	EXTERNAL
		QANCHOR,	! Pointer to start of linked .Q list
		BASE	LASTQ,	! Pointer to the last .Q used by the current statement
		QLOC,		! Last location in .Q space that was used by the current statement
		QMAX,		! Maximum size of .Q space for all statements
		QCNT,		! Value to use for .Qnnnn
		CORMAN;		! Routine to get space for the entry

GLOBAL ROUTINE MAKRC0(VTYPE)=
%(***************************************************************************
	ROUTINE TO MAKE A REGCONTENTS NODE FOR REG 0 HAVING TYPE "VTYPE".
	 THESE NODES WILL BE SUBSTITUTED FOR THE LHS OF ALL STMNT
	FNS (SUBSTITUTION IS DONE DURING REG ALLOC PASS).
***************************************************************************)%
BEGIN
	EXTERNAL NAME,CORMAN;	!USED TO GET SOME FREE CORE

	OWN PEXPRNODE REGC0;

	NAME<LEFT>_EXSIZ;	!NUMBER OF WDS IN AN EXPRESSION NODE
	REGC0_CORMAN();		!GET FREE STORAGE FOR THE NODE

	REGC0[VALTYPE]_.VTYPE;
	REGC0[OPRCLS]_REGCONTENTS;
	REGC0[INREGFLG]_1;
	REGC0[TARGTAC]_RETREG;	!THE REG USED FOR RETURNING FN VALS (REG 0)
	REGC0[TARGADDR]_RETREG;
	RETURN .REGC0		!RETURN A PTR TO THE NODE
END;

GLOBAL ROUTINE ALODIMCONSTS=
%(***************************************************************************
	ROUTINE TO ALLOCATE CORE FOR ALL CONSTANTS THAT OCCUR IN
	SPECIFICATIONS OF DIMENSION INFORMATION FOR 
	ARRAYS  WHEN THE "BOUNDS" SWITCH OR THE "DEBUG" SWITCH IS SET.
***************************************************************************)%
BEGIN
	EXTERNAL SYMTBL;
	EXTERNAL ALDIM1;
	REGISTER BASE SYMPTR;

	IF NOT (.FLGREG<BOUNDS> OR .FLGREG<DBGDIMN>) THEN RETURN;	!WILL ALLOCATE THE DIM CONSTS IF
					! THE USER SPECIFIED ARRAY BOUNDS CHECKING TO BE DONE
					! OR DEBUGGING INFO TO BE PASSED TO FORDDT


	%(***WALK THRU THE SYMBOL TABLE AND FOR EACH ENTRY WHICH IS
		AN ARRAY NAME, PROCESS THE DIMENSION INFO FOR THAT ARRAY.
		THIS IS ECESSARY BECAUSE THERE IS NO WAY TO DIRECTLY WALK
		THRU THE DIMENSION TABLE
	****)%
	DECR I FROM SSIZ-1 TO 0
	DO
	BEGIN
		SYMPTR_.SYMTBL[.I];
		UNTIL .SYMPTR EQL 0	!LOOK AT EACH SYMBOL THAT HASHED
					! TO ENTRY "I"
		DO
		BEGIN
			IF .SYMPTR[OPRSP1] EQL ARRAYNM1	!IF THIS AN ENTRY FOR AN ARRAY NAME
			THEN
			 ALDIM1(.SYMPTR[IDDIM]);	! ALLOCATE ALL CONSTS IN ITS DIM TABLE ENTRY
			SYMPTR_.SYMPTR[CLINK]
		END
	END
END;


GLOBAL ROUTINE ALDIM1(DIMPTR)=
%(***************************************************************************
	ROUTINE TO GO THRU A DIMENSION TABLE ENTRY ALLOCATING CORE FOR ALL CONSTANTS
	USED IN THAT ENTRY. THIS ROUTINE IS CALLED:
		1. WHEN THE USER HAS SPECIFIED THE "DEBUG" SWITCH
			INDICATING THAT ALL DIMENSION TABLE INFORMATION
			SHOULD BE OUTPUT.
		2. WHEN THE USER HAS SPECIFIED THAT THIS PARTICULAR ARRAY
		   SHOULD BE "PROTECTED".
***************************************************************************)%
BEGIN
	EXTERNAL ALOCONST;	!ROUTINE TO SET FLAG IN CONST TABLE
				! ENTRY INDICATING THAT CORE SHOULD BE ALLOCATED
				! FOR THIS CONST
	MAP BASE DIMPTR;	!PTR TO THE DIMENSION TABLE ENTRY
	REGISTER DIMSUBENTRY DIMLSTPTR;	!PTR TO THE SUBENTRY FOR A GIVEN DIMENSION

	IF NOT .DIMPTR[ADJDIMFLG]	!IF THIS ARRAY HAS NO ADJUSTABLE DIMENSIONS
	THEN ALOCONST(.DIMPTR[ARAOFFSET]);	! THEN THE "OFFSET" WILL BE CONST - ALLOCATE CORE FOR IT


	DIMLSTPTR_DIMPTR[FIRSTDIM];	!PTR TO SUBENTRY FOR 1ST DIMENSION

	DECR CT FROM (.DIMPTR[DIMNUM] - 1) TO 0	!LOOK AT THE SUBENTRY FOR EACH DIMENSION
	DO
	BEGIN
		IF NOT .DIMLSTPTR[VARLBFLG]	!IF THE LOWER BOUND IS A CONST
		THEN ALOCONST(.DIMLSTPTR[DIMLB]);	! ALLOCATE CORE FOR IT
		IF NOT .DIMLSTPTR[VARUBFLG]	!IF THE UPPER BOUND IS A CONST
		THEN ALOCONST(.DIMLSTPTR[DIMUB]);
		IF NOT .DIMLSTPTR[VARFACTFLG]	!IF THE FACTOR FOR THIS DIMENSION IS A CONST
		THEN ALOCONST(.DIMLSTPTR[DIMFACTOR]);

		DIMLSTPTR_.DIMLSTPTR+DIMSUBSIZE
	END
END;


GLOBAL ROUTINE ALOCONST(CNODE)=
%(***************************************************************************
	ROUTINE TO SET A FLAG INDICATING THAT THIS CONSTANT SHOULD HAVE CORE
	ALLOCATED FOR IT.
	THIS SHOULD PROBABLY BE MADE A MACRO AT SOME POINT.
***************************************************************************)%
BEGIN
	MAP BASE CNODE;

	CNODE[CNTOBEALCFLG]_1;
	.CNODE
END;
GLOBAL ROUTINE NEWQTMP=
BEGIN

%1274%	! Written by TFV on 20-Oct-81
	! Create a new .Q variable entry

	REGISTER PEXPRNODE QVAR;	! Pointer to entry

	NAME<LEFT> = IDSIZ;		! Use a symbol table like entry
	QVAR = CORMAN();		! Get space for new .Q variable

	QVAR[OPRCLS] = DATAOPR;		! Data operator OPRCLS
	QVAR[OPERSP] = TEMPORARY;	! Specific operator is temporary
	QVAR[IDADDR] = .QLOC;		! Set address to offset in .Q space
%1552%	QVAR[IDPSECT] = QVAR[IDPSCHARS] = PSDATA; ! Temps live in the lowseg

	QVAR[IDSYMBOL] = SIXBIT'.Q0000' +	! Make the .Qnnnn name
		(.QCNT<9,3>)^18 +
		(.QCNT<6,3>)^12 +
		(.QCNT<3,3>)^6 +
		(.QCNT<0,3>);

	QCNT = .QCNT + 1;	! Increment QCNT

	RETURN .QVAR;

END;	! NEWQTMP

GLOBAL ROUTINE NXTTMP(SIZE)=
BEGIN
%1274%	! Rewritten by TFV on  20-Oct-81	
	! Get or create the next .Qnnnn variable
	! They are kept as a linked list, the IDADDR field points to 
	! the offset into .Q space	

	REGISTER
		BASE	CURRQ,	! Pointer to the current .Q variable we created or reused
		NEXTQ;		! Pointer to the next .Q variable in the .Q list

	LABEL	FINDIT;		! Used when we are searching down the .Q list

	IF .LASTQ EQL 0
	THEN
	BEGIN	! This is the first .Q variable for this statement

		IF .QANCHOR EQL 0
		THEN
		BEGIN	! First ever - create it

			CURRQ = NEWQTMP();
			QANCHOR  = .CURRQ;	! First ever created

		END	! First ever - create it

		ELSE	CURRQ = .QANCHOR;	! Start at beginning of .Q list

	END	! This is the first .Q variable for this statement
	ELSE
FINDIT:
	BEGIN	! Search down .Q list to find a .Q variable at QLOC

		WHILE (CURRQ = .LASTQ[CLINK]) NEQ 0 DO
		BEGIN

			IF .CURRQ[IDADDR] EQL .QLOC THEN LEAVE FINDIT;	! One exists, we are done

			IF .CURRQ[IDADDR] GTR .QLOC
			THEN
			BEGIN	! There is none, create a new one and link it in

				NEXTQ = .CURRQ;		! Insert before CURRQ
				CURRQ = NEWQTMP();	! Make a new .Q variable
				LASTQ[CLINK] = .CURRQ;	! Last points to new .Q variable
				CURRQ[CLINK] = .NEXTQ;	! New points to next .Q variable

				LEAVE FINDIT;		! We create a new one, we are done

			END;	! There is none, create a new one and link it in

			LASTQ = .CURRQ;		! Look at next exntry in .Q list
		END;	! WHILE (CURRQ = .LASTQ[CLINK] NEQ 0 DO

		! We walked off the end of the list - create a new .Q and link it at the end

		CURRQ = NEWQTMP();	! Create it
		LASTQ[CLINK] = .CURRQ;	! Link it in

	END;	! FINDIT - Search down .Q list to find a .Q variable at QLOC

	QLOC = .QLOC + .SIZE;		! QLOC points after this entry

	IF .QLOC GTR .QMAX THEN QMAX = .QLOC;	! Update QMAX if it grew

	LASTQ = .CURRQ;		! LASTQ is now the one we just created or reused
	RETURN .LASTQ;		! Return the pointer to it

END;	! NXTTMP

END
ELUDOM