Trailing-Edge
-
PDP-10 Archives
-
BB-4157F-BM_1983
-
fortran/compiler/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