mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-05-28 12:41:35 +00:00
4e7a7e67e7
These mainly related to situations where the optimization of multiple natural loops (including those created by continue statements) could interact to generate invalid results. Invalid optimizations could also be performed in certain other cases where there were multiple goto statements targeting a single label and at least one of them formed a loop. These issues are addressed by appropriately adjusting the control flow and updating various data structures after each loop is processed during loop invariant removal. This fixes #18 (compca18.c).
4934 lines
151 KiB
ObjectPascal
4934 lines
151 KiB
ObjectPascal
{$optimize 7}
|
|
{---------------------------------------------------------------}
|
|
{ }
|
|
{ DAG Creation }
|
|
{ }
|
|
{ Places intermediate codes into DAGs and trees. }
|
|
{ }
|
|
{---------------------------------------------------------------}
|
|
|
|
unit DAG;
|
|
|
|
interface
|
|
|
|
{$segment 'CG'}
|
|
|
|
{$LibPrefix '0/obj/'}
|
|
|
|
uses CCommon, CGI, CGC, Gen;
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
procedure DAG (code: icptr);
|
|
|
|
{ place an op code in a DAG or tree }
|
|
{ }
|
|
{ parameters: }
|
|
{ code - opcode }
|
|
|
|
|
|
function TypeOf (op: icptr): baseTypeEnum;
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
implementation
|
|
|
|
var
|
|
c_ind: iclist; {vars that can be changed by indirect stores}
|
|
maxLoc: integer; {max local label number used by compiler}
|
|
memberOp: icptr; {operation found by Member}
|
|
optimizations: array[pcodes] of integer; {starting indexes into peeptable}
|
|
peepTablesInitialized: boolean; {have the peephole tables been initialized?}
|
|
rescan: boolean; {redo the optimization pass?}
|
|
|
|
{-- External unsigned math routines; imported from Expression.pas --}
|
|
|
|
function udiv (x,y: longint): longint; extern;
|
|
|
|
function umod (x,y: longint): longint; extern;
|
|
|
|
function umul (x,y: longint): longint; extern;
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
function CodesMatch (op1, op2: icptr; exact: boolean): boolean;
|
|
|
|
{ Check to see if the trees op1 and op2 are equivalent }
|
|
{ }
|
|
{ parameters: }
|
|
{ op1, op2 - trees to check }
|
|
{ exact - is an exact match of operands required? }
|
|
{ }
|
|
{ Returns: True if trees are equivalent, else false. }
|
|
|
|
|
|
function LongStrCmp (s1, s2: longStringPtr): boolean;
|
|
|
|
{ Are the strings s1 amd s2 equal? }
|
|
{ }
|
|
{ parameters: }
|
|
{ s1, s2 - strings to compare }
|
|
{ }
|
|
{ Returns: True if the strings are equal, else false }
|
|
|
|
label 1;
|
|
|
|
var
|
|
i: integer; {loop/index variable}
|
|
|
|
begin {LongStrCmp}
|
|
LongStrCmp := false;
|
|
if s1^.length = s2^.length then begin
|
|
for i := 1 to s1^.length do
|
|
if s1^.str[i] <> s2^.str[i] then
|
|
goto 1;
|
|
LongStrCmp := true;
|
|
end; {if}
|
|
1:
|
|
end; {LongStrCmp}
|
|
|
|
|
|
function OpsEqual (op1, op2: icptr): boolean;
|
|
|
|
{ See if the operands are equal }
|
|
{ }
|
|
{ parameters: }
|
|
{ op1, op2 - operations to check }
|
|
{ }
|
|
{ Returns: True if the operands are equivalent, else }
|
|
{ false. }
|
|
|
|
var
|
|
result: boolean; {temp result}
|
|
|
|
begin {OpsEqual}
|
|
result := false;
|
|
case op1^.opcode of
|
|
pc_cup, pc_cui, pc_tl1, pc_bno:
|
|
{this rule prevents optimizations from removing sensitive operations}
|
|
;
|
|
|
|
pc_adi, pc_adl, pc_adr, pc_and, pc_lnd, pc_bnd, pc_bal, pc_bor,
|
|
pc_blr, pc_bxr, pc_blx, pc_equ, pc_neq, pc_ior, pc_lor, pc_mpi,
|
|
pc_umi, pc_mpl, pc_uml, pc_mpr: begin
|
|
if op1^.left = op2^.left then
|
|
if op1^.right = op2^.right then
|
|
result := true;
|
|
if not result then
|
|
if op1^.left = op2^.right then
|
|
if op1^.right = op2^.left then
|
|
result := true;
|
|
if not result then
|
|
if not exact then
|
|
if CodesMatch(op1^.left, op2^.left, false) then
|
|
if CodesMatch(op1^.right, op2^.right, false) then
|
|
result := true;
|
|
if not result then
|
|
if not exact then
|
|
if CodesMatch(op1^.left, op2^.right, false) then
|
|
if CodesMatch(op1^.right, op2^.left, false) then
|
|
result := true;
|
|
end;
|
|
|
|
otherwise: begin
|
|
if op1^.left = op2^.left then
|
|
if op1^.right = op2^.right then
|
|
result := true;
|
|
if not result then
|
|
if not exact then
|
|
if CodesMatch(op1^.left, op2^.left, false) then
|
|
if CodesMatch(op1^.right, op2^.right, false) then
|
|
result := true;
|
|
end;
|
|
end; {case}
|
|
OpsEqual := result;
|
|
end; {OpsEqual}
|
|
|
|
|
|
begin {CodesMatch}
|
|
CodesMatch := false;
|
|
if op1 = op2 then
|
|
CodesMatch := true
|
|
else if (op1 <> nil) and (op2 <> nil) then
|
|
if op1^.opcode = op2^.opcode then
|
|
if op1^.q = op2^.q then
|
|
if op1^.r = op2^.r then
|
|
if op1^.s = op2^.s then
|
|
if op1^.lab^ = op2^.lab^ then
|
|
if OpsEqual(op1, op2) then
|
|
if op1^.optype = op2^.optype then
|
|
case op1^.optype of
|
|
cgByte, cgUByte, cgWord, cgUWord:
|
|
if op1^.opnd = op2^.opnd then
|
|
if op1^.llab = op2^.llab then
|
|
if op1^.slab = op2^.slab then
|
|
CodesMatch := true;
|
|
cgLong, cgULong:
|
|
if op1^.lval = op2^.lval then
|
|
CodesMatch := true;
|
|
cgReal, cgDouble, cgComp, cgExtended:
|
|
if op1^.rval = op2^.rval then
|
|
CodesMatch := true;
|
|
cgString:
|
|
CodesMatch := LongStrCmp(op1^.str, op2^.str);
|
|
cgVoid, ccPointer:
|
|
if op1^.pval = op2^.pval then
|
|
CodesMatch := LongStrCmp(op1^.str, op2^.str);
|
|
end; {case}
|
|
end; {CodesMatch}
|
|
|
|
{- Peephole Optimization ---------------------------------------}
|
|
|
|
function Base (val: longint): integer;
|
|
|
|
{ Assuming val is a power of 2, find ln(val) base 2 }
|
|
{ }
|
|
{ parameters: }
|
|
{ val - value for which to find the base }
|
|
{ }
|
|
{ Returns: ln(val), base 2 }
|
|
|
|
var
|
|
i: integer; {base counter}
|
|
|
|
begin {Base}
|
|
i := 0;
|
|
while not odd(val) do begin
|
|
val := val >> 1;
|
|
i := i+1;
|
|
end; {while}
|
|
Base := i;
|
|
end; {Base}
|
|
|
|
|
|
procedure BinOps (var op1, op2: icptr);
|
|
|
|
{ Make sure the operands are of the same type }
|
|
{ }
|
|
{ parameters: }
|
|
{ op1, op2: two pc_ldc operands }
|
|
|
|
var
|
|
opt1, opt2: baseTypeEnum; {temp operand types}
|
|
|
|
begin {BinOps}
|
|
opt1 := op1^.optype;
|
|
opt2 := op2^.optype;
|
|
if opt1 = cgByte then begin
|
|
op1^.optype := cgWord;
|
|
opt1 := cgWord;
|
|
end {if}
|
|
else if opt1 = cgUByte then begin
|
|
op1^.optype := cgUWord;
|
|
opt1 := cgUWord;
|
|
end {else if}
|
|
else if opt1 in [cgReal, cgDouble, cgComp] then begin
|
|
op1^.optype := cgExtended;
|
|
opt1 := cgExtended;
|
|
end; {else if}
|
|
if opt2 = cgByte then begin
|
|
op2^.optype := cgWord;
|
|
opt2 := cgWord;
|
|
end {if}
|
|
else if opt2 = cgUByte then begin
|
|
op2^.optype := cgUWord;
|
|
opt2 := cgUWord;
|
|
end {else if}
|
|
else if opt2 in [cgReal, cgDouble, cgComp] then begin
|
|
op2^.optype := cgExtended;
|
|
opt2 := cgExtended;
|
|
end; {else if}
|
|
|
|
if opt1 <> opt2 then begin
|
|
case opt1 of
|
|
cgWord:
|
|
case opt2 of
|
|
cgUWord:
|
|
op1^.optype := cgUWord;
|
|
cgLong, cgULong: begin
|
|
op1^.lval := op1^.q;
|
|
op1^.optype := opt2;
|
|
end;
|
|
cgExtended: begin
|
|
op1^.rval := op1^.q;
|
|
op1^.optype := cgExtended;
|
|
end;
|
|
otherwise: ;
|
|
end; {case}
|
|
cgUWord:
|
|
case opt2 of
|
|
cgWord:
|
|
op2^.optype := cgUWord;
|
|
cgLong, cgULong: begin
|
|
op1^.lval := ord4(op1^.q) & $0000FFFF;
|
|
op1^.optype := opt2;
|
|
end;
|
|
cgExtended: begin
|
|
op1^.rval := ord4(op1^.q) & $0000FFFF;
|
|
op1^.optype := cgExtended;
|
|
end;
|
|
otherwise: ;
|
|
end; {case}
|
|
cgLong:
|
|
case opt2 of
|
|
cgWord: begin
|
|
op2^.lval := op2^.q;
|
|
op2^.optype := cgLong;
|
|
end;
|
|
cgUWord: begin
|
|
op2^.lval := ord4(op2^.q) & $0000FFFF;
|
|
op2^.optype := cgLong;
|
|
end;
|
|
cgULong:
|
|
op1^.optype := cgULong;
|
|
cgExtended: begin
|
|
op1^.rval := op1^.lval;
|
|
op1^.optype := cgExtended;
|
|
end;
|
|
otherwise: ;
|
|
end; {case}
|
|
cgULong:
|
|
case opt2 of
|
|
cgWord: begin
|
|
op2^.lval := op2^.q;
|
|
op2^.optype := cgLong;
|
|
end;
|
|
cgUWord: begin
|
|
op2^.lval := ord4(op2^.q) & $0000FFFF;
|
|
op2^.optype := cgLong;
|
|
end;
|
|
cgLong:
|
|
op2^.optype := cgULong;
|
|
cgExtended: begin
|
|
op1^.rval := op1^.lval;
|
|
if op1^.rval < 0.0 then
|
|
op1^.rval := 4294967296.0 + op1^.rval;
|
|
op1^.optype := cgExtended;
|
|
end;
|
|
otherwise: ;
|
|
end; {case}
|
|
cgExtended: begin
|
|
case opt2 of
|
|
cgWord:
|
|
op2^.rval := op2^.q;
|
|
cgUWord:
|
|
op2^.rval := ord4(op2^.q) & $0000FFFF;
|
|
cgLong:
|
|
op2^.rval := op2^.lval;
|
|
cgULong: begin
|
|
op2^.rval := op2^.lval;
|
|
if op2^.rval < 0.0 then
|
|
op2^.rval := 4294967296.0 + op2^.rval;
|
|
end;
|
|
otherwise: ;
|
|
end; {case}
|
|
op2^.optype := cgExtended;
|
|
end;
|
|
otherwise: ;
|
|
end; {case}
|
|
end; {if}
|
|
end; {BinOps}
|
|
|
|
|
|
procedure CheckLabels;
|
|
|
|
{ remove unused dc_lab labels }
|
|
|
|
var
|
|
lop: icptr; {predecessor of op}
|
|
op: icptr; {used to trace the opcode list}
|
|
|
|
|
|
function Used (lab: integer): boolean;
|
|
|
|
{ see if a label is used }
|
|
{ }
|
|
{ parameters: }
|
|
{ lab - label number to check }
|
|
{ }
|
|
{ Returns: True if the label is used, else false. }
|
|
|
|
var
|
|
found: boolean; {was the label found?}
|
|
op: icptr; {used to trace the opcode list}
|
|
|
|
begin {Used}
|
|
found := false;
|
|
op := DAGhead;
|
|
while (not found) and (op <> nil) do begin
|
|
if op^.opcode in [pc_add, pc_fjp, pc_tjp, pc_ujp] then
|
|
found := op^.q = lab
|
|
else if op^.opcode = pc_nat then
|
|
found := true;
|
|
op := op^.next;
|
|
end; {while}
|
|
Used := found;
|
|
end; {Used}
|
|
|
|
|
|
begin {CheckLabels}
|
|
op := DAGhead;
|
|
while op^.next <> nil do begin
|
|
lop := op;
|
|
op := op^.next;
|
|
if op^.opcode = dc_lab then
|
|
if not Used(op^.q) then begin
|
|
lop^.next := op^.next;
|
|
op := lop;
|
|
rescan := true;
|
|
end; {if}
|
|
end; {while}
|
|
end; {CheckLabels}
|
|
|
|
|
|
procedure RemoveDeadCode (op: icptr);
|
|
|
|
{ remove dead code following an unconditional branch }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - unconditional branch opcode }
|
|
|
|
begin {RemoveDeadCode}
|
|
while not (op^.next^.opcode in [dc_lab, dc_enp, dc_cns, dc_glb,
|
|
dc_dst, dc_str, dc_pin, pc_ent, dc_loc, dc_prm, dc_sym]) do begin
|
|
op^.next := op^.next^.next;
|
|
rescan := true;
|
|
end; {while}
|
|
end; {RemoveDeadCode}
|
|
|
|
|
|
function NoFunctions (op: icptr): boolean;
|
|
|
|
{ are there any function calls? }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - operation tree to search }
|
|
{ }
|
|
{ returns: True if there are no pc_cup or pc_cui operations }
|
|
{ in the tree, else false. }
|
|
|
|
begin {NoFunctions}
|
|
if op = nil then
|
|
NoFunctions := true
|
|
else if op^.opcode in [pc_cup,pc_cui,pc_tl1] then
|
|
NoFunctions := false
|
|
else
|
|
NoFunctions := NoFunctions(op^.left) or NoFunctions(op^.right);
|
|
end; {NoFunctions}
|
|
|
|
|
|
function OneBit (val: longint): boolean;
|
|
|
|
{ See if there is exactly one bit set in val }
|
|
{ }
|
|
{ parameters: }
|
|
{ val - value to check }
|
|
{ }
|
|
{ Returns: True if exactly one bit is set, else false }
|
|
|
|
begin {OneBit}
|
|
if val = 0 then
|
|
OneBit := false
|
|
else begin
|
|
while not odd(val) do
|
|
val := val >> 1;
|
|
OneBit := val = 1;
|
|
end; {else}
|
|
end; {OneBit}
|
|
|
|
|
|
procedure PeepHoleOptimization (var opv: icptr);
|
|
|
|
{ do peephole optimization on a list of opcodes }
|
|
{ }
|
|
{ parameters: }
|
|
{ opv - pointer to the first opcode }
|
|
{ }
|
|
{ Notes: }
|
|
{ 1. Many optimizations assume the children have already }
|
|
{ been optimized. In particular, many optimizations }
|
|
{ depend on pc_ldc operands being on a specific side of }
|
|
{ a child's expression tree. (e.g. pc_fjp and pc_equ) }
|
|
|
|
var
|
|
done: boolean; {optimization done test}
|
|
doit: boolean; {should we do the optimization?}
|
|
lq, lval: longint; {temps for long calculations}
|
|
op2,op3: icptr; {temp opcodes}
|
|
op: icptr; {copy of op (for efficiency)}
|
|
opcode: pcodes; {temp opcode}
|
|
optype: baseTypeEnum; {temp optype}
|
|
q: integer; {temp for integer calculations}
|
|
rval: double; {temp for real calculations}
|
|
|
|
fromtype, totype, firstType: record {for converting numbers to optypes}
|
|
case boolean of
|
|
true: (i: integer);
|
|
false: (optype: baseTypeEnum);
|
|
end;
|
|
|
|
|
|
function SideEffects (op: icptr): boolean;
|
|
|
|
{ Check a tree for operations that have side effects }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - tree to check }
|
|
|
|
var
|
|
result: boolean; {temp result}
|
|
|
|
begin {SideEffects}
|
|
if op = nil then begin
|
|
if volatile then
|
|
SideEffects := true
|
|
else
|
|
SideEffects := false
|
|
end {if}
|
|
else if op^.opcode in
|
|
[pc_mov,pc_cbf,pc_cop,pc_cpi,pc_cpo,pc_gil,pc_gli,pc_gdl,
|
|
pc_gld,pc_iil,pc_ili,pc_idl,pc_ild,pc_lil,pc_lli,pc_ldl,
|
|
pc_lld,pc_sbf,pc_sro,pc_sto,pc_str,pc_cui,pc_cup,pc_tl1] then
|
|
SideEffects := true
|
|
else if op^.opcode = pc_ldc then
|
|
SideEffects := false
|
|
else
|
|
SideEffects := SideEffects(op^.left) or SideEffects(op^.right);
|
|
end; {SideEffects}
|
|
|
|
|
|
procedure JumpOptimizations (op: icptr; newOpcode: pcodes);
|
|
|
|
{ handle common code for jump optimizations }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - jump opcode }
|
|
{ newOpcode - opcode to use if the jump sense is reversed }
|
|
|
|
var
|
|
done: boolean; {optimization done test}
|
|
topcode: pcodes; {temp opcode}
|
|
|
|
begin {JumpOptimizations}
|
|
topcode := op^.left^.opcode;
|
|
if topcode = pc_not then begin
|
|
op^.left := op^.left^.left;
|
|
op^.opcode := newOpcode;
|
|
PeepHoleOptimization(opv);
|
|
end {else if}
|
|
else if topcode in [pc_neq,pc_equ] then begin
|
|
with op^.left^.right^ do
|
|
if opcode = pc_ldc then
|
|
if optype in [cgByte,cgUByte,cgWord,cgUWord] then
|
|
if q = 0 then begin
|
|
op^.left := op^.left^.left;
|
|
if topcode = pc_equ then
|
|
op^.opcode := newOpcode;
|
|
end; {if}
|
|
end; {else if}
|
|
if op^.next^.opcode = dc_lab then
|
|
if op^.next^.q = op^.q then
|
|
if not SideEffects(op^.left) then begin
|
|
rescan := true;
|
|
opv := op^.next;
|
|
end; {else if}
|
|
end; {JumpOptimizations}
|
|
|
|
|
|
procedure RealStoreOptimizations (op, opl: icptr);
|
|
|
|
{ do strength reductions associated with stores of reals }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - real store to optimize }
|
|
{ opl - load operand for the store operation }
|
|
|
|
var
|
|
disp: 0..9; {disp to the word to change}
|
|
same: boolean; {are the operands the same?}
|
|
op2: icptr; {new opcode}
|
|
opt: icptr; {temp opcode}
|
|
|
|
cnvrl: record {for stuffing a real in a long space}
|
|
case boolean of
|
|
true: (lval: longint);
|
|
false: (rval: real);
|
|
end;
|
|
|
|
begin {RealStoreOptimizations}
|
|
if opl^.opcode = pc_ngr then begin
|
|
same := false;
|
|
with opl^.left^ do
|
|
if op^.opcode = pc_sro then begin
|
|
if opcode = pc_ldo then
|
|
if q = op^.q then
|
|
if optype = op^.optype then
|
|
if lab^ = op^.lab^ then
|
|
same := true;
|
|
end {if}
|
|
else {if op^.opcode = pc_str then}
|
|
if opcode = pc_lod then
|
|
if q = op^.q then
|
|
if r = op^.r then
|
|
if optype = op^.optype then
|
|
same := true;
|
|
if same then begin
|
|
case op^.optype of
|
|
cgReal: disp := 3;
|
|
cgDouble: disp := 7;
|
|
cgExtended: disp := 9;
|
|
cgComp: disp := 11;
|
|
end; {case}
|
|
opl^.left^.optype := cgWord;
|
|
opl^.left^.q := opl^.left^.q + disp;
|
|
op^.optype := cgWord;
|
|
op^.q := op^.q + disp;
|
|
op2 := pointer(Calloc(sizeof(intermediate_code)));
|
|
op2^.opcode := pc_ldc;
|
|
op2^.optype := cgWord;
|
|
op2^.q := $0080;
|
|
opl^.right := op2;
|
|
opl^.opcode := pc_bxr;
|
|
end {if}
|
|
else if op^.optype = cgReal then begin
|
|
opt := opl^.left;
|
|
if opt^.opcode in [pc_ind,pc_ldo,pc_lod] then
|
|
if opt^.optype = cgReal then begin
|
|
opt^.optype := cgLong;
|
|
op^.optype := cgLong;
|
|
op2 := pointer(Calloc(sizeof(intermediate_code)));
|
|
op2^.opcode := pc_ldc;
|
|
op2^.optype := cgLong;
|
|
op2^.lval := $80000000;
|
|
opl^.right := op2;
|
|
opl^.opcode := pc_blx;
|
|
end; {if}
|
|
end; {else if}
|
|
end {if}
|
|
else if op^.optype = cgReal then begin
|
|
if opl^.opcode = pc_ldc then begin
|
|
cnvrl.rval := opl^.rval;
|
|
opl^.lval := cnvrl.lval;
|
|
opl^.optype := cgLong;
|
|
op^.optype := cgLong;
|
|
end {if}
|
|
else if opl^.opcode in [pc_ind,pc_ldo,pc_lod] then
|
|
if opl^.optype = cgReal then begin
|
|
opl^.optype := cgLong;
|
|
op^.optype := cgLong;
|
|
end; {if}
|
|
end; {if}
|
|
end; {RealStoreOptimizations}
|
|
|
|
|
|
procedure ReplaceLoads (ldop, stop, tree: icptr);
|
|
|
|
{ Replace any pc_lod operations in tree that load from the }
|
|
{ location stored to by the pc_str operation stop by ldop }
|
|
{ }
|
|
{ parameters: }
|
|
{ ldop - operation to replace the pc_lods with }
|
|
{ stop - pc_str operation }
|
|
{ tree - tree to check for pc_lod operations }
|
|
{ }
|
|
{ Notes: ldop must be an instruction, not a tree }
|
|
|
|
begin {ReplaceLoads}
|
|
if tree^.left <> nil then
|
|
ReplaceLoads(ldop, stop, tree^.left);
|
|
if tree^.right <> nil then
|
|
ReplaceLoads(ldop, stop, tree^.right);
|
|
if tree^.opcode = pc_lod then
|
|
if tree^.optype = stop^.optype then
|
|
if tree^.q = stop^.q then
|
|
if tree^.r = stop^.r then
|
|
tree^ := ldop^;
|
|
end; {ReplaceLoads}
|
|
|
|
|
|
procedure ReverseChildren (op: icptr);
|
|
|
|
{ reverse the children of a node }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - node for which to reverse the children }
|
|
|
|
var
|
|
opt: icptr; {temp opcode pointer}
|
|
|
|
begin {ReverseChildren}
|
|
opt := op^.right;
|
|
op^.right := op^.left;
|
|
op^.left := opt;
|
|
end; {ReverseChildren}
|
|
|
|
|
|
procedure ZeroIntermediateCode (op: icptr);
|
|
|
|
{ Set all fields in the record to 0, nil, etc. }
|
|
{ }
|
|
{ Parameters: }
|
|
{ op - intermediate code record to clear }
|
|
|
|
begin {ZeroIntermediateCode}
|
|
op^.q := 0;
|
|
op^.r := 0;
|
|
op^.s := 0;
|
|
op^.lab := nil;
|
|
op^.next := nil;
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
op^.optype := cgWord;
|
|
op^.opnd := 0;
|
|
op^.llab := 0;
|
|
op^.slab := 0;
|
|
end; {ZeroIntermediateCode}
|
|
|
|
|
|
begin {PeepHoleOptimization}
|
|
{if printSymbols then begin write('Optimize: '); WriteCode(opv); end; {debug}
|
|
op := opv; {copy for efficiency}
|
|
if op^.left <> nil then {optimize the children}
|
|
PeepHoleOptimization(op^.left);
|
|
if op^.right <> nil then
|
|
PeepHoleOptimization(op^.right);
|
|
case op^.opcode of {check for optimizations of this node}
|
|
pc_add: begin {pc_add}
|
|
if op^.next^.opcode <> pc_add then
|
|
RemoveDeadCode(op);
|
|
end; {case pc_add}
|
|
|
|
pc_adi: begin {pc_adi}
|
|
if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
|
|
op^.left^.q := op^.left^.q + op^.right^.q;
|
|
opv := op^.left;
|
|
end {if}
|
|
else begin
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
q := op^.right^.q;
|
|
if q = 0 then
|
|
opv := op^.left
|
|
else if q > 0 then begin
|
|
op^.opcode := pc_inc;
|
|
op^.q := q;
|
|
op^.right := nil;
|
|
end {else if}
|
|
else {if q < 0 then} begin
|
|
op^.opcode := pc_dec;
|
|
op^.q := -q;
|
|
op^.right := nil;
|
|
end; {else if}
|
|
end {if}
|
|
else if CodesMatch(op^.left, op^.right, false) then begin
|
|
if not SideEffects(op^.left) then begin
|
|
ZeroIntermediateCode(op^.right);
|
|
with op^.right^ do begin
|
|
opcode := pc_ldc;
|
|
q := 1;
|
|
optype := cgWord;
|
|
end; {with}
|
|
op^.opcode := pc_shl;
|
|
PeepHoleOptimization(opv);
|
|
end; {if}
|
|
end {else if}
|
|
else if op^.left^.opcode in [pc_inc,pc_dec] then begin
|
|
if op^.right^.opcode in [pc_inc,pc_dec] then begin
|
|
op2 := op^.left;
|
|
if op2^.opcode = pc_inc then
|
|
q := op2^.q
|
|
else
|
|
q := -op2^.q;
|
|
if op^.right^.opcode = pc_inc then
|
|
q := q + op^.right^.q
|
|
else
|
|
q := q - op^.right^.q;
|
|
if q >= 0 then begin
|
|
op2^.opcode := pc_inc;
|
|
op2^.q := q;
|
|
end {if}
|
|
else begin
|
|
op2^.opcode := pc_dec;
|
|
op2^.q := -q;
|
|
end; {else}
|
|
op^.left := op^.left^.left;
|
|
op^.right := op^.right^.left;
|
|
op2^.left := op;
|
|
opv := op2;
|
|
PeepHoleOptimization(opv);
|
|
end; {if}
|
|
end; {else if}
|
|
end; {else}
|
|
end; {case pc_adi}
|
|
|
|
pc_adl: begin {pc_adl}
|
|
if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
|
|
op^.left^.lval := op^.left^.lval + op^.right^.lval;
|
|
opv := op^.left;
|
|
end {if}
|
|
else begin
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
lval := op^.right^.lval;
|
|
if lval = 0 then
|
|
opv := op^.left
|
|
else if (lval >= 0) and (lval <= maxint) then begin
|
|
op^.opcode := pc_inc;
|
|
op^.optype := cgLong;
|
|
op^.q := ord(lval);
|
|
op^.right := nil;
|
|
end {else if}
|
|
else if (lval > -maxint) and (lval < 0) then begin
|
|
op^.opcode := pc_dec;
|
|
op^.optype := cgLong;
|
|
op^.q := -ord(lval);
|
|
op^.right := nil;
|
|
end; {else if}
|
|
end {if}
|
|
else if CodesMatch(op^.left, op^.right, false) then
|
|
if not SideEffects(op^.left) then begin
|
|
ZeroIntermediateCode(op^.right);
|
|
with op^.right^ do begin
|
|
opcode := pc_ldc;
|
|
lval := 1;
|
|
optype := cgLong;
|
|
end; {with}
|
|
op^.opcode := pc_sll;
|
|
end; {if}
|
|
if op^.right^.opcode in [pc_lao,pc_lda,pc_ixa] then
|
|
ReverseChildren(op);
|
|
if op^.left^.opcode in [pc_lao,pc_lda,pc_ixa] then
|
|
if op^.right^.opcode = pc_sll then begin
|
|
if op^.right^.right^.opcode = pc_ldc then
|
|
if (op^.right^.right^.lval & $FFFF8000) = 0 then
|
|
if op^.right^.left^.opcode = pc_cnv then begin
|
|
fromtype.i := (op^.right^.left^.q & $00F0) >> 4;
|
|
if fromType.optype in [cgByte,cgUByte,cgWord,cgUWord] then
|
|
if op^.left^.opcode = pc_lda then
|
|
begin
|
|
if fromType.optype = cgByte then
|
|
op^.right^.left^.q := $02
|
|
else if fromType.optype = cgUByte then
|
|
op^.right^.left^.q := $13
|
|
else
|
|
op^.right^.left := op^.right^.left^.left;
|
|
with op^.right^.right^ do begin
|
|
lq := lval;
|
|
lval := 0;
|
|
q := long(lq).lsw;
|
|
optype := cgUWord;
|
|
end; {with}
|
|
op^.right^.opcode := pc_shl;
|
|
op^.opcode := pc_ixa;
|
|
if fromType.optype in [cgByte,cgWord] then
|
|
op^.optype := cgWord
|
|
else
|
|
op^.optype := cgUWord;
|
|
PeepHoleOptimization(opv);
|
|
end; {if}
|
|
end; {if}
|
|
end {if}
|
|
else if op^.right^.opcode = pc_cnv then begin
|
|
fromtype.i := (op^.right^.q & $00F0) >> 4;
|
|
if fromtype.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin
|
|
if fromType.optype = cgByte then
|
|
op^.right^.q := $02
|
|
else if fromType.optype = cgUByte then
|
|
op^.right^.q := $13
|
|
else
|
|
op^.right := op^.right^.left;
|
|
op^.opcode := pc_ixa;
|
|
if fromType.optype in [cgByte,cgWord] then
|
|
op^.optype := cgWord
|
|
else
|
|
op^.optype := cgUWord;
|
|
PeepHoleOptimization(opv);
|
|
end; {if}
|
|
end; {else if}
|
|
end; {else}
|
|
end; {case pc_adl}
|
|
|
|
pc_adr: begin {pc_adr}
|
|
if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
|
|
op^.left^.rval := op^.left^.rval + op^.right^.rval;
|
|
opv := op^.left;
|
|
end {if}
|
|
else begin
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
if op^.right^.rval = 0.0 then
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {else}
|
|
end; {case pc_adr}
|
|
|
|
pc_and: begin {pc_and}
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.q := ord((op^.left^.q <> 0) and (op^.right^.q <> 0));
|
|
opv := op^.left;
|
|
end {if}
|
|
else begin
|
|
if op^.right^.q = 0 then
|
|
if not SideEffects(op^.left) then
|
|
opv := op^.right;
|
|
end {else}
|
|
end {if}
|
|
else if op^.left^.opcode = pc_ldc then
|
|
if op^.left^.q = 0 then
|
|
opv := op^.left;
|
|
end; {case pc_and}
|
|
|
|
pc_bal: begin {pc_bal}
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.lval := op^.left^.lval & op^.right^.lval;
|
|
opv := op^.left;
|
|
end {if}
|
|
else if op^.right^.opcode = pc_ldc then begin
|
|
if op^.right^.lval = 0 then
|
|
opv := op^.right
|
|
else if op^.right^.lval = -1 then
|
|
opv := op^.left;
|
|
end; {else if}
|
|
end; {case pc_bal}
|
|
|
|
pc_blr: begin {pc_blr}
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.lval := op^.left^.lval | op^.right^.lval;
|
|
opv := op^.left;
|
|
end {if}
|
|
else if op^.right^.opcode = pc_ldc then begin
|
|
if op^.right^.lval = -1 then
|
|
opv := op^.right
|
|
else if op^.right^.lval = 0 then
|
|
opv := op^.left;
|
|
end; {else if}
|
|
end; {case pc_blr}
|
|
|
|
pc_blx: begin {pc_blx}
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.lval := op^.left^.lval ! op^.right^.lval;
|
|
opv := op^.left;
|
|
end {if}
|
|
else if op^.right^.opcode = pc_ldc then begin
|
|
if op^.right^.lval = 0 then
|
|
opv := op^.left
|
|
else if op^.right^.lval = -1 then begin
|
|
op^.opcode := pc_bnl;
|
|
op^.right := nil;
|
|
end; {else if}
|
|
end; {else if}
|
|
end; {case pc_blx}
|
|
|
|
pc_bnd: begin {pc_bnd}
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.q := op^.left^.q & op^.right^.q;
|
|
opv := op^.left;
|
|
end {if}
|
|
else if op^.right^.opcode = pc_ldc then begin
|
|
if op^.right^.q = 0 then
|
|
opv := op^.right
|
|
else if op^.right^.q = -1 then
|
|
opv := op^.left;
|
|
end; {else if}
|
|
end; {case pc_bnd}
|
|
|
|
pc_bnl: begin {pc_bnl}
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.lval := op^.left^.lval ! $FFFFFFFF;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_bnl}
|
|
|
|
pc_bno: begin {pc_bno}
|
|
{Invalid optimization disabled}
|
|
{if op^.left^.opcode = pc_str then
|
|
if op^.left^.left^.opcode in [pc_lda,pc_lao] then begin
|
|
ReplaceLoads(op^.left^.left, op^.left, op^.right);
|
|
opv := op^.right;
|
|
end;} {if}
|
|
end; {case pc_bno}
|
|
|
|
pc_bnt: begin {pc_bnt}
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.q := op^.left^.q ! $FFFF;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_bnt}
|
|
|
|
pc_bor: begin {pc_bor}
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.q := op^.left^.q | op^.right^.q;
|
|
opv := op^.left;
|
|
end {if}
|
|
else if op^.right^.opcode = pc_ldc then begin
|
|
if op^.right^.q = -1 then
|
|
opv := op^.right
|
|
else if op^.right^.q = 0 then
|
|
opv := op^.left;
|
|
end; {else if}
|
|
end; {case pc_bor}
|
|
|
|
pc_bxr: begin {pc_bxr}
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.q := op^.left^.q ! op^.right^.q;
|
|
opv := op^.left;
|
|
end {if}
|
|
else if op^.right^.opcode = pc_ldc then begin
|
|
if op^.right^.q = 0 then
|
|
opv := op^.left
|
|
else if op^.right^.q = -1 then begin
|
|
op^.opcode := pc_bnt;
|
|
op^.right := nil;
|
|
end; {else if}
|
|
end; {else if}
|
|
end; {case pc_bxr}
|
|
|
|
pc_cnv: begin {pc_cnv}
|
|
fromtype.i := (op^.q & $00F0) >> 4;
|
|
totype.i := op^.q & $000F;
|
|
if (fromtype.optype = cgWord) and (TypeOf(op^.left) = cgUByte) then begin
|
|
fromType.optype := cgUWord;
|
|
op^.q := (op^.q & $FF0F) | (fromtype.i << 4);
|
|
end; {if}
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
case fromtype.optype of
|
|
cgByte,cgWord:
|
|
case totype.optype of
|
|
cgByte,cgUByte,cgWord,cgUWord: ;
|
|
cgLong,cgULong: begin
|
|
lval := op^.left^.q;
|
|
op^.left^.q := 0;
|
|
op^.left^.lval := lval;
|
|
end;
|
|
cgReal,cgDouble,cgComp,cgExtended: begin
|
|
rval := op^.left^.q;
|
|
op^.left^.q := 0;
|
|
op^.left^.rval := rval;
|
|
end;
|
|
otherwise: ;
|
|
end; {case}
|
|
cgUByte,cgUWord:
|
|
case totype.optype of
|
|
cgByte,cgUByte,cgWord,cgUWord: ;
|
|
cgLong,cgULong: begin
|
|
lval := ord4(op^.left^.q) & $0000FFFF;
|
|
op^.left^.q := 0;
|
|
op^.left^.lval := lval;
|
|
end;
|
|
cgReal,cgDouble,cgComp,cgExtended: begin
|
|
rval := ord4(op^.left^.q) & $0000FFFF;
|
|
op^.left^.q := 0;
|
|
op^.left^.rval := rval;
|
|
end;
|
|
otherwise: ;
|
|
end; {case}
|
|
cgLong:
|
|
case totype.optype of
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
q := long(op^.left^.lval).lsw;
|
|
op^.left^.lval := 0;
|
|
op^.left^.q := q;
|
|
end;
|
|
cgLong, cgULong: ;
|
|
cgReal,cgDouble,cgComp,cgExtended: begin
|
|
rval := op^.left^.lval;
|
|
op^.left^.lval := 0;
|
|
op^.left^.rval := rval;
|
|
end;
|
|
otherwise: ;
|
|
end; {case}
|
|
cgULong:
|
|
case totype.optype of
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
q := long(op^.left^.lval).lsw;
|
|
op^.left^.lval := 0;
|
|
op^.left^.q := q;
|
|
end;
|
|
cgLong, cgULong: ;
|
|
cgReal,cgDouble,cgComp,cgExtended: begin
|
|
lval := op^.left^.lval;
|
|
op^.left^.lval := 0;
|
|
if lval >= 0 then
|
|
rval := lval
|
|
else
|
|
rval := (lval & $7FFFFFFF) + 2147483648.0;
|
|
op^.left^.rval := rval;
|
|
end;
|
|
otherwise: ;
|
|
end; {case}
|
|
cgReal,cgDouble,cgComp,cgExtended: begin
|
|
rval := op^.left^.rval;
|
|
case totype.optype of
|
|
cgByte: begin
|
|
if rval < -128.0 then
|
|
q := -128
|
|
else if rval > 127.0 then
|
|
q := 127
|
|
else
|
|
q := trunc(rval);
|
|
op^.left^.rval := 0.0;
|
|
op^.left^.q := q;
|
|
end;
|
|
cgUByte: begin
|
|
if rval < 0.0 then
|
|
q := 0
|
|
else if rval > 255.0 then
|
|
q := 255
|
|
else
|
|
q := trunc(rval);
|
|
op^.left^.rval := 0.0;
|
|
op^.left^.q := q;
|
|
end;
|
|
cgWord: begin
|
|
if rval < -32768.0 then
|
|
lval := -32768
|
|
else if rval > 32767.0 then
|
|
lval := 32767
|
|
else
|
|
lval := trunc(rval);
|
|
op^.left^.rval := 0.0;
|
|
op^.left^.q := long(lval).lsw;
|
|
end;
|
|
cgUWord: begin
|
|
if rval < 0.0 then
|
|
lval := 0
|
|
else if rval > 65535.0 then
|
|
lval := 65535
|
|
else
|
|
lval := trunc4(rval);
|
|
op^.left^.rval := 0.0;
|
|
op^.left^.q := long(lval).lsw;
|
|
end;
|
|
cgLong: begin
|
|
if rval < -2147483648.0 then
|
|
lval := $80000000
|
|
else if rval > 2147483647.0 then
|
|
lval := 2147483647
|
|
else
|
|
lval := trunc4(rval);
|
|
op^.left^.rval := 0.0;
|
|
op^.left^.lval := lval;
|
|
end;
|
|
cgULong: begin
|
|
if rval < 0.0 then
|
|
lval := 0
|
|
else if rval >= 4294967295.0 then
|
|
lval := $FFFFFFFF
|
|
else if rval > 2147483647.0 then begin
|
|
rval := rval - 2147483647.0;
|
|
lval := 2147483647 + trunc4(rval);
|
|
end {else if}
|
|
else
|
|
lval := trunc4(rval);
|
|
op^.left^.rval := 0.0;
|
|
op^.left^.lval := lval;
|
|
end;
|
|
cgReal,cgDouble,cgComp,cgExtended: ;
|
|
otherwise: ;
|
|
end;
|
|
end; {case}
|
|
otherwise: ;
|
|
end; {case}
|
|
if fromtype.optype in
|
|
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgReal,cgDouble,
|
|
cgComp,cgExtended] then
|
|
if totype.optype in
|
|
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgReal,cgDouble,
|
|
cgComp,cgExtended] then begin
|
|
op^.left^.optype := totype.optype;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end {if}
|
|
else if op^.left^.opcode = pc_cnv then begin
|
|
doit := false;
|
|
firsttype.i := (op^.left^.q & $00F0) >> 4;
|
|
if fromType.optype in [cgReal,cgDouble,cgComp,cgExtended] then begin
|
|
if toType.optype in [cgReal,cgDouble,cgComp,cgExtended] then
|
|
doit := true;
|
|
end {if}
|
|
else begin
|
|
if firstType.optype in [cgByte,cgWord,cgLong] then
|
|
if fromType.optype in [cgByte,cgWord,cgLong] then
|
|
if toType.optype in [cgByte,cgWord,cgLong] then
|
|
doit := true;
|
|
if firstType.optype in [cgUByte,cgUWord,cgULong] then
|
|
if fromType.optype in [cgUByte,cgUWord,cgULong] then
|
|
if toType.optype in [cgUByte,cgUWord,cgLong] then
|
|
doit := true;
|
|
if TypeSize(firstType.optype) = TypeSize(fromType.optype) then
|
|
if TypeSize(firstType.optype) = TypeSize(toType.optype) then
|
|
doit := true;
|
|
if TypeSize(fromType.optype) < TypeSize(firstType.optype) then
|
|
if TypeSize(fromType.optype) < TypeSize(toType.optype) then
|
|
doit := false; {disable optimization in invalid cases}
|
|
end; {else}
|
|
if doit then begin
|
|
op^.q := (op^.left^.q & $00F0) | (op^.q & $000F);
|
|
op^.left := op^.left^.left;
|
|
PeepHoleOptimization(opv);
|
|
end; {if}
|
|
end {else if}
|
|
else if op^.left^.opcode in [pc_lod,pc_ldo,pc_ind] then begin
|
|
if fromtype.optype in [cgWord,cgUWord] then
|
|
if totype.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin
|
|
op^.left^.optype := totype.optype;
|
|
opv := op^.left;
|
|
end; {if}
|
|
if fromtype.optype in [cgLong,cgULong] then
|
|
if totype.optype in [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong]
|
|
then begin
|
|
op^.left^.optype := totype.optype;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end {else if}
|
|
else if op^.q in [$40,$41,$50,$51] then begin
|
|
{any long type to byte type}
|
|
with op^.left^ do
|
|
if opcode = pc_bal then
|
|
if right^.opcode = pc_ldc then
|
|
if right^.lval = 255 then begin
|
|
op^.left := op^.left^.left;
|
|
PeepHoleOptimization(opv);
|
|
end; {if}
|
|
with op^.left^ do
|
|
if opcode in [pc_slr,pc_vsr] then
|
|
if right^.opcode = pc_ldc then
|
|
if left^.opcode in [pc_lod,pc_ldo,pc_ind] then begin
|
|
lq := right^.lval;
|
|
if long(lq).msw = 0 then
|
|
if long(lq).lsw in [8,16,24] then begin
|
|
lq := lq div 8;
|
|
left^.q := left^.q + long(lq).lsw;
|
|
op^.left := left;
|
|
PeepHoleOptimization(opv);
|
|
end; {if}
|
|
end; {if}
|
|
end; {else if}
|
|
end; {case pc_cnv}
|
|
|
|
pc_dec: begin {pc_dec}
|
|
if op^.q = 0 then
|
|
opv := op^.left
|
|
else begin
|
|
opcode := op^.left^.opcode;
|
|
if opcode = pc_dec then begin
|
|
if ord4(op^.left^.q) + ord4(op^.q) < ord4(maxint) then begin
|
|
op^.q := op^.q + op^.left^.q;
|
|
op^.left := op^.left^.left;
|
|
end; {if}
|
|
end {if}
|
|
else if opcode = pc_inc then begin
|
|
q := op^.q - op^.left^.q;
|
|
if q < 0 then begin
|
|
q := -q;
|
|
op^.opcode := pc_inc;
|
|
end; {if}
|
|
op^.q := q;
|
|
op^.left := op^.left^.left;
|
|
PeepHoleOptimization(opv);
|
|
end {else if}
|
|
else if opcode = pc_ldc then begin
|
|
if op^.optype in [cgLong, cgULong] then begin
|
|
op^.left^.lval := op^.left^.lval - op^.q;
|
|
opv := op^.left;
|
|
end {if}
|
|
else if op^.optype in [cgUByte, cgByte, cgUWord, cgWord] then begin
|
|
op^.left^.q := op^.left^.q - op^.q;
|
|
opv := op^.left;
|
|
end; {else if}
|
|
end; {else if}
|
|
end; {else}
|
|
end; {case pc_dec}
|
|
|
|
pc_dvi: begin {pc_dvi}
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
if op^.right^.q <> 0 then begin
|
|
op^.left^.q := op^.left^.q div op^.right^.q;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end {if}
|
|
else if op^.right^.q = 1 then
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_dvi}
|
|
|
|
pc_dvl: begin {pc_dvl}
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
if op^.right^.lval <> 0 then begin
|
|
op^.left^.lval := op^.left^.lval div op^.right^.lval;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end {if}
|
|
else if op^.right^.lval = 1 then
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_dvl}
|
|
|
|
pc_dvr: begin {pc_dvr}
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
if op^.right^.rval <> 0.0 then begin
|
|
op^.left^.rval := op^.left^.rval/op^.right^.rval;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end {if}
|
|
else if op^.right^.rval = 1.0 then
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_dvr}
|
|
|
|
pc_equ: begin {pc_equ}
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
BinOps(op^.left, op^.right);
|
|
case op^.left^.optype of
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
op^.opcode := pc_ldc;
|
|
op^.q := ord(op^.left^.q = op^.right^.q);
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
end;
|
|
cgLong,cgULong: begin
|
|
op^.opcode := pc_ldc;
|
|
op^.q := ord(op^.left^.lval = op^.right^.lval);
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
end;
|
|
cgReal,cgDouble,cgComp,cgExtended: begin
|
|
op^.opcode := pc_ldc;
|
|
op^.q := ord(op^.left^.rval = op^.right^.rval);
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
end;
|
|
cgVoid,ccPointer: begin
|
|
op^.opcode := pc_ldc;
|
|
op^.q := ord(op^.left^.pval = op^.right^.pval);
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
end;
|
|
end; {case}
|
|
end {if}
|
|
else if op^.right^.optype in [cgByte, cgUByte, cgWord, cgUWord] then begin
|
|
if op^.right^.q <> 0 then
|
|
if op^.left^.opcode in
|
|
[pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt]
|
|
then begin
|
|
opv := op^.left;
|
|
opv^.next := op^.next;
|
|
end; {if}
|
|
end {else if}
|
|
else if op^.right^.optype in [cgLong, cgULong] then begin
|
|
if op^.right^.lval <> 0 then
|
|
if op^.left^.opcode in
|
|
[pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt]
|
|
then begin
|
|
opv := op^.left;
|
|
opv^.next := op^.next;
|
|
end; {if}
|
|
end; {else if}
|
|
end; {if}
|
|
end; {case pc_equ}
|
|
|
|
pc_fjp: begin {pc_fjp}
|
|
opcode := op^.left^.opcode;
|
|
if opcode = pc_ldc then begin
|
|
if op^.left^.optype in [cgByte, cgUByte, cgWord, cgUWord] then begin
|
|
if op^.left^.q <> 0 then begin
|
|
opv := op^.next;
|
|
rescan := true;
|
|
end {if}
|
|
else begin
|
|
op^.opcode := pc_ujp;
|
|
op^.left := nil;
|
|
PeepHoleOptimization(opv);
|
|
end; {else}
|
|
end {if}
|
|
end {if}
|
|
else if opcode = pc_and then begin
|
|
op2 := op^.left;
|
|
op2^.next := op^.next;
|
|
op^.next := op2;
|
|
op^.left := op2^.left;
|
|
op2^.left := op2^.right;
|
|
op2^.right := nil;
|
|
op2^.opcode := pc_fjp;
|
|
op2^.q := op^.q;
|
|
PeepHoleOptimization(opv);
|
|
end {else if}
|
|
else if opcode = pc_ior then begin
|
|
op2 := op^.left;
|
|
op2^.next := op^.next;
|
|
op^.next := op2;
|
|
op^.left := op2^.left;
|
|
op2^.left := op2^.right;
|
|
op2^.right := nil;
|
|
op2^.opcode := pc_fjp;
|
|
op2^.q := op^.q;
|
|
op^.opcode := pc_tjp;
|
|
op3 := pointer(Calloc(sizeof(intermediate_code)));
|
|
op3^.opcode := dc_lab;
|
|
op3^.optype := cgWord;
|
|
op3^.q := GenLabel;
|
|
op3^.next := op2^.next;
|
|
op2^.next := op3;
|
|
op^.q := op3^.q;
|
|
PeepHoleOptimization(opv);
|
|
end {else if}
|
|
else
|
|
JumpOptimizations(op, pc_tjp);
|
|
end; {case pc_fjp}
|
|
|
|
pc_inc: begin {pc_inc}
|
|
if op^.q = 0 then
|
|
opv := op^.left
|
|
else begin
|
|
opcode := op^.left^.opcode;
|
|
if opcode = pc_inc then begin
|
|
if ord4(op^.left^.q) + ord4(op^.q) < ord4(maxint) then begin
|
|
op^.q := op^.q + op^.left^.q;
|
|
op^.left := op^.left^.left;
|
|
end; {if}
|
|
end {if}
|
|
else if opcode = pc_dec then begin
|
|
q := op^.q - op^.left^.q;
|
|
if q < 0 then begin
|
|
q := -q;
|
|
op^.opcode := pc_dec;
|
|
end; {if}
|
|
op^.q := q;
|
|
op^.left := op^.left^.left;
|
|
PeepHoleOptimization(opv);
|
|
end {else if}
|
|
else if opcode = pc_ldc then begin
|
|
if op^.optype in [cgLong, cgULong] then begin
|
|
op^.left^.lval := op^.left^.lval + op^.q;
|
|
opv := op^.left;
|
|
end {if}
|
|
else if op^.optype in [cgUByte, cgByte, cgUWord, cgWord] then begin
|
|
op^.left^.q := op^.left^.q + op^.q;
|
|
opv := op^.left;
|
|
end; {else if}
|
|
end {else if}
|
|
else if opcode in [pc_lao,pc_lda] then begin
|
|
op^.left^.q := op^.left^.q + op^.q;
|
|
opv := op^.left;
|
|
end; {else if}
|
|
end; {else}
|
|
end; {case pc_inc}
|
|
|
|
pc_ind: begin {pc_ind}
|
|
opcode := op^.left^.opcode;
|
|
if opcode = pc_lda then begin
|
|
op^.left^.opcode := pc_lod;
|
|
op^.left^.optype := op^.optype;
|
|
op^.left^.q := op^.left^.q + op^.q;
|
|
opv := op^.left;
|
|
end {if}
|
|
else if opcode = pc_lao then begin
|
|
op^.left^.opcode := pc_ldo;
|
|
op^.left^.optype := op^.optype;
|
|
op^.left^.q := op^.left^.q + op^.q;
|
|
opv := op^.left;
|
|
end {else if}
|
|
else if opcode = pc_inc then begin
|
|
if op^.left^.optype = cgULong then begin
|
|
if ord4(op^.left^.q) + ord4(op^.q) < ord4(maxint - 1) then begin
|
|
op^.q := op^.q + op^.left^.q;
|
|
op^.left := op^.left^.left;
|
|
PeepHoleOptimization(opv);
|
|
end; {if}
|
|
end; {if}
|
|
end; {else if}
|
|
end; {case pc_ind}
|
|
|
|
pc_ior: begin {pc_ior}
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.q := ord((op^.left^.q <> 0) or (op^.right^.q <> 0));
|
|
opv := op^.left;
|
|
end {if}
|
|
else begin
|
|
if op^.right^.q <> 0 then begin
|
|
if not SideEffects(op^.left) then begin
|
|
op^.right^.q := 1;
|
|
opv := op^.right;
|
|
end; {if}
|
|
end {if}
|
|
else
|
|
op^.opcode := pc_neq;
|
|
end {if}
|
|
end {if}
|
|
else if op^.left^.opcode = pc_ldc then
|
|
if op^.left^.q <> 0 then begin
|
|
op^.left^.q := 1;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_ior}
|
|
|
|
pc_ixa: begin {pc_ixa}
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
optype := op^.optype;
|
|
if optype in [cgUByte, cgByte, cgUWord, cgWord] then begin
|
|
lval := op^.right^.q;
|
|
if optype = cgUByte then
|
|
lval := lval & $000000FF
|
|
else if optype = cgUWord then
|
|
lval := lval & $0000FFFF;
|
|
done := false;
|
|
if op^.left^.opcode in [pc_lao, pc_lda] then begin
|
|
lq := op^.left^.q + lval;
|
|
if (lq >= 0) and (lq < maxint) then begin
|
|
done := true;
|
|
op^.left^.q := ord(lq);
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {if}
|
|
if not done then begin
|
|
op^.right^.lval := lval;
|
|
op^.right^.optype := cgLong;
|
|
op^.opcode := pc_adl;
|
|
PeepHoleOptimization(opv);
|
|
end; {if}
|
|
end; {if}
|
|
end {if}
|
|
else if op^.left^.opcode = pc_lao then begin
|
|
if op^.right^.opcode = pc_inc then begin
|
|
lq := ord4(op^.right^.q) + ord4(op^.left^.q);
|
|
if lq < maxint then begin
|
|
op^.left^.q := ord(lq);
|
|
op^.right := op^.right^.left;
|
|
end; {if}
|
|
PeepHoleOptimization(opv);
|
|
end; {if}
|
|
end {else if}
|
|
else if op^.left^.opcode = pc_ixa then begin
|
|
if smallMemoryModel then
|
|
if op^.left^.left^.opcode in [pc_lao,pc_lda] then
|
|
if op^.left^.left^.q = 0 then begin
|
|
op2 := op^.left;
|
|
op^.left := op^.left^.left;
|
|
op2^.left := op^.right;
|
|
op2^.opcode := pc_adi;
|
|
op^.right := op2;
|
|
op^.optype := cgUWord;
|
|
end; {if}
|
|
end; {else if}
|
|
end; {case pc_ixa}
|
|
|
|
pc_leq, pc_les, pc_geq, pc_grt: begin {pc_leq, pc_les, pc_geq, pc_grt}
|
|
if (op^.opcode = pc_leq) and (op^.optype in [cgWord,cgUWord]) then
|
|
if op^.right^.opcode = pc_ldc then
|
|
if op^.right^.q < maxint then begin
|
|
op^.right^.q := op^.right^.q + 1;
|
|
op^.opcode := pc_les;
|
|
end; {if}
|
|
if (op^.optype = cgWord) then
|
|
if (TypeOf(op^.right) = cgUByte)
|
|
or ((op^.right^.opcode = pc_ldc) and (op^.right^.q >= 0)
|
|
and (op^.right^.optype in [cgByte,cgUByte,cgWord])) then
|
|
if (TypeOf(op^.left) = cgUByte)
|
|
or ((op^.left^.opcode = pc_ldc) and (op^.left^.q >= 0)
|
|
and (op^.left^.optype in [cgByte,cgUByte,cgWord])) then
|
|
op^.optype := cgUWord;
|
|
end; {case pc_leq, pc_les, pc_geq, pc_grt}
|
|
|
|
pc_lnd: begin {pc_lnd}
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.q := ord((op^.left^.lval <> 0) and (op^.right^.lval <> 0));
|
|
op^.left^.optype := cgWord;
|
|
opv := op^.left;
|
|
end {if}
|
|
else begin
|
|
if op^.right^.lval = 0 then begin
|
|
if not SideEffects(op^.left) then begin
|
|
with op^.right^ do begin
|
|
lval := 0;
|
|
optype := cgWord;
|
|
q := 0;
|
|
end; {with}
|
|
opv := op^.right;
|
|
end; {if}
|
|
end {if}
|
|
else
|
|
op^.opcode := pc_neq;
|
|
end; {if}
|
|
end {if}
|
|
else if op^.left^.opcode = pc_ldc then
|
|
if op^.left^.lval = 0 then begin
|
|
with op^.left^ do begin
|
|
lval := 0;
|
|
optype := cgWord;
|
|
q := 0;
|
|
end; {with}
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_lnd}
|
|
|
|
pc_lnm: begin {pc_lnm}
|
|
if op^.next^.opcode = pc_lnm then begin
|
|
opv := op^.next;
|
|
rescan := true;
|
|
end; {if}
|
|
end; {case pc_lnm}
|
|
|
|
pc_lor: begin {pc_lor}
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.q := ord((op^.left^.lval <> 0) or (op^.right^.lval <> 0));
|
|
optype := cgWord;
|
|
opv := op^.left;
|
|
end {if}
|
|
else begin
|
|
if op^.right^.lval <> 0 then begin
|
|
if not SideEffects(op^.left) then begin
|
|
op^.right^.lval := 0;
|
|
op^.right^.q := 1;
|
|
op^.right^.optype := cgWord;
|
|
opv := op^.right;
|
|
end; {if}
|
|
end {if}
|
|
else begin
|
|
op^.opcode := pc_neq;
|
|
op^.optype := cgLong;
|
|
end; {else}
|
|
end; {if}
|
|
end {if}
|
|
else if op^.left^.opcode = pc_ldc then
|
|
if op^.left^.lval <> 0 then begin
|
|
op^.left^.lval := 0;
|
|
op^.left^.q := 1;
|
|
op^.left^.optype := cgWord;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_lor}
|
|
|
|
pc_mdl: begin {pc_mdl}
|
|
if op^.right^.opcode = pc_ldc then
|
|
if op^.left^.opcode = pc_ldc then
|
|
if op^.right^.lval <> 0 then begin
|
|
op^.left^.lval := op^.left^.lval mod op^.right^.lval;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_mdl}
|
|
|
|
pc_mod: begin {pc_mod}
|
|
if op^.right^.opcode = pc_ldc then
|
|
if op^.left^.opcode = pc_ldc then
|
|
if op^.right^.q <> 0 then begin
|
|
op^.left^.q := op^.left^.q mod op^.right^.q;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_mod}
|
|
|
|
pc_mpi, pc_umi: begin {pc_mpi, pc_umi}
|
|
if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
|
|
if op^.opcode = pc_mpi then
|
|
op^.left^.q := op^.left^.q*op^.right^.q
|
|
else {if op^.opcode = pc_umi then} begin
|
|
lval := umul(op^.left^.q & $0000FFFF, op^.right^.q & $0000FFFF);
|
|
op^.left^.q := long(lval).lsw;
|
|
end; {else}
|
|
opv := op^.left;
|
|
end {if}
|
|
else begin
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
q := op^.right^.q;
|
|
if q = 1 then
|
|
opv := op^.left
|
|
else if q = 0 then begin
|
|
if not SideEffects(op^.left) then
|
|
opv := op^.right;
|
|
end {else if}
|
|
else if (q = -1) and (op^.opcode = pc_mpi) then begin
|
|
op^.opcode := pc_ngi;
|
|
op^.right := nil;
|
|
end {else if}
|
|
else if OneBit(q) then begin
|
|
op^.right^.q := Base(q);
|
|
op^.opcode := pc_shl;
|
|
PeepHoleOptimization(opv);
|
|
end; {else if}
|
|
end; {if}
|
|
end; {else}
|
|
end; {case pc_mpi, pc_umi}
|
|
|
|
pc_mpl, pc_uml: begin {pc_mpl, pc_uml}
|
|
if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
|
|
if op^.opcode = pc_mpl then
|
|
op^.left^.lval := op^.left^.lval*op^.right^.lval
|
|
else {if op^.opcode = pc_uml then}
|
|
op^.left^.lval := umul(op^.left^.lval, op^.right^.lval);
|
|
opv := op^.left;
|
|
end {if}
|
|
else begin
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
lval := op^.right^.lval;
|
|
if lval = 1 then
|
|
opv := op^.left
|
|
else if lval = 0 then begin
|
|
if not SideEffects(op^.left) then
|
|
opv := op^.right;
|
|
end {else if}
|
|
else if (lval = -1) and (op^.opcode = pc_mpl) then begin
|
|
op^.opcode := pc_ngl;
|
|
op^.right := nil;
|
|
end {else if}
|
|
else if OneBit(lval) then begin
|
|
op^.right^.lval := Base(lval);
|
|
op^.opcode := pc_sll;
|
|
end; {else if}
|
|
end; {if}
|
|
end; {else}
|
|
end; {case pc_mpl, pc_uml}
|
|
|
|
pc_mpr: begin {pc_mpr}
|
|
if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
|
|
op^.left^.rval := op^.left^.rval*op^.right^.rval;
|
|
opv := op^.left;
|
|
end {if}
|
|
else begin
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
rval := op^.right^.rval;
|
|
if rval = 1.0 then
|
|
opv := op^.left
|
|
else if rval = 0.0 then
|
|
if not SideEffects(op^.left) then
|
|
opv := op^.right;
|
|
end; {if}
|
|
end; {else}
|
|
end; {case pc_mpr}
|
|
|
|
pc_neq: begin {pc_neq}
|
|
if op^.left^.opcode = pc_ldc then
|
|
ReverseChildren(op);
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
BinOps(op^.left, op^.right);
|
|
case op^.left^.optype of
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
op^.opcode := pc_ldc;
|
|
op^.q := ord(op^.left^.q <> op^.right^.q);
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
end;
|
|
cgLong,cgULong: begin
|
|
op^.opcode := pc_ldc;
|
|
op^.q := ord(op^.left^.lval <> op^.right^.lval);
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
end;
|
|
cgReal,cgDouble,cgComp,cgExtended: begin
|
|
op^.opcode := pc_ldc;
|
|
op^.q := ord(op^.left^.rval <> op^.right^.rval);
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
end;
|
|
cgVoid,ccPointer: begin
|
|
op^.opcode := pc_ldc;
|
|
op^.q := ord(op^.left^.pval <> op^.right^.pval);
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
end;
|
|
end; {case}
|
|
end {if}
|
|
else if op^.right^.optype in [cgByte, cgUByte, cgWord, cgUWord] then begin
|
|
if op^.right^.q = 0 then
|
|
if op^.left^.opcode in
|
|
[pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt]
|
|
then begin
|
|
opv := op^.left;
|
|
opv^.next := op^.next;
|
|
end; {if}
|
|
end {else if}
|
|
else if op^.right^.optype in [cgLong, cgULong] then begin
|
|
if op^.right^.lval = 0 then
|
|
if op^.left^.opcode in
|
|
[pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt]
|
|
then begin
|
|
opv := op^.left;
|
|
opv^.next := op^.next;
|
|
end; {if}
|
|
end; {else if}
|
|
end; {if}
|
|
end; {case pc_neq}
|
|
|
|
pc_ngi: begin {pc_ngi}
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.q := -op^.left^.q;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_ngi}
|
|
|
|
pc_ngl: begin {pc_ngl}
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.lval := -op^.left^.lval;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_ngl}
|
|
|
|
pc_ngr: begin {pc_ngr}
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
op^.left^.rval := -op^.left^.rval;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_ngr}
|
|
|
|
pc_not: begin {pc_not}
|
|
opcode := op^.left^.opcode;
|
|
if opcode = pc_ldc then begin
|
|
if op^.left^.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin
|
|
op^.left^.q := ord(op^.left^.q = 0);
|
|
opv := op^.left;
|
|
end {if}
|
|
else if op^.left^.optype in [cgLong,cgULong] then begin
|
|
q := ord(op^.left^.lval = 0);
|
|
lval := 0;
|
|
op^.left^.q := q;
|
|
op^.left^.optype := cgWord;
|
|
opv := op^.left;
|
|
end; {else if}
|
|
end {if}
|
|
else if opcode = pc_equ then begin
|
|
op^.left^.opcode := pc_neq;
|
|
opv := op^.left;
|
|
end {else if}
|
|
else if opcode = pc_neq then begin
|
|
op^.left^.opcode := pc_equ;
|
|
opv := op^.left;
|
|
end {else if}
|
|
else if opcode = pc_geq then begin
|
|
op^.left^.opcode := pc_les;
|
|
opv := op^.left;
|
|
end {else if}
|
|
else if opcode = pc_grt then begin
|
|
op^.left^.opcode := pc_leq;
|
|
opv := op^.left;
|
|
end {else if}
|
|
else if opcode = pc_les then begin
|
|
op^.left^.opcode := pc_geq;
|
|
opv := op^.left;
|
|
end {else if}
|
|
else if opcode = pc_leq then begin
|
|
op^.left^.opcode := pc_grt;
|
|
opv := op^.left;
|
|
end; {else if}
|
|
end; {case pc_not}
|
|
|
|
pc_pop: begin {pc_pop}
|
|
if op^.left^.opcode = pc_cnv then
|
|
op^.left := op^.left^.left;
|
|
opcode := op^.left^.opcode;
|
|
if opcode = pc_cop then begin
|
|
op^.left^.opcode := pc_str;
|
|
opv := op^.left;
|
|
opv^.next := op^.next;
|
|
PeepHoleOptimization(opv);
|
|
end {if}
|
|
else if opcode = pc_cpi then begin
|
|
op^.left^.opcode := pc_sto;
|
|
opv := op^.left;
|
|
opv^.next := op^.next;
|
|
PeepHoleOptimization(opv);
|
|
end {else if}
|
|
else if opcode = pc_cbf then begin
|
|
op^.left^.opcode := pc_sbf;
|
|
opv := op^.left;
|
|
opv^.next := op^.next;
|
|
end {else if}
|
|
else if opcode = pc_cpo then begin
|
|
op^.left^.opcode := pc_sro;
|
|
opv := op^.left;
|
|
opv^.next := op^.next;
|
|
PeepHoleOptimization(opv);
|
|
end {else if}
|
|
else if opcode in [pc_inc,pc_dec] then
|
|
op^.left := op^.left^.left;
|
|
end; {case pc_pop}
|
|
|
|
pc_ret: begin {pc_ret}
|
|
RemoveDeadCode(op);
|
|
end; {case pc_ret}
|
|
|
|
pc_sbi: begin {pc_sbi}
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
op^.left^.q := op^.left^.q - op^.right^.q;
|
|
opv := op^.left;
|
|
end {if}
|
|
else if op^.left^.q = 0 then begin
|
|
op^.opcode := pc_ngi;
|
|
op^.left := op^.right;
|
|
op^.right := nil;
|
|
end; {else if}
|
|
end {if}
|
|
else if op^.right^.opcode = pc_ldc then begin
|
|
q := op^.right^.q;
|
|
if q = 0 then
|
|
opv := op^.left
|
|
else if (q > 0) then begin
|
|
op^.opcode := pc_dec;
|
|
op^.q := q;
|
|
op^.right := nil;
|
|
end {else if}
|
|
else {if q < 0) then} begin
|
|
op^.opcode := pc_inc;
|
|
op^.q := -q;
|
|
op^.right := nil;
|
|
end; {else if}
|
|
end {if}
|
|
else if op^.left^.opcode in [pc_inc,pc_dec] then
|
|
if op^.right^.opcode in [pc_inc,pc_dec] then begin
|
|
op2 := op^.left;
|
|
if op^.left^.opcode = pc_inc then
|
|
q := op^.left^.q
|
|
else
|
|
q := -op^.left^.q;
|
|
if op^.right^.opcode = pc_inc then
|
|
q := q - op^.right^.q
|
|
else
|
|
q := q + op^.right^.q;
|
|
if q >= 0 then begin
|
|
op2^.opcode := pc_inc;
|
|
op2^.q := q;
|
|
end {if}
|
|
else begin
|
|
op2^.opcode := pc_dec;
|
|
op2^.q := -q;
|
|
end; {else}
|
|
op^.left := op^.left^.left;
|
|
op^.right := op^.right^.left;
|
|
op2^.left := op;
|
|
opv := op2;
|
|
PeepHoleOptimization(opv);
|
|
end; {if}
|
|
end; {case pc_sbi}
|
|
|
|
pc_sbl: begin {pc_sbl}
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
op^.left^.lval := op^.left^.lval - op^.right^.lval;
|
|
opv := op^.left;
|
|
end {if}
|
|
else if op^.left^.lval = 0 then begin
|
|
op^.opcode := pc_ngl;
|
|
op^.left := op^.right;
|
|
op^.right := nil;
|
|
end; {else if}
|
|
end {if}
|
|
else if op^.right^.opcode = pc_ldc then begin
|
|
lval := op^.right^.lval;
|
|
if lval = 0 then
|
|
opv := op^.left
|
|
else if (lval > 0) and (lval <= maxint) then begin
|
|
op^.opcode := pc_dec;
|
|
op^.q := ord(lval);
|
|
op^.right := nil;
|
|
op^.optype := cgLong;
|
|
end {else if}
|
|
else if (lval > -maxint) and (lval < 0) then begin
|
|
op^.opcode := pc_inc;
|
|
op^.q := -ord(lval);
|
|
op^.right := nil;
|
|
op^.optype := cgLong;
|
|
end; {else if}
|
|
end; {if}
|
|
end; {case pc_sbl}
|
|
|
|
pc_sbr: begin {pc_sbr}
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
op^.left^.rval := op^.left^.rval - op^.right^.rval;
|
|
opv := op^.left;
|
|
end {if}
|
|
else if op^.left^.rval = 0.0 then begin
|
|
op^.opcode := pc_ngr;
|
|
op^.left := op^.right;
|
|
op^.right := nil;
|
|
end; {else if}
|
|
end {if}
|
|
else if op^.right^.opcode = pc_ldc then begin
|
|
if op^.right^.rval = 0.0 then
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_sbr}
|
|
|
|
pc_shl: begin {pc_shl}
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
opcode := op^.left^.opcode;
|
|
if opcode = pc_shl then begin
|
|
if op^.left^.right^.opcode = pc_ldc then begin
|
|
op^.right^.q := op^.right^.q + op^.left^.right^.q;
|
|
op^.left := op^.left^.left;
|
|
end; {if}
|
|
end {if}
|
|
else if opcode = pc_inc then begin
|
|
op2 := op^.left;
|
|
op^.left := op2^.left;
|
|
op2^.q := op2^.q << op^.right^.q;
|
|
op2^.left := op;
|
|
opv := op2;
|
|
PeepHoleOptimization(op2^.left);
|
|
end; {else if}
|
|
end; {if}
|
|
end; {case pc_shl}
|
|
|
|
pc_sro, pc_str: begin {pc_sro, pc_str}
|
|
if op^.optype in [cgReal,cgDouble,cgExtended] then
|
|
RealStoreOptimizations(op, op^.left);
|
|
end; {case pc_sro, pc_str}
|
|
|
|
pc_sto: begin {pc_sto}
|
|
if op^.optype in [cgReal,cgDouble,cgExtended] then
|
|
RealStoreOptimizations(op, op^.right);
|
|
if op^.left^.opcode = pc_lao then begin
|
|
op^.q := op^.left^.q;
|
|
op^.lab := op^.left^.lab;
|
|
op^.opcode := pc_sro;
|
|
op^.left := op^.right;
|
|
op^.right := nil;
|
|
end {if}
|
|
else if op^.left^.opcode = pc_lda then begin
|
|
op^.q := op^.left^.q;
|
|
op^.r := op^.left^.r;
|
|
op^.opcode := pc_str;
|
|
op^.left := op^.right;
|
|
op^.right := nil;
|
|
end; {if}
|
|
end; {case pc_sto}
|
|
|
|
pc_tjp: begin {pc_tjp}
|
|
opcode := op^.left^.opcode;
|
|
if opcode = pc_ldc then begin
|
|
if op^.left^.optype in [cgByte, cgUByte, cgWord, cgUWord] then
|
|
if op^.left^.q = 0 then begin
|
|
opv := op^.next;
|
|
rescan := true;
|
|
end {if}
|
|
else begin
|
|
op^.opcode := pc_ujp;
|
|
op^.left := nil;
|
|
PeepHoleOptimization(opv);
|
|
end; {else}
|
|
end {if}
|
|
else if opcode = pc_ior then begin
|
|
op2 := op^.left;
|
|
op2^.next := op^.next;
|
|
op^.next := op2;
|
|
op^.left := op2^.left;
|
|
op2^.left := op2^.right;
|
|
op2^.right := nil;
|
|
op2^.opcode := pc_tjp;
|
|
op2^.q := op^.q;
|
|
PeepHoleOptimization(opv);
|
|
end {else if}
|
|
else if opcode = pc_and then begin
|
|
op2 := op^.left;
|
|
op2^.next := op^.next;
|
|
op^.next := op2;
|
|
op^.left := op2^.left;
|
|
op2^.left := op2^.right;
|
|
op2^.right := nil;
|
|
op2^.opcode := pc_tjp;
|
|
op2^.q := op^.q;
|
|
op^.opcode := pc_fjp;
|
|
op3 := pointer(Calloc(sizeof(intermediate_code)));
|
|
op3^.opcode := dc_lab;
|
|
op3^.optype := cgWord;
|
|
op3^.q := GenLabel;
|
|
op3^.next := op2^.next;
|
|
op2^.next := op3;
|
|
op^.q := op3^.q;
|
|
PeepHoleOptimization(opv);
|
|
end {else if}
|
|
else
|
|
JumpOptimizations(op, pc_fjp);
|
|
end; {case pc_tjp}
|
|
|
|
pc_tri: begin {pc_tri}
|
|
opcode := op^.left^.opcode;
|
|
if opcode = pc_not then begin
|
|
ReverseChildren(op^.right);
|
|
op^.left := op^.left^.left;
|
|
PeepHoleOptimization(opv);
|
|
end {if}
|
|
else if opcode in [pc_equ, pc_neq] then begin
|
|
with op^.left^.right^ do
|
|
if opcode = pc_ldc then
|
|
if optype in [cgByte,cgUByte,cgWord,cgUWord] then
|
|
if q = 0 then begin
|
|
if op^.left^.opcode = pc_equ then
|
|
ReverseChildren(op^.right);
|
|
op^.left := op^.left^.left;
|
|
end; {if}
|
|
end; {else if}
|
|
end; {case pc_tri}
|
|
|
|
pc_udi: begin {pc_udi}
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
q := op^.right^.q;
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
if q <> 0 then begin
|
|
op^.left^.q := ord(udiv(op^.left^.q & $0000FFFF, q & $0000FFFF));
|
|
opv := op^.left;
|
|
end; {if}
|
|
end {if}
|
|
else if q = 1 then
|
|
opv := op^.left
|
|
else if OneBit(q) then begin
|
|
op^.right^.q := Base(q);
|
|
op^.opcode := pc_usr;
|
|
end; {else if}
|
|
end; {if}
|
|
end; {case pc_udi}
|
|
|
|
pc_udl: begin {pc_udl}
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
lq := op^.right^.lval;
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
if lq <> 0 then begin
|
|
op^.left^.lval := udiv(op^.left^.lval, lq);
|
|
opv := op^.left;
|
|
end; {if}
|
|
end {if}
|
|
else if lq = 1 then
|
|
opv := op^.left
|
|
else if OneBit(lq) then begin
|
|
op^.right^.lval := Base(lq);
|
|
op^.opcode := pc_vsr;
|
|
end; {else if}
|
|
end; {if}
|
|
end; {case pc_udl}
|
|
|
|
pc_uim: begin {pc_uim}
|
|
if op^.right^.opcode = pc_ldc then
|
|
if op^.left^.opcode = pc_ldc then
|
|
if op^.right^.q <> 0 then begin
|
|
op^.left^.q :=
|
|
ord(umod(op^.left^.q & $0000FFFF, op^.right^.q & $0000FFFF));
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_uim}
|
|
|
|
pc_ujp: begin {pc_ujp}
|
|
RemoveDeadCode(op);
|
|
if op^.next^.opcode = dc_lab then begin
|
|
if op^.q = op^.next^.q then begin
|
|
opv := op^.next;
|
|
rescan := true;
|
|
end {if}
|
|
else if op^.next^.next^.opcode = dc_lab then
|
|
if op^.next^.next^.q = op^.q then begin
|
|
opv := op^.next;
|
|
rescan := true;
|
|
end; {if}
|
|
end; {if}
|
|
end; {case pc_ujp}
|
|
|
|
pc_ulm: begin {pc_ulm}
|
|
if op^.right^.opcode = pc_ldc then
|
|
if op^.left^.opcode = pc_ldc then
|
|
if op^.right^.lval <> 0 then begin
|
|
op^.left^.lval := umod(op^.left^.lval, op^.right^.lval);
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_ulm}
|
|
|
|
otherwise: ;
|
|
end; {case}
|
|
end; {PeepHoleOptimization}
|
|
|
|
{- Common Subexpression Elimination ----------------------------}
|
|
|
|
function MatchLoc (op1, op2: icptr): boolean;
|
|
|
|
{ See if two loads, stores or copies refer to the same }
|
|
{ location }
|
|
{ }
|
|
{ parameters: }
|
|
{ op1, op2 - operations to check }
|
|
{ }
|
|
{ Returns: True if they do, false if they don't. }
|
|
|
|
begin {MatchLoc}
|
|
MatchLoc := false;
|
|
if (op1^.opcode in [pc_str,pc_cop,pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl,pc_lda])
|
|
and (op2^.opcode in [pc_str,pc_cop,pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl,pc_lda]) then begin
|
|
if op1^.r = op2^.r then
|
|
MatchLoc := true;
|
|
end {if}
|
|
else if (op1^.opcode in [pc_sro,pc_cpo,pc_ldo,pc_gli,pc_gil,pc_gld,pc_gdl,pc_lao])
|
|
and (op2^.opcode in [pc_sro,pc_cpo,pc_ldo,pc_gli,pc_gil,pc_gld,pc_gdl,pc_lao]) then
|
|
if op1^.lab^ = op2^.lab^ then
|
|
MatchLoc := true;
|
|
end; {MatchLoc}
|
|
|
|
|
|
function Member (op: icptr; list: iclist): boolean;
|
|
|
|
{ See if the operand of a load is referenced in a list }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - load to check }
|
|
{ list - list to check }
|
|
{ }
|
|
{ Returns: True if op is in list, else false. }
|
|
{ }
|
|
{ Notes: As a side effect, this subroutine sets memberOp to }
|
|
{ point to any matching member; memberOp is undefined if }
|
|
{ there is no matching member. }
|
|
|
|
begin {Member}
|
|
Member := false;
|
|
while list <> nil do begin
|
|
if MatchLoc(op, list^.op) then begin
|
|
Member := true;
|
|
memberOp := list^.op;
|
|
list := nil;
|
|
end {if}
|
|
else
|
|
list := list^.next;
|
|
end; {while}
|
|
end; {Member}
|
|
|
|
|
|
function TypeOf {(op: icptr): baseTypeEnum};
|
|
|
|
{ find the type for the expression tree }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - tree for which to find the type }
|
|
{ }
|
|
{ Returns: base type }
|
|
|
|
begin {TypeOf}
|
|
case op^.opcode of
|
|
pc_gil, pc_gli, pc_gdl, pc_gld, pc_iil, pc_ili, pc_idl, pc_ild,
|
|
pc_ldc, pc_ldo, pc_lil, pc_lli, pc_ldl, pc_lld, pc_lod, pc_dec,
|
|
pc_inc, pc_ind, pc_lbf, pc_lbu, pc_cop, pc_cbf, pc_cpi, pc_cpo,
|
|
pc_tri, pc_cup, pc_cui:
|
|
TypeOf := op^.optype;
|
|
|
|
pc_lad, pc_lao, pc_lca, pc_lda, pc_psh, pc_ixa:
|
|
TypeOf := cgULong;
|
|
|
|
pc_nop, pc_bnt, pc_ngi, pc_not, pc_adi, pc_and, pc_lnd, pc_bnd,
|
|
pc_bor, pc_bxr, pc_dvi, pc_equ, pc_geq, pc_grt, pc_leq, pc_les,
|
|
pc_neq, pc_ior, pc_lor, pc_mod, pc_mpi, pc_sbi, pc_shl, pc_shr:
|
|
TypeOf := cgWord;
|
|
|
|
pc_udi, pc_uim, pc_umi, pc_usr:
|
|
TypeOf := cgUWord;
|
|
|
|
pc_bnl, pc_ngl, pc_adl, pc_bal, pc_blr, pc_blx, pc_dvl, pc_mdl,
|
|
pc_mpl, pc_sbl, pc_sll, pc_slr:
|
|
TypeOf := cgLong;
|
|
|
|
pc_udl, pc_ulm, pc_uml, pc_vsr:
|
|
TypeOf := cgULong;
|
|
|
|
pc_ngr, pc_adr, pc_dvr, pc_mpr, pc_sbr:
|
|
TypeOf := cgExtended;
|
|
|
|
pc_cnn, pc_cnv:
|
|
TypeOf := baseTypeEnum(op^.q & $000F);
|
|
|
|
pc_stk:
|
|
TypeOf := TypeOf(op^.left);
|
|
|
|
pc_bno:
|
|
TypeOf := TypeOf(op^.right);
|
|
|
|
pc_tl1: {pc_tl1 doesn't have type info.}
|
|
TypeOf := cgVoid; {Just return cgVoid for now.}
|
|
|
|
otherwise: Error(cge1);
|
|
end; {case}
|
|
end; {TypeOf}
|
|
|
|
|
|
procedure CommonSubexpressionElimination;
|
|
|
|
{ Remove common subexpressions }
|
|
|
|
type
|
|
localPtr = ^localRecord; {list of local temp variables}
|
|
localRecord = record
|
|
next: localPtr; {next label in list}
|
|
inUse: boolean; {is this temp already in use?}
|
|
size: integer; {size of the temp area}
|
|
lab: integer; {label number}
|
|
end;
|
|
|
|
var
|
|
bb: blockPtr; {used to trace basic block lists}
|
|
done: boolean; {for loop termination tests}
|
|
op: icptr; {used to trace operation lists, trees}
|
|
lop: icptr; {predecessor of op}
|
|
temps: localPtr; {list of temp variables}
|
|
|
|
|
|
procedure DisposeTemps;
|
|
|
|
{ dispose of the list of temp variables }
|
|
|
|
var
|
|
tp: localPtr; {temp pointer}
|
|
|
|
begin {DisposeTemps}
|
|
while temps <> nil do begin
|
|
tp := temps;
|
|
temps := tp^.next;
|
|
dispose(tp);
|
|
end; {while}
|
|
end; {DisposeTemps}
|
|
|
|
|
|
function GetTemp (bb: blockPtr; size: integer): integer;
|
|
|
|
{ Allocate a temp storage location }
|
|
{ }
|
|
{ parameters: }
|
|
{ bb - block in which the temp is allocated }
|
|
{ size - size of the temp }
|
|
{ }
|
|
{ Returns: local label number for the temp }
|
|
|
|
var
|
|
lab: integer; {label number}
|
|
loc: icptr; {for dc_loc instruction}
|
|
tp: localPtr; {used to trace lists, allocate new items}
|
|
|
|
begin {GetTemp}
|
|
lab := 0; {no label found, yet}
|
|
tp := temps; {try for a temp of the exact size}
|
|
while tp <> nil do begin
|
|
if not tp^.inUse then
|
|
if tp^.size = size then begin
|
|
lab := tp^.lab;
|
|
tp^.inUse := true;
|
|
tp := nil;
|
|
end; {if}
|
|
if tp <> nil then
|
|
tp := tp^.next;
|
|
end; {while}
|
|
if lab = 0 then begin {try for a larger temp}
|
|
tp := temps;
|
|
while tp <> nil do begin
|
|
if not tp^.inUse then
|
|
if tp^.size > size then begin
|
|
lab := tp^.lab;
|
|
tp^.inUse := true;
|
|
tp := nil;
|
|
end; {if}
|
|
if tp <> nil then
|
|
tp := tp^.next;
|
|
end; {while}
|
|
end; {if}
|
|
if lab = 0 then begin {allocate a new temp}
|
|
loc := pointer(Calloc(sizeof(intermediate_code)));
|
|
loc^.opcode := dc_loc;
|
|
loc^.optype := cgWord;
|
|
maxLoc := maxLoc + 1;
|
|
loc^.r := maxLoc;
|
|
lab := maxLoc;
|
|
loc^.q := size;
|
|
if bb^.code = nil then begin
|
|
loc^.next := nil;
|
|
bb^.code := loc;
|
|
end {if}
|
|
else begin
|
|
loc^.next := bb^.code^.next;
|
|
bb^.code^.next := loc;
|
|
end; {else}
|
|
new(tp);
|
|
tp^.next := temps;
|
|
temps := tp;
|
|
tp^.inUse := true;
|
|
tp^.size := loc^.q;
|
|
tp^.lab := lab;
|
|
end; {if}
|
|
GetTemp := lab; {return the temp label number}
|
|
end; {GetTemp}
|
|
|
|
|
|
procedure ResetTemps;
|
|
|
|
{ Mark all temps as available }
|
|
|
|
var
|
|
tp: localPtr; {temp pointer}
|
|
|
|
begin {ResetTemps}
|
|
tp := temps;
|
|
while tp <> nil do begin
|
|
tp^.inUse := false;
|
|
tp := tp^.next;
|
|
end; {while}
|
|
end; {ResetTemps}
|
|
|
|
|
|
procedure CheckForBlocks (op: icptr);
|
|
|
|
{ Scan a tree for blocked instructions }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - tree to check }
|
|
{ }
|
|
{ Notes: Some code takes less time to execute than saving }
|
|
{ and storing the intermediate value. This subroutine }
|
|
{ identifies such patterns. }
|
|
|
|
|
|
function Block (op: icptr): boolean;
|
|
|
|
{ See if the pattern should be blocked }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - pattern to check }
|
|
{ }
|
|
{ Returns: True if the pattern should be blocked, else }
|
|
{ false. }
|
|
|
|
var
|
|
opcode: pcodes; {temp opcode}
|
|
|
|
begin {Block}
|
|
Block := false;
|
|
opcode := op^.opcode;
|
|
if opcode = pc_ixa then begin
|
|
if op^.left^.opcode in [pc_lao,pc_lca,pc_lda] then
|
|
Block := true;
|
|
end {else if}
|
|
else if opcode = pc_shl then begin
|
|
if op^.right^.opcode = pc_ldc then
|
|
if op^.right^.q = 1 then
|
|
if op^.parents <= 3 then
|
|
Block := true;
|
|
end {else if}
|
|
else if opcode = pc_stk then
|
|
Block := true
|
|
else if opcode = pc_psh then
|
|
Block := true
|
|
else if opcode = pc_cnv then
|
|
if op^.q & $000F = ord(cgVoid) then
|
|
Block := true;
|
|
end; {Block}
|
|
|
|
|
|
function Max (a, b: integer): integer;
|
|
|
|
{ Return the larger of two integers }
|
|
{ }
|
|
{ parameters: }
|
|
{ a, b - integers to check }
|
|
{ }
|
|
{ Returns: a if a > b, else b }
|
|
|
|
begin {Max}
|
|
if a > b then
|
|
Max := a
|
|
else
|
|
Max := b;
|
|
end; {Max}
|
|
|
|
|
|
begin {CheckForBlocks}
|
|
if Block(op) then begin
|
|
if op^.left <> nil then {handle a blocked instruction}
|
|
op^.left^.parents := op^.left^.parents + Max(op^.parents - 1, 0);
|
|
if op^.right <> nil then
|
|
op^.right^.parents := op^.right^.parents + Max(op^.parents - 1, 0);
|
|
op^.parents := 1;
|
|
end; {if}
|
|
if op^.left <> nil then {check the children}
|
|
CheckForBlocks(op^.left);
|
|
if op^.right <> nil then
|
|
CheckForBlocks(op^.right);
|
|
end; {CheckForBlocks}
|
|
|
|
|
|
procedure CheckTree (var op: icptr; bb: blockPtr);
|
|
|
|
{ check the trees used by op for common subexpressions }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - operation to check }
|
|
{ bb - start of the current BASIC block }
|
|
|
|
var
|
|
op2: icptr; {result from Match calls}
|
|
op3: icptr; {used to trace the codes in a block}
|
|
|
|
|
|
function Match (var op: icptr; tree: icptr): icptr;
|
|
|
|
{ Check for matches to op in tree }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - operation to check }
|
|
{ tree - tree to examine for matches }
|
|
{ }
|
|
{ Returns: pointer to matching node or nil if none found }
|
|
|
|
var
|
|
op2: icptr; {result from recursive Match calls}
|
|
kill, start, stop: boolean; {used by Scan}
|
|
skip: boolean; {used to see if children should be scanned}
|
|
|
|
|
|
procedure Combine (var op1, op2: icptr);
|
|
|
|
{ Op2 is a save or copy of the same value as op1; use a copy }
|
|
{ for op2. }
|
|
{ }
|
|
{ parameters: }
|
|
{ op1 - first copy or save }
|
|
{ op2 - copy or save to optimize }
|
|
|
|
var
|
|
op3: icptr; {work pointer}
|
|
|
|
begin {Combine}
|
|
done := false; {force another labeling pass}
|
|
op3 := op2; {remove op2 from the list}
|
|
if op3^.opcode in [pc_str,pc_sro] then begin
|
|
if op3^.opcode = pc_str then
|
|
op3^.opcode := pc_cop
|
|
else
|
|
op3^.opcode := pc_cpo;
|
|
op2 := op3^.next;
|
|
op3^.next := nil;
|
|
end {if}
|
|
else
|
|
op2 := op3^.left;
|
|
op1^.left := op3; {place in the new location}
|
|
end; {Combine}
|
|
|
|
|
|
function SameTree (list, op1, op2: icptr): boolean;
|
|
|
|
{ Are op1 and op2 in the same expression tree? }
|
|
{ }
|
|
{ parameters: }
|
|
{ list - list of expression trees }
|
|
{ op1, op2 - operations to check }
|
|
|
|
|
|
function InTree (tree, op: icptr): boolean;
|
|
|
|
{ See if op is in the tree }
|
|
{ }
|
|
{ parameters: }
|
|
{ tree - expression tree to check }
|
|
{ op - operatio to look for }
|
|
|
|
begin {InTree}
|
|
if tree = nil then
|
|
InTree := false
|
|
else if tree = op then
|
|
InTree := true
|
|
else
|
|
InTree := InTree(tree^.left, op) or InTree(tree^.right, op);
|
|
end; {InTree}
|
|
|
|
|
|
begin {SameTree}
|
|
SameTree := false;
|
|
while list <> nil do
|
|
if InTree(list, op1) then begin
|
|
SameTree := InTree(list, op2);
|
|
list := nil;
|
|
end {if}
|
|
else
|
|
list := list^.next;
|
|
end; {SameTree}
|
|
|
|
|
|
procedure Scan (list, op1, op2: icptr);
|
|
|
|
{ Check to see if any operation between op1 and op2 kills the }
|
|
{ optimization }
|
|
{ }
|
|
{ parameters: }
|
|
{ list - instruction stream }
|
|
{ op1 - starting operation }
|
|
{ op2 - ending operation }
|
|
{ }
|
|
{ globals: }
|
|
{ kill - set to true if the optimization must be blocked, }
|
|
{ or false if it can be performed }
|
|
{ start - has op1 been found? (initialize to false) }
|
|
{ stop - has kill been set? (initialize to false) }
|
|
|
|
label 1;
|
|
|
|
begin {Scan}
|
|
1: if not start then {see if it is time to start}
|
|
if list = op1 then
|
|
start := true;
|
|
if list^.left <> nil then {scan the children}
|
|
Scan(list^.left, op1, op2);
|
|
if not stop then
|
|
if list^.right <> nil then
|
|
Scan(list^.right, op1, op2);
|
|
if start then {check for a kill or termination}
|
|
if not stop then
|
|
if list = op2 then begin
|
|
kill := false;
|
|
stop := true;
|
|
end {if}
|
|
{kill indirect accesses on stores}
|
|
{to indirectly-accessible locations}
|
|
else if op1^.opcode in [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,
|
|
pc_cup,pc_cui,pc_tl1,pc_ind,pc_sbf,pc_cbf] then begin
|
|
if list^.opcode in [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,
|
|
pc_cup,pc_cui,pc_tl1,pc_sbf,pc_cbf] then begin
|
|
kill := true;
|
|
stop := true;
|
|
end {if}
|
|
else if list^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo,pc_lli,
|
|
pc_lil,pc_lld,pc_ldl,pc_gli,pc_gil,pc_gld,pc_gdl] then
|
|
if Member(list, c_ind) then begin
|
|
kill := true;
|
|
stop := true;
|
|
end {if}
|
|
end {else if}
|
|
else if list^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo,pc_lli,pc_lil,
|
|
pc_lld,pc_ldl,pc_gli,pc_gil,pc_gld,pc_gdl] then begin
|
|
if MatchLoc(list, op2) then begin
|
|
kill := true;
|
|
stop := true;
|
|
end {if}
|
|
end {else if}
|
|
else if list^.opcode in [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,
|
|
pc_cup,pc_cui,pc_tl1,pc_sbf,pc_cbf] then
|
|
if Member(op1, c_ind) or (op1^.opcode in [pc_lbf,pc_lbu]) then
|
|
begin
|
|
kill := true;
|
|
stop := true;
|
|
end; {if}
|
|
if not stop then {scan forward in the stream}
|
|
if list^.next <> nil then begin
|
|
list := list^.next;
|
|
goto 1;
|
|
end; {if}
|
|
end; {Scan}
|
|
|
|
|
|
begin {Match}
|
|
op2 := nil; {check for an exact match}
|
|
skip := false;
|
|
if CodesMatch(op, tree, true) then begin
|
|
if op = tree then
|
|
op2 := tree
|
|
else begin
|
|
start := false;
|
|
stop := false;
|
|
Scan(bb^.code, tree, op);
|
|
if not kill then
|
|
op2 := tree;
|
|
end; {else}
|
|
end {if}
|
|
{check for stores of a common value}
|
|
else if op^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo] then
|
|
if tree^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo] then
|
|
if op^.left = tree^.left then begin
|
|
start := false;
|
|
stop := false;
|
|
Scan(bb^.code, tree, op);
|
|
if not kill then
|
|
if not SameTree(bb^.code, op, tree) then
|
|
if (op^.left^.opcode <> pc_ldc)
|
|
or ((op^.left^.optype in [cgByte,cgUByte,cgWord,cgUWord])
|
|
and (op^.left^.q <> 0))
|
|
or ((op^.left^.optype in [cgLong,cgULong])
|
|
and (op^.left^.lval <> 0))
|
|
or (not (op^.left^.optype in [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong]))
|
|
then begin
|
|
Combine(tree, op);
|
|
skip := true;
|
|
end; {if}
|
|
end; {if}
|
|
if not skip then begin {check for matches in the children}
|
|
if op2 = nil then
|
|
if tree^.left <> nil then
|
|
op2 := Match(op, tree^.left);
|
|
if op2 = nil then
|
|
if tree^.right <> nil then
|
|
op2 := Match(op, tree^.right);
|
|
end; {if}
|
|
Match := op2;
|
|
end; {Match}
|
|
|
|
|
|
begin {CheckTree}
|
|
op^.parents := 0; {zero the parent counter}
|
|
if op^.left <> nil then {check the children}
|
|
CheckTree(op^.left, bb);
|
|
if op^.right <> nil then
|
|
CheckTree(op^.right, bb);
|
|
if op^.next = nil then {look for a match to the current code}
|
|
if not (op^.opcode in [pc_cup,pc_cui,pc_tl1,pc_bno]) then begin
|
|
op2 := nil;
|
|
op3 := bb^.code;
|
|
while (op2 = nil) and (op3 <> nil) do begin
|
|
op2 := Match(op, op3);
|
|
if op2 <> nil then
|
|
if op2^.next = nil then begin
|
|
op := op2;
|
|
bb := nil;
|
|
op3 := nil;
|
|
end ;{if}
|
|
if op3 <> nil then
|
|
op3 := op3^.next;
|
|
end; {while}
|
|
end; {if}
|
|
end; {CheckTree}
|
|
|
|
|
|
procedure CountParents (op: icptr);
|
|
|
|
{ increment the parent counter for all children of this node }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - node for which to check the children }
|
|
|
|
begin {CountParents}
|
|
if op^.parents = 0 then begin
|
|
if op^.left <> nil then begin
|
|
CountParents(op^.left);
|
|
op^.left^.parents := op^.left^.parents + 1;
|
|
end; {if}
|
|
if op^.right <> nil then begin
|
|
CountParents(op^.right);
|
|
op^.right^.parents := op^.right^.parents + 1;
|
|
end; {if}
|
|
end; {if}
|
|
end; {CountParents}
|
|
|
|
|
|
procedure CreateTemps (var op: icptr; bb: blockPtr; var lop: icptr);
|
|
|
|
{ create temps for nodes with multiple parents }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - node for which to create temps }
|
|
{ bb - current basic block }
|
|
{ lop - predecessor to op }
|
|
|
|
var
|
|
children: boolean; {does this node have children?}
|
|
llab: integer; {local label number; for temp}
|
|
op2, str: icptr; {new opcodes}
|
|
optype: baseTypeEnum; {type of the temp variable}
|
|
|
|
begin {CreateTemps}
|
|
children := false; {create temps for the children}
|
|
if op^.left <> nil then begin
|
|
children := true;
|
|
CreateTemps(op^.left, bb, lop);
|
|
end; {if}
|
|
if op^.right <> nil then begin
|
|
children := true;
|
|
CreateTemps(op^.right, bb, lop);
|
|
end; {if}
|
|
if children then
|
|
if op^.parents > 1 then begin
|
|
optype := TypeOf(op); {create a temp label}
|
|
llab := GetTemp(bb, TypeSize(optype));
|
|
{make a copy of the duplicated tree}
|
|
op2 := pointer(Calloc(sizeof(intermediate_code)));
|
|
op2^ := op^;
|
|
op^.opcode := pc_lod; {substitute a load of the temp}
|
|
op^.optype := optype;
|
|
op^.parents := 1;
|
|
op^.r := llab;
|
|
op^.q := 0;
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
{store the temp result}
|
|
str := pointer(Calloc(sizeof(intermediate_code)));
|
|
str^.opcode := pc_str;
|
|
str^.optype := optype;
|
|
str^.r := llab;
|
|
str^.q := 0;
|
|
str^.left := op2;
|
|
if lop = nil then begin {insert the store in the basic block}
|
|
str^.next := bb^.code;
|
|
bb^.code := str;
|
|
end {if}
|
|
else begin
|
|
str^.next := lop^.next;
|
|
lop^.next := str;
|
|
end; {else}
|
|
lop := str;
|
|
end; {if}
|
|
end; {CreateTemps}
|
|
|
|
|
|
begin {CommonSubexpressionElimination}
|
|
temps := nil; {no temps allocated, yet}
|
|
repeat {identify common parts}
|
|
done := true;
|
|
bb := DAGblocks;
|
|
while bb <> nil do begin
|
|
Spin;
|
|
op := bb^.code;
|
|
if op <> nil then begin
|
|
CheckTree(bb^.code, bb);
|
|
while op^.next <> nil do begin
|
|
CheckTree(op^.next, bb);
|
|
if op^.next <> nil then
|
|
op := op^.next;
|
|
end; {while}
|
|
end; {if}
|
|
bb := bb^.next;
|
|
end; {while}
|
|
until done;
|
|
bb := DAGblocks; {count the number of parents}
|
|
while bb <> nil do begin
|
|
op := bb^.code;
|
|
Spin;
|
|
while op <> nil do begin
|
|
CountParents(op);
|
|
op := op^.next;
|
|
end; {while}
|
|
bb := bb^.next;
|
|
end; {while}
|
|
bb := DAGblocks; {check for blocked instructions}
|
|
while bb <> nil do begin
|
|
op := bb^.code;
|
|
Spin;
|
|
while op <> nil do begin
|
|
CheckForBlocks(op);
|
|
op := op^.next;
|
|
end; {while}
|
|
bb := bb^.next;
|
|
end; {while}
|
|
bb := DAGblocks; {create temps for common subexpressions}
|
|
while bb <> nil do begin
|
|
op := bb^.code;
|
|
lop := nil;
|
|
ResetTemps;
|
|
Spin;
|
|
while op <> nil do begin
|
|
CreateTemps(op, bb, lop);
|
|
lop := op;
|
|
op := op^.next;
|
|
end; {while}
|
|
bb := bb^.next;
|
|
end; {while}
|
|
DisposeTemps; {get rid of the temp variable list}
|
|
end; {CommonSubexpressionElimination}
|
|
|
|
{- Loop Optimizations ------------------------------------------}
|
|
|
|
procedure AddOperation (op: icptr; var lp: iclist);
|
|
|
|
{ Add an operation to an operation list }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - operation to add }
|
|
{ lp - list to add the operation to }
|
|
|
|
var
|
|
inList: boolean; {is op already in the list?}
|
|
llp: iclist; {work pointer}
|
|
|
|
begin {AddOperation}
|
|
llp := lp;
|
|
inList := false;
|
|
while llp <> nil do
|
|
if MatchLoc(llp^.op, op) then begin
|
|
inList := true;
|
|
llp := nil;
|
|
end {if}
|
|
else
|
|
llp := llp^.next;
|
|
if not inList then begin
|
|
new(llp);
|
|
llp^.next := lp;
|
|
lp := llp;
|
|
llp^.op := op;
|
|
end; {if}
|
|
end; {AddOperation}
|
|
|
|
|
|
procedure DisposeBlkList (var blk: blockListPtr);
|
|
|
|
{ dispose of all entries in the block list }
|
|
{ }
|
|
{ parameters: }
|
|
{ blk - list of blocks to dispose of }
|
|
|
|
var
|
|
bk1, bk2: blockListPtr; {work pointers}
|
|
|
|
begin {DisposeBlkList}
|
|
bk1 := blk;
|
|
blk := nil;
|
|
while bk1 <> nil do begin
|
|
bk2 := bk1;
|
|
bk1 := bk2^.next;
|
|
dispose(bk2);
|
|
end; {while}
|
|
end; {DisposeBlkList}
|
|
|
|
|
|
procedure DisposeOpList (var oplist: iclist);
|
|
|
|
{ dispose of all entries in the list }
|
|
{ }
|
|
{ parameters: }
|
|
{ oplist - operation list to dispose of }
|
|
|
|
var
|
|
op1, op2: iclist; {work pointers}
|
|
|
|
begin {DisposeOpList}
|
|
op1 := oplist;
|
|
oplist := nil;
|
|
while op1 <> nil do begin
|
|
op2 := op1;
|
|
op1 := op2^.next;
|
|
dispose(op2);
|
|
end; {while}
|
|
end; {DisposeOpList}
|
|
|
|
|
|
procedure DumpLoopLists;
|
|
|
|
{ dispose of lists created by ReachingDefinitions and Dominators}
|
|
|
|
var
|
|
bb: blockPtr; {used to trace basic block list}
|
|
dom: blockListPtr; {used to dispose of a dominator}
|
|
|
|
begin {DumpLoopLists}
|
|
bb := DAGBlocks;
|
|
while bb <> nil do begin
|
|
DisposeOpList(bb^.c_in); {dump the reaching definition lists}
|
|
DisposeOpList(bb^.c_out);
|
|
DisposeOpList(bb^.c_gen);
|
|
DisposeBlkList(bb^.dom);
|
|
while bb^.dom <> nil do begin {dump the dominator lists}
|
|
dom := bb^.dom;
|
|
bb^.dom := dom^.next;
|
|
dispose(dom);
|
|
end; {while}
|
|
bb := bb^.next;
|
|
end; {while}
|
|
end; {DumpLoopLists}
|
|
|
|
|
|
procedure AddLoads (jp: icptr; var lp: iclist);
|
|
|
|
{ Add any load addresses from the children of this }
|
|
{ operation }
|
|
{ }
|
|
{ parameters: }
|
|
{ jp - operation to check }
|
|
{ lp - list to add the loads to }
|
|
|
|
begin {AddLoads}
|
|
if jp^.opcode in [pc_lda,pc_lao,pc_lod,pc_lod] then
|
|
AddOperation(jp, lp)
|
|
else begin
|
|
if jp^.left <> nil then
|
|
AddLoads(jp^.left, lp);
|
|
if jp^.right <> nil then
|
|
AddLoads(jp^.right, lp);
|
|
end {else}
|
|
end; {AddLoads}
|
|
|
|
|
|
procedure FlagIndirectUses;
|
|
|
|
{ Find all variables that could be changed by an indirect }
|
|
{ access. }
|
|
|
|
var
|
|
bb: blockPtr; {used to trace block list}
|
|
|
|
|
|
procedure Check (op: icptr; doingInd: boolean);
|
|
|
|
{ Check op and its children & followers for dangerous }
|
|
{ references }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - operation to check }
|
|
{ doingInd - are we doing a pc_ind? If so, pc_lda's }
|
|
{ are safe }
|
|
|
|
var
|
|
lDoingInd: boolean; {local doingInd}
|
|
|
|
begin {Check}
|
|
while op <> nil do begin
|
|
if op^.opcode = pc_ind then
|
|
lDoingInd := true
|
|
else
|
|
lDoingInd := doingInd;
|
|
if op^.left <> nil then
|
|
Check(op^.left, lDoingInd);
|
|
if op^.right <> nil then
|
|
Check(op^.right, lDoingInd);
|
|
if op^.opcode in [pc_lao,pc_cpo,pc_ldo,pc_sro,pc_gil,pc_gli,
|
|
pc_gdl,pc_gld] then
|
|
AddOperation(op, c_ind)
|
|
else if op^.opcode = pc_ind then begin
|
|
if op^.left^.opcode = pc_ind then
|
|
AddLoads(op^.left^.left, c_ind);
|
|
end {else if}
|
|
else if op^.opcode = pc_lda then
|
|
if not doingInd then
|
|
AddOperation(op, c_ind);
|
|
op := op^.next;
|
|
end; {while}
|
|
end; {Check}
|
|
|
|
|
|
begin {FlagIndirectUses}
|
|
c_ind := nil;
|
|
bb := DAGBlocks;
|
|
while bb <> nil do begin
|
|
Check(bb^.code, false);
|
|
bb := bb^.next;
|
|
end; {while}
|
|
end; {FlagIndirectUses}
|
|
|
|
|
|
procedure DoLoopOptimization;
|
|
|
|
{ Perform optimizations related to loops and data flow }
|
|
|
|
type
|
|
dftptr = ^dftrecord; {depth first tree edges}
|
|
dftrecord = record
|
|
next: dftptr;
|
|
from, dest: blockPtr;
|
|
end;
|
|
|
|
var
|
|
backEdge: dftptr; {list of back edges}
|
|
dft: dftptr; {depth first tree}
|
|
dft2: dftptr; {work pointer}
|
|
|
|
|
|
function DFN (i: integer): blockPtr;
|
|
|
|
{ find the basic block with dfn index of i }
|
|
{ }
|
|
{ parameters: }
|
|
{ i - index to look for }
|
|
{ }
|
|
{ Returns: block pointer, or nil if there is none }
|
|
|
|
var
|
|
bb: blockPtr; {used to trace block list}
|
|
|
|
begin {DFN}
|
|
bb := DAGBlocks;
|
|
DFN := nil;
|
|
while bb <> nil do begin
|
|
if bb^.dfn = i then begin
|
|
DFN := bb;
|
|
bb := nil;
|
|
end
|
|
else
|
|
bb := bb^.next;
|
|
end; {while}
|
|
end; {DFN}
|
|
|
|
|
|
function MemberDFNList (dfn: integer; bl: blockListPtr): boolean;
|
|
|
|
{ See if dfn is a member of the list bl }
|
|
{ }
|
|
{ parameters: }
|
|
{ dfn - block number to check }
|
|
{ bl - list of block numbers to check }
|
|
{ }
|
|
{ Returns: True if dfn is in bl, else false. }
|
|
|
|
begin {MemberDFNList}
|
|
MemberDFNList := false;
|
|
while bl <> nil do
|
|
if bl^.dfn = dfn then begin
|
|
MemberDFNList := true;
|
|
bl := nil;
|
|
end {if}
|
|
else
|
|
bl := bl^.next;
|
|
end; {MemberDFNList}
|
|
|
|
|
|
function FindDAG (q: integer): blockPtr;
|
|
|
|
{ Find the DAG containing label q }
|
|
{ }
|
|
{ parameters: }
|
|
{ q - label to find }
|
|
{ }
|
|
{ Returns: pointer to the proper basic block }
|
|
|
|
var
|
|
bb: blockPtr; {used to trace basic block list}
|
|
|
|
begin {FindDAG}
|
|
bb := DAGBlocks;
|
|
FindDAG := nil;
|
|
while bb <> nil do begin
|
|
if bb^.code^.opcode = dc_lab then
|
|
if bb^.code^.q = q then begin
|
|
FindDAG := bb;
|
|
bb := nil;
|
|
end; {if}
|
|
if bb <> nil then
|
|
bb := bb^.next;
|
|
end; {while}
|
|
end; {FindDAG}
|
|
|
|
|
|
procedure DepthFirstOrder;
|
|
|
|
{ Number the DAG for depth first order }
|
|
|
|
var
|
|
bb: blockPtr; {used to trace basic block lists}
|
|
i: integer; {dfn index}
|
|
|
|
|
|
procedure Search (bb: blockPtr);
|
|
|
|
{ Search this block }
|
|
{ }
|
|
{ parameters: }
|
|
{ bb - basic block to search }
|
|
|
|
var
|
|
blk: blockPtr; {work block}
|
|
ndft: dftptr; {for new tree entries}
|
|
op: icptr; {used to trace operation list}
|
|
|
|
|
|
function NotUnconditional: boolean;
|
|
|
|
{ See if the block ends with something other than an }
|
|
{ unconditional jump }
|
|
{ }
|
|
{ Returns: True if the block ends with something other }
|
|
{ than pc_ujp or pc_add, else false }
|
|
|
|
var
|
|
op: icptr; {used to trace the list}
|
|
|
|
begin {NotUnconditional}
|
|
NotUnconditional := true;
|
|
op := bb^.code;
|
|
if op <> nil then begin
|
|
while op^.next <> nil do
|
|
op := op^.next;
|
|
if op^.opcode in [pc_add,pc_ujp] then
|
|
NotUnconditional := false;
|
|
end; {if}
|
|
end; {NotUnconditional}
|
|
|
|
|
|
begin {Search}
|
|
Spin;
|
|
if bb <> nil then
|
|
if not bb^.visited then begin
|
|
bb^.visited := true;
|
|
if NotUnconditional then
|
|
if bb^.next <> nil then begin
|
|
new(ndft);
|
|
ndft^.next := dft;
|
|
dft := ndft;
|
|
ndft^.from := bb;
|
|
ndft^.dest := bb^.next;
|
|
Search(bb^.next);
|
|
end; {if}
|
|
op := bb^.code;
|
|
while op <> nil do begin
|
|
if op^.opcode in [pc_ujp, pc_fjp, pc_tjp, pc_add] then begin
|
|
blk := FindDAG(op^.q);
|
|
new(ndft);
|
|
if blk^.visited then begin
|
|
ndft^.next := backEdge;
|
|
backEdge := ndft;
|
|
end {if}
|
|
else begin
|
|
ndft^.next := dft;
|
|
dft := ndft;
|
|
Search(blk);
|
|
end; {else}
|
|
ndft^.from := bb;
|
|
ndft^.dest := blk;
|
|
end; {if}
|
|
op := op^.next;
|
|
end; {while}
|
|
bb^.dfn := i;
|
|
i := i-1;
|
|
end; {if}
|
|
end; {Search}
|
|
|
|
|
|
begin {DepthFirstOrder}
|
|
dft := nil;
|
|
backEdge := nil;
|
|
i := 0;
|
|
bb := DAGblocks;
|
|
while bb <> nil do begin
|
|
bb^.visited := false;
|
|
i := i+1;
|
|
bb := bb^.next;
|
|
end; {while}
|
|
Search(DAGBlocks);
|
|
if i <> 0 then begin {ensure DFNs start from 1}
|
|
bb := DAGblocks;
|
|
while bb <> nil do begin
|
|
if bb ^.dfn <> 0 then
|
|
bb^.dfn := bb^.dfn - i;
|
|
bb := bb^.next;
|
|
end; {while}
|
|
end; {if}
|
|
end; {DepthFirstOrder}
|
|
|
|
|
|
procedure AddDominator (var dom: blockListPtr; dfn: integer);
|
|
|
|
{ Add dfn to the list of dominators }
|
|
{ }
|
|
{ parameters: }
|
|
{ dom - dominator list }
|
|
{ dfn - new dominator number }
|
|
|
|
var
|
|
dp: blockListPtr; {new node}
|
|
|
|
begin {AddDominator}
|
|
new(dp);
|
|
dp^.last := nil;
|
|
dp^.next := dom;
|
|
dom^.last := dp;
|
|
dom := dp;
|
|
dp^.dfn := dfn;
|
|
end; {AddDominator}
|
|
|
|
|
|
procedure Dominators;
|
|
|
|
{ Find a list of dominators for each node }
|
|
|
|
var
|
|
bb: blockPtr; {used to trace the block list}
|
|
change: boolean; {for loop termination test}
|
|
i, j: integer; {loop variables}
|
|
maxdfn, mindfn: integer; {max and min dfn values used}
|
|
|
|
|
|
procedure CheckPredecessors (bb: blockPtr; bl: dftptr);
|
|
|
|
{ Eliminate nodes that don't dominate a predecessor }
|
|
{ }
|
|
{ parameters: }
|
|
{ bb - block being checked }
|
|
{ bl - list of edges to check for predecessors }
|
|
|
|
var
|
|
dp: blockListPtr; {list of dominator numbers}
|
|
tdp: blockListPtr; {used to remove a dominator entry}
|
|
|
|
begin {CheckPredecessors}
|
|
while bl <> nil do begin
|
|
if bl^.dest = bb then begin
|
|
dp := bb^.dom;
|
|
while dp <> nil do
|
|
if dp^.dfn <> bb^.dfn then
|
|
if not MemberDFNList(dp^.dfn, bl^.from^.dom) then begin
|
|
change := true;
|
|
tdp := dp;
|
|
if tdp^.last = nil then
|
|
bb^.dom := tdp^.next
|
|
else
|
|
tdp^.last^.next := tdp^.next;
|
|
if tdp^.next <> nil then
|
|
tdp^.next^.last := tdp^.last;
|
|
dp := tdp^.next;
|
|
dispose(tdp);
|
|
end {if}
|
|
else
|
|
dp := dp^.next
|
|
else
|
|
dp := dp^.next;
|
|
end; {if}
|
|
bl := bl^.next;
|
|
end; {while}
|
|
end; {CheckPredecessors}
|
|
|
|
|
|
begin {Dominators}
|
|
Spin;
|
|
maxdfn := 0; {find the largest dfn}
|
|
bb := DAGBlocks;
|
|
while bb <> nil do begin
|
|
if bb^.dfn > maxdfn then
|
|
maxdfn := bb^.dfn;
|
|
bb := bb^.next;
|
|
end; {while}
|
|
AddDominator(DAGBlocks^.dom, DAGBlocks^.dfn); {the first node is it's own dominator}
|
|
mindfn := DAGBlocks^.dfn; {assume all other nodes are dominated by every other node}
|
|
for i := mindfn+1 to maxdfn do begin
|
|
bb := DFN(i);
|
|
if bb <> nil then
|
|
for j := mindfn to maxdfn do
|
|
AddDominator(bb^.dom, j);
|
|
end; {for}
|
|
repeat {iterate to the true set of dominators}
|
|
change := false;
|
|
for i := mindfn+1 to maxdfn do begin
|
|
bb := DFN(i);
|
|
CheckPredecessors(bb, dft);
|
|
CheckPredecessors(bb, backEdge);
|
|
end; {for}
|
|
until not change;
|
|
end; {Dominators}
|
|
|
|
|
|
procedure ReachingDefinitions;
|
|
|
|
{ find the list of reaching definitions for each basic block }
|
|
|
|
var
|
|
bb: blockPtr; {block being scanned}
|
|
change: boolean; {loop termination test}
|
|
i: integer; {node index number}
|
|
newIn: iclist; {list of inputs}
|
|
|
|
|
|
function Gen (op: icptr): iclist;
|
|
|
|
{ find a list of generated values }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - list of intermediate codes to scan }
|
|
{ }
|
|
{ Returns: list of generated definitions }
|
|
|
|
var
|
|
gp: iclist; {list of generated definitions}
|
|
indFound: boolean; {has an indirect store been found?}
|
|
|
|
|
|
procedure Check (ip: icptr);
|
|
|
|
{ Add any result from ip to gp }
|
|
{ }
|
|
{ parameters: }
|
|
{ ip - instruction to check }
|
|
|
|
var
|
|
lc_ind: iclist; {used to trace the c_ind list}
|
|
|
|
begin {Check}
|
|
if ip^.left <> nil then
|
|
Check(ip^.left);
|
|
if ip^.right <> nil then
|
|
Check(ip^.right);
|
|
if ip^.opcode in
|
|
[pc_str,pc_sro,pc_cop,pc_cpo,pc_lli,pc_lil,pc_lld,pc_ldl,
|
|
pc_gli,pc_gil,pc_gld,pc_gdl] then
|
|
AddOperation(ip, gp)
|
|
else if ip^.opcode in [pc_mov,pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild] then
|
|
AddLoads(ip, gp);
|
|
if not indFound then
|
|
if ip^.opcode in
|
|
[pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,pc_cup,pc_cui,pc_tl1]
|
|
then begin
|
|
lc_ind := c_ind;
|
|
while lc_ind <> nil do begin
|
|
AddOperation(lc_ind^.op, gp);
|
|
lc_ind := lc_ind^.next;
|
|
end; {while}
|
|
indFound := true;
|
|
end; {if}
|
|
end; {Check}
|
|
|
|
|
|
begin {Gen}
|
|
indFound := false;
|
|
gp := nil;
|
|
while op <> nil do begin
|
|
Check(op);
|
|
op := op^.next;
|
|
end; {while}
|
|
Gen := gp;
|
|
end; {Gen}
|
|
|
|
|
|
function EqualSets (l1, l2: iclist): boolean;
|
|
|
|
{ See if two sets of stores and copies are equivalent }
|
|
{ }
|
|
{ parameters: }
|
|
{ l1, l2 - lists of copies and stores }
|
|
{ }
|
|
{ Returns: True if the lists are equivalent, else false }
|
|
{ }
|
|
{ Notes: The members of each list are assumed to be }
|
|
{ unique within that list. }
|
|
|
|
var
|
|
c1, c2: integer; {number of elements in the sets}
|
|
l3: iclist; {used to trace the lists}
|
|
matchFound: boolean; {was a match found?}
|
|
|
|
begin {EqualSets}
|
|
EqualSets := false; {assume they are not equal}
|
|
c1 := 0; {count the elements of l1}
|
|
l3 := l1;
|
|
while l3 <> nil do begin
|
|
c1 := c1+1;
|
|
l3 := l3^.next;
|
|
end; {while}
|
|
c2 := 0; {count the elements of l2}
|
|
l3 := l2;
|
|
while l3 <> nil do begin
|
|
c2 := c2+1;
|
|
l3 := l3^.next;
|
|
end; {while}
|
|
if c1 = c2 then begin {make sure each member of l1 is in l2}
|
|
EqualSets := true;
|
|
while l1 <> nil do begin
|
|
matchFound := false;
|
|
l3 := l2;
|
|
while l3 <> nil do begin
|
|
if MatchLoc(l1^.op, l3^.op) then begin
|
|
l3 := nil;
|
|
matchFound := true;
|
|
end {if}
|
|
else
|
|
l3 := l3^.next;
|
|
end; {while}
|
|
if not matchFound then begin
|
|
EqualSets := false;
|
|
l1 := nil;
|
|
end {if}
|
|
else
|
|
l1 := l1^.next;
|
|
end; {while}
|
|
end; {if}
|
|
end; {EqualSets}
|
|
|
|
|
|
function Union (l1, l2: iclist): iclist;
|
|
|
|
{ Returns a list that is the union of two input lists }
|
|
{ }
|
|
{ parameters: }
|
|
{ l1, l2 - lists }
|
|
{ }
|
|
{ Returns: New, dynamically allocated list that includes }
|
|
{ all of the members in l1 and l2. }
|
|
{ }
|
|
{ Notes: }
|
|
{ 1. If there are duplicates, the member from l1 is }
|
|
{ returned. }
|
|
{ 2. It is assumed that all members of l1 and l2 are }
|
|
{ unique within their own list. }
|
|
{ 3. The original lists are not disturbed. }
|
|
{ 4. The caller is responsible for disposing of the }
|
|
{ memory used by the list. }
|
|
|
|
var
|
|
lp: iclist; {new list pointer}
|
|
np: iclist; {new list member pointer}
|
|
tp: iclist; {temp list pointer}
|
|
|
|
begin {Union}
|
|
lp := nil;
|
|
tp := l1;
|
|
while tp <> nil do begin
|
|
new(np);
|
|
np^.next := lp;
|
|
lp := np;
|
|
np^.op := tp^.op;
|
|
tp := tp^.next;
|
|
end; {while}
|
|
while l2 <> nil do begin
|
|
if not Member(l2^.op, l1) then begin
|
|
new(np);
|
|
np^.next := lp;
|
|
lp := np;
|
|
np^.op := l2^.op;
|
|
end; {if}
|
|
l2 := l2^.next;
|
|
end; {while}
|
|
Union := lp;
|
|
end; {Union}
|
|
|
|
|
|
function UnionOfPredecessors (bptr: blockPtr): iclist;
|
|
|
|
{ create a union of the outputs of predecessors to bptr }
|
|
{ }
|
|
{ parameters: }
|
|
{ bptr - block for which to look for predecessors }
|
|
{ }
|
|
{ Returns: Resulting set }
|
|
|
|
var
|
|
bp: dftptr; {used to trace edge lists}
|
|
plist: iclist; {result list}
|
|
tlist: iclist; {temp result list}
|
|
|
|
begin {UnionOfPredecessors}
|
|
plist := nil;
|
|
bp := dft;
|
|
while bp <> nil do begin
|
|
if bp^.dest = bptr then begin
|
|
tlist := Union(plist, bp^.from^.c_out);
|
|
DisposeOpList(plist);
|
|
plist := tlist;
|
|
end; {if}
|
|
bp := bp^.next;
|
|
end; {while}
|
|
bp := backEdge;
|
|
while bp <> nil do begin
|
|
if bp^.dest = bptr then begin
|
|
tlist := Union(plist, bp^.from^.c_out);
|
|
DisposeOpList(plist);
|
|
plist := tlist;
|
|
end; {if}
|
|
bp := bp^.next;
|
|
end; {while}
|
|
UnionOfPredecessors := plist;
|
|
end; {UnionOfPredecessors}
|
|
|
|
|
|
begin {ReachingDefinitions}
|
|
i := 1; {initialize the lists}
|
|
repeat
|
|
bb := DFN(i);
|
|
if bb <> nil then begin
|
|
bb^.c_in := nil;
|
|
bb^.c_gen := Gen(bb^.code);
|
|
bb^.c_out := Union(nil, bb^.c_gen);
|
|
end; {if}
|
|
i := i+1;
|
|
until bb = nil;
|
|
repeat {iterate to a solution}
|
|
change := false;
|
|
i := 1;
|
|
repeat
|
|
Spin;
|
|
bb := DFN(i);
|
|
if bb <> nil then begin
|
|
newIn := UnionOfPredecessors(bb);
|
|
if not EqualSets(bb^.c_in, newIn) then begin
|
|
{IN[n] := newIn}
|
|
DisposeOpList(bb^.c_in);
|
|
bb^.c_in := newIn;
|
|
newIn := nil;
|
|
{OUT[n] := IN[n] - KILL[n] U GEN[n]}
|
|
DisposeOpList(bb^.c_out);
|
|
bb^.c_out := Union(bb^.c_in, nil);
|
|
change := true;
|
|
end; {if}
|
|
DisposeOpList(newIn);
|
|
end; {if}
|
|
i := i+1;
|
|
until bb = nil;
|
|
until not change;
|
|
end; {ReachingDefinitions}
|
|
|
|
|
|
procedure LoopInvariantRemoval;
|
|
|
|
{ Remove all loop invariant computations }
|
|
|
|
type
|
|
loopPtr = ^loopRecord; {blocks in a list}
|
|
loopRecord = record
|
|
next: loopPtr; {next entry}
|
|
block: blockPtr; {code block}
|
|
exit: boolean; {is this a loop exit?}
|
|
end;
|
|
|
|
loopListPtr = ^loopListRecord; {list of loop lists}
|
|
loopListRecord = record
|
|
next: loopListPtr;
|
|
loop: loopPtr;
|
|
end;
|
|
|
|
var
|
|
icount: integer; {order invariant found}
|
|
loops: loopListPtr; {list of loops}
|
|
lp: loopPtr; {used to trace loop lists}
|
|
llp: loopListPtr; {used to trace the list of loops}
|
|
fakeDFN: integer; {to uniquely number newly-created blocks}
|
|
|
|
|
|
function InLoop (blk: blockPtr; lp: loopPtr): boolean;
|
|
|
|
{ See if the block is in the loop }
|
|
{ }
|
|
{ parameters: }
|
|
{ blk - block to check for }
|
|
{ lp - loop list }
|
|
{ }
|
|
{ Returns: True if blk is in the list, else false }
|
|
|
|
begin {InLoop}
|
|
InLoop := false;
|
|
while lp <> nil do begin
|
|
if lp^.block = blk then begin
|
|
lp := nil;
|
|
InLoop := true;
|
|
end {if}
|
|
else
|
|
lp := lp^.next;
|
|
end; {while}
|
|
end; {InLoop}
|
|
|
|
|
|
procedure FindLoops;
|
|
|
|
{ Create a list of the natural loops }
|
|
|
|
var
|
|
blk: blockPtr; {target block for a jump}
|
|
bp: dftptr; {used to trace the back edges}
|
|
lp, lp2: loopPtr; {used to reverse the list}
|
|
llp: loopListPtr; {loop list header entry}
|
|
llp2: loopListPtr; {used to reverse the list}
|
|
op: icptr; {used to trace the opcode list}
|
|
|
|
|
|
procedure Add (block: blockPtr);
|
|
|
|
{ Add a block to the current loop list }
|
|
{ }
|
|
{ parameters: }
|
|
{ block - block to add }
|
|
|
|
var
|
|
lp: loopPtr; {new loop entry}
|
|
|
|
begin {Add}
|
|
new(lp);
|
|
lp^.next := llp^.loop;
|
|
llp^.loop := lp;
|
|
lp^.block := block;
|
|
lp^.exit := false;
|
|
end; {Add}
|
|
|
|
|
|
procedure Insert (block: blockPtr);
|
|
|
|
{ Insert a block into the loop list }
|
|
{ }
|
|
{ parameters: }
|
|
{ block - block to add }
|
|
|
|
|
|
procedure AddPredecessors (block: blockPtr; bl: dftptr);
|
|
|
|
{ add any predecessors to the loop }
|
|
{ }
|
|
{ parameters: }
|
|
{ block - block for which to check for }
|
|
{ predecessors }
|
|
{ bl - list of edges to check }
|
|
|
|
begin {AddPredecessors}
|
|
while bl <> nil do begin
|
|
if bl^.dest = block then
|
|
Insert(bl^.from);
|
|
bl := bl^.next;
|
|
end; {while}
|
|
end; {AddPredecessors}
|
|
|
|
|
|
begin {Insert}
|
|
if not InLoop(block, llp^.loop) then begin
|
|
Add(block);
|
|
AddPredecessors(block, dft);
|
|
AddPredecessors(block, backEdge);
|
|
end; {if}
|
|
end; {Insert}
|
|
|
|
|
|
begin {FindLoops}
|
|
loops := nil;
|
|
bp := backEdge; {scan the back edges}
|
|
while bp <> nil do begin
|
|
if MemberDFNList(bp^.dest^.dfn, bp^.from^.dom) then begin
|
|
new(llp); {create a new loop list entry}
|
|
llp^.next := loops;
|
|
loops := llp;
|
|
llp^.loop := nil;
|
|
Add(bp^.dest);
|
|
Insert(bp^.from);
|
|
lp := llp^.loop; {reverse the list}
|
|
llp^.loop := nil;
|
|
while lp <> nil do begin
|
|
lp2 := lp;
|
|
lp := lp2^.next;
|
|
lp2^.next := llp^.loop;
|
|
llp^.loop := lp2;
|
|
end; {while}
|
|
lp := llp^.loop; {mark the exits}
|
|
while lp <> nil do begin
|
|
op := lp^.block^.code;
|
|
while op <> nil do begin
|
|
if op^.opcode in [pc_ujp, pc_fjp, pc_tjp, pc_add] then begin
|
|
blk := FindDAG(op^.q);
|
|
if not InLoop(blk, llp^.loop) then
|
|
lp^.exit := true;
|
|
if op^.opcode in [pc_fjp,pc_tjp] then
|
|
if not InLoop(lp^.block^.next, llp^.loop) then
|
|
lp^.exit := true;
|
|
end; {if}
|
|
op := op^.next;
|
|
end; {while}
|
|
lp := lp^.next;
|
|
end; {while}
|
|
end; {if}
|
|
bp := bp^.next;
|
|
end; {while}
|
|
llp := loops; {reverse the loop list}
|
|
loops := nil;
|
|
while llp <> nil do begin
|
|
llp2 := llp;
|
|
llp := llp2^.next;
|
|
llp2^.next := loops;
|
|
loops := llp2;
|
|
end; {while}
|
|
end; {FindLoops}
|
|
|
|
|
|
function MarkInvariants (lp: loopPtr): boolean;
|
|
|
|
{ Make a pass over the opcodes, marking those that are }
|
|
{ invariant. }
|
|
{ }
|
|
{ parameters: }
|
|
{ lp - loop to scan }
|
|
{ }
|
|
{ Returns: True if any new nodes were marked, else false. }
|
|
|
|
var
|
|
count: integer; {number of generating blocks}
|
|
indirectStores: boolean; {does the loop contain indirect stores or function calls?}
|
|
inhibit: boolean; {inhibit stores?}
|
|
lp2: loopPtr; {used to trace the loop}
|
|
op: icptr; {used to trace the instruction list}
|
|
opcode: pcodes; {op^.opcode; for efficiency}
|
|
|
|
|
|
procedure Check (op: icptr; olp: loopPtr);
|
|
|
|
{ See if this node or its children is invariant }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - node to check }
|
|
{ olp - loop entry for the block containing the store }
|
|
|
|
var
|
|
invariant: boolean; {are the operands invariant?}
|
|
|
|
|
|
function IndirectInhibit (op: icptr): boolean;
|
|
|
|
{ See if a store should be inhibited due to indirect }
|
|
{ accesses }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - instruction to check }
|
|
{ }
|
|
{ Returns: True if the instruction should be inhibited, }
|
|
{ else false. }
|
|
|
|
begin {IndirectInhibit}
|
|
IndirectInhibit := false;
|
|
if indirectStores then
|
|
if Member(op, c_ind) then
|
|
IndirectInhibit := true;
|
|
end; {IndirectInhibit}
|
|
|
|
|
|
function NoOtherStoresOrUses (lp, olp: loopPtr; op: icptr): boolean;
|
|
|
|
{ Check for invalid stores }
|
|
{ }
|
|
{ parameters: }
|
|
{ lp - loop to check }
|
|
{ olp - loop entry for the block containing the store }
|
|
{ op - store to check }
|
|
{ }
|
|
{ Returns: True if the store is valid, false if not. }
|
|
{ }
|
|
{ Notes: Specifically, these two rules are inforced: }
|
|
{ 1. No other stores to the same location appear in the }
|
|
{ loop. }
|
|
{ 2. All uses of the value in the loop can be reached }
|
|
{ only by the assign. }
|
|
|
|
var
|
|
lp2: loopPtr; {used to trace the loop list}
|
|
op2: icptr; {used to trace code list}
|
|
|
|
|
|
function SafeLoad (sop, lop: icptr; sbk, lbk: blockPtr): boolean;
|
|
|
|
{ See if a load is in a safe position }
|
|
{ }
|
|
{ parameters: }
|
|
{ sop - save opcode that may need to be left in loop }
|
|
{ lop - load operation that may inhibit the save }
|
|
{ sbk - block containing the save }
|
|
{ lbk - block containing the load }
|
|
|
|
|
|
function First (op1, op2, stream: icptr): icptr;
|
|
|
|
{ See which operation comes first }
|
|
{ }
|
|
{ parmeters: }
|
|
{ op1, op2 - instructions to check }
|
|
{ stream - start of block containing the instructions }
|
|
{ }
|
|
{ Returns: First operation found, or nil if missing }
|
|
|
|
var
|
|
op: icptr; {temp opcode}
|
|
|
|
begin {First}
|
|
if stream = op1 then
|
|
First := op1
|
|
else if stream = op2 then
|
|
First := op2
|
|
else begin
|
|
op := nil;
|
|
if stream^.left <> nil then
|
|
op := First(op1, op2, stream^.left);
|
|
if op = nil then
|
|
if stream^.right <> nil then
|
|
op := First(op1, op2, stream^.right);
|
|
if op = nil then
|
|
if stream^.next <> nil then
|
|
op := First(op1, op2, stream^.next);
|
|
First := op;
|
|
end; {else}
|
|
end; {First}
|
|
|
|
|
|
begin {SafeLoad}
|
|
if sbk = lbk then
|
|
SafeLoad := First(sop, lop, sbk^.code) = sop
|
|
else
|
|
SafeLoad := MemberDFNList(sbk^.dfn, lbk^.dom);
|
|
end; {SafeLoad}
|
|
|
|
|
|
function MatchStores (op, tree: icptr; opbk, treebk: blockPtr):
|
|
boolean;
|
|
|
|
{ Check the tree for stores to the same location as op }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - store to check for }
|
|
{ tree - operation tree to check }
|
|
{ opbk - block containing op }
|
|
{ treebk - block containing tree }
|
|
{ }
|
|
{ Returns: True if there are matching stores, else false }
|
|
|
|
var
|
|
result: boolean; {function result}
|
|
|
|
begin {MatchStores}
|
|
result := false;
|
|
if tree^.opcode in [pc_lli,pc_lil,pc_lld,pc_ldl,pc_str,pc_cop,
|
|
pc_sro,pc_cpo,pc_gli,pc_gil,pc_gld,pc_gdl] then begin
|
|
if tree <> op then
|
|
result := MatchLoc(op, tree);
|
|
end {if}
|
|
else if tree^.opcode in [pc_ldo,pc_lod] then
|
|
if MatchLoc(op, tree) then
|
|
result := not SafeLoad(op, tree, opbk, treebk);
|
|
if not result then
|
|
if tree^.left <> nil then
|
|
result := MatchStores(op, tree^.left, opbk, treebk);
|
|
if not result then
|
|
if tree^.right <> nil then
|
|
result := MatchStores(op, tree^.right, opbk, treebk);
|
|
MatchStores := result;
|
|
end; {MatchStores}
|
|
|
|
|
|
begin {NoOtherStoresOrUses}
|
|
NoOtherStoresOrUses := true;
|
|
lp2 := lp;
|
|
while lp2 <> nil do begin
|
|
op2 := lp2^.block^.code;
|
|
while op2 <> nil do
|
|
if MatchStores(op, op2, olp^.block, lp2^.block) then begin
|
|
op2 := nil;
|
|
lp2 := nil;
|
|
NoOtherStoresOrUses := false;
|
|
end {if}
|
|
else
|
|
op2 := op2^.next;
|
|
if lp2 <> nil then
|
|
lp2 := lp2^.next;
|
|
end; {while}
|
|
end; {NoOtherStoresOrUses}
|
|
|
|
|
|
function NumberOfGens (op: icptr; lp: loopPtr): integer;
|
|
|
|
{ Count the number of nodes that generate op }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - instruction to check }
|
|
{ lp - loop to check }
|
|
|
|
var
|
|
count: integer; {number of generators}
|
|
|
|
begin {NumberOfGens}
|
|
count := 0;
|
|
while lp <> nil do begin
|
|
if Member(op, lp^.block^.c_gen) then
|
|
count := count+1;
|
|
lp := lp^.next;
|
|
end; {while}
|
|
NumberOfGens := count;
|
|
end; {NumberOfGens}
|
|
|
|
|
|
function PreviousStore (op, list: icptr): boolean;
|
|
|
|
{ See if the last save was invariant }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - load operation }
|
|
{ list - block containing the load }
|
|
{ }
|
|
{ Returns: True if the previous store was invariant, else }
|
|
{ false. }
|
|
|
|
var
|
|
indop: icptr; {any indirect operation after strop}
|
|
strop: icptr; {last matching store before op}
|
|
|
|
|
|
procedure Check (lop: icptr);
|
|
|
|
{ Stop if this is lop; save if it is a matching store }
|
|
{ }
|
|
{ parameters: }
|
|
{ lop - check this operation and it's children }
|
|
|
|
begin {Check}
|
|
if lop^.left <> nil then
|
|
Check(lop^.left);
|
|
if list <> nil then
|
|
if lop^.right <> nil then
|
|
Check(lop^.right);
|
|
if list <> nil then
|
|
if lop = op then
|
|
list := nil
|
|
else if (lop^.opcode in [pc_str,pc_cop,pc_str,pc_cop])
|
|
and MatchLoc(op, lop) then begin
|
|
strop := lop;
|
|
indop := nil;
|
|
end {else if}
|
|
else if op^.opcode in
|
|
[pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,pc_cup,pc_cui,pc_tl1]
|
|
then
|
|
indop := op;
|
|
end; {Check}
|
|
|
|
|
|
function Inhibit (indop, op: icptr): boolean;
|
|
|
|
{ See if op should be inhibited due to indirect stores }
|
|
{ }
|
|
{ parameters: }
|
|
{ indop - inhibiting indirect store or nil }
|
|
{ op - instruction to check }
|
|
|
|
begin {Inhibit}
|
|
Inhibit := false;
|
|
if indop <> nil then
|
|
if Member(op, c_ind) then
|
|
Inhibit := true;
|
|
end; {Inhibit}
|
|
|
|
|
|
begin {PreviousStore}
|
|
indop := nil;
|
|
strop := nil;
|
|
while list <> nil do begin
|
|
Check(list);
|
|
if list <> nil then
|
|
list := list^.next;
|
|
end; {while}
|
|
PreviousStore := false;
|
|
if strop <> nil then
|
|
if strop^.parents <> 0 then
|
|
if not Inhibit(indop, op) then
|
|
PreviousStore := true;
|
|
end; {PreviousStore}
|
|
|
|
|
|
begin {Check}
|
|
if op^.parents = 0 then begin
|
|
invariant := true;
|
|
if op^.left <> nil then begin
|
|
Check(op^.left, olp);
|
|
if op^.left^.parents = 0 then
|
|
invariant := false;
|
|
end; {if}
|
|
if op^.right <> nil then begin
|
|
Check(op^.right, olp);
|
|
if op^.right^.parents = 0 then
|
|
invariant := false;
|
|
end; {if}
|
|
if invariant then begin
|
|
opcode := op^.opcode;
|
|
if opcode in
|
|
[pc_adi,pc_adl,pc_adr,pc_and,pc_lnd,pc_bnd,pc_bal,
|
|
pc_bnt,pc_bnl,pc_bor,pc_blr,pc_bxr,pc_blx,pc_bno,
|
|
pc_dec,pc_dvi,pc_udi,pc_dvl,pc_udl,pc_dvr,pc_equ,pc_neq,
|
|
pc_grt,pc_les,pc_geq,pc_leq,pc_inc,pc_ior,pc_lor,
|
|
pc_ixa,pc_lad,pc_lao,pc_lca,pc_lda,pc_ldc,pc_mod,pc_uim,
|
|
pc_mdl,pc_ulm,pc_mpi,pc_umi,pc_mpl,pc_uml,pc_mpr,pc_ngi,
|
|
pc_ngl,pc_ngr,pc_not,pc_pop,pc_sbi,pc_sbl,pc_sbr,
|
|
pc_shl,pc_sll,pc_shr,pc_usr,pc_slr,pc_vsr,pc_tri]
|
|
then begin
|
|
op^.parents := icount;
|
|
icount := icount+1;
|
|
end {if}
|
|
else if opcode = pc_ind then begin
|
|
{conservatively assume any indirect stores may alias with op}
|
|
if not indirectStores then begin
|
|
op^.parents := icount;
|
|
icount := icount+1;
|
|
end; {if}
|
|
end {else if}
|
|
else if opcode = pc_cnv then begin
|
|
if op^.q & $000F <> ord(cgVoid) then begin
|
|
op^.parents := icount;
|
|
icount := icount+1;
|
|
end; {if}
|
|
end {else if}
|
|
else if opcode
|
|
in [pc_sro,pc_sto,pc_str,pc_cop,pc_cpo,pc_cpi]
|
|
then begin
|
|
if not inhibit then
|
|
if not IndirectInhibit(op) then
|
|
if NoOtherStoresOrUses(lp, olp, op) then begin
|
|
op^.parents := icount;
|
|
icount := icount+1;
|
|
end; {if}
|
|
end {else if}
|
|
else if opcode in [pc_ldo,pc_lod] then begin
|
|
{invariant if there is an immediately preceeding invariant store}
|
|
if PreviousStore(op, lp2^.block^.code) then begin
|
|
op^.parents := icount;
|
|
icount := icount+1;
|
|
end {if}
|
|
else if not Member(op, lp2^.block^.c_gen) then begin
|
|
{invariant if there are no generators in the loop}
|
|
count := NumberOfGens(op, lp);
|
|
if count = 0 then begin
|
|
op^.parents := icount;
|
|
icount := icount+1;
|
|
end {if}
|
|
else if count = 1 then begin
|
|
{invariant if there is one generator AND the generator}
|
|
{is not in the current block AND no reaching }
|
|
{definitions for the loop AND generating statement is }
|
|
{invariant }
|
|
if memberOp^.parents <> 0 then
|
|
if not Member(op, lp^.block^.c_in) then begin
|
|
op^.parents := icount;
|
|
icount := icount+1;
|
|
end; {if}
|
|
end; {else if}
|
|
end; {else}
|
|
end {else if}
|
|
end; {if}
|
|
if op^.parents <> 0 then
|
|
MarkInvariants := true;
|
|
end; {if}
|
|
end; {Check}
|
|
|
|
|
|
function CheckForIndirectStores (lp: loopPtr): boolean;
|
|
|
|
{ See if there are any indirect stores or function calls in }
|
|
{ the loop }
|
|
{ }
|
|
{ parameters: }
|
|
{ lp - loop to check }
|
|
{ }
|
|
{ Returns: True if there are indirect stores or function }
|
|
{ calls, else false. }
|
|
|
|
|
|
function CheckOps (op: icptr): boolean;
|
|
|
|
{ Check this operation list }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - operation list to check }
|
|
{ }
|
|
{ Returns: True if an indirect store or function call is }
|
|
{ found, else false. }
|
|
|
|
var
|
|
result: boolean; {value to return}
|
|
|
|
begin {CheckOps}
|
|
result := false;
|
|
while op <> nil do begin
|
|
if op^.opcode in
|
|
[pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,pc_cup,pc_cui,
|
|
pc_tl1,pc_mov]
|
|
then begin
|
|
result := true;
|
|
op := nil;
|
|
end {if}
|
|
else begin
|
|
if op^.left <> nil then
|
|
result := CheckOps(op^.left);
|
|
if not result then
|
|
if op^.right <> nil then
|
|
result := CheckOps(op^.right);
|
|
if result then
|
|
op := nil;
|
|
end; {if}
|
|
if op <> nil then
|
|
op := op^.next;
|
|
end; {while}
|
|
CheckOps := result;
|
|
end; {CheckOps}
|
|
|
|
|
|
begin {CheckForIndirectStores}
|
|
CheckForIndirectStores := false;
|
|
while lp <> nil do
|
|
if CheckOps(lp^.block^.code) then begin
|
|
CheckForIndirectStores := true;
|
|
lp := nil;
|
|
end {if}
|
|
else
|
|
lp := lp^.next;
|
|
end; {CheckForIndirectStores}
|
|
|
|
|
|
function DominatesExits (dfn: integer; lp: loopPtr): boolean;
|
|
|
|
{ See if this block dominates all loop exits }
|
|
{ }
|
|
{ parameters: }
|
|
{ dfn - block that must dominate exits }
|
|
{ lp - loop list }
|
|
{ }
|
|
{ Returns: True if the block dominates all exits, else false. }
|
|
|
|
var
|
|
dom: blockListPtr; {used to trace dominator list}
|
|
|
|
begin {DominatesExits}
|
|
DominatesExits := true;
|
|
while lp <> nil do begin
|
|
if lp^.exit then begin
|
|
dom := lp^.block^.dom;
|
|
while dom <> nil do
|
|
if dom^.dfn = dfn then
|
|
dom := nil
|
|
else begin
|
|
dom := dom^.next;
|
|
if dom = nil then begin
|
|
lp := nil;
|
|
DominatesExits := false;
|
|
end; {if}
|
|
end; {else}
|
|
end; {if}
|
|
if lp <> nil then
|
|
lp := lp^.next;
|
|
end; {while}
|
|
end; {DominatesExits}
|
|
|
|
|
|
begin {MarkInvariants}
|
|
MarkInvariants := false;
|
|
lp2 := lp;
|
|
while lp2 <> nil do begin
|
|
inhibit := not DominatesExits(lp2^.block^.dfn, lp);
|
|
indirectStores := CheckForIndirectStores(lp);
|
|
op := lp2^.block^.code;
|
|
while op <> nil do begin
|
|
Check(op, lp2);
|
|
op := op^.next;
|
|
end; {while}
|
|
lp2 := lp2^.next;
|
|
end; {while}
|
|
end; {MarkInvariants}
|
|
|
|
|
|
procedure RemoveInvariants (llp: loopListPtr);
|
|
|
|
{ Remove loop invariant calculations }
|
|
{ }
|
|
{ parameters: }
|
|
{ llp - pointer to the loop entry to process }
|
|
|
|
var
|
|
icount, oldIcount: integer; {invariant order counters}
|
|
nhp: blockPtr; {new loop header pointer}
|
|
ohp: blockPtr; {old loop header pointer}
|
|
op1, op2, op3: icptr; {used to reverse the code list}
|
|
|
|
|
|
procedure CreateHeader;
|
|
|
|
{ Create the new loop header }
|
|
{ }
|
|
{ Notes: As a side effect, CreateHeader sets nhp to point to }
|
|
{ the new loop header, and ohp to point to the old header. }
|
|
|
|
var
|
|
lp: loopPtr; {new loop list entry}
|
|
|
|
begin {CreateHeader}
|
|
nhp := pointer(Calloc(sizeof(block))); {create the new block}
|
|
ohp := llp^.loop^.block; {insert it in the block list}
|
|
nhp^.last := ohp^.last;
|
|
if nhp^.last <> nil then
|
|
nhp^.last^.next := nhp;
|
|
nhp^.next := ohp;
|
|
ohp^.last := nhp;
|
|
nhp^.dfn := fakeDFN; {just a unique number, not a real DFN}
|
|
fakeDFN := fakeDFN - 1;
|
|
new(lp); {add it to the loop list}
|
|
lp^.next := llp^.loop;
|
|
llp^.loop := lp;
|
|
lp^.block := nhp;
|
|
lp^.exit := false;
|
|
end; {CreateHeader}
|
|
|
|
|
|
function FindInvariant (ic: integer): integer;
|
|
|
|
{ Find the next invariant calculation }
|
|
{ }
|
|
{ parameters: }
|
|
{ ic - base count; the new count must exceed this }
|
|
{ }
|
|
{ Returns: count for the invariant record to remove }
|
|
|
|
var
|
|
lp: loopPtr; {used to trace loop list}
|
|
op: icptr; {used to trace code list}
|
|
nic: integer; {lowest count > ic}
|
|
|
|
|
|
procedure Check (op: icptr);
|
|
|
|
{ See if op or its children represent a newer invariant }
|
|
{ calculation than the one numbered nic }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - instruction to check }
|
|
{ }
|
|
{ Notes: Rejecting pc_bno here is rather odd, but it allows }
|
|
{ expressions _containing_ pc_bno to be removed without }
|
|
{ messing up pc_tri operations by allowing pc_bno to be }
|
|
{ removed as the top level of an expression. }
|
|
|
|
begin {Check}
|
|
if op^.parents = 0 then begin
|
|
if op^.left <> nil then
|
|
Check(op^.left);
|
|
if op^.right <> nil then
|
|
Check(op^.right);
|
|
end {if}
|
|
else begin
|
|
if op^.parents < nic then
|
|
if op^.parents > ic then
|
|
if op^.opcode <> pc_bno then
|
|
nic := op^.parents;
|
|
end; {else}
|
|
end; {Check}
|
|
|
|
|
|
begin {FindInvariant}
|
|
nic := maxint;
|
|
lp := llp^.loop;
|
|
while (lp <> nil) and (nic <> ic+1) do begin
|
|
op := lp^.block^.code;
|
|
while op <> nil do begin
|
|
Check(op);
|
|
op := op^.next;
|
|
end; {while}
|
|
lp := lp^.next;
|
|
end; {while}
|
|
FindInvariant := nic;
|
|
end; {FindInvariant}
|
|
|
|
|
|
procedure RemoveInvariant (ic: integer);
|
|
|
|
{ Move the invariant calculation to the header }
|
|
{ }
|
|
{ parameters: }
|
|
{ ic - index number for instruction to remove }
|
|
|
|
var
|
|
done: boolean; {loop termination test}
|
|
lp: loopPtr; {used to trace loop list}
|
|
op: icptr; {used to trace code list}
|
|
|
|
|
|
procedure Check (op: icptr);
|
|
|
|
{ See if a child of op is the target instruction to move }
|
|
{ (If so, move it.) }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - instruction to check }
|
|
|
|
|
|
procedure Remove (var op: icptr);
|
|
|
|
{ Move a calculation to the loop header }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - invariant calculation to move }
|
|
|
|
var
|
|
loc, op2, str: icptr; {new opcodes}
|
|
optype: baseTypeEnum; {type of the temp variable}
|
|
|
|
begin {Remove}
|
|
if (op^.left <> nil) or (op^.right <> nil) then begin
|
|
optype := TypeOf(op); {create a temp label}
|
|
loc := pointer(Calloc(sizeof(intermediate_code)));
|
|
loc^.opcode := dc_loc;
|
|
loc^.optype := cgWord;
|
|
maxLoc := maxLoc + 1;
|
|
loc^.r := maxLoc;
|
|
loc^.q := TypeSize(optype);
|
|
loc^.next := nhp^.code;
|
|
nhp^.code := loc;
|
|
{make a copy of the tree}
|
|
op2 := pointer(Malloc(sizeof(intermediate_code)));
|
|
op2^ := op^;
|
|
op^.opcode := pc_lod; {substitute a load of the temp}
|
|
op^.optype := optype;
|
|
op^.r := loc^.r;
|
|
op^.q := 0;
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
{store the temp result}
|
|
str := pointer(Calloc(sizeof(intermediate_code)));
|
|
str^.opcode := pc_str;
|
|
str^.optype := optype;
|
|
str^.r := loc^.r;
|
|
str^.q := 0;
|
|
str^.left := op2;
|
|
str^.next := loc^.next; {insert the store in the basic block}
|
|
loc^.next := str;
|
|
end; {if}
|
|
done := true;
|
|
end; {Remove}
|
|
|
|
|
|
begin {Check}
|
|
if op^.left <> nil then begin
|
|
if op^.left^.parents = ic then
|
|
Remove(op^.left);
|
|
if not done then
|
|
Check(op^.left);
|
|
end; {if}
|
|
if not done then
|
|
if op^.right <> nil then begin
|
|
if op^.right^.parents = ic then
|
|
Remove(op^.right);
|
|
if not done then
|
|
Check(op^.right);
|
|
end; {if}
|
|
end; {Check}
|
|
|
|
|
|
procedure RemoveTop (var op: icptr);
|
|
|
|
{ Move a top-level instruction to the header }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - top level instruction to remove }
|
|
|
|
var
|
|
op2: icptr; {temp operation}
|
|
|
|
begin {RemoveTop}
|
|
op2 := op;
|
|
op := op^.next;
|
|
op2^.next := nhp^.code;
|
|
nhp^.code := op2;
|
|
end; {RemoveTop}
|
|
|
|
|
|
begin {RemoveInvariant}
|
|
lp := llp^.loop;
|
|
done := false;
|
|
while not done do begin
|
|
op := lp^.block^.code;
|
|
if op <> nil then
|
|
if op^.parents = ic then begin
|
|
RemoveTop(lp^.block^.code);
|
|
done := true;
|
|
end {if}
|
|
else begin
|
|
Check(op);
|
|
while (op^.next <> nil) and (not done) do begin
|
|
if op^.next^.parents = ic then begin
|
|
RemoveTop(op^.next);
|
|
done := true;
|
|
end {if}
|
|
else
|
|
Check(op^.next);
|
|
if op^.next <> nil then
|
|
op := op^.next;
|
|
end; {while}
|
|
end; {else}
|
|
lp := lp^.next;
|
|
if lp = nil then
|
|
done := true;
|
|
end; {while}
|
|
end; {RemoveInvariant}
|
|
|
|
|
|
procedure AdjustControlFlow;
|
|
|
|
{ Adjust control flow to account for loop invariant removal. }
|
|
{ The current loop's back edges should go to the old header }
|
|
{ block, bypassing removed invariant computations. Any other }
|
|
{ jumps to the start of the loop should go to the new header }
|
|
{ block so that those computations are performed. }
|
|
|
|
var
|
|
lp: loopPtr; {used to trace loop list}
|
|
op, op1: icptr; {used to trace code list}
|
|
|
|
begin {AdjustControlFlow}
|
|
{move old header label to new header}
|
|
{(for any jumps to it from outside loop)}
|
|
if (ohp^.code = nil) or (ohp^.code^.opcode <> dc_lab) then
|
|
TermError(3); {shouldn't happen, but let's be sure}
|
|
op1 := pointer(Calloc(sizeof(intermediate_code)));
|
|
op1^.opcode := dc_lab;
|
|
op1^.q := ohp^.code^.q;
|
|
op1^.next := nhp^.code;
|
|
nhp^.code := op1;
|
|
|
|
ohp^.code^.q := GenLabel; {make new label for old header &}
|
|
lp := llp^.loop; {adjust loop back edges to go to it}
|
|
while (lp <> nil) do begin
|
|
op := lp^.block^.code;
|
|
while op <> nil do begin
|
|
if op^.opcode in [pc_ujp,pc_fjp,pc_tjp,pc_add] then
|
|
if op^.q = op1^.q then begin
|
|
op^.q := ohp^.code^.q;
|
|
end;
|
|
op := op^.next;
|
|
end; {while}
|
|
lp := lp^.next;
|
|
end; {while}
|
|
end; {AdjustControlFlow}
|
|
|
|
|
|
procedure UpdateLoopLists;
|
|
|
|
{ Update not-yet-processed loops to include the new header }
|
|
{ block if appropriate. Also update any additional loops with }
|
|
{ the same original header to now include all the nodes of the }
|
|
{ loop just processed, since their back edges will now go to }
|
|
{ the new header, which dominates the original header. }
|
|
|
|
var
|
|
lp, lp2, lp3: loopPtr; {used to trace loop list}
|
|
|
|
begin {UpdateLoopLists}
|
|
loops := llp^.next;
|
|
while loops <> nil do begin
|
|
if loops^.loop^.block = ohp then begin
|
|
{Another loop with the same header.}
|
|
{Nodes of llp^.loop must be added to it.}
|
|
{They go after the original header.}
|
|
lp3 := loops^.loop;
|
|
lp := llp^.loop;
|
|
while lp <> nil do begin
|
|
if lp^.block <> nhp then
|
|
if not InLoop(lp^.block, loops^.loop) then begin
|
|
new(lp2);
|
|
lp2^.next := lp3^.next;
|
|
lp2^.block := lp^.block;
|
|
lp2^.exit := lp^.exit;
|
|
lp3^.next := lp2;
|
|
lp3 := lp2;
|
|
end; {if}
|
|
lp := lp^.next;
|
|
end; {while}
|
|
end; {if}
|
|
lp := loops^.loop; {Add nhp to other loops containing ohp}
|
|
while lp <> nil do begin
|
|
if lp^.block = ohp then begin
|
|
new(lp2);
|
|
lp2^.next := lp^.next;
|
|
lp2^.block := lp^.block;
|
|
lp2^.exit := lp^.exit;
|
|
lp^.next := lp2;
|
|
lp^.block := nhp;
|
|
lp^.exit := false;
|
|
lp := nil;
|
|
end {if}
|
|
else
|
|
lp := lp^.next;
|
|
end; {while}
|
|
loops := loops^.next;
|
|
end; {while}
|
|
end; {UpdateLoopLists}
|
|
|
|
|
|
procedure UpdateDominators;
|
|
|
|
{ Set dominators of the new header block, and update }
|
|
{ dominators of other blocks to include it where appropriate. }
|
|
|
|
var
|
|
bb: blockPtr; {used to trace list of basic blocks}
|
|
dom: blockListPtr; {used to trace dominator list}
|
|
|
|
begin {UpdateDominators}
|
|
dom := ohp^.dom; {Set dominators of new header block}
|
|
while dom <> nil do begin
|
|
if dom^.dfn <> ohp^.dfn then
|
|
AddDominator(nhp^.dom, dom^.dfn);
|
|
dom := dom^.next;
|
|
end; {while}
|
|
AddDominator(nhp^.dom, nhp^.dfn);
|
|
|
|
bb := DAGBlocks; {Add nhp to other loops' dominators}
|
|
while bb <> nil do begin
|
|
if MemberDFNList(ohp^.dfn, bb^.dom) then
|
|
AddDominator(bb^.dom, nhp^.dfn);
|
|
bb := bb^.next;
|
|
end; {while}
|
|
end; {UpdateDominators}
|
|
|
|
|
|
begin {RemoveInvariants}
|
|
CreateHeader; {create a loop header block}
|
|
icount := 0; {find & remove all invariants}
|
|
repeat
|
|
oldIcount := icount;
|
|
icount := FindInvariant (icount);
|
|
if icount <> maxint then
|
|
RemoveInvariant(icount);
|
|
until icount = maxint;
|
|
op1 := nhp^.code; {reverse the new code list}
|
|
op2 := nil;
|
|
while op1 <> nil do begin
|
|
op3 := op1;
|
|
op1 := op1^.next;
|
|
op3^.next := op2;
|
|
op2 := op3;
|
|
end; {while}
|
|
nhp^.code := op2;
|
|
{adjust things to account for changes}
|
|
if nhp^.code <> nil then begin
|
|
Spin;
|
|
AdjustControlFlow;
|
|
UpdateLoopLists;
|
|
UpdateDominators;
|
|
end; {if}
|
|
end; {RemoveInvariants}
|
|
|
|
|
|
procedure ZeroParents (lp: loopPtr);
|
|
|
|
{ Zero the parents field in all nodes }
|
|
{ }
|
|
{ parameters: }
|
|
{ lp - loop for which to zero the parents }
|
|
|
|
var
|
|
op: icptr; {used to trace the opcode list}
|
|
|
|
|
|
procedure Zero (op: icptr);
|
|
|
|
{ Zero the parents field for this node and its }
|
|
{ children. }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - node to zero }
|
|
|
|
begin {Zero}
|
|
op^.parents := 0;
|
|
if op^.left <> nil then
|
|
Zero(op^.left);
|
|
if op^.right <> nil then
|
|
Zero(op^.right);
|
|
end; {Zero}
|
|
|
|
|
|
begin {ZeroParents}
|
|
while lp <> nil do begin
|
|
op := lp^.block^.code;
|
|
while op <> nil do begin
|
|
Zero(op);
|
|
op := op^.next;
|
|
end; {while}
|
|
lp := lp^.next;
|
|
end; {while}
|
|
end; {ZeroParents}
|
|
|
|
|
|
begin {LoopInvariantRemoval}
|
|
Spin;
|
|
FindLoops; {find a list of natural loops}
|
|
fakeDFN := -1;
|
|
|
|
llp := loops; {scan the loops...}
|
|
icount := 1;
|
|
while llp <> nil do begin
|
|
Spin;
|
|
ZeroParents(llp^.loop); {set the parents field to zero}
|
|
while MarkInvariants(llp^.loop) do {mark the loop invariant computations}
|
|
;
|
|
if icount <> 1 then
|
|
RemoveInvariants(llp); {remove loop invariant calculations}
|
|
llp := llp^.next;
|
|
end; {while}
|
|
|
|
|
|
while loops <> nil do begin {dispose of the loop lists}
|
|
while loops^.loop <> nil do begin
|
|
lp := loops^.loop;
|
|
loops^.loop := lp^.next;
|
|
dispose(lp);
|
|
end; {while}
|
|
llp := loops;
|
|
loops := llp^.next;
|
|
dispose(llp);
|
|
end; {while}
|
|
end; {LoopInvariantRemoval}
|
|
|
|
|
|
begin {DoLoopOptimization}
|
|
DepthFirstOrder; {create the depth first tree}
|
|
ReachingDefinitions; {find reaching definitions}
|
|
Dominators; {find the lists of dominators}
|
|
LoopInvariantRemoval; {remove loop invariant computations}
|
|
while dft <> nil do begin {dispose of the depth first tree}
|
|
dft2 := dft;
|
|
dft := dft2^.next;
|
|
dispose(dft2);
|
|
end; {while}
|
|
while backEdge <> nil do begin {dispose of the back edge list}
|
|
dft2 := backEdge;
|
|
backEdge := dft2^.next;
|
|
dispose(dft2);
|
|
end; {while}
|
|
end; {DoLoopOptimization}
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
procedure DAG {code: icptr};
|
|
|
|
{ place an op code in a DAG or tree }
|
|
{ }
|
|
{ parameters: }
|
|
{ code - opcode }
|
|
|
|
var
|
|
temp: icptr; {temp node}
|
|
|
|
|
|
procedure Generate;
|
|
|
|
{ generate the code for the current procedure }
|
|
|
|
var
|
|
op: icptr; {temp opcode pointers}
|
|
|
|
|
|
procedure BasicBlocks;
|
|
|
|
{ Break the code up into basic blocks }
|
|
|
|
var
|
|
blast: blockPtr; {last block pointer}
|
|
bp: blockPtr; {current block pointer}
|
|
cb: icptr; {last code in block pointer}
|
|
cp: icptr; {current code pointer}
|
|
|
|
begin {BasicBlocks}
|
|
cp := DAGhead;
|
|
DAGblocks := nil;
|
|
if cp <> nil then begin
|
|
bp := pointer(Calloc(sizeof(block)));
|
|
DAGblocks := bp;
|
|
blast := bp;
|
|
bp^.code := cp;
|
|
cb := cp;
|
|
cp := cp^.next;
|
|
cb^.next := nil;
|
|
while cp <> nil do
|
|
{labels start a new block}
|
|
if cp^.opcode = dc_lab then begin
|
|
Spin;
|
|
bp := pointer(Calloc(sizeof(block)));
|
|
bp^.last := blast;
|
|
blast^.next := bp;
|
|
blast := bp;
|
|
bp^.code := cp;
|
|
cb := cp;
|
|
cp := cp^.next;
|
|
cb^.next := nil;
|
|
end {if}
|
|
{conditionals are followed by a new block}
|
|
else if cp^.opcode in [pc_fjp, pc_tjp, pc_ujp, pc_ret, pc_xjp] then
|
|
begin
|
|
Spin;
|
|
while cp^.next^.opcode = pc_add do begin
|
|
cb^.next := cp;
|
|
cb := cp;
|
|
cp := cp^.next;
|
|
cb^.next := nil;
|
|
end; {while}
|
|
cb^.next := cp;
|
|
cb := cp;
|
|
cp := cp^.next;
|
|
cb^.next := nil;
|
|
bp := pointer(Calloc(sizeof(block)));
|
|
bp^.last := blast;
|
|
blast^.next := bp;
|
|
blast := bp;
|
|
bp^.code := cp;
|
|
cb := cp;
|
|
cp := cp^.next;
|
|
cb^.next := nil;
|
|
end {else if}
|
|
else begin {all other statements get added to a block}
|
|
cb^.next := cp;
|
|
cb := cp;
|
|
cp := cp^.next;
|
|
cb^.next := nil;
|
|
end; {else}
|
|
end; {if}
|
|
end; {BasicBlocks}
|
|
|
|
|
|
begin {Generate}
|
|
if peepHole then {peephole optimization}
|
|
repeat
|
|
rescan := false;
|
|
PeepHoleOptimization(DAGhead);
|
|
op := DAGHead;
|
|
while op^.next <> nil do begin
|
|
Spin;
|
|
PeepHoleOptimization(op^.next);
|
|
op := op^.next;
|
|
end; {while}
|
|
CheckLabels;
|
|
until not rescan;
|
|
BasicBlocks; {build the basic blocks}
|
|
if commonSubexpression or loopOptimizations then
|
|
if not volatile then
|
|
FlagIndirectUses; {create a list of all indirect uses}
|
|
if commonSubexpression then {common sub-expression removal}
|
|
if not volatile then
|
|
CommonSubexpressionElimination;
|
|
if loopOptimizations then {loop optimizations}
|
|
if not volatile then
|
|
DoLoopOptimization;
|
|
{ if printSymbols then {debug}
|
|
{ PrintBlocks(@'DAG: ', DAGblocks); {debug}
|
|
if commonSubexpression or loopOptimizations then
|
|
if not volatile then
|
|
DisposeOpList(c_ind); {dispose of indirect use list}
|
|
Gen(DAGblocks); {generate native code}
|
|
if loopOptimizations then {dump and dynamic space}
|
|
if not volatile then
|
|
DumpLoopLists;
|
|
DAGhead := nil; {reset the DAG pointers}
|
|
end; {Generate}
|
|
|
|
|
|
procedure Push (code: icptr);
|
|
|
|
{ place a node on the operation stack }
|
|
{ }
|
|
{ parameters: }
|
|
{ code - node }
|
|
|
|
begin {Push}
|
|
code^.next := DAGhead;
|
|
DAGhead := code;
|
|
end; {Push}
|
|
|
|
|
|
function Pop: icptr;
|
|
|
|
{ pop a node from the operation stack }
|
|
{ }
|
|
{ returns: node pointer or nil }
|
|
|
|
var
|
|
node: icptr; {node poped}
|
|
tn: icptr; {temp node}
|
|
|
|
begin {Pop}
|
|
node := DAGhead;
|
|
if node = nil then
|
|
Error(cge1)
|
|
else begin
|
|
DAGhead := node^.next;
|
|
node^.next := nil;
|
|
end; {else}
|
|
if node^.opcode = dc_loc then begin
|
|
tn := node;
|
|
node := Pop;
|
|
Push(tn);
|
|
end; {if}
|
|
Pop := node;
|
|
end; {Pop}
|
|
|
|
|
|
procedure Reverse;
|
|
|
|
{ Reverse the operation stack }
|
|
|
|
var
|
|
list, temp: icptr; {work pointers}
|
|
|
|
begin {Reverse}
|
|
list := nil;
|
|
while DAGhead <> nil do begin
|
|
temp := DAGhead;
|
|
DAGhead := temp^.next;
|
|
temp^.next := list;
|
|
list := temp;
|
|
end; {while}
|
|
DAGhead := list;
|
|
end; {Reverse}
|
|
|
|
|
|
begin {DAG}
|
|
case code^.opcode of
|
|
|
|
pc_bnt, pc_bnl, pc_cnv, pc_dec, pc_inc, pc_ind, pc_lbf, pc_lbu,
|
|
pc_ngi, pc_ngl, pc_ngr, pc_not, pc_stk, pc_cop, pc_cpo, pc_tl1,
|
|
pc_sro, pc_str, pc_fjp, pc_tjp, pc_xjp, pc_cup, pc_pop, pc_iil,
|
|
pc_ili, pc_idl, pc_ild:
|
|
begin
|
|
code^.left := Pop;
|
|
Push(code);
|
|
end;
|
|
|
|
pc_adi, pc_adl, pc_adr, pc_and, pc_lnd, pc_bnd, pc_bal, pc_bno,
|
|
pc_bor, pc_blr, pc_bxr, pc_blx, pc_cbf, pc_cpi, pc_dvi, pc_mov,
|
|
pc_udi, pc_dvl, pc_udl, pc_dvr, pc_equ, pc_geq, pc_grt, pc_leq,
|
|
pc_les, pc_neq, pc_ior, pc_lor, pc_ixa, pc_mod, pc_uim, pc_mdl,
|
|
pc_ulm, pc_mpi, pc_umi, pc_mpl, pc_uml, pc_mpr, pc_psh, pc_sbi,
|
|
pc_sbl, pc_sbr, pc_shl, pc_sll, pc_shr, pc_usr, pc_slr, pc_vsr,
|
|
pc_tri, pc_sbf, pc_sto, pc_cui:
|
|
begin
|
|
code^.right := Pop;
|
|
code^.left := Pop;
|
|
Push(code);
|
|
end;
|
|
|
|
pc_gil, pc_gli, pc_gdl, pc_gld, pc_lil, pc_lli, pc_ldl, pc_lld,
|
|
pc_lad, pc_lao, pc_lca, pc_lda, pc_ldc, pc_ldo, pc_lod, pc_nop,
|
|
dc_cns, dc_glb, dc_dst, pc_lnm, pc_nam, pc_nat, dc_lab, pc_add,
|
|
pc_ujp, dc_pin, pc_ent, pc_ret, dc_sym:
|
|
Push(code);
|
|
|
|
pc_cnn:
|
|
begin
|
|
code^.opcode := pc_cnv;
|
|
temp := Pop;
|
|
code^.left := Pop;
|
|
Push(code);
|
|
Push(temp);
|
|
end;
|
|
|
|
dc_loc: begin
|
|
Push(code);
|
|
if code^.r > maxLoc then
|
|
maxLoc := code^.r;
|
|
end;
|
|
|
|
dc_prm: begin
|
|
Push(code);
|
|
if code^.s > maxLoc then
|
|
maxLoc := code^.s;
|
|
end;
|
|
|
|
dc_str: begin
|
|
Push(code);
|
|
maxLoc := 0;
|
|
end;
|
|
|
|
dc_enp: begin
|
|
Push(code);
|
|
Reverse;
|
|
Generate;
|
|
end;
|
|
|
|
otherwise: Error(cge1); {invalid opcode}
|
|
end; {case}
|
|
end; {DAG}
|
|
|
|
end.
|