Trailing-Edge
-
PDP-10 Archives
-
BB-4157F-BM_1983
-
fortran/compiler/ver5.bli
There are 12 other files named ver5.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 1976, 1983
! AUTHOR: STAN WHITLOCK
MODULE VER5(RESERVE(0,1,2,3),SREG = #17,VREG = #15,FREG = #16,DREGS = 4,START)=
BEGIN
! REQUIRES FIRST, TABLES, OPTMAC
GLOBAL BIND VER5V = 7^24 + 0^18 + 7; ! Version Date: 13-Aug-81
%(
***** 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 *****
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE OPTMAC.BLI;
SWITCHES LIST;
SWITCHES NOSPEC;
FORWARD ![631]
%[631]% ZIOLIST, !CALLED FROM ZDEFPT AND ZSTATEMENT
%[631]% ZDEFPT, !CALLED FROM ZIOLIST
%[631]% ZSTATEMENT; !CALLED FROM ZDEFPT
! ZERO DEFINITION POINTS IN AN IOLIST
! OR IN A LIST OF COMMON SUBEXPRESSIONS
ROUTINE ZIOLIST(LIST)= ![631]
BEGIN ![631]
MAP BASE LIST; ![631]
%[631]% WHILE .LIST NEQ 0 DO
%[631]% BEGIN
%[631]% ZDEFPT(.LIST);
%[631]% LIST_.LIST[CLINK]
%[631]% END
END; ![631]
SWITCHES NOSPEC; ![631]
! ZERO DEFINITION POINTS IN EXPRESSION
ROUTINE ZDEFPT (EXPR) =
BEGIN
MAP PEXPRNODE EXPR;
! ZERO DEFPT FOR ARG 1
MACRO ZDEFPT1 =
BEGIN
IF NOT .EXPR [A1VALFLG]
THEN BEGIN
ZDEFPT (.EXPR [ARG1PTR]);
END;
EXPR [DEFPT1] _ 0;
END$;
! ZERO DEFPT FOR ARG 2
MACRO ZDEFPT2 =
BEGIN
IF NOT .EXPR [A2VALFLG]
THEN BEGIN
ZDEFPT (.EXPR [ARG2PTR]);
END;
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;
TES;
RETURN;
END; ! END OF ROUTINE ZDEFPT
SWITCHES NOSPEC;
! ZERO DEFINITION POINTS IN STATEMENT
ROUTINE ZSTATEMENT (SRC) =
BEGIN
MAP BASE SRC;
CASE .SRC [SRCID] OF SET
!ASSIGNMENT
BEGIN
ZDEFPT (.SRC [RHEXP]);
ZDEFPT (.SRC [LHEXP]);
END;
!ASSIGN
BEGIN END;
!CALL
BEGIN
LOCAL ARGUMENTLIST AG;
AG _ .SRC [CALLIST]; ! = 0 IF NO ARGS
IF .AG NEQ 0
THEN BEGIN
INCR I FROM 1 TO .AG [ARGCOUNT]
DO BEGIN
IF NOT .AG [.I, AVALFLG]
THEN ZDEFPT (.AG [.I, ARGNPTR]);
END;
END;
END;
!CONTINUE
BEGIN END;
!DO
BEGIN
ZDEFPT (.SRC [DOM1]); ! INITIAL EXPR
ZDEFPT (.SRC [DOM2]); ! FINAL EXPR
ZDEFPT (.SRC [DOM3]); ! INCR EXPR
ZDEFPT (.SRC [DOLPCTL]); ! CONTROL EXPR
END;
!ENTRY
BEGIN END;
!COMNSUB
BEGIN END;
!GOTO
BEGIN END;
!ASSIGNED GOTO
BEGIN END;
!COMPUTED GOTO
BEGIN
ZDEFPT (.SRC [CGOTOLBL]);
END;
!ARITHMETIC IF
BEGIN
ZDEFPT (.SRC [AIFEXPR]);
END;
!LOGICAL IF
BEGIN
ZDEFPT (.SRC [LIFEXPR]);
ZSTATEMENT (.SRC [LIFSTATE]); ! THEN STATEMENT
END;
!RETURN
BEGIN
ZDEFPT (.SRC [RETEXPR]);
END;
!STOP
BEGIN END;
!READ
BEGIN
ZDEFPT (.SRC [IORECORD]);
%[631]% ZIOLIST(.SRC[IOLIST]);
END;
!WRITE
BEGIN
ZDEFPT (.SRC [IORECORD]);
%[631]% ZIOLIST(.SRC[IOLIST]);
END;
!DECODE
%[631]% BEGIN
%[631]% ZIOLIST(.SRC[IOLIST])
%[631]% END;
!ENCODE
%[631]% BEGIN
%[631]% ZIOLIST(.SRC[IOLIST])
%[631]% END;
!REREAD
%[631]% BEGIN
%[631]% ZIOLIST(.SRC[IOLIST])
%[631]% END;
!FIND
BEGIN
ZDEFPT (.SRC [IORECORD]);
END;
!CLOSE
BEGIN END;
!INPUID
BEGIN END; ! UNUSED
!OUTPID
BEGIN END; ! UNUSED
!BACKSPACE
BEGIN END;
!BACKFILE
BEGIN END;
!REWIND
BEGIN END;
!SKIPFILE
BEGIN END;
!SKIPRECORD
BEGIN END;
!UNLOAD
BEGIN END;
!RELSID
BEGIN END; ! RELEASE ?
!ENDFILE
BEGIN END;
!END
BEGIN END;
!PAUSE
BEGIN END;
!OPEN
BEGIN END;
!STATEMENT FUNCTION
BEGIN END; ! NO DEFPTS IN SFNEXPR
!FORMAT
BEGIN END;
!BLTID
BEGIN END;
!REGMARK
BEGIN END;
TES;
RETURN;
END; ! END OF ROUTINE ZSTATEMENT
SWITCHES NOSPEC;
! ZERO DEFINITION POINTS IN ENTIRE TREE
! ZERO OUT ORFIXFLG, OMOVDCNS IN SYMTBL FOR .O VARS
! CALLED FROM MRP2 IN PHA2
GLOBAL ROUTINE ZTREE =
BEGIN
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; ! END OF ROUTINE 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 ROUTINE 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
MACRO IDDOTF = 0,3,24,12$;
!%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.
%1245% MACRO REGSTUFF = 0,8,18,7$;
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"
THEN T [REGSTUFF] _ 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
ET [REGSTUFF] _ 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 ! END OF MODULE VER5
ELUDOM