mirror of
https://github.com/byteworksinc/ORCA-Pascal.git
synced 2024-12-06 16:51:31 +00:00
5467 lines
164 KiB
ObjectPascal
5467 lines
164 KiB
ObjectPascal
{$optimize 15}
|
|
{---------------------------------------------------------------}
|
|
{ }
|
|
{ DAG Creation }
|
|
{ }
|
|
{ Places intermediate codes into DAGs and trees. }
|
|
{ }
|
|
{---------------------------------------------------------------}
|
|
|
|
unit DAG;
|
|
|
|
interface
|
|
|
|
{$segment 'cg'}
|
|
|
|
{$LibPrefix '0/obj/'}
|
|
|
|
uses PCommon, CGI, CGC, Gen;
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
procedure DAG (code: icptr);
|
|
|
|
{ place an op code in a DAG or tree }
|
|
{ }
|
|
{ parameters: }
|
|
{ code - opcode }
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
implementation
|
|
|
|
const
|
|
peepSpinRate = 20; {PeepHoleOptimize spin rate}
|
|
|
|
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}
|
|
peepSpin: 0..peepSpinRate; {spinner delay for PeepHoleOptimize}
|
|
peepTablesInitialized: boolean; {have the peephole tables been initialized?}
|
|
prsFound: boolean; {are there any pc_prs opcodes?}
|
|
rescan: boolean; {redo the optimization pass?}
|
|
|
|
{-- External unsigned math routines ----------------------------}
|
|
|
|
function udiv (x,y: longint): longint; extern;
|
|
|
|
function umod (x,y: longint): longint; extern;
|
|
|
|
function umul (x,y: longint): longint; extern;
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
function SetsEqual (s1, s2: setPtr): boolean;
|
|
|
|
{ See if two sets are equal }
|
|
{ }
|
|
{ parameters: }
|
|
{ s1, s2 - sets to compare }
|
|
{ }
|
|
{ Returns: True if the sets are equal, else false }
|
|
|
|
label 1;
|
|
|
|
var
|
|
i: unsigned; {loop/index variable}
|
|
|
|
begin {SetsEqual}
|
|
SetsEqual := false;
|
|
if s1^.smax = s2^.smax then begin
|
|
for i := 1 to s1^.smax do
|
|
if s1^.sval[i] <> s2^.sval[i] then
|
|
goto 1;
|
|
SetsEqual := true;
|
|
end; {if}
|
|
1: ;
|
|
end; {SetsEqual}
|
|
|
|
|
|
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 of operands match required? }
|
|
{ }
|
|
{ Returns: True if trees are equivalent, else false. }
|
|
|
|
|
|
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_cum, pc_cui, pc_csp, pc_tl1, pc_tl2, pc_vct, pc_pds, 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_int, pc_uni: 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}
|
|
|
|
|
|
function LabsEqual (l1, l2: pStringPtr): boolean;
|
|
|
|
{ See if the labels are equal }
|
|
{ }
|
|
{ parameters: }
|
|
{ l1, l2 - labels to check }
|
|
{ }
|
|
{ Returns: True if the labels are equal, else false }
|
|
|
|
begin {LabsEqual}
|
|
if (l1 = nil) and (l2 = nil) then
|
|
LabsEqual := true
|
|
else if (l1 <> nil) and (l2 <> nil) then
|
|
LabsEqual := l1^ = l2^
|
|
else
|
|
LabsEqual := false;
|
|
end; {LabsEqual}
|
|
|
|
|
|
begin {CodesMatch}
|
|
CodesMatch := false;
|
|
if (op1 = nil) and (op2 = nil) 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 LabsEqual(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 := op1^.str^ = op2^.str^;
|
|
cgSet:
|
|
CodesMatch := SetsEqual(op1^.setp, op2^.setp);
|
|
cgVoid:
|
|
CodesMatch := true;
|
|
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 }
|
|
|
|
type
|
|
nameTypePtr = ^nameType; {named label list element}
|
|
nameType = record
|
|
next: nameTypePtr;
|
|
lab: pStringPtr;
|
|
end;
|
|
{used label array}
|
|
usedArray = packed array[0..maxLabel] of boolean;
|
|
|
|
var
|
|
lop: icptr; {predecessor of op}
|
|
op: icptr; {used to trace the opcode list}
|
|
usedLabels: ^usedArray; {used numeric label array}
|
|
usedNames: nameTypePtr; {used named labels list}
|
|
|
|
|
|
procedure BuildLabels;
|
|
|
|
{ build the used label array and list }
|
|
|
|
var
|
|
lab: 0..maxLabel; {loop/index variable}
|
|
op: icptr; {used to trace the opcode list}
|
|
|
|
|
|
procedure RecordName (lab: pStringPtr);
|
|
|
|
{ record a named label }
|
|
{ }
|
|
{ parameters: }
|
|
{ lab - label name to record }
|
|
|
|
var
|
|
found: boolean; {was the name in the list already?}
|
|
np: nameTypePtr; {name pointer}
|
|
|
|
begin {RecordName}
|
|
found := false;
|
|
np := usedNames;
|
|
while np <> nil do
|
|
if np^.lab^ = lab^ then begin
|
|
np := nil;
|
|
found := true;
|
|
end {if}
|
|
else
|
|
np := np^.next;
|
|
if not found then begin
|
|
new(np);
|
|
np^.next := usedNames;
|
|
usedNames := np;
|
|
np^.lab := lab;
|
|
end; {if}
|
|
end; {RecordName}
|
|
|
|
|
|
procedure CheckCup (op: icptr);
|
|
|
|
{ Check for labels in procedure calls }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - label to check }
|
|
|
|
begin {CheckCup}
|
|
if op^.opcode = pc_cup then
|
|
if op^.lab = nil then begin
|
|
if op^.r <= maxLabel then
|
|
usedLabels^[op^.r] := true;
|
|
end {if}
|
|
else
|
|
RecordName(op^.lab);
|
|
if op^.left <> nil then
|
|
CheckCup(op^.left);
|
|
if op^.right <> nil then
|
|
CheckCup(op^.right);
|
|
end; {CheckCup}
|
|
|
|
|
|
begin {BuildLabels}
|
|
new(usedLabels); {no numbered labels}
|
|
for lab := 0 to maxLabel do
|
|
usedLabels^[lab] := false;
|
|
usedNames := nil; {no named labels}
|
|
|
|
op := DAGhead;
|
|
while op <> nil do begin
|
|
if op^.opcode in [pc_add, pc_fjp, pc_tjp, pc_ujp] then
|
|
if op^.lab = nil then begin
|
|
if op^.q <= maxLabel then
|
|
usedLabels^[op^.q] := true;
|
|
end {if}
|
|
else
|
|
RecordName(op^.lab);
|
|
CheckCup(op);
|
|
op := op^.next;
|
|
end; {while}
|
|
end; {BuildLabels}
|
|
|
|
|
|
procedure DisposeLabels;
|
|
|
|
{ dispose of the dynamic memory allocated by BuildLabels }
|
|
|
|
var
|
|
p1, p2: nameTypePtr; {work pointers}
|
|
|
|
begin {DisposeLabels}
|
|
dispose(usedLabels);
|
|
p1 := usedNames;
|
|
while p1 <> nil do begin
|
|
p2 := p1;
|
|
p1 := p2^.next;
|
|
dispose(p2);
|
|
end; {while}
|
|
end; {DisposeLabels}
|
|
|
|
|
|
function Used (q: integer; lab: pStringPtr): boolean;
|
|
|
|
{ see if a label is used }
|
|
{ }
|
|
{ parameters: }
|
|
{ q - label number to check }
|
|
{ lab - named label to check }
|
|
{ }
|
|
{ Returns: True if the label is used, else false. }
|
|
|
|
var
|
|
np: nameTypePtr; {used to trace usedNames list}
|
|
|
|
begin {Used}
|
|
if lab = nil then
|
|
if q <= maxLabel then
|
|
Used := usedLabels^[q]
|
|
else
|
|
Used := true
|
|
else begin
|
|
np := usedNames;
|
|
Used := false;
|
|
while np <> nil do
|
|
if np^.lab^ = lab^ then begin
|
|
np := nil;
|
|
Used := true;
|
|
end {if}
|
|
else
|
|
np := np^.next;
|
|
end; {else}
|
|
end; {Used}
|
|
|
|
|
|
begin {CheckLabels}
|
|
BuildLabels; {build a list of used labels}
|
|
|
|
op := DAGhead; {get rid of unused labels}
|
|
while op^.next <> nil do begin
|
|
lop := op;
|
|
op := op^.next;
|
|
if op^.opcode = dc_lab then begin
|
|
Spin;
|
|
if op^.lab = nil then
|
|
if not Used(op^.q, op^.lab) then begin
|
|
lop^.next := op^.next;
|
|
op := lop;
|
|
rescan := true;
|
|
end; {if}
|
|
end; {if}
|
|
end; {while}
|
|
|
|
DisposeLabels; {get rid of label lists}
|
|
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_fun, 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_cum,pc_csp,pc_tl1,pc_tl2,pc_vct,pc_pds]
|
|
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}
|
|
|
|
|
|
function TypeSize (tp: baseTypeEnum): integer;
|
|
|
|
{ Find the size, in bytes, of a variable }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - base type of the variable }
|
|
|
|
begin {TypeSize}
|
|
case tp of
|
|
cgByte,cgUByte: TypeSize := cgByteSize;
|
|
cgWord,cgUWord: TypeSize := cgWordSize;
|
|
cgLong,cgULong: TypeSize := cgLongSize;
|
|
cgReal: TypeSize := cgRealSize;
|
|
cgDouble: TypeSize := cgDoubleSize;
|
|
cgComp: TypeSize := cgCompSize;
|
|
cgExtended: TypeSize := cgExtendedSize;
|
|
cgString: TypeSize := cgByteSize;
|
|
cgVoid,cgSet: TypeSize := cgLongSize;
|
|
end; {case}
|
|
end; {TypeSize}
|
|
|
|
|
|
function LabelsMatch (op1, op2: icptr): boolean;
|
|
|
|
{ See if the labels from two instructions match }
|
|
{ }
|
|
{ parameters: }
|
|
{ op1, op2 - instructions to check }
|
|
{ }
|
|
{ Returns: True for match, otherwise false }
|
|
|
|
begin {LabelsMatch}
|
|
if (op1^.lab = nil) and (op2^.lab = nil) then
|
|
LabelsMatch := op1^.q = op2^.q
|
|
else if (op1^.lab <> nil) and (op2^.lab <> nil) then
|
|
LabelsMatch := op1^.lab^ = op2^.lab^
|
|
else
|
|
LabelsMatch := false;
|
|
end; {LabelsMatch}
|
|
|
|
|
|
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?}
|
|
i,j: integer; {general work variables}
|
|
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}
|
|
set1,set2: setPtr; {work set pointer}
|
|
|
|
fromtype, totype, firstType: record {for converting numbers to optypes}
|
|
case boolean of
|
|
true: (i: integer);
|
|
false: (optype: baseTypeEnum);
|
|
end;
|
|
|
|
|
|
function IsUnsigned (op: icptr): boolean;
|
|
|
|
{ Check to see if the operand is unsigned }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - opcode to check }
|
|
|
|
begin {IsUnsigned}
|
|
case op^.opcode of
|
|
|
|
pc_abi, pc_abl, pc_equ, pc_geq, pc_grt, pc_lad, pc_lao, pc_lca,
|
|
pc_lda, pc_leq, pc_les, pc_lla, pc_neq, pc_not, pc_odd, pc_odl,
|
|
pc_sqi, pc_sql, pc_udi, pc_udl, pc_uim, pc_ulm, pc_umi, pc_uml,
|
|
pc_usr, pc_vsr:
|
|
IsUnsigned := true;
|
|
|
|
pc_adi, pc_adl, pc_and, pc_ior, pc_lnd, pc_lor:
|
|
IsUnsigned := IsUnsigned(op^.left) and IsUnsigned(op^.right);
|
|
|
|
pc_cnv:
|
|
IsUnsigned := (op^.q & $00F0 >> 4) in
|
|
[ord(cgUByte), ord(cgUWord), ord(cgULong)];
|
|
|
|
pc_cop, pc_cpo, pc_cui, pc_cum, pc_cup, pc_ind, pc_ldo, pc_lod:
|
|
IsUnsigned := op^.optype in [cgUByte, cgUWord, cgULong];
|
|
|
|
pc_inc:
|
|
IsUnsigned := IsUnsigned(op^.left);
|
|
|
|
pc_ldc:
|
|
case op^.optype of
|
|
cgByte, cgWord: IsUnsigned := op^.q >= 0;
|
|
cgLong: IsUnsigned := op^.lval >= 0;
|
|
cgUByte,cgUWord,cgULong: IsUnsigned := true;
|
|
otherwise: IsUnsigned := false;
|
|
end;
|
|
|
|
otherwise:
|
|
IsUnsigned := false;
|
|
end;
|
|
end; {IsUnsigned}
|
|
|
|
|
|
function SideEffects (op: icptr): boolean;
|
|
|
|
{ Check a tree for operations that have side effects }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - tree to check }
|
|
|
|
var
|
|
result: boolean; {temp result}
|
|
|
|
begin {SideEffects}
|
|
if op = nil then
|
|
SideEffects := false
|
|
else if op^.opcode in
|
|
[pc_mov,pc_cop,pc_cpo,pc_sro,pc_sto,pc_str,pc_cui,pc_cup,pc_tl1,
|
|
pc_tl1,pc_pds,pc_csp,pc_prs,pc_fix,pc_cum,pc_vct] then
|
|
SideEffects := true
|
|
else
|
|
SideEffects := SideEffects(op^.left) or SideEffects(op^.right);
|
|
end; {SideEffects}
|
|
|
|
|
|
procedure MakeWordSet (op: icptr);
|
|
|
|
{ Convert the tree from set operations to equivalent word }
|
|
{ operations }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - tree to convert }
|
|
|
|
var
|
|
c: record {conversion record}
|
|
case boolean of
|
|
true: (b1, b2: byte);
|
|
false: (ival: integer);
|
|
end;
|
|
op2,op3: icptr; {temp opcodes}
|
|
opcode: pcodes; {op^.opcode}
|
|
|
|
begin {MakeWordSet}
|
|
opcode := op^.opcode;
|
|
if opcode = pc_ldc then begin
|
|
op^.optype := cgUWord;
|
|
c.ival := 0;
|
|
if op^.setp^.smax <> 0 then begin
|
|
c.b1 := ord(op^.setp^.sval[1]);
|
|
if op^.setp^.smax <> 1 then
|
|
c.b2 := ord(op^.setp^.sval[2]);
|
|
end; {if}
|
|
op^.setp := nil;
|
|
op^.q := c.ival;
|
|
end {if}
|
|
else if opcode = pc_ldo then begin
|
|
op^.optype := cgUWord;
|
|
op^.q := op^.r;
|
|
op^.r := 0;
|
|
end {else if}
|
|
else if opcode = pc_lod then begin
|
|
op^.optype := cgUWord;
|
|
op^.s := 0;
|
|
end {else if}
|
|
else if opcode = pc_sgs then begin
|
|
op^.right^.q := 1;
|
|
op2 := op^.left;
|
|
op^.left := op^.right;
|
|
op^.right := op2;
|
|
op^.opcode := pc_shl;
|
|
end {else if}
|
|
else if opcode = pc_inn then begin
|
|
MakeWordSet(op^.right);
|
|
op2 := pointer(Calloc(sizeof(intermediate_code)));
|
|
op2^.optype := cgUWord;
|
|
op2^.opcode := pc_ldc;
|
|
op2^.q := 1;
|
|
op3 := pointer(Calloc(sizeof(intermediate_code)));
|
|
op3^.optype := cgWord;
|
|
op3^.opcode := pc_shl;
|
|
op3^.left := op2;
|
|
op3^.right := op^.left;
|
|
op^.left := op3;
|
|
op^.opcode := pc_bnd;
|
|
end {else if}
|
|
else if opcode = pc_dif then begin
|
|
MakeWordSet(op^.left);
|
|
MakeWordSet(op^.right);
|
|
op2 := pointer(Calloc(sizeof(intermediate_code)));
|
|
op2^.optype := cgWord;
|
|
op2^.opcode := pc_bnt;
|
|
op2^.left := op^.right;
|
|
op^.right := op2;
|
|
op^.opcode := pc_bnd;
|
|
end {else if}
|
|
else if opcode = pc_int then begin
|
|
MakeWordSet(op^.left);
|
|
MakeWordSet(op^.right);
|
|
op^.opcode := pc_bnd;
|
|
end {else if}
|
|
else if opcode = pc_uni then begin
|
|
MakeWordSet(op^.left);
|
|
MakeWordSet(op^.right);
|
|
op^.opcode := pc_bor;
|
|
end; {else if}
|
|
end; {MakeWordSet}
|
|
|
|
|
|
function WordSet (op: icptr): boolean;
|
|
|
|
{ See if the tree consists entirely of set operations that }
|
|
{ can be converted to word operations }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - tree to check }
|
|
{ }
|
|
{ Returns: True if so, false if not }
|
|
|
|
var
|
|
opcode: pcodes; {op^.opcode}
|
|
|
|
begin {WordSet}
|
|
opcode := op^.opcode;
|
|
if opcode = pc_ldc then
|
|
WordSet := op^.setp^.smax <= 2
|
|
else if opcode = pc_ldo then
|
|
WordSet := op^.q = 2
|
|
else if opcode = pc_lod then
|
|
WordSet := op^.s = 2
|
|
else if opcode in [pc_dif,pc_int,pc_uni] then
|
|
WordSet := WordSet(op^.left) and WordSet(op^.right)
|
|
else if opcode = pc_inn then
|
|
WordSet := WordSet(op^.right) and IsUnsigned(op^.left)
|
|
else if opcode = pc_sgs then
|
|
if op^.right^.opcode = pc_ldc then
|
|
WordSet := op^.right^.q = $8000
|
|
else
|
|
WordSet := false
|
|
else
|
|
WordSet := false;
|
|
end; {WordSet}
|
|
|
|
|
|
procedure MakeLongSet (op: icptr);
|
|
|
|
{ Convert the tree from set operations to equivalent long }
|
|
{ operations }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - tree to convert }
|
|
|
|
var
|
|
c: record {conversion record}
|
|
case boolean of
|
|
true: (b1, b2, b3, b4: byte);
|
|
false: (lval: longint);
|
|
end;
|
|
op2,op3: icptr; {temp opcodes}
|
|
opcode: pcodes; {op^.opcode}
|
|
|
|
begin {MakeLongSet}
|
|
opcode := op^.opcode;
|
|
if opcode = pc_ldc then begin
|
|
op^.optype := cgULong;
|
|
c.lval := 0;
|
|
if op^.setp^.smax <> 0 then begin
|
|
c.b1 := ord(op^.setp^.sval[1]);
|
|
if op^.setp^.smax <> 1 then begin
|
|
c.b2 := ord(op^.setp^.sval[2]);
|
|
if op^.setp^.smax <> 2 then begin
|
|
c.b3 := ord(op^.setp^.sval[3]);
|
|
if op^.setp^.smax <> 3 then
|
|
c.b4 := ord(op^.setp^.sval[4]);
|
|
end; {if}
|
|
end; {if}
|
|
end; {if}
|
|
op^.setp := nil;
|
|
op^.lval := c.lval;
|
|
end {if}
|
|
else if opcode = pc_ldo then begin
|
|
op^.optype := cgULong;
|
|
op^.q := op^.r;
|
|
op^.r := 0;
|
|
end {else if}
|
|
else if opcode = pc_lod then begin
|
|
op^.optype := cgULong;
|
|
op^.s := 0;
|
|
end {else if}
|
|
else if opcode = pc_dif then begin
|
|
MakeLongSet(op^.left);
|
|
MakeLongSet(op^.right);
|
|
op2 := pointer(Calloc(sizeof(intermediate_code)));
|
|
op2^.optype := cgWord;
|
|
op2^.opcode := pc_bnl;
|
|
op2^.left := op^.right;
|
|
op^.right := op2;
|
|
op^.opcode := pc_bal;
|
|
end {else if}
|
|
else if opcode = pc_int then begin
|
|
MakeLongSet(op^.left);
|
|
MakeLongSet(op^.right);
|
|
op^.opcode := pc_bal;
|
|
end {else if}
|
|
else if opcode = pc_uni then begin
|
|
MakeLongSet(op^.left);
|
|
MakeLongSet(op^.right);
|
|
op^.opcode := pc_blr;
|
|
end; {else if}
|
|
end; {MakeLongSet}
|
|
|
|
|
|
function LongSet (op: icptr): boolean;
|
|
|
|
{ See if the tree consists entirely of set operations that }
|
|
{ can be converted to long operations }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - tree to check }
|
|
{ }
|
|
{ Returns: True if so, false if not }
|
|
|
|
var
|
|
opcode: pcodes; {op^.opcode}
|
|
|
|
begin {LongSet}
|
|
opcode := op^.opcode;
|
|
if opcode = pc_ldc then
|
|
LongSet := op^.setp^.smax <= 4
|
|
else if opcode = pc_ldo then
|
|
LongSet := op^.q = 4
|
|
else if opcode = pc_lod then
|
|
LongSet := op^.s = 4
|
|
else if opcode in [pc_dif,pc_int,pc_uni] then
|
|
LongSet := LongSet(op^.left) and LongSet(op^.right)
|
|
else
|
|
LongSet := false;
|
|
end; {LongSet}
|
|
|
|
|
|
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_inn then
|
|
if WordSet(op^.left) then begin
|
|
MakeWordSet(op^.left);
|
|
topcode := op^.left^.opcode;
|
|
end; {if}
|
|
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 LabelsMatch(op^.next, op) 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 peepSpin = 0 then begin {spinner}
|
|
peepSpin := peepSpinRate;
|
|
Spin;
|
|
end {if}
|
|
else
|
|
peepSpin := peepSpin-1;
|
|
{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 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 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 {else 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}
|
|
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
|
|
lval := trunc4(rval);
|
|
op^.left^.rval := 0.0;
|
|
op^.left^.q := long(lval).lsw;
|
|
end;
|
|
cgLong,cgULong: begin
|
|
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
|
|
lval := trunc4(rval);
|
|
op^.left^.rval := 0.0;
|
|
op^.left^.lval := lval;
|
|
end;
|
|
cgReal,cgDouble,cgComp,cgExtended: ;
|
|
otherwise: ;
|
|
end;
|
|
end; {case}
|
|
otherwise: ;
|
|
end; {case}
|
|
if fromtype.optype in
|
|
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgReal,cgDouble,
|
|
cgComp,cgExtended] then
|
|
if totype.optype in
|
|
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgReal,cgDouble,
|
|
cgComp,cgExtended] then begin
|
|
op^.left^.optype := totype.optype;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end {if}
|
|
else if op^.left^.opcode = pc_cnv then begin
|
|
doit := false;
|
|
firsttype.i := (op^.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_csp: begin {pc_csp}
|
|
if op^.q = 91 then begin {string move}
|
|
op2 := op^.left^.left^.right^.left;
|
|
op3 := op^.left^.right^.right^.left;
|
|
if op2^.opcode = pc_ldc then
|
|
if op3^.opcode = pc_ldc then
|
|
if op2^.q = op3^.q then begin
|
|
q := op2^.q;
|
|
if q < -1 then q := 1-q;
|
|
if q > 0 then begin
|
|
op^.opcode := pc_mov;
|
|
op^.right := op^.left^.right^.left^.left;
|
|
op^.left := op^.left^.left^.left^.left;
|
|
op^.q := q;
|
|
op^.r := 0;
|
|
PeepHoleOptimization(opv);
|
|
end; {if}
|
|
end; {if}
|
|
end {if}
|
|
else if op^.next <> nil then
|
|
if op^.next^.opcode = pc_csp then
|
|
if op^.next^.q = 26 then begin
|
|
if op^.q in [16,19,21,29,37] then begin
|
|
if op^.q = 16 then
|
|
op^.q := 34
|
|
else if op^.q = 19 then
|
|
op^.q := 12
|
|
else
|
|
op^.q := op^.q-1;
|
|
op^.next := op^.next^.next;
|
|
end; {if}
|
|
end {if}
|
|
else if op^.next^.q = 27 then begin
|
|
if op^.q in [39,42,25,31,23] then begin
|
|
if op^.q = 42 then
|
|
op^.q := 43
|
|
else
|
|
op^.q := op^.q-1;
|
|
op^.next := op^.next^.next;
|
|
end; {if}
|
|
end; {else if}
|
|
end; {case pc_csp}
|
|
|
|
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}
|
|
else if IsUnsigned(op^.left) and IsUnsigned(op^.right) then begin
|
|
op^.opcode := pc_udi;
|
|
PeepHoleOptimization(opv);
|
|
end; {else 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}
|
|
else if IsUnsigned(op^.left) and IsUnsigned(op^.right) then begin
|
|
op^.opcode := pc_udl;
|
|
PeepHoleOptimization(opv);
|
|
end; {else 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^.optype = cgSet then
|
|
if WordSet(op^.left) then begin
|
|
if WordSet(op^.right) then begin
|
|
MakeWordSet(op^.left);
|
|
MakeWordSet(op^.right);
|
|
op^.optype := cgUWord;
|
|
end; {if}
|
|
end {if}
|
|
else if LongSet(op^.left) then
|
|
if LongSet(op^.right) then begin
|
|
MakeLongSet(op^.left);
|
|
MakeLongSet(op^.right);
|
|
op^.optype := cgULong;
|
|
end; {if}
|
|
if IsUnsigned(op^.left) and IsUnsigned(op^.right) then
|
|
if op^.optype = cgWord then
|
|
op^.optype := cgUWord
|
|
else if op^.optype = cgLong then
|
|
op^.optype := cgULong
|
|
else if op^.optype = cgByte then
|
|
op^.optype := cgUByte;
|
|
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;
|
|
cgSet: begin
|
|
op^.opcode := pc_ldc;
|
|
op^.q := ord(SetsEqual(op^.left^.setp, op^.right^.setp));
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
end;
|
|
cgVoid: 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 := cgUWord;
|
|
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_geq,pc_grt,pc_les: {pc_geq, pc_grt, pc_les}
|
|
if IsUnsigned(op^.left) and IsUnsigned(op^.right) then
|
|
if op^.optype = cgWord then
|
|
op^.optype := cgUWord
|
|
else if op^.optype = cgLong then
|
|
op^.optype := cgULong
|
|
else if op^.optype = cgByte then
|
|
op^.optype := cgUByte;
|
|
|
|
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}
|
|
if op^.optype <> cgSet then begin
|
|
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;
|
|
op^.left^.r := op^.left^.s;
|
|
op^.left^.s := 0;
|
|
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; {if}
|
|
end; {case pc_ind}
|
|
|
|
pc_int: begin {pc_int}
|
|
if op^.left^.opcode = pc_ldc then
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
if op^.left^.setp^.smax > op^.right^.setp^.smax then
|
|
ReverseChildren(op);
|
|
set1 := op^.left^.setp;
|
|
set2 := op^.right^.setp;
|
|
for i := 1 to set1^.smax do
|
|
set1^.sval[i] := chr(ord(set1^.sval[i]) & ord(set2^.sval[i]));
|
|
i := set1^.smax;
|
|
while (i <> 1) and (ord(set1^.sval[i]) = 0) do
|
|
i := i-1;
|
|
set1^.smax := i;
|
|
opv := op^.left;
|
|
end; {if}
|
|
end; {case pc_int}
|
|
|
|
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 IsUnsigned(op^.left) and IsUnsigned(op^.right) then
|
|
if op^.optype = cgWord then
|
|
op^.optype := cgUWord
|
|
else if op^.optype = cgLong then
|
|
op^.optype := cgULong
|
|
else if op^.optype = cgByte then
|
|
op^.optype := cgUByte;
|
|
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 begin
|
|
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 {if}
|
|
else if IsUnsigned(op^.left) and IsUnsigned(op^.right) then begin
|
|
op^.opcode := pc_ulm;
|
|
PeepHoleOptimization(opv);
|
|
end; {else if}
|
|
end; {case pc_mdl}
|
|
|
|
pc_mod: begin {pc_mod}
|
|
if op^.right^.opcode = pc_ldc then begin
|
|
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 {if}
|
|
else if IsUnsigned(op^.left) and IsUnsigned(op^.right) then begin
|
|
op^.opcode := pc_uim;
|
|
PeepHoleOptimization(opv);
|
|
end; {else if}
|
|
end; {case pc_mod}
|
|
|
|
pc_mpi, pc_umi: begin {pc_mpi, pc_umi}
|
|
if IsUnsigned(op^.left) and IsUnsigned(op^.right) then
|
|
op^.opcode := 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 IsUnsigned(op^.left) and IsUnsigned(op^.right) then
|
|
op^.opcode := 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^.optype = cgSet then
|
|
if WordSet(op^.left) then begin
|
|
if WordSet(op^.right) then begin
|
|
MakeWordSet(op^.left);
|
|
MakeWordSet(op^.right);
|
|
op^.optype := cgUWord;
|
|
end; {if}
|
|
end {if}
|
|
else if LongSet(op^.left) then
|
|
if LongSet(op^.right) then begin
|
|
MakeLongSet(op^.left);
|
|
MakeLongSet(op^.right);
|
|
op^.optype := cgULong;
|
|
end; {if}
|
|
if IsUnsigned(op^.left) and IsUnsigned(op^.right) then
|
|
if op^.optype = cgWord then
|
|
op^.optype := cgUWord
|
|
else if op^.optype = cgLong then
|
|
op^.optype := cgULong
|
|
else if op^.optype = cgByte then
|
|
op^.optype := cgUByte;
|
|
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;
|
|
cgSet: begin
|
|
op^.opcode := pc_ldc;
|
|
op^.q := ord(not SetsEqual(op^.left^.setp, op^.right^.setp));
|
|
op^.left := nil;
|
|
op^.right := nil;
|
|
end;
|
|
cgVoid: 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 := cgUWord;
|
|
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;
|
|
op^.left^.optype := cgWord;
|
|
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;
|
|
op^.left^.optype := cgLong;
|
|
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;
|