[fpc-pascal] code optimization
Adrian Veith
adrian at veith-system.de
Thu Sep 23 16:59:04 CEST 2010
Hi Stefan,
I analyzed your code - I think the problem is the array element address
calculation of the fpc compiler. You have a lot of code like
Bar[MinValley] etc. The delphi compile uses the lea assembler code for
this, whereas fpc calculates the address of one element with imul which
is much slower. Anyway you could speed up your code significantly if you
help the compiler by reducing the address calculations with the help of
pointers like this:
MinValley:= ...
PBarMinValley:= @Bar[MinValley]
and replace any following Bar[MinValley].FOO with PBarMinValley.FOO
and the same with any other index.
This will speed up the code for Delphi and fpc as well, because both
compilers are not smart enough the see the unnecessary repeated address
calculations.
Cheers,
Adrian.
On 22.09.2010 16:08, stefan077 at web.de wrote:
> 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