[fpc-pascal] code optimization
stefan077 at web.de
stefan077 at web.de
Wed Sep 22 16:08:37 CEST 2010
Hi Adrian,
it is a scientific application that I have, which has about 2000 lines of code. By extracting the most time consuming routine I now have 360 lines of code. With this code I get the following runtime results:
optimized FPC pascal *** is 58% SLOWER *** than optimized DELPHI 7
unoptimized FPC pascal *** is 60% SLOWER *** than optimized DELPHI 7
unoptimized Delphi 7 *** is 62% SLOWER *** than optimized DELPHI 7
Thus it looks like FPC pascal is doing very bad on optimizing the code.
I agree, that I also have seen examples where FPC pascal code is about 10% faster than Delphi code.
So why does FPC pascal fail on this code?
I have included the code below. I compiled it with Delphi 7 , optimization on, range checking off, stack checking off, I/O checking off.
For FPC pascal I used the compiler options: -Mdelphi -O3 -OpPENTIUMM -Cfsse2 -Cr- -Co- -CO- -Ci-
The FPC compiler version is 2.4.0, I run under Windows XP.
any suggestions?
Stefan
-----Ursprüngliche Nachricht-----
Von: "Adrian Veith" <adrian at veith-system.de>
Gesendet: 22.09.2010 08:08:45
An: "FPC-Pascal users discussions" <fpc-pascal at lists.freepascal.org>
Betreff: Re: [fpc-pascal] code optimization
> Hi Stefan,
>
>is this a benchmark program or a complex program you are talking about.
>If it is a benchmark, then it would be interesting to see the code,
>because from my experience I doubt that Delphi produces better code than
>fpc (in general it is the other way round). If it is a complex program,
>then you need to analyze carefully which part of the program consumes
>the most time and why. A number of 50% is in anyway unrealistic (this is
>something you get if you compare inlined code against uninlined) ,
>because the differences you get from code optimization are in a range
>from +/-10% normally - unless you have found a real performance
>bottleneck. And sometimes (most of) it is only an unoptimized library code.
>
>Adrian.
>
Here is the code (I was not able to cut it down in size further):
program P;
{$APPTYPE CONSOLE}
uses
Math,
SysUtils,
Windows;
type
TRectangle = object
width : Integer;
Area : Int64;
NextUnusedRectangle: Integer;
end;
TRectangleArray = Array of TRectangle;
var
UnsortedRectangle: TRectangleArray;
NumRectangles : Integer;
BoundingBox : TRectangle;
function GapAlgorithm: Boolean;
type
TBarEntry = record
Height: Integer;
Width : Integer;
Start : Integer;
Next : Integer;
Prev : Integer;
end;
var
SolutionFound : Boolean;
Bar : Array of TBarEntry;
FreeBarEntry : Array of Integer;
NumFreeBarEntries: Integer;
NumIterations : Int64;
procedure ExtendPartialSolution (NumPlacedRectangles, FirstUnusedRectangle: Integer);
type
TBarCase = (BarCase1, BarCase2, BarCase3, BarCase4, BarCase5, BarCase6);
var
i, MinValley, MinValleyWidth: Integer;
PrevBar, NextBar : Integer;
RectWidth : Integer;
BarCase : TBarCase;
NextBarWidth : Integer;
NewEntry, NewEntry2 : Integer;
MinValleyArea : Int64;
MinValleyHeight : Integer;
TotalAreaOfFittingRectangles: Int64;
CurrentRectangle : Integer;
PreviousRectangle : Integer;
OldFirstUnusedRectangle : Integer;
OldPrevNextRectangle : Integer;
begin
if NumPlacedRectangles = NumRectangles
then begin
writeln ('Solution found');
SolutionFound := true;
exit;
end
else begin
inc (NumIterations);
MinValleyWidth := BoundingBox.Width+1;
PrevBar := 1;
i := Bar[PrevBar].Next;
NextBar := Bar[i].Next;
while NextBar <> 0 do begin
if (Bar[i].Width < MinValleyWidth) and
(Bar[PrevBar].Height > Bar[i].Height) and
(Bar[NextBar].Height > Bar[i].Height)
then begin
MinValleyWidth := Bar[i].Width;
MinValley := i;
end;
PrevBar := i;
i := NextBar;
NextBar := Bar[i].Next;
end;
MinValleyHeight := min(Bar[Bar[MinValley].Prev].Height, Bar[Bar[MinValley].Next].Height)- Bar[MinValley].Height;
MinValleyArea := int64(MinValleyHeight) * int64(MinValleyWidth);
if MinValleyWidth < BoundingBox.Width
then begin
TotalAreaOfFittingRectangles := 0;
CurrentRectangle := FirstUnusedRectangle;
while CurrentRectangle <> 0 do begin
i := CurrentRectangle;
if (UnsortedRectangle[i].Width <= MinValleyWidth)
then inc (TotalAreaOfFittingRectangles, UnsortedRectangle[i].Area);
CurrentRectangle := UnsortedRectangle[CurrentRectangle].NextUnusedRectangle
end;
if TotalAreaOfFittingRectangles < MinValleyArea
then exit;
end;
PreviousRectangle := 0;
CurrentRectangle := FirstUnusedRectangle;
while CurrentRectangle <> 0 do begin
i := CurrentRectangle;
if (UnsortedRectangle[i].width <= MinValleyWidth)
and (UnsortedRectangle[i].Width + Bar[MinValley].Height <= BoundingBox.Width)
then begin
OldFirstUnusedRectangle := FirstUnusedRectangle;
OldPrevNextRectangle := UnsortedRectangle[PreviousRectangle].NextUnusedRectangle;
if CurrentRectangle = FirstUnusedRectangle
then begin
FirstUnusedRectangle := UnsortedRectangle[CurrentRectangle].NextUnusedRectangle;
end
else begin
UnsortedRectangle[PreviousRectangle].NextUnusedRectangle := UnsortedRectangle[CurrentRectangle].NextUnusedRectangle
end;
PrevBar := Bar[MinValley].Prev;
NextBar := Bar[MinValley].Next;
RectWidth := UnsortedRectangle[i].Width;
if MinValleyWidth = RectWidth
then begin
if Bar[PrevBar].Height = Bar[MinValley].Height + RectWidth
then begin
if Bar[NextBar].Height = Bar[MinValley].Height + RectWidth
then begin
BarCase := BarCase3;
NextBarWidth := Bar[NextBar].Width;
inc (Bar[PrevBar].Width, RectWidth + NextBarWidth);
Bar[PrevBar].Next := Bar[NextBar].Next;
Bar[Bar[NextBar].Next].Prev := PrevBar;
Inc (NumFreeBarEntries);
FreeBarEntry[NumFreeBarEntries] := NextBar;
Inc (NumFreeBarEntries);
FreeBarEntry[NumFreeBarEntries] := MinValley;
end
else begin
BarCase := BarCase4;
inc (Bar[PrevBar].Width, RectWidth);
Bar[PrevBar].Next := NextBar;
Bar[NextBar].Prev := PrevBar;
Inc (NumFreeBarEntries);
FreeBarEntry[NumFreeBarEntries] := MinValley;
end
end
else begin
if Bar[NextBar].Height = Bar[MinValley].Height + RectWidth
then begin
BarCase := BarCase5;
inc (Bar[NextBar].Width, RectWidth);
dec (Bar[NextBar].Start, RectWidth);
Bar[PrevBar].Next := NextBar;
Bar[NextBar].Prev := PrevBar;
Inc (NumFreeBarEntries);
FreeBarEntry[NumFreeBarEntries] := MinValley;
end
else begin
BarCase := BarCase6;
inc (Bar[MinValley].Height, RectWidth);
end
end
end
else begin
if Bar[PrevBar].Height = Bar[MinValley].Height + RectWidth
then begin
BarCase := BarCase1;
inc (Bar[PrevBar].Width, RectWidth);
dec (Bar[MinValley].Width, RectWidth);
inc (Bar[MinValley].Start, RectWidth);
end
else begin
BarCase := BarCase2;
NewEntry := FreeBarEntry[NumFreeBarEntries];
dec (NumFreeBarEntries);
Bar[PrevBar].Next := NewEntry;
Bar[MinValley].Prev := NewEntry;
dec (Bar[MinValley].Width, RectWidth);
inc (Bar[MinValley].Start, RectWidth);
Bar[NewEntry].Height := Bar[MinValley].Height + RectWidth;
Bar[NewEntry].Width := RectWidth;
Bar[NewEntry].Start := Bar[MinValley].Start - RectWidth;
Bar[NewEntry].Prev := PrevBar;
Bar[NewEntry].Next := MinValley;
end
end;
ExtendPartialSolution (NumPlacedRectangles+1, FirstUnusedRectangle);
if SolutionFound then exit;
case BarCase of
BarCase1: begin
dec (Bar[PrevBar].Width, RectWidth);
inc (Bar[MinValley].Width, RectWidth);
dec (Bar[MinValley].Start, RectWidth);
end;
BarCase2: begin
Bar[PrevBar].Next := MinValley;
Bar[MinValley].Prev := PrevBar;
inc (Bar[MinValley].Width, RectWidth);
dec (Bar[MinValley].Start, RectWidth);
inc (NumFreeBarEntries);
FreeBarEntry[NumFreeBarEntries] := NewEntry;
end;
BarCase3: begin
dec (Bar[PrevBar].Width, RectWidth + NextBarWidth);
NewEntry := FreeBarEntry[NumFreeBarEntries];
dec (NumFreeBarEntries);
NewEntry2 := FreeBarEntry[NumFreeBarEntries];
dec (NumFreeBarEntries);
Bar[NewEntry ].Height := Bar[PrevBar].Height - RectWidth;
Bar[NewEntry ].Width := RectWidth;
Bar[NewEntry ].Start := Bar[PrevBar].Start + Bar[PrevBar].Width;
Bar[NewEntry ].Prev := PrevBar;
Bar[NewEntry ].Next := NewEntry2;
Bar[NewEntry2].Height := Bar[PrevBar].Height;
Bar[NewEntry2].Width := NextBarWidth;
Bar[NewEntry2].Start := Bar[NewEntry].Start + RectWidth;
Bar[NewEntry2].Prev := NewEntry;
Bar[NewEntry2].Next := Bar[PrevBar].Next;
Bar[Bar[PrevBar].Next].Prev := NewEntry2;
Bar[PrevBar].Next := NewEntry;
end;
BarCase4: begin
dec (Bar[PrevBar].Width, RectWidth);
NewEntry := FreeBarEntry[NumFreeBarEntries];
dec (NumFreeBarEntries);
Bar[NewEntry].Height := Bar[PrevBar].Height - RectWidth;
Bar[NewEntry].Width := RectWidth;
Bar[NewEntry].Start := Bar[PrevBar].Start + Bar[PrevBar].Width;
Bar[NewEntry].Prev := PrevBar;
Bar[NewEntry].Next := NextBar;
Bar[PrevBar].Next := NewEntry;
Bar[NextBar].Prev := NewEntry;
end;
BarCase5: begin
dec (Bar[NextBar].Width, RectWidth);
inc (Bar[NextBar].Start, RectWidth);
NewEntry := FreeBarEntry[NumFreeBarEntries];
dec (NumFreeBarEntries);
Bar[NewEntry].Height := Bar[NextBar].Height - RectWidth;
Bar[NewEntry].Width := RectWidth;
Bar[NewEntry ].Start := Bar[NextBar].Start - RectWidth;
Bar[NewEntry].Prev := PrevBar;
Bar[NewEntry].Next := NextBar;
Bar[PrevBar].Next := NewEntry;
Bar[NextBar].Prev := NewEntry;
end;
BarCase6: begin
dec (Bar[MinValley].Height, RectWidth);
end;
end;
FirstUnusedRectangle := OldFirstUnusedRectangle;
UnsortedRectangle[PreviousRectangle].NextUnusedRectangle := OldPrevNextRectangle ;
end;
PreviousRectangle := CurrentRectangle;
CurrentRectangle := UnsortedRectangle[CurrentRectangle].NextUnusedRectangle;
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 := 2;
Bar[1].Prev := 0;
Bar[1].Start := -1;
Bar[2].Height := 0;
Bar[2].Width := BoundingBox.Width;
Bar[2].Next := 3;
Bar[2].Prev := 1;
Bar[2].Start := 0;
Bar[3].Height := Bar[1].Height;
Bar[3].Width := 1;
Bar[3].Next := 0;
Bar[3].Prev := 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] := i;
end;
for i:=1 to NumRectangles-1 do
UnsortedRectangle[i].NextUnusedRectangle := i+1;
UnsortedRectangle[NumRectangles].NextUnusedRectangle := 0;
NumIterations :=0;
SolutionFound := false;
ExtendPartialSolution (0, 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
UnsortedRectangle[i].Width := i;
UnsortedRectangle[i].Area := int64(i) * int64(i);
end;
if GapAlgorithm
then writeln ('solution found')
else writeln ('no solution found');
writeln ('runtime: ', (Now-StartTime)*3600*24:8:2, 's');
end.
___________________________________________________________
GRATIS: Spider-Man 1-3 sowie 300 weitere Videos!
Jetzt kostenlose Movie-FLAT freischalten! http://movieflat.web.de
More information about the fpc-pascal
mailing list