Trailing-Edge
-
PDP-10 Archives
-
fortv11
-
doxpn.bli
There are 12 other files named doxpn.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1987
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
!AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!AUTHOR: NORMA ABEL/HPW/JNG/TFV/EGM/CDM/AHM/TJK
MODULE DOXPN(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4,GLOROUTINES)=
BEGIN
GLOBAL BIND DOXPNV = #11^24 + 0^18 + #4515; ! Version Date: 20-SEP-85
%(
***** Begin Revision History *****
75 ----- ----- FIX ADJGEN TO CORRSPOND TO NEW DIMENSION ENTRY
76 ----- ----- FIX EDIT 75
77 ----- ----- REMOVE CODE THAT KEEPS ARRAY DIMENSIONS ASSOCIATED
WITH ADJUSTABLE DIMENSIONS ACROSS ENTRIES
78 ----- ----- IN ADJGEN, SET THE "IDLIBFNFLG" IN THE SYMBOL TABLE
ENTRIES FOR "ADJG." AND "ADJ1." (SO THAT CAN KNOW
THAT THEY DONT CLOBBER ALL REGS AS OTHER CALLS DO)
79 ----- ----- DO NOT BUILD A REGCONTENTS NODE IN DOXPN
(CLEVER BUT A BUMMER)
80 ----- ----- CLEAR THE NOALLOC BIT FOR PHASE 1, WHEN GENERATING TEMPORARIES
81 19130 433 IF ALL DO PARAMS KNOWN AT COMPILE TIME AND
LOOP WILL BE XCT'D NEG OR ZERO TIMES, DO IT ONCE, (JNG)
82 19130 633 FIX 433 TO NOT WIPE OUT A CONSTANT TABLE ENTRY., (JNG)
***** Begin Version 6 *****
83 761 TFV 1-Mar-80 -----
Add indices for folding /GFLOATING and remove KA indices
84 772 EGM 5-Jun-80 29516
Generate fatal error for adjustable dimension variable dimensioned
after the fact.
88 1143 AHM 13-Nov-81
More of edit 1136 to make "data transfer" statements work as well as
"device control" statements. Delete code in IODOXPN that incremented
the reference count for labels used in END= and ERR= in "data
transfer" statements. BLDKEY now references those labels correctly.
***** Begin Version 7 *****
85 1204 DCE 25-Nov-80 -----
Handle F77 DO loops (potential zero trip). Modify the trip count
code substantially to separate out F66 and F77. Use different
algorithm (F77) for trip count, being careful to preserve correct
behavior for both F66 and F77.
86 1250 CKS 6-Aug-81
Modify ADJGEN to call ADJC1. or ADJCG. for character arrays.
87 1413 CDM 4-Nov-81
Modify ADJGEN to use ARGLSTSIZE when getting core for argument node.
1505 AHM 12-Mar-82
Have SSIZTMP and INITLTEMP set the psect index of STEs for DO
loop temps to PSDATA and have ADJGEN set the ADJxy. STE to
PSCODE to relocate those references properly.
1551 AHM 3-Jun-82
Don't set the psect index of ADJxy. STEs to PSCODE in ADJGEN
since they are only external references.
1670 CKS 10-Nov-82
Adjustable array dimension bounds can be arbitrary integer expressions,
not just constants and scalars. Modify ADJGEN to set AVALFLG correctly
in the ADJ. arg list.
***** End V7 Development *****
1746 CDM 2-May-83
Subscript expression nodes for adjustably dimensioned arrays are
not evaluated for some expressions, so later compiler processing
finds an expression node where it wants a variable. Create a
.Innnn variable to assign the expression into, and store this
away in the dimension tables.
2002 TJK 23-Sep-83
Fix evaluation of INT((M2-M1+M3)/M3) in DOXPN for cases in
which M3 is a constant +1 or -1. Previously it used
INT(M2-M1)+1 and 1-INT(M2-M1), which is incorrect when
-1 < (M2-M1) < 0 (first case) and 0 < (M2-M1) < 1 (second case).
Changed to INT((M2-M1)+M3) and INT(-((M2-M1)+M3)).
2011 TJK 13-Oct-83
Have all non-constant step size expressions be stored in
temporaries. Previously this was not done for any DATAOPR, so
if the step size was a variable which changed during execution
of the loop, the new value was used for the step (instead of
the original value, which is what should be used).
2451 AHM 16-Aug-84
Modify ADJCALL to only call ADJGEN for arrays that are
allocated. This prevents ADJxy.'s arg lists from referencing
0' and 1'. ADJx. would Ill Mem Ref when it interpreted byte
pointers left in 0' by the routine prologue as an address.
***** End Revision History *****
***** Begin Version 11 *****
4515 CDM 20-Sep-85
Phase I for VMS long symbols. Create routine ONEWPTR for Sixbit
symbols. For now, return what is passed it. For phase II, return
[1,,pointer to symbol].
ENDV11
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
%*****
TAKE A NUMBER AND MAKE 4 SIXBIT DIGITS OUT OF IT
USED TO GENERATE TEMPORARY NAMES
*****%
MACRO MAKNAME(NUMB)=
(.NUMB<9,3>+16)^18 + (.NUMB<6,3>+16)^12 + (.NUMB<3,3>+16)^6
+ (.NUMB<0,3>+16)$;
FORWARD
!**; [1746] DOXPN, 4056, CDM, 2-May-83
%1746% DOTIASGN, ! Makes a .Innnn assignment statement for the
%1746% ! expression passed to it.
INITLTEMP, SSIZTMP;
EXTERNAL
%1746% CORMAN, ! Core manager
%1746% BASE CSTMNT, ! Current statement
%4515% ONEWPTR; ! Returns [1,,pointer] to Sixbit argument
GLOBAL ROUTINE DOXPN(CNODE)=
BEGIN
![761] KARIGB and KGFRL for folding /GFLOATING
%761% EXTERNAL CORMAN,KARIGB,KARIIB;
EXTERNAL C1L,C1H,C2L,C2H,TBLSEARCH,CNVNODE;
EXTERNAL COPRIX,SPKABA,CNSTCM,EXPRTYPER,MAKPR1;
%761% EXTERNAL KDPRL,KGFRL;
!CREATE DO LOOP CONTROL EXPRESSION
!CNODE POINTS TO DO STATEMENT ENCODED SOURCE
MAP BASE CNODE;
OWN DOINITL, !POINTER TO INITIAL VALUE
DOULIM, !POINTER TO UPPER LIMIT
DOSTEPSIZ, !POINTER TO STEP SIZE;0 IF STEP SIZE IS 1
DOSYMBOL, !POINTER TO INDUCTION VARABLE
DOCESSOR, !PREDECESSOR OF DO STATEMENT
OPEXPR, !TEMPORARY
PEXPR; !TEMPORARY
OWN SSIZMINUSONEFLG; !SET THIS FLAG IF STEP SIZE IS MINUS ONE
OWN BASE T; !TEMPORARY
MAP PEXPRNODE DOCESSOR;
MAP PEXPRNODE DOSYMBOL:DOINITL:DOULIM:DOSTEPSIZ:PEXPR:OPEXPR;
!MACRO WILL MOVE LABEL ON THE DO STATEMENT ITSELF (IF ANY)
!BACK TO THE STEP SIZE COMPUTATION OR INITIAL VALUE
!COMPUTATION IF THESE ARE PRESENT
MACRO ADJLAB=
IF .CNODE[SRCLBL] NEQ 0 THEN
BEGIN
LOCAL BASE TMP;
OPEXPR[SRCLBL]_.CNODE[SRCLBL];
CNODE[SRCLBL]_0;
TMP_.OPEXPR[SRCLBL];
TMP[SNHDR]_.OPEXPR;
END$;
DOSYMBOL_.CNODE[DOSYM];
!SET SYMBOL TABLE BIT TO INDICATE THIS VARIABLE IS
!STORED INTO IN CASE IT IS AN ARGUMENT THAT NEEDS
!STORING BACK
DOSYMBOL[IDATTRIBUT(STORD)]_1;
DOINITL_.CNODE[DOM1];
DOULIM_.CNODE[DOM2];
DOSTEPSIZ_.CNODE[DOM3];
DOCESSOR_.CNODE[DOPRED];
CNODE[NEDSMATRLZ]_1; !SET BIT OPTIMIZER WILL RESET
!IF EITHER OF THE LIMITS OR THE STEP SIZE IS A NEGATIVE OF A CONSTANT,
! FOLD THAT NEGATION HERE SO THAT THE GENERATED CODE FOR
! DO 10 I=10,1,-1
! WILL NOT TREAT THE -1 AS AN ARBITRARY EXPRESSION(SRM-FEB 9,1973)
IF .DOINITL[OPR1] EQL NEGFL
THEN
BEGIN
T_.DOINITL[ARG2PTR]; !ARG UNDER THE NEG
IF .T[OPR1] EQL CONSTFL THEN DOINITL_NEGCNST(T);
END;
IF .DOULIM[OPR1] EQL NEGFL
THEN
BEGIN
T_.DOULIM[ARG2PTR]; !ARG UNDER THE NEG
IF .T[OPR1] EQL CONSTFL THEN DOULIM_NEGCNST(T);
END;
IF .DOSTEPSIZ[OPR1] EQL NEGFL
THEN
BEGIN
T_.DOSTEPSIZ[ARG2PTR]; !ARG UNDER THE NEG
IF .T[OPR1] EQL CONSTFL THEN DOSTEPSIZ_NEGCNST(T);
END;
!IF EITHER OF THE LIMITS OR THE STEP SIZE HAS A DIFFERENT VAL-TYPE FROM
! THE INDUCTION VARIABLE, MUST PERFORM TYPE CONVERSION (SRM-OCT 6,1972)
IF .DOINITL[VALTP2] NEQ .DOSYMBOL[VALTP2] THEN DOINITL_CNVNODE(.DOINITL,.DOSYMBOL[VALTYPE],0);
IF .DOULIM[VALTP2] NEQ .DOSYMBOL[VALTP2] THEN DOULIM_CNVNODE(.DOULIM,.DOSYMBOL[VALTYPE],0);
IF .DOSTEPSIZ[VALTP2] NEQ .DOSYMBOL[VALTP2] THEN DOSTEPSIZ_CNVNODE(.DOSTEPSIZ,.DOSYMBOL[VALTYPE],0);
IF .DOSYMBOL[VALTP1] NEQ INTEG1
THEN
CNODE[REALARITH]_1;
!LOOK AT THE STEP SIZE
SSIZMINUSONEFLG_FALSE; !FLAG FOR STEP SIZE = -1, INIT TO FALSE
IF .DOSTEPSIZ[OPR1] EQL CONSTFL THEN
BEGIN
!CHECK FOR STEP SIZES ONE AND MINUS ONE
IF .DOSTEPSIZ[VALTYPE] EQL REAL THEN
BEGIN
%(***FOR REALS- MUST ROUND FROM 2 WDS OF PREC TO ONE BEFORE
EXAMINING THE VALUE (KEEP THEM AS UNROUNDED 2 WD VALS
INSIDE THE COMPILER) ***)%
C1H_.DOSTEPSIZ[CONST1]; !SET GLOBALS FOR THE ASSEMBLY LANG
C1L_.DOSTEPSIZ[CONST2]; ! THAT ROUNDS THE CONST
![761] Choose index for folding based on /GFLOATING
%761% IF .GFLOAT
%761% THEN COPRIX_KGFRL
%761% ELSE COPRIX_KDPRL;
CNSTCM(); !ROUND - LEAVE RESULT IN C2H
IF .C2H EQL #201400000000 THEN
CNODE[SSIZONE]_1
ELSE IF .C2H EQL #576400000000
THEN
SSIZMINUSONEFLG_TRUE
END ELSE
IF .DOSTEPSIZ[VALTP1] EQL INTEG1 THEN
BEGIN
IF .DOSTEPSIZ[CONST2] EQL 1 THEN
CNODE[SSIZONE]_1
ELSE IF .DOSTEPSIZ[CONST2] EQL -1 THEN
SSIZMINUSONEFLG_TRUE
END
ELSE
%(***FOR DOUBLE PRECISION AND COMPLEX - DONT BOTHER OPTIMIZING THE -1 CASE***)%
BEGIN
IF .DOSTEPSIZ[CONST1] EQL #201400000000 AND .DOSTEPSIZ[CONST2] EQL 0
THEN CNODE[SSIZONE]_1
END;
END
%2011% ELSE ! Step size is not a constant
%2011% BEGIN
%2011% ! Step size must be stored in a temporary. Make an
%2011% ! assignment statement for it and put it in front of
%2011% ! the DO statement.
%2011%
NAME<LEFT>_ASGNSIZ+SRCSIZ;
OPEXPR_CORMAN();
!LINK IT IN
DOCESSOR[SRCLINK]_.OPEXPR;
OPEXPR[SRCLINK]_.CNODE;
!SET VAL FLG IN STATEMENT NODE
OPEXPR[A1VALFLG]_1;
OPEXPR[OPRCLS]_STATEMENT;
OPEXPR[SRCID]_ASGNID;
OPEXPR[LHEXP]_SSIZTMP(.DOSTEPSIZ[VALTYPE]);
OPEXPR[RHEXP]_.DOSTEPSIZ;
%2011% IF .DOSTEPSIZ[OPRCLS] EQL DATAOPR ! Is step a variable?
%2011% THEN OPEXPR[A2VALFLG] = 1 ! Yes, set val flag
%2011% ELSE DOSTEPSIZ[PARENT] = .OPEXPR; ! No, set parent field
!FIX FIELDS IN DO STATMENT NODE
CNODE[DOPRED]_.OPEXPR;
!FIX LOCALS
DOCESSOR_.OPEXPR;
DOSTEPSIZ_.OPEXPR[LHEXP];
!SET FLAG
CNODE[SSIZINTMP]_1;
!MOVE THE LABEL BACK
ADJLAB;
END;
CNODE[DOSSIZE]_.DOSTEPSIZ;
CNODE[DOCTLVAR]_SSIZTMP(INTEGER);
PEXPR_0;
%(***SET "PEXPR" TO POINT TO AN EXPRESSION NODE FOR "M2-M1"
THIS WILL BE USED IN THE COMPUTATION OF THE LOOP ITERATION CT***)%
IF .DOULIM[OPR1] EQL CONSTFL AND .DOINITL[OPR1] EQL CONSTFL THEN
BEGIN
COPRIX_KKARITHOP(.DOINITL[VALTP1],SUBOP);
C1H_.DOULIM[CONST1];
C1L_.DOULIM[CONST2];
C2H_.DOINITL[CONST1];
C2L_.DOINITL[CONST2];
CNSTCM();
PEXPR_MAKECNST(.DOINITL[VALTYPE],.C2H,.C2L);
END
ELSE
!IF NOT BOTH CONSTANTS, BUILD EXPRESSION
BEGIN
!BUILD AN EXPRESSION NODE
!CHECK THE PROPERTIES OF THE INITIAL VALUE
!BAD RESULTS (IN CODE) IF IT IS A CONSTANT EXPRESSION
!AS WE WILL NOT FOLD IT HERE
!IF INITIAL VAL IS AN EXPRESSION, BUILD AN ASSIGNMENT
!STMNT TO A TEMPORARY FOR THAT EXPRESSION
!INSERT THAT ASSIGNMENT STMNT BEFORE THE DO STMNT
IF .DOINITL[OPRCLS] NEQ DATAOPR THEN
BEGIN
CNODE[INITLTMP]_1; !SET FLAG
!MAKE AN ASSIGNMENT STATEMENT FOR IT
!OPEXPR IS USED AS A TEMPORARY
NAME<LEFT>_ASGNSIZ+SRCSIZ;
OPEXPR_CORMAN();
!LINK IT IN FRONT OF THE DO STATEMENT
DOCESSOR[SRCLINK]_.OPEXPR;
OPEXPR[SRCLINK]_.CNODE;
!SET APPROPRIATE FLAGS
OPEXPR[A1VALFLG]_1; !THE TEMP
OPEXPR[OPRCLS]_STATEMENT;
OPEXPR[SRCID]_ASGNID;
!GENERATE TEMPORARY
!FOR INITIAL
!VALUE
OPEXPR[LHEXP]_INITLTEMP(.DOINITL[VALTYPE]);
OPEXPR[RHEXP]_.DOINITL;
DOINITL[PARENT]_.OPEXPR;
!RESET DOPRED IN THE DO STATEMENT
CNODE[DOPRED]_.OPEXPR;
!RESET MY LOCALS FOR THE RIGHT THING
DOINITL_.OPEXPR[LHEXP];
DOCESSOR_.OPEXPR;
!MOVE THE LABEL BACK IF THERE IS ONE
ADJLAB;
END;
%(***MAKE EXPRESSION NODE FOR FINAL VALUE(POSSIBLY AN EXPRESSION)
MINUS INITIAL VALUE (ALWAYS EITHER A DATAOPR OR THE REGCONTENTS
NODE JUST BUILT) ****)%
PEXPR_MAKPR1(.CNODE,ARITHMETIC,SUBOP,.DOULIM[VALTYPE],.DOULIM,.DOINITL);
PEXPR[A2VALFLG]_1; !ARG2 OF THE SUBTRACT IS EITHER A DATAOPR OR A REGCONTENTS
! HENCE SHOULD ALWAYS HAVE VALFLG SET ABOVE IT
OPEXPR_.PEXPR[ARG1PTR]; !IF ARG1 IS A DATAOPR, SET THE VALFLG ABOVE IT
PEXPR[A1VALFLG]_.OPEXPR[OPRCLS] EQL DATAOPR;
END;
!**;[1204], DOXPN @3455, DCE, 25-Nov-80
!**;[1204], Modify the calculation of the loop control expression to conform
!**;[1204], to the F77 standard. Preserve the F66 behavior under switch control.
%[1204]% !NOW MAKE THE LOOP CONTROL EXPRESSION
%[1204]%
%[1204]% ! We have computed the expression M2-M1. Using this and the stepsize M3,
%[1204]% ! it is time to create the loop control expression. We try for a
%[1204]% ! constant expression first; if not possible, then build the loop
%[1204]% ! control expression by hand to be: (M2-M1+M3)/M3. Observe that
%[1204]% ! one tries to be clever with M3 if it is +1 or -1.
%[1204]%
%[1204]% IF .PEXPR[OPR1] EQL CONSTFL AND .DOSTEPSIZ[OPR1] EQL CONSTFL
%[1204]% THEN ! Everyting in sight is a constant (wonderful!)
%[1204]% BEGIN
%2002% COPRIX_KKARITHOP(.PEXPR[VALTP1],ADDOP);
%2002% C1H_.PEXPR[CONST1];
%2002% C1L_.PEXPR[CONST2];
%2002% C2H_.DOSTEPSIZ[CONST1];
%2002% C2L_.DOSTEPSIZ[CONST2];
%2002% CNSTCM();
%2002% PEXPR_MAKECNST(.PEXPR[VALTYPE],.C2H,.C2L); ! M2-M1+M3
%2002%
%2002% IF .SSIZMINUSONEFLG THEN
%2002% PEXPR_NEGCNST(PEXPR) ! -(M2-M1+M3)
%2002% ELSE IF NOT .CNODE[SSIZONE] THEN
%2002% BEGIN
%[1204]% ! Now divide by the stepsize M3
%[1204]%
%[1204]% COPRIX_KKARITHOP(.PEXPR[VALTP1],DIVOP);
%[1204]% C1H_.PEXPR[CONST1];
%[1204]% C1L_.PEXPR[CONST2];
%[1204]% C2H_.DOSTEPSIZ[CONST1];
%[1204]% C2L_.DOSTEPSIZ[CONST2];
%[1204]% CNSTCM();
%[1204]% PEXPR_MAKECNST(.PEXPR[VALTYPE],.C2H,.C2L); ! (M2-M1+M3)/M3
%[1204]% END;
%[1204]%
%[1204]% ! We are done with computing the loop trip count. We need
%[1204]% ! to put on the finishing touches - convert to integer type,
%[1204]% ! and check for zero trip cases both F66 and F77.
%[1204]%
%[1204]% IF .PEXPR[VALTYPE] NEQ INTEGER
%[1204]% THEN PEXPR_CNVNODE(.PEXPR,INTEGER,0);
%[1204]%
%[1204]% IF .PEXPR[CONST2] LEQ 0 THEN
%[1204]% IF F77 THEN
%[1204]% BEGIN
%[1204]% PEXPR_MAKECNST(INTEGER,0,0);
%[1204]% CNODE[MAYBEZTRIP]_1
%[1204]% END
%[1204]% ELSE PEXPR_MAKECNST(INTEGER,0,1); ! For F66, 1 trip loop
%[1204]% END ! Of case where everything is a constant
%[1204]% ELSE ! Either M2-M1 is non-constant or M3 is non-constant.
%[1204]% ! We need to build an expression (sigh).
%[1204]% BEGIN
%[1204]% CNODE[MAYBEZTRIP]_1;
%2002% PEXPR_MAKPR1(.CNODE,ARITHMETIC,ADDOP,.PEXPR[VALTYPE],
%2002% .PEXPR,.DOSTEPSIZ); ! M2-M1+M3
%2002% IF .SSIZMINUSONEFLG THEN
%2002% PEXPR_MAKPR1(.CNODE,NEGNOT,NEGOP,.PEXPR[VALTYPE]
%2002% ,0,.PEXPR) ! -(M2-M1+M3)
%2002% ELSE IF NOT .CNODE[SSIZONE] THEN
%2002% PEXPR_MAKPR1(.CNODE,ARITHMETIC,DIVOP,.PEXPR[VALTYPE],
%2002% .PEXPR,.DOSTEPSIZ); ! (M2-M1+M3)/M3
%[1204]%
%[1204]% IF .PEXPR[VALTYPE] NEQ INTEGER
%[1204]% THEN PEXPR_CNVNODE(.PEXPR,INTEGER,0);
%[1204]% END; ! Of case where there is a non-constant
!IF LOOP CAN BE HANDLED WITH AN AOBJN, MAKE LOOP CONTROL CONSTANT
IF .PEXPR[OPR1] EQL CONSTFL !NUMBER OF ITERATIONS A COMPILE TIME CONSTANT
AND NOT .CNODE[REALARITH] ! LOOP INDEX MUST BE INTEGER
AND .CNODE[SSIZONE] !STEP SIZE MUST BE ONE
AND .DOINITL[CONST2] LEQ #377777 !LOWER BOUND ON INDEX MUST BE LESS THAN 17 BITS
AND .DOINITL[CONST2] GEQ 0 ! AND MUST BE POSITIVE
AND .DOULIM[CONST2] LEQ #377777 !UPPER BOUND ON INDEX MUST BE LESS THAN 17 BITS
AND .DOULIM[CONST2] GEQ 0 ! AND MUST BE POSITIVE
THEN
BEGIN
PEXPR_MAKECNST(INTEGER,0,-.PEXPR[CONST2]^18+.DOINITL[CONST2]);
CNODE[SSIZONE]_0; !RESET ALL OTHER FLAGS
CNODE[FLCWD]_1;
END ELSE
!SET SOME OTHER FLAGS DESCRIBING THE CONTROL WORD (IF ITS CONSTANT)
IF .PEXPR[OPR1] EQL CONSTFL THEN
BEGIN
%(***IF THE NUMBER OF TIMES THAT THE LOOP IS TO BE EXECUTED IS A POS
NUMBER THAT CAN BE USED IMMEDIATE MODE, DO SO. FOR A NEG
ITERATION COUNT, DONT BOTHER. (NOTE THAT CAN COUNT ON THE CT BEING
AN INTEGER***)%
IF .PEXPR[CONST2] LEQ #777777
THEN
CNODE[CTLIMMED]_1;
CNODE[CTLNEG]_1;
END ELSE
IF .PEXPR[OPRCLS] EQL DATAOPR THEN
CNODE[CTLNEG]_1
ELSE
!INSERT THE NEGATE NODE NEEDED
PEXPR_MAKPR1(.CNODE,NEGNOT,NEGOP,INTEGER,0,.PEXPR);
CNODE[DOLPCTL]_.PEXPR;
CNODE[DOM1]_.DOINITL; !INITIAL VALUE FOR LOOP INDEX
END;
EXTERNAL
SSIZTC, !COUNTER FOR STEP SIZE TEMPS
!GENERATED FOR DO LOOPS
INTLTC; !COUNTER FOR TEMPS GENERATED
!FOR DO LOOP INITIAL VALUES
%*****
NOTE THAT THE NAMES WILL NOT BE UNIQUE OR VALID IF THERE
ARE MORE THAN 9999 FOR EACH
*****%
GLOBAL ROUTINE SSIZTMP(SSIZ)=
BEGIN
EXTERNAL TBLSEARCH;
! Create a step size temporary for DO loops
REGISTER BASE STPTMP;
NAME_IDTAB;
%4515% ENTRY[0] = ONEWPTR(SIXBIT'.S'+MAKNAME(SSIZTC));
SSIZTC_.SSIZTC+1;
STPTMP_TBLSEARCH(); ! Look up the name
STPTMP[VALTYPE]_.SSIZ; ! Set the value type of the variable
STPTMP[IDATTRIBUT(NOALLOC)]_0; ! Clear NOALLOC bit for phase 1
%1505% STPTMP[IDPSECT] = PSDATA; ! Put it in .DATA.
RETURN .STPTMP
END;
GLOBAL ROUTINE INITLTEMP(IVAL)=
BEGIN
EXTERNAL TBLSEARCH;
! Make an initial value temporary
REGISTER BASE ITLTMP;
NAME = IDTAB;
%4515% ENTRY[0] = ONEWPTR(SIXBIT'.I'+MAKNAME(INTLTC));
INTLTC = .INTLTC+1;
ITLTMP = TBLSEARCH();
ITLTMP[VALTYPE] = .IVAL; ! IVAL is the initial value type
ITLTMP[IDATTRIBUT(NOALLOC)] = 0; ! Clear NOALLOC bit for phase 1
%1505% ITLTMP[IDPSECT] = PSDATA; ! Put it in .DATA.
RETURN .ITLTMP
END;
GLOBAL ROUTINE IODOXPN(IOSTMNT)=
%(***************************************************************************
ROUTINE TO WALK THRU AN IOLIST AND PERFORM DOXPN ON ALL IMPLICIT
DO STMNT NODES. SETS THE "DOPRED" FIELD OF EACH DO STMNT NODE
BEFORE CALLING DOXPN.
CALLED WITH A PTR TO THE IO STMNT FOR WHICH THE IOLIST IS TO BE
PROCESSED.
***************************************************************************)%
BEGIN
EXTERNAL CORMAN;
MAP BASE IOSTMNT;
OWN PEXPRNODE IOLPTR;
OWN PEXPRNODE PRVELEM; !PTR TO THE ELEMENT IN THE IOLIST PRECEEDING
! THE ELEMENT POINTED TO BY IOLPTR
![1143] The following code used to increment the reference counts of the
![1143] labels used after ERR= or END= in "data transfer" statments because
![1143] the labels were lexically parsed as integer constants and never had
![1143] their counts bumped by one. Edit 760 made the front end routines for
![1143] "data transfer" and "device control" statements use the routine LABREF
![1143] which incremented the count correctly. Unfortunately, IODOXPN was
![1143] still incrementing the counts, so code written for edit 760
![1143] decremented the counts to even things out. This made the counts for
![1143] labels referenced by "device control" statements incorrect because
![1143] they don't go through here, so edit 1136 removed the decrement
![1143] inserted in edit 760. At this point, labels used by "data transfer"
![1143] statements were wrong because they were still being incremented here.
![1143] So the final solution is to get rid of this code entirely.
![1143] !PHASE ONE IS NOT COUNTING END=,ERR= LABEL REFERENCES
![1143] !SO WE WILL COUNT THEM NOW
![1143] IF (IOLPTR_.IOSTMNT[IOEND]) NEQ 0 THEN
![1143] IOLPTR[SNREFNO]_.IOLPTR[SNREFNO]+1;
![1143]
![1143] IF (IOLPTR_.IOSTMNT[IOERR]) NEQ 0 THEN
![1143] IOLPTR[SNREFNO]_.IOLPTR[SNREFNO]+1;
IF (IOLPTR_.IOSTMNT[IOLIST]) EQL 0
THEN RETURN; !IF STMNT HAS NO IOLIST
%(***IF THE FIRST ELEMENT IN THE IOLIST IS A DO-STMNT, INSERT A
CONTINUE STMNT IN FRONT OF IT FOR THE "DOPRED" FIELD
OF THE DO STMNT TO POINT BACK TO***)%
IF .IOLPTR[OPERATOR] EQL DOSTATEMENT
THEN
BEGIN
NAME_CONTDATA;
PRVELEM_CORMAN();
PRVELEM[OPERATOR]_CONTSTATEMENT;
PRVELEM[CLINK]_.IOLPTR;
IOSTMNT[IOLIST]_.PRVELEM;
END;
%(***WALK THRU SUCCESSIVE ELEMS OF THE IOLIST. SET THE "DOPRED" FIELD
OF EACH DO-STMNT NODE TO PT TO THE NODE PRECEEDING IT. CALL
DOXPN FOR EACH DO STMNT NODE***)%
%(** IF HAVE AN EXPRESSION NODE UNDER A DATACALL, FILL
IN THE PARENT POINTER)%
UNTIL .IOLPTR EQL 0
DO
BEGIN
IF .IOLPTR[OPERATOR] EQL DOSTATEMENT
THEN
BEGIN
IOLPTR[DOPRED]_.PRVELEM;
DOXPN(.IOLPTR);
END
ELSE
IF .IOLPTR[OPERATOR] EQL DATACLFL
THEN
BEGIN
OWN PEXPRNODE T;
T _ .IOLPTR[DCALLELEM];
IF .T NEQ 0 !IF THERE WAS AN ERROR FOUND WHEN
! PROCESSING THIS DATA ELEMNT (EG
! AN ILLEGAL ARRAYREF)
THEN
BEGIN
IF .T[OPRCLS] NEQ DATAOPR
THEN
T[PARENT] _ .IOLPTR
END;
END;
%(***GO ON TO THE NEXT ELEMENT***)%
PRVELEM_.IOLPTR;
IOLPTR_.IOLPTR[CLINK];
END;
END;
FORWARD ALLONES;
ROUTINE ADJGEN(DTABB,ARY)=
BEGIN
!GENERATE ACTUAL FN(CALL STATEMENT)
!NODE FOR CALL TO RUN-TIME
!ROUTINES FOR ADJUSTABLE DIMENSIONS
LABEL ARGDO;
%1413% LOCAL ARGNUM; !Number of arguments for call to ADJ*
OWN BASE CALNODE;
EXTERNAL BASE CSTMNT,CORMAN,ONEPLIT;
EXTERNAL TBLSEARCH;
MAP BASE DTABB: ARY;
OWN BASE G:ROUT:DNUM:J;
OWN DIMSUBENTRY DSUBETRY;
OWN ARGUMENTLIST CLNODLST;
BTTMSTFNFLG_FALSE; !IF INSERT A CALL TO ADJUST, THIS ROUTINE IS NO LONGER "BOTTOMMOST"
NAME<LEFT>_CALLSIZ+SRCSIZ;
CALNODE_CORMAN();
CALNODE[SRCLINK]_.CSTMNT[SRCLINK];
CSTMNT[SRCLINK]_.CALNODE;
CALNODE[OPRCLS]_STATEMENT;
CALNODE[SRCID]_CALLID;
G_ALLONES(.DTABB);
!THE SPECIAL PURPOSE ROUTINE FOR ALL LOWER BOUND OF
!ONE WILL BE CALLED ONLY IF IT IS ALSO TRUE THAT
!ALL DIMENSIONS ARE ADJUSTABLE. WE NOW DETERMINE THAT FACT
!BY SEEING IF THE SECOND ONE IS ADJUSTABLE. THE
!FIRST ONE ALWAYS HAS A FACTOR OF ONE .
%[1250] ***** REMOVE, SEE WHAT BREAKS *****
IF .DTABB[DIMNUM] GTR 1 THEN
BEGIN
DSUBETRY_DTABB[FIRSTDIM]+DIMSUBSIZE; !SECOND ONE
IF NOT .DSUBETRY[VARFACTFLG] THEN G_0;
END;
[1250]%
%1250% IF .ARY[VALTYPE] NEQ CHARACTER
%1250% THEN
IF .G
THEN ENTRY _ SIXBIT'ADJ1. '
ELSE ENTRY _ SIXBIT'ADJG. '
%1250% ELSE
%1250% IF .G
%1250% THEN ENTRY _ SIXBIT'ADJC1.'
%1250% ELSE ENTRY _ SIXBIT'ADJCG.';
%4515% ENTRY = ONEWPTR(.ENTRY); ! [count,,pointer]
NAME_IDTAB;
ROUT_TBLSEARCH();
!FILL IN THE POINTER TO THE FUNCTION NAME
CALNODE[CALSYM]_.ROUT;
IF NOT .FLAG ! If we have just created a new STE
THEN
BEGIN
ROUT[OPERSP]_FNNAME;
ROUT[IDLIBFNFLG]_1
END;
DNUM_.DTABB[DIMNUM];
!COMPOSE THE ARGUMENT LIST FOR A CALL TO
!ADJ1.OR ADJG.
%1250% !OR ADJC1. OR ADJCG.
!First get the core for the list
%1413% ARGNUM _ (3-.G)*(.DNUM)+4; !Number of arguments
%1413% NAME<LEFT> _ ARGLSTSIZE(.ARGNUM);
!FOR EACH DIMENSION
!ONE WORD FOR U(I) !MAYBE ONE FDR L(I)
!ONE WORD FOR MULT(I)
!=(2 OR 3)*DNUM
!+
!ONE WORD FOR OFFSET
!+
!ONE WORD FOR NUMBER OF DIMENSIONS
!+
!WORD THAT CONTAINS NUMBER OF PARAMETERS
!+
!ZERO HEADER WORD (FILLED IN IN CODE
!GENERATION WITH LABEL FOR GENERATED
!ARG LIST)
!+
!WORD FOR ARRAY SIZE
!+
!WORD FOR BASE ADDRESS OF ARRAY
CLNODLST _ CALNODE[CALLIST] _ CORMAN();
!FILL IN ARG LIST
!First the number of arguments
%1413% CLNODLST[ARGCOUNT] _ .ARGNUM;
!NOW FILL IN THE ARGUMENT LIST.
!J POINTS TO ARG ENTRY WHILE THE INCR LOOP
!GOES THROUGH ALL DIMENSIONS
!THE FIRST ARGUMENT WE WILL FIRST FILL IN IS UB(1)
!WHUCH IS THE FOURTH ARGUMENT,THUS J=4.
!THEN MULT(2) WHICH IS THE DIMFACTOR FROM THE
!DIMENSION SUBENTRY AFTER THE ONE CONTAINING UB(1).
J_6;
DSUBETRY_DTABB[FIRSTDIM];
!IN ORDER FOR THE LOOP TO OPERATE CORRECTLY, WE ARE
!NOT DOING WHAT IT APPEARS WE ARE DOING. WE WILL
!FILL IN MULT(1), UB(1),.....MULT(N),UB(N) AND
!THEN SINCE MULT(1) IS SPECIAL REALLY FILL IT IT LATER
!ROUT WILL BE USED AS A TEMP TO
!HELP US SAVE THE RIGHT THING TO PUT INTO MULT(1)
!LATER.
!A DOUBLE PRECISION OR COMPLEX ARRAY STARTS OUT AT TWO
%1250% !A CHARACTER ARRAY USES A .I TEMP FOR MULT(1). IT'S FILLED IN
%1250% !AT RUNTIME BY ADJC.
%1250% IF .ARY[VALTYPE] EQL CHARACTER
%1250% THEN ROUT _ .DSUBETRY[DIMFACTOR]
ELSE IF .ARY[DBLFLG]
THEN ROUT_MAKECNST(INTEGER,0,2)
ELSE ROUT_.ONEPLIT;
ARGDO:
INCR I FROM 1 TO .DNUM DO
BEGIN
!HOLE FOR PARTIALLY CONSTANT ONES
%1670% LOCAL PEXPRNODE E;
!**; [1746] ADJGEN, 4697, CDM, 2-May-83
%1746% E = .DSUBETRY[DIMUB]; ! upper bound dismens
%1746% CLNODLST[.J,AVALFLG] = 1;
%1746% ! Either assign dimension espression, or the
%1746% ! .Innnn that expression is assigned into.
%1670% IF .E[OPRCLS] EQL DATAOPR
%1746% THEN CLNODLST[.J,ARGNPTR] = .E ! Expr given
%1746% ELSE CLNODLST[.J,ARGNPTR] = ! make .Innnn
%1746% DSUBETRY[DIMUB] = DOTIASGN(.E);
IF NOT .G THEN
BEGIN
!ALL LOWER BOUNDS ARE NOT 1
J_.J+1;
!**; [1746] ADJGEN, 4705, CDM, 2-May-83
%1746% E = .DSUBETRY[DIMLB]; ! Lower bound dimens
%1746% CLNODLST[.J,AVALFLG] = 1;
%1746% ! Either assign dimension espression, or the
%1746% ! .Innnn that expression is assigned into.
%1670% IF .E[OPRCLS] EQL DATAOPR
%1746% THEN CLNODLST[.J,ARGNPTR] = .E ! As is
%1746% ELSE CLNODLST[.J,ARGNPTR] = ! .Innnn
%1746% DSUBETRY[DIMLB] =
%1746% DOTIASGN(.E);
END;
!DONT PUT OUT FACTOR FOR LAST ONE
IF .I EQL .DNUM THEN LEAVE ARGDO;
DSUBETRY_.DSUBETRY+DIMSUBSIZE;
J_.J+1;
CLNODLST[.J,ARGNPTR]_.DSUBETRY[DIMFACTOR];
CLNODLST[.J,AVALFLG]_1;
J_.J+1;
END; !INCR LOOP
!FILL IN ARGUMENT 1, THE NUMBER
!OF DIMENSIONS
CLNODLST[1,ARGNPTR]_MAKECNST(INTEGER,0,.DNUM);
CLNODLST[1,AVALFLG]_1;
!FILL IN ARRAY SIZE
CLNODLST[2,ARGNPTR]_.DTABB[ARASIZ];
CLNODLST[2,AVALFLG]_1;
!FILL IN ARGUMENT 2, BASE ADDRESS OF ARRAY
CLNODLST[3,ARGNPTR]_.ARY;
CLNODLST[3,AVALFLG]_1;
!FILL IN ARGUMENT 4, THE ARRAY OFFSET
CLNODLST[4,ARGNPTR]_.DTABB[ARAOFFSET];
CLNODLST[4,AVALFLG]_1;
!FILL IN MULT(1)
CLNODLST[5,ARGNPTR]_.ROUT;
CLNODLST[5,AVALFLG]_1;
END; ! of ADJGEN
!**; [1746], add routine after ADJGEN, 4737, CDM, 2-May-83
ROUTINE DOTIASGN(EXPR)= ![1746] NEW
BEGIN
! Make an assignment statement
! .Innnn = expr
! Inserts created assignment node after CSTMNT.
! Returns: symbol table entry for .Innnn created.
REGISTER
BASE ASGN, ! Assignment statement created
BASE DOTI; ! .Innnn variable
MAP BASE EXPR; ! Expression assigned to .Innnn
NAME<LEFT> = ASGNSIZ + SRCSIZ;
ASGN = CORMAN(); ! Get node for assignment
EXPR[PARENT] = .ASGN; ! Parent pointer of expression
ASGN[OPRS] = ASGNOS; ! Operator fields
ASGN[LHEXP] = DOTI = INITLTEMP(.EXPR[VALTYPE]); ! LH expression (.I)
ASGN[RHEXP] = .EXPR; ! RH expression (expression in stmnt)
ASGN[A1VALFLG] = 1; ! LH expression is a leaf.
ASGN[SRCLINK] = .CSTMNT[SRCLINK]; ! Link into statements
CSTMNT[SRCLINK] = .ASGN;
RETURN .DOTI; ! Return .Innnn variable of the statement
END; ! of DOTIASGN
ROUTINE ALLONES(DTABB)=
BEGIN
!LOOK THROUGH DIMENSION TABLE ENTRY
!TO SEE IF ALL LOWER BOUNDS ARE 1.
!RETURN 1 (TRUE) IF THEY ARE AND
!0 (FALSE) IF NOT
EXTERNAL ONEPLIT;
OWN DNUM,DSUBETRY;
MAP PEXPRNODE DTABB;
MAP DIMSUBENTRY DSUBETRY;
DNUM_.DTABB[DIMNUM];
DSUBETRY_DTABB[FIRSTDIM]; !POINT TO FIRST SUBENTRY
INCR I FROM 1 TO .DNUM DO
BEGIN
IF .DSUBETRY[DIMLB] NEQ .ONEPLIT
THEN
RETURN(0)
ELSE
DSUBETRY_.DSUBETRY+DIMSUBSIZE;
END;
RETURN 1
END;
GLOBAL ROUTINE ADJCALL=
BEGIN
!INSERT CALL STATEMENT NODES FOR ADJUSTABLY DIMENSIONED
!ARRAYS TO CALL THE OBJECT TIME ROUTINES
!ADJ1. OR ADJG. TO COMPUTE FACTORS AND OFFSET
EXTERNAL CSTMNT,CHOSEN,ENTRY,NAME,CORMAN;
EXTERNAL VERYFRST,QQ;
OWN DTABB,CLST,CALNODE,CLNODLST,G,CLSTARG;
MAP ARGUMENTLIST CLNODLST:CLST;
MAP BASE CSTMNT:DTABB:CLSTARG;
%772% EXTERNAL FATLERR,E126;
%772% OWN DIMSUBENTRY DSUBETRY;
%772% MAP BASE G; ! SYMBOL TEMP FOR ADJCAL
VERYFRST_0;
CSTMNT_.SORCPTR<LEFT>;
WHILE .CSTMNT NEQ 0 DO
BEGIN
!IF ITS AN ENTRY
IF .CSTMNT[SRCID] EQL ENTRID THEN
!IF THERE ARE PARAMETERS
IF .CSTMNT[CALLIST] NEQ 0 THEN
BEGIN
CLST_.CSTMNT[CALLIST];
INCR I FROM 1 TO .CLST[ARGCOUNT] DO
BEGIN
CLSTARG_.CLST[.I,ARGNPTR];
!IF AN ARRAY LOOK TO SEE
!IF IT IS ADJUSTABLE
IF .CLSTARG[OPR1] EQL
OPR1C(DATAOPR,FORMLARRAY)
THEN
BEGIN
DTABB_.CLSTARG[IDDIM];
!LOOK TO SEE IF IT IS
!ADJUSTABLY DIMENSIONED
![772] If this is indeed a variable DIMENSIONed array, generate the
![772] run-time call, and check the dimension information one last
![772] time to catch the case where a variable dimension subscript
![772] variable has later been DIMENSIONed itself.
%772% IF .DTABB[ADJDIMFLG]
%772% THEN
%772% BEGIN
%2451% IF NOT .CLSTARG[IDATTRIBUT(NOALLOC)]
%2451% THEN ADJGEN(.DTABB,.CLSTARG);
%772% DSUBETRY_DTABB[FIRSTDIM]<0,0>;
%772% INCR J FROM 1 TO .DTABB[DIMNUM] DO
%772% BEGIN
%772% G_.DSUBETRY[DIMLB];
%772% IF .DSUBETRY[VARLBFLG] AND
%772% .G[IDDIM] NEQ 0
%772% THEN
%772% FATLERR(.G[IDSYMBOL],0,E126<0,0>);
%772% G_.DSUBETRY[DIMUB];
%772% IF .DSUBETRY[VARUBFLG] AND
%772% .G[IDDIM] NEQ 0
%772% THEN
%772% FATLERR(.G[IDSYMBOL],0,E126<0,0>);
%772% DSUBETRY_.DSUBETRY+DIMSUBSIZE;
%772% END;
%772% END;
END;
END;
END;
CSTMNT_.CSTMNT[SRCLINK];
END;
END;