INCLUDE "ERCC07.TRIMP_TFORM1S"
INCLUDE "ERCC07.TRIPCNSTS"
EXTRINSICRECORD (WORKAF) WORKA
EXTRINSICRECORD (PARMF) PARM
CONSTINTEGER YES=1
CONSTINTEGER NO=0
EXTERNALROUTINESPEC IMPABORT
EXTERNALROUTINESPEC FAULT(INTEGER N,DATA,IDENT)
EXTERNALROUTINESPEC PRINT TRIPS(RECORD (TRIPF) ARRAYNAME TRIPLES)
CONSTBYTEINTEGERARRAY WORDS(0:7)=0(3),1,1,1,2,4;
ROUTINE EXTRACT(RECORD (RD) NAME OPND, INTEGERNAME VAL,
LONGREALNAME RVAL, STRINGNAME STRVAL)
!***********************************************************************
!* EXTRACTS A CONTANT OPERAND RETURNING REAL &INT VALUES *
!***********************************************************************
INTEGER TYPE,PREC,I,AD
TYPE=OPND_PTYPE; PREC=TYPE>>4
TYPE=TYPE&15
VAL=0; RVAL=0; STRVAL=""
IF TYPE=5 START
LENGTH(STRVAL)=WORKA_A(OPND_D)
FOR I=1,1,OPND_XTRA CYCLE
CHARNO(STRVAL,I)=WORKA_A(OPND_D+I)
REPEAT
FINISHELSEIF TYPE=1 THENSTART
VAL=OPND_D
RVAL=VAL
FINISHELSESTART
IF PREC=5 THEN RVAL=OPND_R ELSE RVAL=OPND_LR
FINISH
END
EXTERNALROUTINE CTOP(INTEGERNAME FLAG,MASK, INTEGER XTRA,
RECORD (RD) NAME OPND1,OPND2)
!***********************************************************************
!* AN OPERATION HAS BEEN FOUND WHERE BOTH OPERANDS ARE *
!* CONSTANTS OR KNOWN AT COMPILE TIME. THIS ROUTINE INTERPRETS *
!* THE OPERATION *
!* ON EXIT FLAG=0 IF INTERPRETED. REFRAINS FROM INTERPRETING *
!* X=1/0 FOR EXAMPLE. CODE IS PLANTED FOR THESE FUNNIES *
!***********************************************************************
CONSTINTEGER UTRUNCMASK=X'00000800',BTRUNCMASK=X'00000013'
CONSTBYTEINTEGERARRAY FCOMP(1:14)= C
8,10,2,7,12,4,7,
8,12,4,7,10,2,7
INTEGER K,TYPEP,PRECP,OP,VAL,SVAL1,SVAL2,C,D,JJ,KK,TRUNCMASK
STRING (255) STRVAL1,STRVAL2
!%LONGINTEGER VAL1,VAL2
INTEGER VAL1,VAL2
!%LONGLONGREAL RVAL1,RVAL2
LONGREAL RVAL1,RVAL2
SWITCH UISW,URSW(10:40),BISW,BRSW(0:24)
ONEVENT 1,2 START
RETURN
FINISH
TYPEP=OPND1_PTYPE&7; PRECP=OPND1_PTYPE>>4&15; OP=FLAG
EXTRACT(OPND1,VAL1,RVAL1,STRVAL1)
SVAL1<-VAL1
IF OP<128 START ; ! UNARY
RETURNUNLESS 10<=OP<=40
TRUNCMASK=UTRUNCMASK
IF TYPEP=2 THEN ->URSW(OP) ELSE ->UISW(OP)
FINISH
OP=OP-128
RETURNIF OP>24
EXTRACT(OPND2,VAL2,RVAL2,STRVAL2)
SVAL2<-VAL2
IF TYPEP=2 THEN ->BRSW(OP) ELSE ->BISW(OP)
UISW(10): ! ¬
VAL1=¬VAL1
INTEND:
! %IF PRECP=6 %THEN %START
! OPND1_D<-VAL1>>32
! OPND1_XTRA<-VAL1
! FLAG=0
! %FINISH %ELSE %START
VAL<-VAL1
IF VAL=VAL1 OR 1<<OP&TRUNCMASK=0 THEN FLAG=0 AND OPND1_D=VAL
! NO ARITH OFLOW CONDITION
! %FINISH
IF FLAG=0 START
OPND1_PTYPE=PRECP<<4!1
IF X'FFFF8000'<=VAL1<=X'FFFF' THEN OPND1_FLAG=0 ELSE OPND1_FLAG=1
FINISH
RETURN
UISW(11): ! INTEGER NEGATE
VAL1=-VAL1; ->INT END
UISW(13): ! INTEGER ABS
VAL1=IMOD(VAL1); ->INT END
UISW(12): ! INTEGER FLOAT
RVAL1=VAL1; PRECP=PRECP+1
->REAL END
URSW(15): ! STRETCH REAL
PRECP=PRECP+1
REAL END:OPND1_FLAG=1
IF PRECP=5 THEN OPND1_R=RVAL1 ELSE OPND1_LR=RVAL1
! %IF PRECP=7 %THEN %START
! OPND1_FLAG=3
! OPND1_XTRA=ADDR(A(R))
! %CYCLE K=0,1,15
! A(R)=BYTEINTEGER(ADDR(RVAL1)+K)
! R=R+1
! %REPEAT
! %FINISH
FLAG=0; OPND1_PTYPE=16*PRECP+2
RETURN
UISW(15): ! STRETCH INTEGER
IF PRECP=4 THEN PRECP=5 AND ->INT END
RETURN
UISW(14): ! SHORTEN INTEGER
IF IMOD(VAL1)<=X'7FFF' THEN PRECP=4 AND ->INT END
RETURN
URSW(14): ! SHORTEN REAL
PRECP=PRECP-1
->REAL END
URSW(12): ! FLOAT REAL
IMPABORT
UISW(16): ! SHORTEN FOR <-
IF PRECP=5 THEN VAL1=VAL1&X'FFFF' AND PRECP=4 AND ->INTEND
RETURN
URSW(36): ! INT
RETURNUNLESS MOD(RVAL1)<X'7FFFFFFE'
VAL1=INT(RVAL1)
PRECP=5
->INTEND
URSW(37): ! INTPT
RETURNUNLESS MOD(RVAL1)<X'7FFFFFFE'
VAL1=INTPT(RVAL1)
PRECP=5
->INTEND
UISW(38): ! TOSTRING
STRVAL1=TOSTRING(VAL1)
->STREND
BISW(0): ! ADD
BISW(14): ! COMBINE VMY RESULTS
VAL1=VAL1+VAL2; ->INT END
BISW(1): ! MINUS
VAL1=VAL1-VAL2; ->INT END
BISW(2): ! EXCLUSIVE OR
VAL1=VAL1!!VAL2; ->INT END
BISW(3): ! OR
VAL1=VAL1!VAL2; ->INT END
BISW(4): ! MULT
VAL1=VAL1*VAL2; ->INT END
BISW(6):RETURN ; ! / DIVISION
BISW(5):RETURNIF VAL2=0; ! // DIVISION
VAL1=VAL1//VAL2; ->INT END
BISW(7): ! AND
VAL1=VAL1&VAL2; ->INT END
BISW(9): ! SLL
IF PRECP=6 THEN VAL1=VAL1<<SVAL2 ELSE VAL1=SVAL1<<SVAL2
->INT END
BISW(8): ! SRL
IF PRECP=6 THEN VAL1=VAL1>>SVAL2 ELSE VAL1=SVAL1>>SVAL2
->INT END
BISW(13): ! VMY & CHK BOUNDS
C=VAL2>>24; ! DIMENSION
D=VAL2&X'FFFF'; ! DV POINTER
RETURNUNLESS D>0; ! UNLESS DV AVAILABLE
IF VAL1<WORKA_CTABLE(D+3*C+1) OR VAL1>WORKA_CTABLE(D+3*C) THEN C
FAULT(50,VAL1,XTRA&X'FFFF')
VAL1=VAL1*WORKA_CTABLE(D+3*C-1) UNLESS C=1
->INT END
BISW(18): ! ARRAY SCALE
D=VAL2>>16&31; ! TOTAL NO OF DIMENSIONS
KK=VAL2&X'FFFF'; ! DV DISP
RETURNUNLESS KK>0
JJ=WORKA_CTABLE(KK+4); ! LB(1)
C=6
WHILE C<=3*D CYCLE
JJ=JJ+WORKA_CTABLE(KK+C-1)*WORKA_CTABLE(KK+C+1)
C=C+3
REPEAT
VAL1=VAL1-JJ
->INT END
BISW(11):
BISW(12): ! COMPARISONS
BRSW(11):
BRSW(12): ! REAL COMPARISONS
MASK=FCOMP(XTRA)
FLAG=0
IF TYPEP=2 THEN ->RCOMP
IF (MASK&8#0 AND VAL1=VAL2) OR (MASK&4#0 AND VAL1<VAL2) OR C
(MASK&2#0 AND VAL1>VAL2) THEN MASK=15 ELSE MASK=0
RETURN
RCOMP:
IF (MASK&8#0 AND RVAL1=RVAL2) OR (MASK&4#0 AND RVAL1<RVAL2) OR C
(MASK&2#0 AND RVAL1>RVAL2) THEN MASK=15 ELSE MASK=0
RETURN
URSW(11): ! NEGATE
RVAL1=-RVAL1; ->REAL END
BRSW(13): ! ABS
RVAL1=MOD(RVAL1); ->REAL END
BRSW(0): ! ADD
RVAL1=RVAL1+RVAL2; ->REAL END
BRSW(1): ! SUBTRACT
RVAL1=RVAL1-RVAL2; ->REAL END
BRSW(4): ! MULT
RVAL1=RVAL1*RVAL2; ->REAL END
BRSW(6): ! DIVISION
RETURNIF RVAL2=0; ! AVOID DIV BY ZERO
RVAL1=RVAL1/RVAL2; ->REAL END
BISW(10): ! '**' WITH 2 INTEGER OPERANDS
BRSW(10): ! '**' WITH AT LEAST 1 REAL
RETURNUNLESS OPND2_PTYPE&7=1 AND -63<=VAL2<=63
RVAL1=RVAL1**VAL2
->REALEND
BISW(17): ! '****' WITH 2 INTEGER OPERAND
RETURNUNLESS 0<=VAL2<=63
VAL2=1
WHILE SVAL2>0 CYCLE
VAL2=VAL2*VAL1
SVAL2=SVAL2-1
! %RETURN %IF VAL2#INTEGER(ADDR(VAL2)+4)
REPEAT
VAL1=VAL2; ->INT END
BISW(24): ! CONCAT
RETURNIF LENGTH(STRVAL1)+LENGTH(STRVAL2)>255
STRVAL1=STRVAL1.STRVAL2
STREND: ! RETURN VALUE
OPND1_PTYPE=X'35'
OPND1_FLAG=LCONST
OPND1_XTRA=LENGTH(STRVAL1)
JJ=WORKA_ARTOP
WORKA_A(JJ)=OPND1_XTRA
FOR K=1,1,OPND1_XTRA CYCLE
WORKA_A(JJ+K)=CHARNO(STRVAL1,K)
REPEAT
OPND1_D=JJ
WORKA_ARTOP=(JJ+OPND1_XTRA+2)&(-2); ! PERQ KEEP 16 BIT ALIGNED
FLAG=0
RETURN
URSW(*):
UISW(*):
BRSW(*):
BISW(*):
END
EXTERNALROUTINE FLAG AND FOLD(RECORD (TRIPF) ARRAYNAME TRIPLES)
!***********************************************************************
!* WORKS DOWN AN ARRAY OF TRIPLES SETTING BITS FOR CODE GENERATOR *
!* ALSO FOLDS OUT ANY REMAINING CONSTANT OPERATIONS *
!***********************************************************************
INTEGER STPTR,CURRTRIPNO,I,J,DEPTH
CONSTINTEGER FOLDI=X'1C00007F'; ! FOLD 10-16 & 36-38
CONSTINTEGER FOLDR=X'0107FFFF'; ! FOLD 128-146 &152
RECORD (TRIPF) NAME CURRT,REFT
ROUTINESPEC INSPECT OPND(INTEGER NO)
ROUTINESPEC REPLACE TRIPREF(INTEGER TRIP, RECORD (RD) NAME OPND)
STPTR=TRIPLES(0)_FLINK
DEPTH=0
!
WHILE STPTR>0 CYCLE
CURRT==TRIPLES(STPTR)
CURRTRIPNO=STPTR
STPTR=CURRT_FLINK
INSPECT OPND(1)
IF CURRT_OPERN>=128 THEN INSPECT OPND(2)
!
IF CURRT_FLAGS&CONSTANTOP#0 AND ((CURRT_OPERN<128 AND C
FOLDI&1<<(CURRT_OPERN-10)#0) OR (CURRT_OPND1_FLAG<=1 AND C
CURRT_OPND2_FLAG<=1 AND FOLDR&1<<(CURRT_OPERN&31)#0)) START
I=CURRT_OPERN
CTOP(I,J,CURRT_X1,CURRT_OPND1,CURRT_OPND2)
IF I=0 THENSTART
CURRT_X1=CURRT_OPERN; ! FOR DEBUGGING OPTIMISATIONS
CURRT_OPERN=NULLT
REPLACE TRIPREF(CURR TRIPNO,CURRT_OPND1)
FINISH
FINISH
IF CURRT_OPERN=LASS AND CURRT_FLAGS&CONSTANTOP#0 AND C
CURRT_CNT>0 THEN REPLACE TRIPREF(CURRTRIPNO,CURRT_OPND2)
CURRT_DPTH<-DEPTH
IF CURRT_CNT>0 AND CURRT_OPTYPE&7#2 C
THEN DEPTH=DEPTH+WORDS(CURRT_OPTYPE>>4)
REPEAT
RETURN
ROUTINE INSPECT OPND(INTEGER NO)
RECORD (TRIPF) NAME RTRIP
RECORD (RD) NAME OPND
CONSTBYTEINTEGERARRAY LOAD ALLOW(0:199)=LOAD OP1(128){UNARY},
LOADOP1!LOADOP2(10),
LOADOP1{**},
LOADOP1!LOADOP2(2),
LOADOP1{VMY},
LOADOP1!LOADOP2,
LOADOP2(2){ASS AND JAM ASS},
LOADOP1{****},
LOADOP1{SCALE},
LOADOP1!LOADOP2,
LOADOP2{INDEXED FETCH},
LOADOP2{LASS},
LOADOP1!LOADOP2(3),
LOADOP2{IOCP DONT LOAD EPNO},
LOADOP2(6){P PASSING},
0(6){LABELS AND SWITCH DECLS},
LOADOP2{GOTO SW LOAD OPERAND},
LOADOP2(7){STR,PTR&RESULT ASSMNT},
LOADOP1!LOADOP2(2){STR COMP&DCOMP},
LOADOP2(2){PRE RES DONT LD WKAREA},
LOADOP1{RESLN DONT LOAD LABEL},
LOADOP2{RES FINALE DONT LOAD WKAREA},
LOADOP1!LOADOP2{SIG EVNT UNUSED},
LOADOP2{REC ASSNMNT},
LOADOP1!LOADOP2(*);
INTEGER I,LOADOP
OPND==CURRT_OPND1
LOADOP=LOAD OP1
IF NO=2 THEN OPND==CURRT_OPND2 AND LOADOP=LOAD OP2
LOADOP=LOADOP&LOAD ALLOW(CURRT_OPERN)
IF OPND_FLAG<=1 THEN CURRT_FLAGS=CURRT_FLAGS!CONSTANTOP
IF OPND_FLAG<8 THEN CURRT_FLAGS=CURRT_FLAGS!LOADOP
IF OPND_FLAG=REFTRIP OR OPND_FLAG=INDIRECT START
RTRIP==TRIPLES(OPND_D)
IF RTRIP_PUSE#CURRTRIPNO OR C
(RTRIP_OPERN=LASS AND RTRIP_FLINK#CURRTRIPNO) OR C
RTRIP_OPERN=PRECC OR RTRIP_OPERN=CONCAT OR C
RTRIP_OPERN=ITOS1 THEN CURRT_FLAGS=CURRT_FLAGS!LOADOP
IF RTRIP_PUSE=CURRTRIPNO AND RTRIP_OPTYPE&7#2 C
THEN DEPTH=DEPTH-WORDS(RTRIP_OPTYPE>>4)
FINISH
END
ROUTINE REPLACE TRIPREF(INTEGER TRIP, RECORD (RD) NAME OPND)
INTEGER PTR
BYTEINTEGERNAME COUNT
RECORD (TRIPF) NAME RTRIP
PTR=STPTR
COUNT==TRIPLES(TRIP)_CNT
WHILE COUNT>0 AND PTR>0 CYCLE
RTRIP==TRIPLES(PTR)
PTR=RTRIP_FLINK
IF RTRIP_OPND1_FLAG=REFTRIP AND RTRIP_OPND1_D=TRIP START
RTRIP_OPND1=OPND
COUNT=COUNT-1
FINISH
IF RTRIP_OPERN>=128 AND RTRIP_OPND2_FLAG=REFTRIP AND C
RTRIP_OPND2_D=TRIP START
RTRIP_OPND2=OPND
COUNT=COUNT-1
FINISH
REPEAT
END
END
EXTERNALROUTINE TRIP OPT(RECORD (TRIPF) ARRAYNAME TRIPLES,
INTEGERNAME NEXT TRIP)
!***********************************************************************
!* SCANS A TRIPLES LIST FOR POSSIBLE OPTIMISATIONS *
!***********************************************************************
INTEGER CHANGES,DUPS,DUPTNO,PTR,I,J,K,VAL,XVAL,CURR,NEXT,OP1,OP2,
CTOPOP,REVOP
BYTEINTEGERARRAYNAME A
RECORD (TRIPF) NAME CURRT,NEWT,NEXTT
RECORD (RD) NAME OPND1,OPND2,POPND
ROUTINESPEC SWOP OPERANDS(RECORD (TRIPF)NAME CURRT)
INTEGERFNSPEC POWEROF2(INTEGER VAL)
INTEGERFNSPEC PRELOAD PLACE(INTEGER TRIP)
ROUTINESPEC NOOP(INTEGER TRIPLE, RECORD (RD) NAME ROPND)
INTEGERFNSPEC SAME OPND(RECORD (RD) NAME OPND1,OPND2)
ROUTINESPEC CHECK DUPS(INTEGER STRIPNO,STRIPNO)
ROUTINESPEC DUPLICATE TRIP(INTEGER TRIPNO,DTRIPNO)
ROUTINESPEC DEC USE(INTEGER TRIPLE NO)
ROUTINESPEC DELETE TRIPLE(INTEGER TRIPLE NO)
CONSTBYTEINTEGERARRAY FOLD NOOP INFO(0:199)= 0(128),
X'89',X'41',X'89',X'89',X'B6',{+,-,!!,!,*} C
2,0,X'A4',1,1,{//,/,&,>>,<<} C
2,0,0,3,X'89',{**,COMP,DCOMP,VMY,COMB} C
0,0,2,0,1,{=,<-,****,SCALE,INDEX} C
0{IFETCH},0(3),
X'40'{CONCAT},0(*)
! 2**0 SET IF SECOND OPERAND ZERO IS NOOP
! 2**1 SET IF SECOND OPERAND 1 IS A NOOP
! 2**2 SET IF SECOND OPERAND 0 MEANS RESULT=0
! 2**3 SET IF FIRST OPERAND ZERO IS NOOP
! 2**4 SET IF FIRST OPERAND 1 IS A NOOP
! 2**5 SET IF FIRST OPERAND ZERO MEANS RESULT=0
! 2**6 SET IF FOLDING WITH ITSELF POSSIBLE BUT NOT SIMPE
! 2**7 SET FOR NORMAL FOLDING
!
CHANGES=0; ! NO CHANGES AS YET
DUPS=0; ! NO DUPLICATES YET
FLAG AND FOLD(TRIPLES)
A==WORKA_A
!
! ADVANCED FOLDING FACTOR CONSTANTS OUT OF 2 OR MORE TRIPLES
! TO SAVE AN OPERATION. ONLY MORE USUSAL CASE CATERED FOR AS IN
! VAR+CONST+CONST.
!
PTR=TRIPLES(0)_FLINK
WHILE PTR>0 CYCLE
CURRT==TRIPLES(PTR)
NEXT=CURRT_FLINK
EXITIF NEXT<=0
NEXTT==TRIPLES(NEXT)
WHILE NEXTT_OPERN=NULLT AND NEXTT_FLINK>0 CYCLE
NEXT=NEXTT_FLINK; ! SKIP OVER ANY NOOPS
NEXTT==TRIPLES(NEXT)
REPEAT
UNLESS CURRT_CNT=1 AND NEXTT_CNT=1 AND C
CURRT_FLAGS&NEXTT_FLAGS&CONSTANTOP#0 AND CURRT_PUSE=NEXT THEN C
PTR=NEXT ANDCONTINUE
PTR=NEXT ANDCONTINUEUNLESS (CURRT_FLAGS!NEXTT_FLAGS)&DONT OPT=0
J=CURRT_OPERN
K=NEXTT_OPERN
UNLESS FOLD NOOP INFO(J)>>6#0 AND FOLD NOOP INFO(K)>>6#0 THEN C
PTR=NEXT ANDCONTINUE
IF CURRT_OPND1_FLAG<=1 THEN OP1=1 AND OPND1==CURRT_OPND1 ELSE C
OP1=2 AND OPND1==CURRT_OPND2
IF NEXTT_OPND1_FLAG<=1 THEN OP2=1 AND OPND2==NEXTT_OPND1 ELSE C
OP2=2 AND OPND2==NEXTT_OPND2
CTOPOP=0; REVOP=0
IF J=K AND FOLD NOOP INFO(J)&X'80'#0 THEN CTOPOP=J
IF J=K=SUB START
IF OP2=2 START
IF OP1=2 THEN CTOPOP=ADD ELSE CTOPOP=SUB
FINISH ELSE START ; ! OP2=1 CASE
IF OP1=1 THEN CTOPOP=SUB AND REVOP=ADD ELSE CTOPOP=ADD
FINISH
FINISH
IF J=ADD AND K=SUB AND OP2=2 THEN CTOPOP=SUB
IF J=SUB AND K=ADD THENSTART
IF OP1=1 THEN CTOPOP=ADD ELSE CTOPOP=SUB
FINISH
IF J=K=CONCAT AND OP1=OP2=2 THEN CTOPOP=CONCAT
IF CTOPOP#0 START
CTOP(CTOPOP,K,0,OPND1,OPND2)
IF CTOPOP=0 THENSTART
IF OP2=2 THEN OPND2==NEXTT_OPND1 ELSE OPND2==NEXTT_OPND2
NOOP(NEXT,OPND2)
IF REVOP#0 THEN CURRT_OPERN=REVOP
CONTINUE
FINISH
FINISH
PTR=NEXT
REPEAT
! %IF CHANGES>0 %THEN PRINT TRIPS(TRIPLES)
!
! FIRST REAL OPTIMISATION IS TO SEARCH FOR AND REMOVE NOPS
! LIKE *1 OR <<0 OR +0 ETC. THESE ARE SURPRISINGLY COMMON
! IN PROGRAMS MADE MACHINE INDEPENDENT BY LIBERAL USE
! OF CONSTANT VARIABLES
!
! ALSO DOES A FEW REARRANGEMENTS OF SIMPLE COMPARISONS AND ARITHMETICS
!
PTR=TRIPLES(0)_FLINK
WHILE PTR>0 CYCLE
CURRT==TRIPLES(PTR); ! EXAMINE EACH TRIPLE
CURR=PTR
PTR=CURRT_FLINK
CONTINUEIF CURRT_FLAGS&DONT OPT#0 OR CURRT_FLAGS&CONSTANTOP=0
I=CURRT_OPERN
OPND1==CURRT_OPND1
OPND2==CURRT_OPND2
IF OPND1_FLAG<=1 THEN OP1=1 AND VAL=OPND1_D AND XVAL=OPND1_XTRA C
ELSE OP1=2 AND VAL=OPND2_D AND XVAL=OPND2_XTRA
IF I=DCOMP AND OP1=2 START ;! EXPAND I=0=J ETC
I=COMP; CURRT_OPERN=COMP
NEXTT==TRIPLES(CURRT_PUSE)
NEXTT_OPND1=OPND2
NEXTT_FLAGS=NEXTT_FLAGS!LOADOP1
FINISH
IF I=COMP START
J=CURRT_X1&15; ! IBM COND MASK
IF CURRT_OPTYPE&7=1 START ;! TRANSFORM I>=1 TO I>0 ETC
IF (OP1=2 AND ((VAL=1 AND (J=4 OR J=10)) C
OR (VAL=-1 AND (J=2 OR J=12)))) C
OR (OP1=1 AND ((VAL=1 AND (J=2 OR J=12)) C
OR (VAL=-1 AND (J=4 OR J=10)))) START
J=J!!8
CURRT_X1=CURRT_X1!!8
NEXTT==TRIPLES(CURRT_FLINK)
NEXTT_X1=NEXTT_X1!!8; ! ALSO ALTER MASK IN THE JUMP
VAL=0
IF OP1=2 THEN OPND2_D=0 ELSE OPND1_D=0
FINISH
FINISH
IF VAL=0 AND 7<=J<=8 AND (XVAL=0 OR CURRT_OPTYPE>>4<=5) START
CURRT_OPERN=ZCOMP
IF OP1=1 THEN SWOP OPERANDS(CURRT)
CURRT_FLAGS=CURRT_FLAGS&(¬LOADOP2)!DONT OPT
FINISH
FINISH
IF (I=LSHIFT OR I=RSHIFT) AND 1<=VAL<=31 AND C
OP1=2 START ; ! <<CONST AND >> CONST
CURRT_OPERN=CLSHIFT
IF I=RSHIFT THEN VAL=-VAL AND OPND2_D=VAL
I=CLSHIFT
CURRT_FLAGS=CURRT_FLAGS&(¬LOADOP2)
FINISH
IF I=INTDIV AND OP1=2 AND VAL>1 START
J=POWEROF2(VAL)
IF J>0 START
CURRT_OPERN=CASHIFT
I=CASHIFT
OPND2_D=-J
CURRT_FLAGS=CURRT_FLAGS&(¬LOADOP2)
FINISH
FINISH
IF I=MULT AND VAL>1 AND CURRT_OPTYPE&15=1 START
J=POWEROF2(VAL)
IF J>0 START
IF OP1=1 THEN SWOP OPERANDS(CURRT)
CURRT_OPERN=CASHIFT
I=CASHIFT
OPND2_D=J
CURRT_FLAGS=CURRT_FLAGS&(¬LOADOP2)
FINISH
FINISH
IF I>=128 THENSTART ; ! BINARY OPERATIONS
IF I=VMY THEN VAL=VAL>>24;! DIM=1 IS NOOP
J=FOLD NOOP INFO(I)&X'3F'
CONTINUEUNLESS VAL<=1 AND J#0 AND CURRT_OPTYPE&7=1
POPND==OPND1; ! FOR PASSING FORWARD
IF OP1=1 THEN K=3 AND POPND==OPND2 ELSE K=0;! BIT SHIFT FOR MASK
IF (J&(1<<K)#0 AND VAL=0) OR (J&(2<<K)#0 AND VAL=1) START
NOOP(CURR,POPND); ! THIS IS NOOP
CONTINUE
FINISH
IF J&(4<<K)#0 AND VAL=0 THENSTART
IF OPND1_FLAG=REFTRIP THEN DEC USE(OPND1_D)
IF OP1=2 THEN OPND1=OPND2; ! RESULT IS ZERO
NOOP(CURR,OPND1)
! MAY CAUSE OTHER NOOPS
! GE I=(A+B)*0
FINISH
IF VAL=0 AND OP1=1 AND CURRT_OPERN=SUB THEN C
OPND1=OPND2 AND CURRT_OPERN=LNEG;! OPTIMISE"0-X"
FINISH
REPEAT
!
! PASS TO CHECK FOR COMMON SUBEXPRESSIONS. DONE IN SUCH A WAY THAT
! SEQUENCES ARE DETECTED AND COMBINED
!
PTR=TRIPLES(0)_FLINK
WHILE PTR>0 CYCLE
CURRT==TRIPLES(PTR)
IF CURRT_FLAGS&DONT OPT=0 THEN CHECK DUPS(PTR,CURRT_FLINK)
PTR=CURRT_FLINK
REPEAT
!
! NESTED ACCUMULATOR PASS. AVOID EXCHANGES BY ARRANGING EARLY LOADS
! OF OPERANDS FOR NON COMMUTABLE OPERATIONS
!
PTR=TRIPLES(0)_FLINK
WHILE PTR>0 CYCLE
CURRT==TRIPLES(PTR)
IF CURRT_OPERN>=128 AND CURRT_OPERN#VASS AND CURRT_OPERN#VJASS C
AND CURRT_OPTYPE&7#2 AND CURRT_FLAGS&(LOADOP1!LOADOP2!COMMUTABLE)=LOADOP1 C
AND CURRT_OPND2_FLAG=REFTRIP AND 1<<CURRT_OPND1_FLAG&BTREFMASK=0 START
J=PRELOAD PLACE(CURRT_OPND2_D)
IF J>=0 AND CURRT_DPTH=TRIPLES(J)_DPTH START ;! PLACE ACCESSIBLE
I=J; K=0
WHILE I#PTR CYCLE ; ! CHECK FOR DEPTH OF NESTING
NEXTT==TRIPLES(I)
IF NEXTT_OPERN=IOCPC OR NEXTT_OPERN=PRECL C
THEN K=999 AND EXIT
IF K<NEXTT_DPTH THEN K=NEXTT_DPTH
I=NEXTT_FLINK
REPEAT
IF K+WORDS(CURRT_OPTYPE>>4)>=6 THEN C
PTR=CURRT_FLINK ANDCONTINUE
NEXTT==TRIPLES(J)
NEWT==TRIPLES(NEXT TRIP)
NEWT=0
NEWT_OPERN=PRELOAD; ! PRELOAD
NEWT_CNT=1
NEWT_OPTYPE=CURRT_OPTYPE
NEWT_FLAGS=LOADOP1!LEAVE STACKED
NEWT_PUSE=PTR
NEWT_OPND1=CURRT_OPND1
CURRT_FLAGS=CURRT_FLAGS&(¬LOAD OP1); ! OP1 DOES NOT NEED LOAD
CURRT_OPND1_FLAG=REFTRIP
CURRT_OPND1_D=NEXT TRIP
CURRT_OPND1_XTRA=0
! LINK IN NEW TRIPLE
NEWT_FLINK=J
NEWT_BLINK=NEXTT_BLINK
NEXTT_BLINK=NEXT TRIP
TRIPLES(NEWT_BLINK)_FLINK=NEXT TRIP
NEXT TRIP=NEXT TRIP+1
!
! CORRECT DEPTH OF NESTING FIELD
!
NEWT_DPTH=NEXTT_DPTH
WHILE J#PTR CYCLE
NEXTT_DPTH=NEXTT_DPTH+WORDS(NEWT_OPTYPE>>4)
J=NEXTT_FLINK
NEXTT==TRIPLES(J)
REPEAT
! CHANGES=CHANGES+1
FINISH
FINISH
PTR=CURRT_FLINK
REPEAT
!
! PASS TO TRY TO KEEP DUPLICTE TRIPLES IN ESTACK. THE SAVING
! HERE IS SO LARGE THAT IT IS WORTH THE EFFORT TO FIND THESE
! RATHER RARE CASES. OFTEN THE FORM IS A(I)=A(I)+B.
!
IF DUPS>0 START ; ! THERE IS AT LEST ONE
PTR=TRIPLES(0)_FLINK
WHILE PTR>0 CYCLE
CURRT==TRIPLES(PTR)
NEXTT==CURRT
CYCLE
NEXT=NEXTT_FLINK
NEXTT==TRIPLES(NEXT)
REPEAT UNTIL NEXTT_OPERN#NULLT
IF CURRT_CNT=2 AND CURRT_OPTYPE&7#2 START ;! ONLY DUPILCATES POSSIBLE
IF CURRT_PUSE#NEXT AND ((NEXTT_OPND1_FLAG=REFTRIP AND C
NEXTT_OPND1_D=PTR) OR (NEXTT_OPND2_FLAG=REFTRIP AND C
NEXTT_FLAGS&(COMMUTABLE!LOADOP1)=COMMUTABLE!LOADOP1 AND C
NEXTT_OPND2_D=PTR)) START
CURRT_FLAGS=CURRT_FLAGS!USE ESTACK
CHANGES=CHANGES+1
PTR=NEXT
CONTINUE
FINISH
IF CURRT_PUSE=NEXT AND C
NEXTT_OPND1_FLAG=REFTRIP=NEXTT_OPND2_FLAG AND C
NEXTT_OPND1_D=PTR=NEXTT_OPND2_D THENSTART
CURRT_FLAGS=CURRT_FLAGS!USE ESTACK
CHANGES=CHANGES+1
PTR=NEXT; CONTINUE
FINISH
IF CURRT_PUSE=NEXT AND NEXTT_FLINK=NEXTT_PUSE#0 AND C
(NEXTT_FLAGS&COMMUTABLE#0 OR (NEXTT_OPND1_FLAG=REFTRIP AND C
NEXTT_OPND1_D=PTR)) START
NEWT==TRIPLES(NEXTT_FLINK)
NEWT==TRIPLES(NEWT_FLINK) WHILE NEWT_OPERN=NULLT
IF (NEWT_OPND2_FLAG=REFTRIP AND NEWT_OPND2_D=PTR) OR C
(NEWT_FLAGS&COMMUTABLE#0 AND C
NEWT_OPND1_FLAG=REFTRIP AND NEWT_OPND1_D=PTR) START
CURRT_FLAGS=CURRT_FLAGS!USE ESTACK
CHANGES=CHANGES+1
PTR=NEXT
CONTINUE
FINISH
FINISH
FINISH
PTR=NEXT
REPEAT
FINISH
! %IF CHANGES>0 %AND PARM_DCOMP#0 %THEN PRINT TRIPS(TRIPLES)
RETURN
INTEGERFN POWEROF2(INTEGER VAL)
!***********************************************************************
!* CHECKS IF VAL IS A POWER OF 2 *
!***********************************************************************
INTEGER I,J
FOR I=1,1,30 CYCLE
J=1<<I
IF J=VAL THEN RESULT =I
IF J>VAL THEN RESULT =0
REPEAT
RESULT =0
END
ROUTINE SWOP OPERANDS(RECORD (TRIPF)NAME CURRT)
!***********************************************************************
!* EXCHANGE OPND1&OPND2 KEEPING THE FLAGS CORRECT *
!***********************************************************************
RECORD (RD)TOPND
INTEGER FLAGS,NEWFLAGS
TOPND=CURRT_OPND1
CURRT_OPND1=CURRT_OPND2
CURRT_OPND2=TOPND
FLAGS=CURRT_FLAGS
NEWFLAGS=FLAGS&(¬(LOADOP1+LOADOP2))
IF FLAGS&LOADOP1#0 THEN NEWFLAGS=NEWFLAGS!LOADOP2
IF FLAGS&LOADOP2#0 THEN NEWFLAGS=NEWFLAGS!LOADOP1
CURRT_FLAGS=NEWFLAGS
END
INTEGERFN PRELOAD PLACE(INTEGER TRIP)
!***********************************************************************
!* LOOK FOR FIRST TRIPLE IN THE CHAIN THAT LEADS TO TRIP *
!* CAN BE VERY COMPILCATED. RETURN -1 IF NOT SIMPLE *
!***********************************************************************
CONSTINTEGER TRIPREFS=X'140'; ! BITMASK OF OPERAND FORMATS
RECORD (RD) NAME OPND1,OPND2
RECORD (TRIPF) NAME CURRT
CURRT==TRIPLES(TRIP)
OPND1==CURRT_OPND1
OPND2==CURRT_OPND2
IF CURRT_OPERN<128 OR 1<<CURRT_OPND2_FLAG&TRIPREFS=0 START ; ! BACK VIA OPND1
IF 1<<CURRT_OPND1_FLAG&TRIPREFS=0 THENRESULT =TRIP
RESULT =PRELOAD PLACE(OPND1_D)
FINISH
IF 1<<CURRT_OPND1_FLAG&TRIPREFS=0 OR OPND1_D=CURRT_BLINK THEN C
RESULT =PRELOAD PLACE(OPND2_D)
!
! BOTH OPERANDS ARE LOADED TRIPLES
!
IF CURRT_BLINK=OPND2_D THENRESULT =PRELOADPLACE(OPND1_D)
RESULT =-1; ! TOO COMPLICATED
END
ROUTINE NOOP(INTEGER TRIPLE NO, RECORD (RD) NAME ROPND)
!***********************************************************************
!* THIS TRIPLE HAS BECOME A NOOP.DELETE IT AND PASS ITS ENTRY TRIPLE*
!* FORWARD TO ANT WHO USE IT *
!***********************************************************************
RECORD (TRIPF) NAME CURRT,NOOPT
RECORD (RD) NAME OPND1,OPND2
INTEGER PTR,CNT
NOOPT==TRIPLES(TRIPLE NO); ! THIS ONE TO BECOME NOOP
CNT=NOOPT_CNT; ! HOW MANY TIMES USED
IMPABORT UNLESS CNT=1; ! NO OPS ELIMINATED BEFORE DUPS
PTR=NOOPT_BLINK
WHILE PTR>0 CYCLE
CURRT==TRIPLES(PTR)
IF CURRT_PUSE=TRIPLE NO THEN CURRT_PUSE=NOOPT_PUSE
PTR=CURRT_BLINK
REPEAT
PTR=NOOPT_FLINK
CYCLE
CURRT==TRIPLES(PTR)
PTR=CURRT_FLINK
CONTINUE IF CURRT_OPERN=NULLT
OPND1==CURRT_OPND1
OPND2==CURRT_OPND2
IF (OPND1_FLAG=REFTRIP OR OPND1_FLAG=INDIRECT) C
AND OPND1_D=TRIPLE NO THENSTART
IF OPND1_FLAG=INDIRECT THEN RETURN ;! CAN OPTIMISE AT PRESESNT
OPND1=ROPND
CNT=CNT-1
IF OPND1_FLAG#REFTRIP THEN CURRT_FLAGS=CURRT_FLAGS!LOAD OP1
FINISH
IF CURRT_OPERN>=128 AND OPND2_D=TRIPLE NO AND C
(OPND2_FLAG=REFTRIP OR OPND2_FLAG=INDIRECT) START
IF OPND2_FLAG=INDIRECT THEN RETURN
OPND2=ROPND
CNT=CNT-1
IF OPND2_FLAG#REFTRIP THEN CURRT_FLAGS=CURRT_FLAGS!LOAD OP2
FINISH
IF CNT=0 OR PTR=0 THENEXIT
IF NOOPT_OPND1_FLAG#REFTRIP THEN C
CURRT_DPTH<-CURRT_DPTH-WORDS(NOOPT_OPTYPE>>4)
REPEAT
NOOPT_X1=NOOPT_OPERN; ! FOR DEBUGGING
NOOPT_OPERN=NULLT; ! SET AS NOOP
NOOPT_PUSE=0
NOOPT_FLAGS=NOOPT_FLAGS!DONT OPT;! SKIP DUP CHECKING
CHANGES=CHANGES+1
END
ROUTINE DEC USE(INTEGER TRIPLE NO)
!***********************************************************************
!* A TRIPLE HAS BEEN PASSED INTO 'DEAD' CODE. DECREMENT ITS USE *
!* AND IF RELEVANT DELETE OPERATIONS LEADING TO IT *
!***********************************************************************
RECORD (TRIPF) NAME CURRT
CURRT==TRIPLES(TRIPLE NO)
CURRT_CNT=CURRT_CNT-1
IF CURRT_CNT=1 THEN DUPS=DUPS-1
IF CURRT_CNT=0 THEN DELETE TRIPLE(TRIPLE NO)
END
ROUTINE DELETE TRIPLE(INTEGER TRIPLE NO)
RECORD (TRIPF) NAME DELT
DELT==TRIPLES(TRIPLE NO)
IF DELT_OPND1_FLAG=REFTRIP OR DELT_OPND1_FLAG=INDIRECT THEN C
DEC USE(DELT_OPND1_D)
IF DELT_OPERN>=128 AND (DELT_OPND2_FLAG=REFTRIP OR C
DELT_OPND2_FLAG=INDIRECT) THEN DEC USE(DELT_OPND2_D)
DELT_X1=DELT_OPERN; ! FOR DEBUGGING
DELT_OPERN=NULLT; ! NO OP
DELT_FLAGS=DELT_FLAGS!DONT OPT
END
ROUTINE DUPLICATE TRIP(INTEGER TRIPNO,DTRIPNO)
!***********************************************************************
!* DTRIPNO IS A DUPLICATE OF TRIPNO. CHANGE ALL REFERENCES *
!* AND DELETE IT *
!***********************************************************************
RECORD (RD) NAME OPND1,OPND2
RECORD (TRIPF) NAME MASTER,CURRT,DUPT
INTEGER CNT,PTR
DUPS=DUPS+1
DUPTNO=TRIPNO
MASTER==TRIPLES(TRIPNO)
DUPT==TRIPLES(DTRIPNO)
CNT=DUPT_CNT
PTR=DUPT_FLINK
!
WHILE CNT>0 AND PTR>0 CYCLE
CURRT==TRIPLES(PTR)
PTR=CURRT_FLINK
IF CURRT_OPERN=NULLT THEN CONTINUE
OPND1==CURRT_OPND1
OPND2==CURRT_OPND2
IF OPND1_D=DTRIPNO AND (OPND1_FLAG=REFTRIP OR C
OPND1_FLAG=INDIRECT) START
MASTER_CNT=MASTER_CNT+1
OPND1_D=TRIPNO
CURRT_FLAGS=CURRT_FLAGS!LOAD OP1
CNT=CNT-1
FINISH
IF CURRT_OPERN>=128 AND OPND2_D=DTRIPNO AND C
(OPND2_FLAG=REFTRIP OR OPND2_FLAG=INDIRECT) START
MASTER_CNT=MASTER_CNT+1
OPND2_D=TRIPNO
CURRT_FLAGS=CURRT_FLAGS!LOAD OP2
CNT=CNT-1
FINISH
REPEAT
DELETE TRIPLE(DTRIPNO)
END
ROUTINE CHECK DUPS(INTEGER TRIPNO,STRIPNO)
!***********************************************************************
!* CHECK STARTING FROM STRIPNO FOR DUPLICATES OF TRIPNO *
!* MAY BE MORE THAN ONE *
!***********************************************************************
RECORD (TRIPF) NAME CURRT,DUPT
INTEGER OPERN,F,NEXT
DUPT==TRIPLES(TRIPNO)
OPERN=DUPT_OPERN
F=DUPT_FLAGS
WHILE STRIPNO>0 CYCLE
CURRT==TRIPLES(STRIPNO)
EXITIF CURRT_OPERN=TLAB OR CURRT_OPERN=RTXIT OR CURRT_OPERN=RCALL
EXITIF CURRT_OPERN=VASS OR CURRT_OPERN=VJASS;! PRO TEM
NEXT=CURRT_FLINK
IF CURRT_OPERN=OPERN AND ((OPERN<128 AND C
SAME OPND(DUPT_OPND1,CURRT_OPND1)=YES) OR (OPERN>=128 AND C
SAME OPND(DUPT_OPND1,CURRT_OPND1)=YES AND C
SAME OPND(DUPT_OPND2,CURRT_OPND2)=YES) OR (F&COMMUTABLE#0 AND C
SAME OPND(DUPT_OPND1,CURRT_OPND2)=YES AND C
SAME OPND(DUPT_OPND2,CURRT_OPND1)=YES)) START
DUPLICATE TRIP(TRIPNO,STRIPNO)
CHANGES=CHANGES+1
FINISH
STRIPNO=NEXT
REPEAT
END
INTEGERFN SAME OPND(RECORD (RD) NAME OPND1,OPND2)
!***********************************************************************
!* ARE THESE OPERANDS THE SAME ? *
!***********************************************************************
INTEGER F,I
RESULT =NO UNLESS OPND1_S1=OPND2_S1
F=OPND1_FLAG
IF F=2 OR F=5 START
RESULT =NO UNLESS OPND1_D=OPND2_D AND C
OPND1_XTRA=OPND2_XTRA AND OPND1_PTYPE&X'3000'=0
RESULT =YES
FINISH
IF F<=1 START ; ! CONSTANTS
IF OPND1_PTYPE=X'35' START
RESULT =NO UNLESS OPND1_XTRA=OPND2_XTRA
FOR I=1,1,OPND1_XTRA CYCLE
RESULT =NO UNLESS A(OPND1_D+I)=A(OPND2_D+I)
REPEAT
RESULT =YES
FINISH
RESULT =YES IF OPND1_D=OPND2_D AND (OPND1_XTRA=OPND2_XTRA OR C
OPND1_PTYPE&X'F0'<=X'50')
RESULT =NO
FINISH
RESULT =YES IF OPND1_D=OPND2_D AND OPND1_XTRA=OPND2_XTRA
RESULT =NO
END
END
ENDOFFILE