[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