[fpc-pascal] code optimization
Adrian Veith
adrian at veith-system.de
Fri Sep 24 11:48:08 CEST 2010
On 24.09.2010 10:37, Jonas Maebe wrote:
>
> On 24 Sep 2010, at 08:06, Adrian Veith wrote:
>
>> On 23.09.2010 17:03, Jonas Maebe wrote:
>>>
>>> It may help a lot, but only because it will reduce register pressure,
>>> not because the multiplications are gone.
>>
>> It reduces the total number of multiplications about 70% - I gave the
>> code to one of my guys and he changed the code using pointers to
>> elements wherever possible.
>
> Note the above: he changed the code using pointers. He did not replace
> the multiplications with "lea" instructions. Simply replacing the
> multiplications with lea instructions has almost no influence on the
> speed, as I mentioned twice before (unless you have a very old x86).
> Multiplications, especially with small numbers, are very fast on
> modern processors.
Changing to pointers reduces the amount of multiplications for accessing
the nth element in an array - if you compare the delphi code to th fpc
code on assembler base, this is the main difference in both generated
codes. Register allocation is on a comparable level for both versions.
>
>> This are the differences:
>>
>> fpc - original code: 17s
>> fpc - pointer to elements: 12 s
>> delphi - original code: 9s
>
we optimized the code further and eliminated the all Next, Prev: Integer
etc to and changed them to pointers again. Here are the results:
original code:
fpc 17 s
delphi 9 s
first optimization - saving redundant array access to pointers:
fpc 12s = -30%
delphi 8s = - 11%
next optimization - changed code to use linked lists inside the arrays:
fpc 7s = -41 % from opt1 = - 58% from orig
delphi 6s = - 25% from opt1 = -33% from orig
> Yes, because as I mentioned above, this reduces the register pressure.
>
The numbers show, that fpc has a problem when it comes to accessing
elements inside an array with elements sizes <> power of 2 - call it
whatever you like. But the numbers show, that the benefits of the
optimizations for delphi are on a much lower level than for fpc -
conclusion is:
delphi's array arithmetic is much better than fpc's in these cases - and
there is a potential for optimization - many of the changes we did
manually could be done by a smart optimizers as well. There were so
many redundant address calculations, most of them should be recognized
by an optimizer. I choose this example to train my people to see
bottlenecks and how to avoid them - even without knowing what the code
does actually.
last optimized version of the code attached:
program project1;
{$APPTYPE CONSOLE}
uses
Math,
SysUtils,
Windows;
type
PRectangle = ^TRectangle;
TRectangle = object
Width: integer;
Area: int64;
NextUnusedRectangle: PRectangle;
end;
TRectangleArray = array of TRectangle;
var
UnsortedRectangle: TRectangleArray;
NumRectangles: integer;
BoundingBox: TRectangle;
function GapAlgorithm: boolean;
type
PBarEntry = ^TBarEntry;
TBarEntry = record
Height: integer;
Width: integer;
Start: integer;
Next: PBarEntry;
Prev: PBarEntry;
end;
var
SolutionFound: boolean;
Bar: array of TBarEntry;
FreeBarEntry: array of PBarEntry;
NumFreeBarEntries: integer;
NumIterations: int64;
procedure ExtendPartialSolution(NumPlacedRectangles,
FirstUnusedRectangle: PRectangle);
type
TBarCase = (BarCase1, BarCase2, BarCase3, BarCase4, BarCase5,
BarCase6);
var
MinValleyWidth: integer;
i, MinValley: PBarEntry;
PrevBar, NextBar: PBarEntry;
RectWidth: integer;
BarCase: TBarCase;
NextBarWidth: integer;
NewEntry, NewEntry2: PBarEntry;
MinValleyArea: int64;
MinValleyHeight: integer;
TotalAreaOfFittingRectangles: int64;
CurrentRectangle: PRectangle;
PreviousRectangle: PRectangle;
OldFirstUnusedRectangle: PRectangle;
OldPrevNextRectangle: PRectangle;
//PPrevBar, PNextBar, PNewEntry, PNewEntry2, PMinValley: PBarEntry;
//PCurrentRectangle,
//PPreviousRectangle,
wi: PRectangle;
begin
if NumPlacedRectangles = @UnsortedRectangle[NumRectangles] then
begin
writeln('Solution found');
SolutionFound := True;
exit;
end
else
begin
Inc(NumIterations);
MinValleyWidth := BoundingBox.Width + 1;
PrevBar := @Bar[1];
i := PrevBar.Next;
NextBar := i.Next;
while NextBar <> @Bar[0] do
begin
with i^ do begin
if (Width < MinValleyWidth) and (PrevBar.Height > Height) and
(NextBar.Height > Height) then
begin
MinValleyWidth := Width;
MinValley := i;
end;
end;
PrevBar := i;
i := NextBar;
NextBar := NextBar.Next;
end;
//PPrevBar:= @Bar[PrevBar];
//PMinValley := @Bar[MinValley];
MinValleyHeight := min(MinValley.Prev.Height,
MinValley.Next.Height) - MinValley.Height;
MinValleyArea := int64(MinValleyHeight) * int64(MinValleyWidth);
if MinValleyWidth < BoundingBox.Width then
begin
TotalAreaOfFittingRectangles := 0;
CurrentRectangle := FirstUnusedRectangle;
while CurrentRectangle <> @UnsortedRectangle[0] do
begin
with CurrentRectangle^ do begin
if (Width <= MinValleyWidth) then
Inc(TotalAreaOfFittingRectangles, Area);
CurrentRectangle := NextUnusedRectangle;
end;
end;
if TotalAreaOfFittingRectangles < MinValleyArea then
exit;
end;
//PPreviousRectangle := 0;
PreviousRectangle:= @UnsortedRectangle[0];
CurrentRectangle := FirstUnusedRectangle;
//PCurrentRectangle:= @UnsortedRectangle[CurrentRectangle];
while CurrentRectangle <> @UnsortedRectangle[0] do
begin
wi := CurrentRectangle;
if (wi.Width <= MinValleyWidth) and
(wi.Width + MinValley.Height <= BoundingBox.Width) then
begin
OldFirstUnusedRectangle := FirstUnusedRectangle;
OldPrevNextRectangle :=
PreviousRectangle.NextUnusedRectangle;
if CurrentRectangle = FirstUnusedRectangle then
begin
FirstUnusedRectangle := CurrentRectangle.NextUnusedRectangle;
end
else
begin
PreviousRectangle.NextUnusedRectangle :=
CurrentRectangle.NextUnusedRectangle;
end;
PrevBar := MinValley.Prev;
//PPrevBar := @Bar[PrevBar];
NextBar := MinValley.Next;
//PNextBar := @Bar[NextBar];
RectWidth := wi.Width;
if MinValleyWidth = RectWidth then
begin
if PrevBar.Height = MinValley.Height + RectWidth then
begin
if NextBar.Height = MinValley.Height + RectWidth then
begin
BarCase := BarCase3;
NextBarWidth := NextBar.Width;
Inc(PrevBar.Width, RectWidth + NextBarWidth);
PrevBar.Next := NextBar.Next;
NextBar.Next.Prev := PrevBar;
Inc(NumFreeBarEntries);
FreeBarEntry[NumFreeBarEntries] := NextBar;
Inc(NumFreeBarEntries);
FreeBarEntry[NumFreeBarEntries] := MinValley;
end
else
begin
BarCase := BarCase4;
Inc(PrevBar.Width, RectWidth);
PrevBar.Next := NextBar;
NextBar.Prev := PrevBar;
Inc(NumFreeBarEntries);
FreeBarEntry[NumFreeBarEntries] := MinValley;
end;
end
else
begin
if NextBar.Height = MinValley.Height + RectWidth then
begin
BarCase := BarCase5;
Inc(NextBar.Width, RectWidth);
Dec(NextBar.Start, RectWidth);
PrevBar.Next := NextBar;
NextBar.Prev := PrevBar;
Inc(NumFreeBarEntries);
FreeBarEntry[NumFreeBarEntries] := MinValley;
end
else
begin
BarCase := BarCase6;
Inc(MinValley.Height, RectWidth);
end;
end;
end
else
begin
if PrevBar.Height = MinValley.Height + RectWidth then
begin
BarCase := BarCase1;
Inc(PrevBar.Width, RectWidth);
Dec(MinValley.Width, RectWidth);
Inc(MinValley.Start, RectWidth);
end
else
begin
BarCase := BarCase2;
NewEntry := FreeBarEntry[NumFreeBarEntries];
//PNewEntry:= @Bar[NewEntry];
Dec(NumFreeBarEntries);
PrevBar.Next := NewEntry;
MinValley.Prev := NewEntry;
Dec(MinValley.Width, RectWidth);
Inc(MinValley.Start, RectWidth);
NewEntry.Height := MinValley.Height + RectWidth;
NewEntry.Width := RectWidth;
NewEntry.Start := MinValley.Start - RectWidth;
NewEntry.Prev := PrevBar;
NewEntry.Next := MinValley;
end;
end;
ExtendPartialSolution(NumPlacedRectangles + 1,
FirstUnusedRectangle);
if SolutionFound then
exit;
case BarCase of
BarCase1:
begin
Dec(PrevBar.Width, RectWidth);
Inc(MinValley.Width, RectWidth);
Dec(MinValley.Start, RectWidth);
end;
BarCase2:
begin
PrevBar.Next := MinValley;
MinValley.Prev := PrevBar;
Inc(MinValley.Width, RectWidth);
Dec(MinValley.Start, RectWidth);
Inc(NumFreeBarEntries);
FreeBarEntry[NumFreeBarEntries] := NewEntry;
end;
BarCase3:
begin
Dec(PrevBar.Width, RectWidth + NextBarWidth);
NewEntry := FreeBarEntry[NumFreeBarEntries];
//PNewEntry:= @Bar[NewEntry];
Dec(NumFreeBarEntries);
NewEntry2 := FreeBarEntry[NumFreeBarEntries];
//PNewEntry2:= @Bar[NewEntry2];
Dec(NumFreeBarEntries);
NewEntry.Height := PrevBar.Height - RectWidth;
NewEntry.Width := RectWidth;
NewEntry.Start := PrevBar.Start + PrevBar.Width;
NewEntry.Prev := PrevBar;
NewEntry.Next := NewEntry2;
NewEntry2.Height := PrevBar.Height;
NewEntry2.Width := NextBarWidth;
NewEntry2.Start := NewEntry.Start + RectWidth;
NewEntry2.Prev := NewEntry;
NewEntry2.Next := PrevBar.Next;
PrevBar.Next.Prev := NewEntry2;
PrevBar.Next := NewEntry;
end;
BarCase4:
begin
Dec(PrevBar.Width, RectWidth);
NewEntry := FreeBarEntry[NumFreeBarEntries];
//PNewEntry:= @Bar[NewEntry];
Dec(NumFreeBarEntries);
NewEntry.Height := PrevBar.Height - RectWidth;
NewEntry.Width := RectWidth;
NewEntry.Start := PrevBar.Start + PrevBar.Width;
NewEntry.Prev := PrevBar;
NewEntry.Next := NextBar;
PrevBar.Next := NewEntry;
NextBar.Prev := NewEntry;
end;
BarCase5:
begin
Dec(NextBar.Width, RectWidth);
Inc(NextBar.Start, RectWidth);
NewEntry := FreeBarEntry[NumFreeBarEntries];
//PNewEntry:= @Bar[NewEntry];
Dec(NumFreeBarEntries);
NewEntry.Height := NextBar.Height - RectWidth;
NewEntry.Width := RectWidth;
NewEntry.Start := NextBar.Start - RectWidth;
NewEntry.Prev := PrevBar;
NewEntry.Next := NextBar;
PrevBar.Next := NewEntry;
NextBar.Prev := NewEntry;
end;
BarCase6:
begin
Dec(MinValley.Height, RectWidth);
end;
end;
FirstUnusedRectangle := OldFirstUnusedRectangle;
PreviousRectangle.NextUnusedRectangle := OldPrevNextRectangle;
end;
PreviousRectangle := CurrentRectangle;
//PPreviousRectangle:= PCurrentRectangle;
CurrentRectangle := CurrentRectangle.NextUnusedRectangle;
//PCurrentRectangle:= @UnsortedRectangle[CurrentRectangle];
end;
end;
end;
var
i: integer;
begin
Result := True;
SetLength(Bar, NumRectangles + 3);
Bar[1].Height := BoundingBox.Width + 1;
Bar[1].Width := 1;
Bar[1].Next := @Bar[2];
Bar[1].Prev := @Bar[0];
Bar[1].Start := -1;
Bar[2].Height := 0;
Bar[2].Width := BoundingBox.Width;
Bar[2].Next := @Bar[3];
Bar[2].Prev := @Bar[1];
Bar[2].Start := 0;
Bar[3].Height := Bar[1].Height;
Bar[3].Width := 1;
Bar[3].Next := @Bar[0];
Bar[3].Prev := @Bar[2];
Bar[3].Start := Bar[2].Width;
SetLength(FreeBarEntry, NumRectangles + 1);
NumFreeBarEntries := 0;
for i := NumRectangles + 2 downto 4 do
begin
Inc(NumFreeBarEntries);
FreeBarEntry[NumFreeBarEntries] := @Bar[i];
end;
for i := 0 to NumRectangles - 1 do
UnsortedRectangle[i].NextUnusedRectangle := @UnsortedRectangle[i + 1];
UnsortedRectangle[NumRectangles].NextUnusedRectangle :=
@UnsortedRectangle[0];
NumIterations := 0;
SolutionFound := False;
ExtendPartialSolution(@UnsortedRectangle[0], @UnsortedRectangle[1]);
Result := SolutionFound;
writeln('# iterations: ', NumIterations: 12);
end;
var
i: integer;
StartTime: TDateTime;
begin
StartTime := now;
BoundingBox.Width := 70;
BoundingBox.Area := int64(BoundingBox.Width) * int64(BoundingBox.Width);
NumRectangles := 24;
SetLength(UnsortedRectangle, NumRectangles + 5);
for i := 1 to NumRectangles do
begin
with UnsortedRectangle[i] do begin
Width := i;
Area := int64(i) * int64(i);
end;
end;
if GapAlgorithm then
writeln('solution found')
else
writeln('no solution found');
writeln('runtime: ', (Now - StartTime) * 3600 * 24: 8: 2, 's');
readln;
end.
More information about the fpc-pascal
mailing list