ORCA-C/DAG.pas
2017-10-21 18:40:19 -05:00

4735 lines
143 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 }
{---------------------------------------------------------------}
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) or volatile then
SideEffects := false
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
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 NoFunctions(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 NoFunctions(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
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;
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;
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}
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 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 begin
rval := trunc4(rval);
lval := round4(rval);
end; {else}
op^.left^.rval := 0.0;
op^.left^.q := long(lval).lsw;
end;
cgLong,cgULong: begin
rval := op^.left^.rval;
if totype.optype = cgULong then begin
if rval < 0 then
rval := 0
else if rval > 2147483647.0 then
rval := rval - 4294967296.0
end; {if}
if rval < -2147483648.0 then
lval := $80000000
else if rval > 2147483647.0 then
lval := 2147483647
else begin
rval := trunc4(rval);
lval := round4(rval);
end; {else}
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^.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;
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}
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^.right^.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
op2 := op^.left;
op^.left := op^.left^.left;
op2^.left := op^.right;
op2^.opcode := pc_adi;
op^.right := op2;
end; {else if}
end; {case pc_ixa}
pc_leq: begin {pc_leq}
if 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}
end; {case pc_lnm}
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 NoFunctions(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 NoFunctions(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 NoFunctions(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:
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);
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 <