Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/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,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: F. INFANTE/HPW/NEA/DCE/SJW
MODULE SRCA(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4,GLOROUTINES)=
BEGIN
GLOBAL BIND SRCAV = 6^24 + 0^18 + 53; ! Version Date: 28-Sep-81
%(
***** Begin 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, (DCE)
***** 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, (SJW)
***** Begin Version 5B *****
52 707 27153 CHANGE SAVSPACE TO REDUCE JOBFF IF POSSIBLE, (DCE)
***** Begin Version 6 *****
53 1133 TFV 28-Sep-81 ------
Keep track of the maximum size of the compiler lowseg in MAXFF
for /STATISTICS output.
***** End 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
! 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
! 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;
%1133% EXTERNAL MAXFF; ! Maximum size of compiler lowseg
!
%1133% IF .JOBFF GTR .MAXFF THEN MAXFF _ .JOBFF; ! Keep track of maximum compiler lowseg size
XTRAC; !FOR DEBUGGING TRACE
SIZ _ .SIZ+1; !SIZES ARE RELATIVE 0, O SIZE MEANS 1 ETC.
![707] BRING JOBFF BACK DOWN IF POSSIBLE - PREVENTS FRAGMENTATION
%[707]% IF (.POINTER+.SIZ) EQL .JOBFF
%[707]% THEN JOBFF_.JOBFF-.SIZ
%[707]% ELSE 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;
%1133% EXTERNAL MAXFF; ! Maximum size of compiler lowseg
!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>[email protected];
!TTOTAL _ .TTOTAL-.BLKSIZ;
LEAVE COR1
);
);
VREG _ .JOBFF; !FOR RETURN
IF (SPACEFREE _ .JOBREL -(JOBFF _ .JOBFF + .BLKSIZ)) LSS 0
THEN
BEGIN
VREG _ .JOBREL;
!MAY HAVE TO ALLOCATE MORE THAN 1 CORE BLOCK
VREG_.VREG-.SPACEFREE; ! ALLOCATE ALL YOU NEED
IF .VREG GTR #400000 THEN CORERR();
CALLI(VREG,#11); !ALLOCATE CORE
CORERR();
SPACEFREE _ .JOBREL - .JOBFF;
VREG _ .JOBFF-.BLKSIZ;
%1133% IF .JOBFF GTR .MAXFF THEN MAXFF _ .JOBFF; ! Keep track of maximum compiler lowseg size
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