Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/ftncsr/ver5.bli
There are 12 other files named ver5.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 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: STAN WHITLOCK/TFV/TJK/AlB/CDM
MODULE VER5(RESERVE(0,1,2,3),SREG = #17,VREG = #15,FREG = #16,DREGS = 4,START)=
BEGIN
! REQUIRES FIRST, TABLES, OPTMAC
GLOBAL BIND VER5V = #11^24 + 0^18 + #4504; ! Version Date: 22-Jan-85
%(
***** Begin Revision History *****
2 437 QAR771 PASS ORFIXFLG UP TO SUBSUMER IN DOTOFIX, (SJW)
3 505 QAR815 IN DOTORFIX MOVE MODIFIED .R INIT TO BEFORE
TOP ONLY IF NOT ALREADY THERE, (SJW)
4 515 QAR815 REMOVE "TEMP [EXPRUSE] = 1" IN DOTORFIX, (SJW)
***** Begin Version 5A ***** 7-Nov-76
5 525 QAR949 DO CORRECT TYPECNV IN DOTOFIX ONLY IF NECESSARY, (SJW)
***** Begin Version 5B ***** 19-Dec-77
6 631 10962 TEACH VER5 HOW TO ZERO DEF POINTS IN IOLISTS, (JNG)
***** Begin Version 7 *****
7 1245 TFV 3-Aug-81 ------
Fix definition of REGSTUFF. IDCHOS, IDUSED, IDDEF were moved from
word 2 to word 8 of symbol table entry. The left half of word 8
also contains the PSECT field so we can not just clear the left half.
***** End Revision History *****
***** Begin Version 10 *****
2211 TFV 18-Aug-83
Add INQUIRE case to ZSTATEMENT. Create routines ZDEFIO and
ZDEFOCI to process I/O specifiers.
2212 CDM 30-Aug-83
Fix for edit 2211. Check if IOFORM is a half word of -1 rather
than a full word.
2372 TJK 14-Jun-84
Add cases in ZDEFPT for SUBSTRING and CONCATENATION.
2427 AlB 17-Jul-84
REGSTUFF used to be defined in DFCLEANUP to clear some fields in STE
word 2, and was also defined (differently) in CLEANUP of module GOPT2
to clear some other fields. This edit uses IDCLEANA instead of
REGSTUFF; IDCLEANA is now defined in FIRST.
Note that the fields being cleared have been moved out of word 2
and placed into word 8.
2507 CDM 21-Dec-84
Move IDDOTF to FIRST.
***** End V10 Development *****
***** End Revision History *****
***** Begin Version 11 *****
4500 MEM 22-Jan-85
Zero the definition points for the expressions for keys pointed to
by IOKEY for OPEN statement nodes.
4502 MEM 22-Jan-85
Modify ZSTATEMENT for DELETE statement.
4503 MEM 22-Jan-85
Modify ZSTATEMENT for REWRITE statement.
4504 MEM 22-Jan-85
Modify ZSTATEMENT for UNLOCK statement.
ENDV11
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE OPTMAC.BLI;
SWITCHES LIST;
FORWARD
%631% ZIOLIST(1), !CALLED FROM ZDEFPT AND ZSTATEMENT
%631% ZDEFPT(1), !CALLED FROM ZIOLIST
%2211% ZDEFIO(1),
%2211% ZDEFOCI(1),
%631% ZSTATEMENT(1), !CALLED FROM ZDEFPT
ZTREE,
UNBUSY(1),
DOTORFIX(2),
DOTOFIX(2),
DFCLEANUP;
ROUTINE ZIOLIST(LIST)=
BEGIN
MAP BASE LIST; ![631]
%631% WHILE .LIST NEQ 0 DO
%631% BEGIN
%631% ZDEFPT(.LIST);
%631% LIST = .LIST[CLINK]
%631% END
END; ! of ZIOLIST ![631]
ROUTINE ZDEFPT(EXPR)=
BEGIN
! ZERO DEFINITION POINTS IN EXPRESSION
MAP PEXPRNODE EXPR;
! ZERO DEFPT FOR ARG 1
MACRO ZDEFPT1=
BEGIN
IF NOT .EXPR[A1VALFLG]
THEN ZDEFPT(.EXPR[ARG1PTR]);
EXPR[DEFPT1] = 0;
END$;
! ZERO DEFPT FOR ARG 2
MACRO ZDEFPT2=
BEGIN
IF NOT .EXPR[A2VALFLG]
THEN ZDEFPT(.EXPR[ARG2PTR]);
EXPR[DEFPT2] = 0;
END$;
IF .EXPR EQL 0
THEN RETURN;
CASE .EXPR [OPRCLS] OF SET
!BOOLEAN
BEGIN
ZDEFPT1;
ZDEFPT2;
END;
!DATAOPR
BEGIN END;
!REALTIONAL
BEGIN
ZDEFPT1;
ZDEFPT2;
END;
!FNCALL
BEGIN
LOCAL ARGUMENTLIST AG;
AG = .EXPR [ARG2PTR]; ! NEVER = 0
INCR I FROM 1 TO .AG [ARGCOUNT]
DO BEGIN
IF NOT .AG [.I, AVALFLG]
THEN ZDEFPT (.AG [.I, ARGNPTR]);
END;
END;
!ARITHMETIC
BEGIN
ZDEFPT1;
ZDEFPT2;
END;
!TYPECNV
BEGIN
ZDEFPT2;
END;
!ARRAYREF
BEGIN
EXPR [DEFPT1] = 0;
ZDEFPT2;
END;
!CMNSUB
BEGIN END; ! NONE GENERATED YET
!NEGNOT
BEGIN
ZDEFPT2;
END;
!SPECOP
BEGIN
ZDEFPT1;
END;
!FIELDREF
BEGIN END; ! UNUSED
!STORECLS
BEGIN END;
!REGCONTENTS
BEGIN END;
!LABOP
BEGIN END;
!STATEMENT
%631% BEGIN
%631% ZSTATEMENT(.EXPR) !CAN HAPPEN UNDER IOLISTS
%631% END;
!IOLSCLS
%631% BEGIN
%631% CASE .EXPR[OPERSP] OF
%631% SET
%631% !DATACALL
%631% ZDEFPT(.EXPR[DCALLELEM]);
%631% !SLISTCALL
%631% BEGIN
%631% ZDEFPT(.EXPR[SCALLELEM]);
%631% ZDEFPT(.EXPR[SCALLCT])
%631% END;
%631% !IOLSTCALL
%631% BEGIN
%631% ZIOLIST(.EXPR[IOLSTPTR]);
%631% ZIOLIST(.EXPR[IOLCOMNSUB])
%631% END;
%631% !E1LISTCALL
%631% BEGIN
%631% ZIOLIST(.EXPR[ELSTPTR]);
%631% ZIOLIST(.EXPR[IOLCOMNSUB])
%631% END;
%631% !E2LISTCALL
%631% BEGIN
%631% ZIOLIST(.EXPR[ELSTPTR]);
%631% ZIOLIST(.EXPR[IOLCOMNSUB])
%631% END;
%631% !ESNGLELEM
%631% ZDEFPT(.EXPR[DCALLELEM]);
%631% !EDBLELEM
%631% ZDEFPT(.EXPR[DCALLELEM])
%631% TES
%631% END;
!INLINFN
BEGIN
ZDEFPT1;
IF .EXPR [ARG2PTR] NEQ 0 ! NO ARG2 ON ABS
THEN ZDEFPT2;
END;
!SUBSTRING [2372]
%2372% BEGIN
%2372% ZDEFPT1; ! Upper bound
%2372% ZDEFPT2; ! Lower bound
%2372% ZDEFPT(.EXPR[ARG4PTR]); ! ARRAYREF or DATAOPR
%2372% EXPR[DEFPTSS] = 0; ! For SUBSTRING only
%2372% END;
!CONCATENATION [2372]
%2372% BEGIN
%2372% LOCAL ARGUMENTLIST AG;
%2372% AG = .EXPR[ARG2PTR]; ! Pointer to argument list
%2372%
%2372% INCR I FROM 2 TO .AG[ARGCOUNT] ! Skip first argument
%2372% DO
%2372% BEGIN ! For each argument
%2372%
%2372% IF NOT .AG[.I,AVALFLG]
%2372% THEN ZDEFPT(.AG[.I,ARGNPTR]);
%2372%
%2372% END; ! For each argument
%2372% END;
TES;
RETURN;
END; ! of ZDEFPT
ROUTINE ZDEFIO(SRC)= ![2211] New
BEGIN
!***************************************************************
! Zero definition points for UNIT, FMT, REC, IOSTAT, and IOLIST
! elements.
!***************************************************************
MAP BASE SRC;
REGISTER BASE TMP;
ZDEFPT(.SRC[IOUNIT]); ! Zero UNIT
! Zero FMT but ignore list-directed
%2212% IF (TMP = .SRC[IOFORM]) NEQ #777777 THEN ZDEFPT(.TMP);
ZDEFPT(.SRC[IORECORD]); ! Zero RECORD
ZDEFPT(.SRC[IOIOSTAT]); ! Zero IOSTAT
TMP = .SRC[IOLIST]; ! Zero IOLIST
WHILE .TMP NEQ 0 DO
BEGIN
ZDEFPT(.TMP);
TMP = .TMP[CLINK];
END
END; ! of ZDEFIO
ROUTINE ZDEFOCI(SRC)=
BEGIN
!***************************************************************
! Zero definition points for OPEN, CLOSE, and INQUIRE
! specifiers. elements.
!***************************************************************
%2211% ! Written by TFV on 18-Aug-83
MAP BASE SRC;
REGISTER OPENLIST OPENL;
%4500% LOCAL OPNKEYLIST KEYL;
ZDEFPT(.SRC[IOUNIT]); ! Zero UNIT
ZDEFPT(.SRC[IOFILE]); ! Zero FILE
ZDEFPT(.SRC[IOIOSTAT]); ! Zero IOSTAT
OPENL = .SRC[OPLST];
DECR I FROM .SRC[OPSIZ] - 1 TO 0 ! Zero other specifiers
DO ZDEFPT(.OPENL[.I,ARGNPTR]);
%4500% IF (KEYL = .SRC[IOKEY]) NEQ 0
%4500% THEN
%4500% BEGIN
%4500% DECR I FROM .KEYL[NUMKEYS] TO 1
%4500% DO
%4500% BEGIN
%4500% ZDEFPT(.KEYL[.I,KEYLOW]);
%4500% ZDEFPT(.KEYL[.I,KEYHIGH]);
%4500% END;
%4500% END;
END; ! of ZDEFOCI
ROUTINE ZSTATEMENT(SRC)=
BEGIN
!*********************************************************
! Zero definition points for expression under a statement.
!*********************************************************
%2211% ! Rewritten by TFV on 18-Aug-83
MAP BASE SRC;
REGISTER TMP;
CASE .SRC[SRCID] OF SET
BEGIN ! ASSIGNMENT
ZDEFPT(.SRC[RHEXP]);
ZDEFPT(.SRC[LHEXP]);
END; ! ASSIGNMENT
ZDEFPT(.SRC[ASISYM]); ! ASSIGN
BEGIN ! CALL
LOCAL ARGUMENTLIST AG;
IF (AG = .SRC[CALLIST]) NEQ 0
THEN DECR I FROM .AG[ARGCOUNT] TO 1 DO
IF NOT .AG[.I,AVALFLG]
THEN ZDEFPT(.AG[.I,ARGNPTR]);
END; ! CALL
BEGIN END; ! CONTINUE
BEGIN ! DO
ZDEFPT(.SRC[DOM1]); ! INITIAL EXPR
ZDEFPT(.SRC[DOM2]); ! FINAL EXPR
ZDEFPT(.SRC[DOM3]); ! INCR EXPR
ZDEFPT(.SRC[DOLPCTL]); ! CONTROL EXPR
END; ! DO
BEGIN END; ! ENTRY
BEGIN END; ! COMNSUB
BEGIN END; ! GOTO
ZDEFPT(.SRC[AGOTOLBL]); ! ASSIGNED GOTO
ZDEFPT(.SRC[CGOTOLBL]); ! COMPUTED GOTO
ZDEFPT(.SRC[AIFEXPR]); ! ARITHMETIC IF
BEGIN ! LOGICAL IF
ZDEFPT(.SRC[LIFEXPR]);
ZSTATEMENT(.SRC[LIFSTATE]);
END; ! LOGICAL IF
ZDEFPT(.SRC[RETEXPR]); ! RETURN
BEGIN END; ! STOP
ZDEFIO(.SRC); ! READ
ZDEFIO(.SRC); ! WRITE
ZDEFIO(.SRC); ! DECODE
ZDEFIO(.SRC); ! ENCODE
ZDEFIO(.SRC); ! REREAD
ZDEFIO(.SRC); ! FIND
ZDEFOCI(.SRC); ! CLOSE
%4502% ZDEFIO(.SRC); ! DELETE
%4503% ZDEFIO(.SRC); ! REWRITE
ZDEFIO(.SRC); ! BACKSPACE
ZDEFIO(.SRC); ! BACKFILE
ZDEFIO(.SRC); ! REWIND
ZDEFIO(.SRC); ! SKIPFILE
ZDEFIO(.SRC); ! SKIPRECORD
ZDEFIO(.SRC); ! UNLOAD
%4504% ZDEFIO(.SRC); ! UNLOCK
ZDEFIO(.SRC); ! ENDFILE
BEGIN END; ! END
BEGIN END; ! PAUSE
ZDEFOCI(.SRC); ! OPEN
BEGIN END; ! STATEMENT FUNCTION
BEGIN END; ! FORMAT
BEGIN END; ! BLTID
BEGIN END; ! REGMARK
ZDEFOCI(.SRC); ! INQUIRE
TES;
RETURN;
END; ! of ZSTATEMENT
GLOBAL ROUTINE ZTREE=
BEGIN
! ZERO DEFINITION POINTS IN ENTIRE TREE
! ZERO OUT ORFIXFLG, OMOVDCNS IN SYMTBL FOR .O VARS
! CALLED FROM MRP2 IN PHA2
EXTERNAL BASE SORCPTR;
LOCAL BASE PTR;
LOCAL BASE SRC;
PTR = .SORCPTR <LEFT>;
WHILE .PTR NEQ .SORCPTR <RIGHT>
DO BEGIN
SRC = .PTR; ! GET THIS STATEMENT
ZSTATEMENT (.SRC); ! ZERO IT
PTR = .SRC [SRCLINK]; ! TO NEXT STATEMENT
END;
DECR I FROM SSIZ-1 TO 0
DO BEGIN
PTR = .SYMTBL [.I];
WHILE .PTR NEQ 0
DO BEGIN
IF .PTR [IDDOTO] EQL SIXBIT ".O"
THEN PTR [TARGET] = 0;
PTR = .PTR [SRCLINK];
END; ! OF WHILE
END; ! OF DECR
RETURN;
END; ! of ZTREE
SWITCHES NOSPEC;
! UNLINK T FROM BUSY & POSTDOM LISTS
! CALLED FROM DOTOHASGN IN GCMNSB
! IF T IS FROM IMPLIED DO (NOW BEING MOVED AS CONSTANT), IT
! WON'T BE ON LISTS => IGNORE
GLOBAL ROUTINE UNBUSY(T)=
BEGIN
MAP PHAZ2 T; ! STATEMENT NODE PTR
EXTERNAL TOP;
MAP PHAZ2 TOP;
REGISTER PHAZ2 P;
LOCAL PHAZ2 OLDP; ! TO FIND END OF POSTDOM LIST
LABEL L;
P = .TOP; ! START SEARCH FOR RIGHT BROTHER
L: WHILE TRUE
DO BEGIN
IF .P EQL 0
THEN RETURN; ! T NOT ON BUSY LIST
IF .P [BUSY] EQL .T
THEN BEGIN
P [BUSY] = .T [BUSY];
LEAVE L; ! DONE WITH BUSY LIST
END;
P = .P [BUSY]; ! NEXT ELEMENT
END; ! OF L: WHILE TRUE DO
OLDP = P = .TOP; ! START SEARCH FOR RIGHT BROTHER
WHILE TRUE
DO BEGIN
IF .P [POSTDOM] EQL .T
THEN BEGIN
P [POSTDOM] = .T [POSTDOM];
RETURN; ! ALL DONE
END;
OLDP = .P; ! SAVE THIS ELEMENT
P = .P [POSTDOM]; ! NEXT ELEMENT
IF .P EQL .OLDP
THEN RETURN; ! T NOT ON POSTDOM LIST
END; ! OF WHILE TRUE DO
END; ! of UNBUSY
SWITCHES NOSPEC;
! REDUCE .R + X -> .O BECAUSE .R USE COUNT = 1
! SET & RETURN HASHP [TEMPER] <- .O CREATED
! NOTE X MUST BE LEAF SINCE MOVCNST HASHED .R + X FOR .O
! .R IS ALWAYS OF TYPE INTEGER
! X MUST BE SAME TYPE AS .R SINCE TO HASH .R + X, THERE
! CAN BE NO TYPECNV NODE IN BETWEEN + & X
! CALLED FROM MOVCNST IN GCMNSB
! IF .R IS REDUCED LOOP VAR
! THEN .R INIT IS DOM1 => DOM1 <- DOM1 + X
! BUT DOM1 ALWAYS VAR OR CNST NEVER EXPR =>
! MAKE .O' <- DOM1 + X STATEMENT BEFORE TOP
! & DOM1 <- .O'
! IF X = .O'' THEN .O' <- DOM1 + .O'' WILL BE AFTER
! .O'' <- E
! MUST PUT DOM1 + .O'' INTO HASH TBL FOR GLOBDEP
! .R INCR IS DOM3
! .R -> .O IN DOSYM => .O CANT MOVE OUTSIDE LOOP SO SET
! .O DEFPT <- TOP => SET .O HASHP [STPT] <- TOP
! MAKE DOM2 <- DOM2 + X FOR COMPLETENESS
! ELSE FIND .R <- Y INIT BETWEEN LENTRY & TOP
! FIND .R <- .R + Z INCR BETWEEN HERE & LEND (EASIER TO
! START AT TOP THAN TO FIND HERE)
! MAKE .R <- Y INTO .O <- Y + X
! IF X = .O'' THEN MOVE .O <- Y + .O'' TO AFTER .O'' <- E
! => MOVE TO BEFORE TOP SINCE FINDTHESPOT PUT .O'' <- E
! INTO TREE AFTER ALL OPTIM CREATED STATEMENTS
! INCLUDING .R <- Y
! DON'T BOTHER MOVING IT IF IT'S ALREADY THERE !
! MUST PUT Y + .O'' INTO HASH TBL SO GLOBDEP WILL
! COMBINE .O'' BACK IN
! Y IS ALWAYS A LEAF (SO Y + .O'' CAN BE HASHED) SINCE
! Y IS INIT OF .R WHICH COMES FROM DOM1 WHICH IS
! ALWAYS A LEAF
! MAKE .R <- .R + Z INTO .O <- .O + Z (CANT ASSUME
! .R IS 1ST ARG ON RHS)
! NOTE: DOPRED NOT CURRENT SO MUST SEARCH FOR STATEMENT BEFORE TOP
! IF EXPR PUT INTO HASH TBL, MUST SET .O [ORFIXFLG] SO MOVCNST
! WILL IGNORE ENTRY & GLOBDEP WILL CALL DOTOFIX TO CLEAN UP
! POTENTIAL .O COMBINATION
GLOBAL ROUTINE DOTORFIX(PB,HASHP)=
BEGIN
MAP BASE PB; ! STRAIGHT EXPR .R + X
MAP BASE HASHP; ! HASH TABLE ENTRY
EXTERNAL GETOPTEMP, SKERR, MAKPR1, MAKASGN;
EXTERNAL HASHIT, TBLSRCH, MAKETRY;
EXTERNAL TOP, LENTRY, LEND;
MAP PEXPRNODE TOP, LENTRY, LEND;
MACRO FIXDOTO (O) =
BEGIN
HASHIT (.O [IDOPTIM], STGHT); ! HASH Y + .O''
PHI = TBLSRCH (); ! LOOK IT UP
IF .FLAG
THEN SKERR (); ! ALREADY EXISTS
PHI = MAKETRY (.PHI, .O [IDOPTIM], STGHT); ! INTO HASH TBL
PHI [TEMPER] = .O; ! SINCE .O <- Y + .O''
PHI [STPT] = .LENTRY; ! WHERE TO MOVE
END$;
LOCAL BASE DOTR; ! .R SYMTAB ENTRY
LOCAL PEXPRNODE RINIT; ! .R INITIALIZATION
LOCAL PEXPRNODE RINITP; ! PRED OF RINIT
LOCAL PEXPRNODE RINCR; ! .R INCREMENT
LOCAL BASE DOTO; ! .O CREATED
LOCAL BASE DOTO2; ! IF X = .O''
LOCAL BASE TEMP;
LOCAL BASE PHI;
LABEL LTOP, LINIT, LINCR, LT1;
DOTR = .PB [ARG1PTR]; ! CAN ASSUME .R IS 1ST ARG
DOTO = GETOPTEMP (INTEGER); ! CREATE .O
IF .TOP [DOSYM] EQL .DOTR
THEN BEGIN ! .R IS REDUCED LOOP VAR
TOP [DOSYM] = .DOTO;
HASHP [STPT] = .TOP; ! CANT MOVE THIS .O OUTSIDE LOOP
TEMP = MAKPR1 (0, ARITHMETIC, ADDOP, INTEGER,
.TOP [DOM1], .PB [ARG2PTR]);
TEMP [A2FLGS] = .PB [A2FLGS];
TEMP [A1NEGFLG] = .TOP [INITLNEG];
TOP [INITLNEG] = 0;
TOP [DOM1] = GETOPTEMP (INTEGER); ! .O'
RINIT = .LENTRY; ! FIND STATEMENT BEFORE TOP
LTOP: WHILE TRUE
DO BEGIN
IF .RINIT EQL 0
THEN SKERR (); ! MISSED TOP
IF .RINIT [SRCLINK] EQL .TOP
THEN LEAVE LTOP;
RINIT = .RINIT [SRCLINK];
END; ! OF LTOP: WHILE TRUE DO
RINIT [SRCLINK] = MAKASGN (.TOP [DOM1], .TEMP);
RINIT = .RINIT [SRCLINK]; ! NEW STATEMENT IS IN TREE
RINIT [SRCLINK] = .TOP; ! LINK TO REST OF TREE
TEMP [PARENT] = .RINIT; ! FIX DOM1 + X EXPR PARENT
TOP [DOM2] = MAKPR1 (.TOP, ARITHMETIC, ADDOP, INTEGER,
.TOP [DOM2], .PB [ARG2PTR]); ! COMPLETENESS
TOP [INITLTMP] = 1; ! DOM1 COMES FROM EXPR
DOTO [IDOPTIM] = .TOP [DOM1];
DOTO2 = .TOP [DOM1];
DOTO2 [IDOPTIM] = .TEMP;
TEMP = .PB [ARG2PTR];
IF .TEMP [IDDOTO] EQL SIXBIT ".O"
THEN BEGIN
FIXDOTO (DOTO2);
DOTO2 [ORFIXFLG] = 1; ! HASHED BY DOTORFIX
!**** TEMP [EXPRUSE] = 1; ! THIS 1 USEAGE
END;
END
ELSE BEGIN
RINIT = .LENTRY;
RINITP = .RINIT;
LINIT: WHILE TRUE ! FIND .R <- Y INIT
DO BEGIN
IF .RINIT EQL .TOP
THEN SKERR (); ! .R INIT NOT FOUND
IF .RINIT [LHEXP] EQL .DOTR
THEN LEAVE LINIT; ! FOUND
RINITP = .RINIT; ! NEXT PREDECESSOR
RINIT = .RINIT [SRCLINK]; ! NEXT STATEMENT
END; ! OF LINIT: WHILE TRUE DO
RINCR = .TOP;
LINCR: WHILE TRUE ! FIND .R <- .R + Z INCR
DO BEGIN
IF .RINCR EQL .LEND
THEN SKERR (); ! .R INCR NOT FOUND
IF .RINCR [LHEXP] EQL .DOTR
THEN LEAVE LINCR; ! FOUND
RINCR = .RINCR [SRCLINK]; ! NEXT STATEMENT
END; ! OF LINCR: WHILE TRUE DO
RINIT [LHEXP] = .DOTO;
TEMP = MAKPR1 (.RINIT, ARITHMETIC, ADDOP, INTEGER,
.RINIT [RHEXP], .PB [ARG2PTR]);
TEMP [A2FLGS] = .PB [A2FLGS];
RINIT [RHEXP] = .TEMP;
DOTO [IDOPTIM] = .TEMP;
TEMP [A1FLGS] = .RINIT [A2FLGS]; ! MOVE Y FLAGS DOWN
CLRA2FLGS (RINIT);
TEMP = .PB [ARG2PTR];
IF .TEMP [IDDOTO] EQL SIXBIT ".O"
THEN BEGIN
!DON'T BOTHER MOVING .R INIT IF IT'S ALREADY IN CORRECT PLACE
IF .RINIT [SRCLINK] NEQ .TOP
THEN BEGIN
TEMP = .RINIT;
LT1: WHILE TRUE ! FIND STATEMENT BEFORE TOP
DO BEGIN
IF .TEMP EQL 0
THEN SKERR ();
IF .TEMP [SRCLINK] EQL .TOP
THEN LEAVE LT1;
TEMP = .TEMP [SRCLINK];
END; ! OF LT1: WHILE TRUE DO
RINITP [SRCLINK] = .RINIT [SRCLINK]; ! UNLINK RINIT
TEMP [SRCLINK] = .RINIT; ! LINK BACK IN
RINIT [SRCLINK] = .TOP; ! REST OF TREE
END;
FIXDOTO (DOTO);
END;
RINCR [LHEXP] = .DOTO;
TEMP = .RINCR [RHEXP];
IF .TEMP [ARG1PTR] EQL .DOTR
THEN TEMP [ARG1PTR] = .DOTO ! WAS .R + Z
ELSE TEMP [ARG2PTR] = .DOTO; ! WAS Z + .R
END; ! OF IF
HASHP [TEMPER] = .DOTO;
HASHP [MOVDCNS] = 0; ! .O ISNT CONSTANT IN LOOP NOW
DOTO [ORFIXFLG] = 1; ! HASHED BY DOTORFIX
DOTR [IDATTRIBUT (NOALLOC)] = 1; ! DONT ALLOCATE THIS .R
RETURN .DOTO;
END; ! of DOTORFIX
SWITCHES NOSPEC;
! IF SUBSUMING .O WHICH CAME FROM .R, FIND .O INCR (=.O + Z) &
! CHANGE TO NEW .O
! IGNORE IF .O BEING SUBSUMED IS DOM1
! IF SUBSUMEE IS DIFFERENT TYPE THAN SUBSUMER, MUST BUILD TYPECNV
! NODE ABOVE .O INCR EXPR (=Z) TO MAKE SUBSUMER GET CORRECT INCR
! EXPR (EXCEPT INTEGER <-> INDEX IS NOT NECESSARY) SO USE VALTP2
! TO CHECK 1ST 3 BITS OF VALTYPE: MUST CONVERT IF NEQ
! CALLED FROM GLOBDEP IN GCMNSB
GLOBAL ROUTINE DOTOFIX(T,PAE)=
BEGIN
MAP BASE T; ! OLD .O TO BE REPLACED
MAP BASE PAE; ! NEW .O <- EXPR (OLD .O) STATEMENT
EXTERNAL SKERR, MAKPR1;
EXTERNAL TOP, LEND;
MAP PEXPRNODE TOP, LEND;
LOCAL BASE P; ! TO MARCH DOWN TREE
LOCAL BASE TEMP;
LOCAL BASE NEWO; ! NEW .O (THE SUBSUMER)
LOCAL BASE T1;
IF .TOP [DOSYM] EQL .T
THEN RETURN;
P = .PAE; ! START TREE SEARCH
WHILE TRUE
DO BEGIN
IF .P EQL .LEND
THEN SKERR (); ! .O INCR NOT FOUND
IF .P [LHEXP] EQL .T
THEN BEGIN ! FOUND OLD .O (ONLY ONE)
NEWO = .PAE [LHEXP];
!MARK SUBSUMING .O AS COMING FROM .R
NEWO [ORFIXFLG] = 1; ! PASS FLAG UP TO SUBSUMER
P [LHEXP] = .NEWO;
TEMP = .P [RHEXP];
IF .TEMP [ARG1PTR] EQL .T
THEN TEMP [ARG1PTR] = .NEWO ! WAS .O + Z
ELSE BEGIN
TEMP [ARG2PTR] = .NEWO; ! WAS Z + .O
SWAPARGS (TEMP); ! MAKE IT .O + Z
T1 = .TEMP [DEFPT1];
TEMP [DEFPT1] = .TEMP [DEFPT2];
TEMP [DEFPT2] = .T1;
END;
! DO TYPE CONVERSION ONLY IF NECESSARY AND DON'T CLOBBER "PARENT"
IF .T [VALTP2] NEQ .NEWO [VALTP2] ! CONVERSION NECESSARY ?
THEN BEGIN
TEMP [VALTYPE] = .NEWO [VALTYPE];
T1 = MAKPR1 (.TEMP, TYPECNV, .T [VALTYPE],
.NEWO [VALTYPE], 0,
.TEMP [ARG2PTR]);
TEMP [ARG2PTR] = .T1;
T1 [A2FLGS] = .TEMP [A2FLGS]; ! MOVE FLAGS DOWN
CLRA2FLGS (TEMP);
END;
RETURN;
END;
P = .P [SRCLINK];
END; ! OF WHILE TRUE DO
END; ! of DOTOFIX
SWITCHES NOSPEC;
! GO THRU SYMBOL TABLE AND ZERO FIELDS USED BY THE OPTIMIZER
! EXCEPT FOR THE .O FIELDS
! CALLED FROM PROPAGATE IN PNROPT (USED TO USE CLEANUP IN GOPT2)
! .O EXPRUSE FIELD ZEROED IN GLOBDE & ORFIXFLG
! & OMOVDCNS FLAGS ZEROED BY ZTREE
GLOBAL ROUTINE DFCLEANUP=
BEGIN
!%1245% Redefine REGSTUFF, IDCHOS, IDUSED, and IDDEF were moved from word 2 to
!%1245% word 8. The left half also contains the PSECT info so we can not clear the half word.
INCR I FROM 0 TO SSIZ-1
DO BEGIN
REGISTER BASE T;
T = .SYMTBL [.I];
WHILE .T NEQ 0
DO BEGIN
! KLUDGE BECAUSE OF STATEMENT FUNCTION OPTIMIZATIONS
IF .T [IDDOTF] NEQ SIXBIT ".F"
THEN BEGIN
IF .T [IDDOTF] NEQ SIXBIT ".O"
%2427% THEN T [IDCLEANA] = 0;
! IF THIS IS A FORMAL ARRAY THE PSEUDO ENTRY
! MUST ALSO BE ZERO IF NOT ADJUSTABLY DIMENSIONED
IF .T [OPERSP] EQL FORMLARRAY
THEN BEGIN
REGISTER BASE ET;
ET = .T [IDDIM];
IF NOT .ET [ADJDIMFLG]
THEN BEGIN
ET = .ET [ARADDRVAR];
! THIS PSEUDO ENTRY IS POINTED TO BY THE
! ARADDRVAR FIELD OF THE DIM TABLE ENTRY
%2427% ET [IDCLEANA] = 0;
END;
END; ! SPECIAL STUFF FOR FORMAL ARRAYS
END; ! SFN KLUDGE
T = .T [CLINK];
END; ! WHILE .T NEQ 0
END; ! INCR I
END; ! of DFCLEANUP
END
ELUDOM