ORCA-C/DAG.pas
Stephen Heumann af3c8e1eea Optimize double stores to just use integer operations.
This is equivalent to an optimization already done for float.
2023-06-17 19:24:50 -05:00

5578 lines
176 KiB
ObjectPascal

{$optimize 7}
{---------------------------------------------------------------}
{ }
{ DAG Creation }
{ }
{ Places intermediate codes into DAGs and trees. }
{ }
{---------------------------------------------------------------}
unit DAG;
interface
{$segment 'DAG'}
{$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 lshr (x,y: longint): longint; extern;
{-- External 64-bit math routines; imported from Expression.pas --}
{ Procedures for arithmetic and shifts compute "x := x OP y". }
procedure umul64 (var x: longlong; y: longlong); extern;
procedure udiv64 (var x: longlong; y: longlong); extern;
procedure div64 (var x: longlong; y: longlong); extern;
procedure umod64 (var x: longlong; y: longlong); extern;
procedure rem64 (var x: longlong; y: longlong); extern;
procedure add64 (var x: longlong; y: longlong); extern;
procedure sub64 (var x: longlong; y: longlong); extern;
procedure shl64 (var x: longlong; y: integer); extern;
procedure ashr64 (var x: longlong; y: integer); extern;
procedure lshr64 (var x: longlong; y: integer); 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 and 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, pc_bqr, pc_bqx, pc_baq, pc_adq,
pc_mpq, pc_umq: 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) or (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;
cgQuad, cgUQuad:
if op1^.qval.lo = op2^.qval.lo then
if op1^.qval.hi = op2^.qval.hi then
CodesMatch := true;
cgReal, cgDouble, cgComp, cgExtended:
if op1^.rval = op2^.rval then
if (SignBit(op1^.rval) = SignBit(op2^.rval))
or fastMath then
CodesMatch := true;
cgString:
if not (op1^.isByteSeq or op1^.isByteSeq) then
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 := cgWord;
opt1 := cgWord;
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 := cgWord;
opt2 := cgWord;
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 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: extended; {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 }
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,
pc_fix,pc_ckp] 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
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;
cnvdbl: record {for stuffing a double in a quad space}
case boolean of
true: (qval: longlong);
false: (rval: double);
end;
begin {RealStoreOptimizations}
if opl^.opcode = pc_cnv then
if baseTypeEnum(opl^.q & $000F) = op^.optype then
opl^.q := (opl^.q & $FFF0) | ord(cgExtended);
if (op^.optype = cgComp) or not (op^.opcode in [pc_sro,pc_str,pc_sto]) then
{skip below optimizations}
else 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 := 2;
cgDouble: disp := 6;
cgExtended: disp := 8;
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 := $8000;
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}
else if op^.optype = cgDouble then begin
if opl^.opcode = pc_ldc then begin
cnvdbl.rval := opl^.rval;
opl^.qval := cnvdbl.qval;
opl^.optype := cgQuad;
op^.optype := cgQuad;
end {if}
else if opl^.opcode in [pc_ind,pc_ldo,pc_lod] then
if opl^.optype = cgDouble then begin
opl^.optype := cgQuad;
op^.optype := cgQuad;
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;
PeepHoleOptimization(opv);
end {else if}
else {if q < 0 then} begin
op^.opcode := pc_dec;
op^.q := -q;
op^.right := nil;
PeepHoleOptimization(opv);
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
done := false;
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 begin
opv := op^.left;
done := true;
end {if}
else if (lval >= 0) and (lval <= maxint) then begin
op^.opcode := pc_inc;
op^.optype := cgLong;
op^.q := ord(lval);
op^.right := nil;
done := true;
PeepHoleOptimization(opv);
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;
done := true;
PeepHoleOptimization(opv);
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;
done := true;
end; {if}
if not done and (op^.right^.opcode in [pc_lao,pc_lda,pc_ixa]) then
ReverseChildren(op);
if not done and (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 fastMath then
if op^.right^.rval = 0.0 then
opv := op^.left;
end; {if}
end; {else}
end; {case pc_adr}
pc_adq: begin {pc_adq}
if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
add64(op^.left^.qval, op^.right^.qval);
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^.qval.lo = 0) and (op^.right^.qval.hi = 0) then
opv := op^.left;
end; {if}
end; {else}
end; {case pc_adq}
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 begin
if not SideEffects(op^.left) then
opv := op^.right;
end {if}
else if op^.right^.lval = -1 then
opv := op^.left;
end; {else if}
end; {case pc_bal}
pc_baq: begin {pc_baq}
if op^.left^.opcode = pc_ldc then
ReverseChildren(op);
if op^.left^.opcode = pc_ldc then begin
op^.left^.qval.hi := op^.left^.qval.hi & op^.right^.qval.hi;
op^.left^.qval.lo := op^.left^.qval.lo & op^.right^.qval.lo;
opv := op^.left;
end {if}
else if op^.right^.opcode = pc_ldc then begin
if (op^.right^.qval.lo = 0) and (op^.right^.qval.hi = 0) then begin
if not SideEffects(op^.left) then
opv := op^.right;
end {if}
else if (op^.right^.qval.lo = -1) and (op^.right^.qval.hi = -1) then
opv := op^.left;
end; {else if}
end; {case pc_baq}
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 begin
if not SideEffects(op^.left) then
opv := op^.right;
end {if}
else if op^.right^.lval = 0 then
opv := op^.left;
end; {else if}
end; {case pc_blr}
pc_bqr: begin {pc_bqr}
if op^.left^.opcode = pc_ldc then
ReverseChildren(op);
if op^.left^.opcode = pc_ldc then begin
op^.left^.qval.hi := op^.left^.qval.hi | op^.right^.qval.hi;
op^.left^.qval.lo := op^.left^.qval.lo | op^.right^.qval.lo;
opv := op^.left;
end {if}
else if op^.right^.opcode = pc_ldc then begin
if (op^.right^.qval.hi = -1) and (op^.right^.qval.lo = -1) then begin
if not SideEffects(op^.left) then
opv := op^.right;
end {if}
else if (op^.right^.qval.hi = 0) and (op^.right^.qval.lo = 0) then
opv := op^.left;
end; {else if}
end; {case pc_bqr}
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_bqx: begin {pc_bqx}
if op^.left^.opcode = pc_ldc then
ReverseChildren(op);
if op^.left^.opcode = pc_ldc then begin
op^.left^.qval.hi := op^.left^.qval.hi ! op^.right^.qval.hi;
op^.left^.qval.lo := op^.left^.qval.lo ! op^.right^.qval.lo;
opv := op^.left;
end {if}
else if op^.right^.opcode = pc_ldc then begin
if (op^.right^.qval.lo = 0) and (op^.right^.qval.hi = 0) then
opv := op^.left
else if (op^.right^.qval.lo = -1) and (op^.right^.qval.hi = -1) then begin
op^.opcode := pc_bnq;
op^.right := nil;
end; {else if}
end; {else if}
end; {case pc_bqx}
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 begin
if not SideEffects(op^.left) then
opv := op^.right;
end {if}
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_bnq: begin {pc_bnq}
if op^.left^.opcode = pc_ldc then begin
op^.left^.qval.hi := op^.left^.qval.hi ! $FFFFFFFF;
op^.left^.qval.lo := op^.left^.qval.lo ! $FFFFFFFF;
opv := op^.left;
end; {if}
end; {case pc_bnq}
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 begin
if not SideEffects(op^.left) then
opv := op^.right;
end {if}
else if op^.right^.q = 0 then
opv := op^.left;
end {else if}
else if ((op^.left^.opcode = pc_shl) and (op^.right^.opcode = pc_usr))
or ((op^.left^.opcode = pc_usr) and (op^.right^.opcode = pc_shl)) then
if op^.left^.right^.opcode = pc_ldc then
if op^.right^.right^.opcode = pc_ldc then
if op^.left^.right^.q = 8 then
if op^.right^.right^.q = 8 then
if CodesMatch(op^.left^.left, op^.right^.left, false) then
if not SideEffects(op^.left^.left) then begin
op^.opcode := pc_rbo;
op^.left := op^.left^.left;
op^.right := nil;
end; {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
doit := true;
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;
cgQuad,cgUQuad: begin
op^.left^.qval.lo := op^.left^.q;
if op^.left^.qval.lo < 0 then
op^.left^.qval.hi := -1
else
op^.left^.qval.hi := 0;
op^.left^.q := 0;
end;
cgReal,cgDouble,cgComp,cgExtended: begin
rval := op^.left^.q;
LimitPrecision(rval, totype.optype);
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;
cgQuad,cgUQuad: begin
op^.left^.qval.lo := ord4(op^.left^.q) & $0000FFFF;
op^.left^.qval.hi := 0;
op^.left^.q := 0;
end;
cgReal,cgDouble,cgComp,cgExtended: begin
rval := ord4(op^.left^.q) & $0000FFFF;
LimitPrecision(rval, totype.optype);
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: ;
cgQuad,cgUQuad: begin
op^.left^.qval.lo := op^.left^.lval;
if op^.left^.qval.lo < 0 then
op^.left^.qval.hi := -1
else
op^.left^.qval.hi := 0;
end;
cgReal,cgDouble,cgComp,cgExtended: begin
rval := op^.left^.lval;
LimitPrecision(rval, totype.optype);
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: ;
cgQuad,cgUQuad: begin
op^.left^.qval.lo := op^.left^.lval;
op^.left^.qval.hi := 0;
end;
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;
LimitPrecision(rval, totype.optype);
op^.left^.rval := rval;
end;
otherwise: ;
end; {case}
cgQuad:
case totype.optype of
cgByte,cgUByte,cgWord,cgUWord: begin
q := long(op^.left^.qval.lo).lsw;
op^.left^.qval := longlong0;
op^.left^.q := q;
end;
cgLong, cgULong: begin
lval := op^.left^.qval.lo;
op^.left^.qval := longlong0;
op^.left^.lval := lval;
end;
cgQuad,cgUQuad: ;
cgDouble,cgExtended: begin
rval := CnvLLX(op^.left^.qval);
LimitPrecision(rval, totype.optype);
op^.left^.qval := longlong0;
op^.left^.rval := rval;
end;
cgReal,cgComp:
doit := false;
otherwise: ;
end; {case}
cgUQuad:
case totype.optype of
cgByte,cgUByte,cgWord,cgUWord: begin
q := long(op^.left^.qval.lo).lsw;
op^.left^.qval := longlong0;
op^.left^.q := q;
end;
cgLong, cgULong: begin
lval := op^.left^.qval.lo;
op^.left^.qval := longlong0;
op^.left^.lval := lval;
end;
cgQuad,cgUQuad: ;
cgDouble,cgExtended: begin
rval := CnvULLX(op^.left^.qval);
LimitPrecision(rval, totype.optype);
op^.left^.qval := longlong0;
op^.left^.rval := rval;
end;
cgReal,cgComp:
doit := false;
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;
cgQuad:
CnvXLL(op^.left^.qval, rval);
cgUQuad:
CnvXULL(op^.left^.qval, rval);
cgReal,cgDouble,cgComp,cgExtended:
LimitPrecision(rval, totype.optype);
otherwise: ;
end;
end; {case}
otherwise: ;
end; {case}
if doit then
if fromtype.optype in
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad,
cgReal,cgDouble,cgComp,cgExtended] then
if totype.optype in
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad,
cgReal,cgDouble,cgComp,cgExtended] then begin
op^.left^.optype := totype.optype;
if totype.optype in [cgByte,cgUByte] then begin
op^.left^.q := op^.left^.q & $00FF;
if totype.optype = cgByte then
if (op^.left^.q & $0080) <> 0 then
op^.left^.q := op^.left^.q | $FF00;
end; {if}
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
if (baseTypeEnum(op^.left^.q & $000F) = toType.optype)
or (baseTypeEnum(op^.left^.q & $000F) = 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]) or
((op^.left^.opcode = pc_ind) and (op^.left^.r = 0)) 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}
if fromtype.optype in [cgQuad,cgUQuad] then
if totype.optype in
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad]
then begin
op^.left^.optype := totype.optype;
opv := op^.left;
end; {if}
if fromtype.optype in [cgReal,cgDouble,cgExtended,cgComp] then
if totype.optype in [cgReal,cgDouble,cgExtended,cgComp] then
if (totype.optype = op^.left^.optype) or
(totype.optype = cgExtended) or
((totype.optype = cgDouble) and (op^.left^.optype = cgReal)) then
opv := op^.left;
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]) or
((left^.opcode = pc_ind) and (left^.r = 0)) 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_cop,pc_cpo: begin {pc_cop,pc_cpo}
if op^.optype in [cgReal,cgDouble,cgExtended,cgComp] then
RealStoreOptimizations(op, op^.left);
end; {case pc_cop,pc_cpo}
pc_cpi: begin {pc_cpi}
if op^.optype in [cgReal,cgDouble,cgExtended,cgComp] then
RealStoreOptimizations(op, op^.right);
end; {case pc_cpi}
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_dvq: begin {pc_dvq}
if op^.right^.opcode = pc_ldc then begin
if op^.left^.opcode = pc_ldc then begin
if (op^.right^.qval.lo <> 0) or (op^.right^.qval.hi <> 0) then begin
div64(op^.left^.qval, op^.right^.qval);
opv := op^.left;
end; {if}
end {if}
else if (op^.right^.qval.lo = 1) and (op^.right^.qval.hi = 0) then
opv := op^.left;
end; {if}
end; {case pc_dvq}
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;
cgQuad,cgUQuad: begin
op^.opcode := pc_ldc;
op^.q := ord((op^.left^.qval.lo = op^.right^.qval.lo) and
(op^.left^.qval.hi = op^.right^.qval.hi));
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}
op^.optype := cgWord;
end {if}
else if op^.right^.optype in [cgByte, cgUByte, cgWord, cgUWord] then begin
if op^.right^.q = 1 then
if op^.left^.opcode in
[pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt,pc_not]
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 = 1 then
if op^.left^.opcode in
[pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt,pc_not]
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 begin
op^.opcode := pc_neq;
PeepHoleOptimization(opv);
end; {else}
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^.left^.opcode = pc_ldc then begin
ReverseChildren(op);
case op^.opcode of
pc_leq: op^.opcode := pc_geq;
pc_les: op^.opcode := pc_grt;
pc_geq: op^.opcode := pc_leq;
pc_grt: op^.opcode := pc_les;
end; {case}
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;
if op^.right^.opcode = pc_ldc then
if ((op^.optype = cgUWord) and (op^.right^.q = 0))
or ((op^.optype = cgULong) and (op^.right^.lval = 0))
or ((op^.optype = cgUQuad)
and (op^.right^.qval.lo = 0) and (op^.right^.qval.hi = 0)) then
begin
case op^.opcode of
pc_leq: begin
op^.opcode := pc_equ;
PeepHoleOptimization(opv);
end;
pc_grt: begin
op^.opcode := pc_neq;
PeepHoleOptimization(opv);
end;
pc_les: if not SideEffects(op^.left) then begin
op^.right^.optype := cgWord;
op^.right^.q := 0;
opv := op^.right;
end; {if}
pc_geq: if not SideEffects(op^.left) then begin
op^.right^.optype := cgWord;
op^.right^.q := 1;
opv := op^.right;
end; {if}
end; {case}
end {if}
else if (op^.opcode = pc_leq) then
if ((op^.optype = cgWord) and (op^.right^.q <> maxint))
or ((op^.optype = cgUWord) and (op^.right^.q <> -1)) then begin
op^.right^.q := op^.right^.q + 1;
op^.opcode := pc_les;
end; {if}
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}
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;
PeepHoleOptimization(opv);
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^.right^.lval = 1 then begin
if not SideEffects(op^.left) then begin
op^.right^.lval := 0;
opv := op^.right;
end; {if}
end {if}
else if op^.left^.opcode = pc_ldc then
if (op^.left^.lval >= 0) and (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_mdq: begin {pc_mdq}
if op^.right^.opcode = pc_ldc then
if (op^.right^.qval.lo = 1) and (op^.right^.qval.hi = 0) then begin
if not SideEffects(op^.left) then begin
op^.right^.qval := longlong0;
opv := op^.right;
end; {if}
end {if}
else if op^.left^.opcode = pc_ldc then
if (op^.right^.qval.lo <> 0) or (op^.right^.qval.hi <> 0) then begin
rem64(op^.left^.qval, op^.right^.qval);
opv := op^.left;
end; {if}
end; {case pc_mdq}
pc_mod: begin {pc_mod}
if op^.right^.opcode = pc_ldc then
if op^.right^.q = 1 then begin
if not SideEffects(op^.left) then begin
op^.right^.q := 0;
opv := op^.right;
end; {if}
end {if}
else if op^.left^.opcode = pc_ldc then
if (op^.left^.q >= 0) and (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_mpq, pc_umq: begin {pc_mpq, pc_umq}
if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
umul64(op^.left^.qval, op^.right^.qval);
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^.qval.lo = 1) and (op^.right^.qval.hi = 0) then
opv := op^.left
else if (op^.right^.qval.lo = 0) and (op^.right^.qval.hi = 0) then
begin
if not SideEffects(op^.left) then
opv := op^.right;
end {else if}
else if (op^.right^.qval.lo = -1) and (op^.right^.qval.hi = -1) then
if op^.opcode = pc_mpq then begin
op^.opcode := pc_ngq;
op^.right := nil;
end; {if}
end; {if}
end; {else}
end; {case pc_mpq, pc_umq}
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 fastMath 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;
cgQuad,cgUQuad: begin
op^.opcode := pc_ldc;
op^.q := ord((op^.left^.qval.lo <> op^.right^.qval.lo) or
(op^.left^.qval.hi <> op^.right^.qval.hi));
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}
op^.optype := cgWord;
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,pc_not]
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,pc_not]
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_ngq: begin {pc_ngq}
if op^.left^.opcode = pc_ldc then begin
with op^.left^.qval do begin
lo := ~lo;
hi := ~hi;
lo := lo + 1;
if lo = 0 then
hi := hi + 1;
end; {with}
opv := op^.left;
end; {if}
end; {case pc_ngq}
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);
op^.left^.q := q;
op^.left^.optype := cgWord;
opv := op^.left;
end {else if}
else if op^.left^.optype in [cgQuad,cgUQuad] then begin
q := ord((op^.left^.qval.lo = 0) and (op^.left^.qval.hi = 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 begin
fromtype.i := (op^.left^.q & $00F0) >> 4;
op^.optype := fromtype.optype;
op^.left := op^.left^.left;
end; {if}
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