Graphic changes

[JuhaManninen]

Lagprogramming, to summarize your posts:
You have lots of talk but little substance behind it.
I also must agree with User137, your formatting style is extremely weird.

[BrunoK]

Or maybe even :

Code: [Select]

function TFPReaderBMP.CountBits(Value: byte): shortint;
begin
  Result := 0;
  while Value <> 0 do begin
    Result:=Result+(Value and 1);
    Value := Value shr 1;
  end;
end;


[BrunoK]

which could be extended

to

Code: [Select]

function TFPReaderBMP.CountBits(Value: <SomeIntType>): shortint;
begin
  Result := 0;
  while Value <> 0 do begin
    Result:=Result+(Value and 1);
    Value := Value shr 1;
  end;
end;

[lagprogramming]

In order to apply the patch for svn revision 47287 you need to type:
svn checkout http://svn.freepascal.org/svn/lazarus/trunk@47287 lazarus
Then patch the sources using the file attached to this message.

[lagprogramming]

   Apparently some developers already use the modifications, in important projects ignoring that I've clearly stated from the very beginning that some existing bugs might be replaced with new ones. This makes me feel like I have to remove some modifications and tell what that was about, so that those of you that use previous modifications, will be prepared for what's worse.
a) procedure DefaultReaderDescription REMAINS
   The workaround consisted in adding:
“25..32 : Adesc.Init_BPP32_B8G8R8A8_BIO_TTB(AWidth,Aheight);” to the case statement.
32bit descriptions were not filled correctly. This is one of the reasons for some transparency bugs. The problem with this workaround is that we initialize using alpha(32 bit Depth) while original code and most of the lcl appears to be prepared for 24bit Depth. There is a subtle difference between bits per pixel and depth, but there is and I have reasons to think that some lcl sources didn't make the difference between these two either. 32 bits per pixel images can be treated like 24 ones if we chose to ignore the alpha byte. So this modification may surface things that I really can't predict. I know that old versions of Windows had problems with 32bit Depth bitmaps. So, I don't consider this modification safe enough.
Also, I don't know how compatible is with "pf32bit:Flags := [riqfRGB, riqfMask, riqfAlpha];" found in TCustomBitmap.RawimageNeeded.
For now, this one remains but might have unpleasant side effects.

b) procedure TlazIntfImage.SetMasked REMOVED
   Fortunately this one was disabled. Some notes on this one.
"and ((self.Width and 3) = 0)" has been added. Probably related to multiple bugs like: 0024241,0025080.....
Extras:
Width has to be multiple of 4 to use masks.
 This might be another bug in Fpc/Lazarus, a widget optimization requirement similar to padding of 24bit bitmaps or something else.
 It is required both width and height to be multiple of 4 but apparently it works just with width.
 http://coronalabs.com/blog/2012/05/29/how-to-use-bitmap-masks/}
 //((self.Width and 3) = 0) is the optimized version of ((self.Width mod 4) = 0)
   I didn't had enough informations, reason why I've disabled the modification by using comments. It might be related to transparency problems.

c)procedure TwinControl.PaintControls REMAINS
Both original and modified codes consider that during paint(during the while/for loop)FControls must be steady(no switches, insertions, removals). Is this OK???

d)procedure TwinControl.Insert REMOVED
Has been modified to really insert, not append. One of the reasons for modifying it was that I knew that lcl has problems with z-ordering. I verified that maybe the reason was connected to the fact that you couldn't set the right position in a list. You try to insert in a specific position and you end up in a different position. The problem with this modification is that apparently, it breaks compatibility with Delphi and also I don't know the following thing: if “Acontrol.CanTab=false”should the control be inserted in the FtabList? I've decided to remove this modification, although even now I consider the modification a better solution than the original.

e) procedure TcustomBitmap.Changed REMOVED
   I knew that modifying the bitmap is not tracked by parent controls. For example, apparently changing the pixelformat is entirely ignored. For this reason I've inserted:
“if FPixelFormatNeedsUpdate then UpdatePixelFormat;”
   The line has been inserted because procedures like "Assign" or "RawimageNeeded" set "FPixelFormatNeedsUpdate:=TRUE;" without calling anything else after that
   The problem is that I'm not sure this is the wright place to do.

procedure TcustomBitmap.SetPixelFormat REMOVED
If the pixel format is changed then call Changed(Self);
If the changed event should not be triggered then "Changed(Self);" may be replaced by "UpdatePixelFormat".
I've removed both modifications.

[lagprogramming]

Changes:
1) When csdesigning, execution should be slower, otherwise it should be a little bit faster.
2) This is the first time I publicly present tracked inlines within the sources. The following text will present what's with this kind of changes.
Untracked inlines are manual function inlines only the developer knows about, modifications that ignore the code outside the block. For example:

original code

Code: [Select]

var p:point;
p:=point(0,0);

modified code

Code: [Select]

var p:point;
p.X:=0;p.Y:=0;
This modification is not tracked, meaning that It's assumed that the "point" function will never change.

Now I'll start talking about tracked inlines by using an example.
Within lclmessageglue.pas and lmessages.pp we find:

Code: [Select]

function LCLSendPaintMsg(const Target: TControl;const  DC: HDC; const PaintStruct: PPaintStruct): PtrInt;
var
  Mess: TLMPaint;
begin
  FillChar(Mess, SizeOf(Mess), 0);
  Mess.Msg := LM_PAINT;
  Mess.DC := DC;
  Mess.PaintStruct := PaintStruct;
 
  Result := DeliverMessage(Target, Mess);
end;
and

Code: [Select]

  TLMPaint = record
    Msg: Cardinal;
{$ifdef cpu64}
    UnusedMsg: Cardinal;
{$endif}
    DC: HDC;
    PaintStruct: PPaintStruct;
    Result: LRESULT;
  end;

   The use of "fillchar" brings at least three benefits
a)It's a safe way to initialize memory blocks.
b)Makes the code easily maintainable and readable.
c)May reduce code size.
   The downside effect is that it reduces code execution speed. As can be seen, the memory block filled with zeros immediately gets written again, without using the zeros.

Modified source follows:

Code: [Select]

function LCLSendPaintMsg(const Target: TControl;const  DC: HDC; const PaintStruct: PPaintStruct): PtrInt;
var Mess:TLMPaint;
begin
Mess.Msg:=LM_PAINT;
{$ifdef cpu64}Mess.UnusedMsg:=0;{$endif}
Mess.DC:=DC;
Mess.PaintStruct:=PaintStruct;
Mess.Result:=0;
Result:=DeliverMessage(Target,Mess);
end;
   Using untracked inlines in this situation, makes the code prone to bugs if the structure of TLMPaint changes.
   This is why a succesful modification of the function "LCLSendPaintMsg" depends on the structure of the "TLMPaint" record. Obviously, there may be a chain of dependencies, for example the order of the entities found in the "uses" statement, but I think I've briefly presented this feature enough .
   Regarding code execution speed, I think it has the potential to increase the image of FPC/Lazarus built applications by adding a plus of snappiness(or lower power consumption). I wonder how many compilers/IDEs offer a similar package to the community.
   I'd like to point out that the svn patch doesn't contain all modifications. Functions/procedures modified by main developers since the stable release are not included in the patch(14 modifications at the moment).

   The latest svn patch is at:
http://forum.lazarus.freepascal.org/index.php/topic,26199.msg161684.html#msg161684

[lagprogramming]

   Ticket "0026284: PNG with special resolution not show in runtime" is also affected by the modifications.
   I'd like to know if anybody noticed any kind of regression using the modified files compared to original ones.

[Laksen]

I wonder what the talk about CountBits is?
This version is 20 times faster on my system.

Code: [Select]

function TFPReaderBMP.CountBits(Value: byte): shortint;
begin
  Result := PopCnt(Value);
end;


[ChrisF]

It seems that the PopCount function is only available in the trunk version of FPC.

I guess it's probably using directly the intrinsic popcount assembly instruction when available for the targeted processor. Otherwise, looking briefly at the source code, it's using a 4 bits lookup table (at least for the FPC 2.6.x branch) when not available, which seems quite effective for a byte value too.

Just for information purposes, counting the number of bits, also known as the Hamming weight, can also been done through the well-known "Swar algorithm":

Sample code for a 32 bits value (can be easily extended):

Code: [Select]

function Swar(Value: Longword): shortint;
begin
  Value := Value - ((Value shr 1) and $55555555);
  Value := (Value and $33333333) + ((Value shr 2) and $33333333);
  result := (((Value + (Value shr 4)) and $0F0F0F0F) * $01010101) shr 24;
end;


[lagprogramming]

@Laksen I think you've had the most elegant approach. It fits great within the function.

@ChrisF's I also think that your approach might be better than what's currently implemented within fpc for non-byte parameters(probably byte can be optimized too). Briefly looking, current implementation, appears like:

Code: [Select]

variable:=0;
repeat
variable:=variable+1;
{CODE};
until variable=7;

Assembler for popcnt

Code: [Select]

fpc_popcnt_dword
0000000000444AA0 90                       nop
0000000000444AA1 b800000000               mov    $0x0,%eax
0000000000444AA6 48be0000000000000000     movabs $0x0,%rsi
0000000000444AB0 4883ee01                 sub    $0x1,%rsi
0000000000444AB4 66666690                 data32 data32 xchg %ax,%ax
0000000000444AB8 4883c601                 add    $0x1,%rsi
0000000000444ABC 89fa                     mov    %edi,%edx
0000000000444ABE 83e20f                   and    $0xf,%edx
0000000000444AC1 488d0dd8da5500           lea    0x55dad8(%rip),%rcx        # 0x9a25a0 <TC_$SYSTEM_$$_POPCNTDATA>
0000000000444AC8 0fb61411                 movzbl (%rcx,%rdx,1),%edx
0000000000444ACC 01d0                     add    %edx,%eax
0000000000444ACE 89fa                     mov    %edi,%edx
0000000000444AD0 c1ea04                   shr    $0x4,%edx
0000000000444AD3 89d7                     mov    %edx,%edi
0000000000444AD5 4883fe07                 cmp    $0x7,%rsi
0000000000444AD9 7cdd                     jl     0x444ab8 <fpc_popcnt_dword+24>
0000000000444ADB 90                       nop
0000000000444ADC c3                       retq   
0000000000444ADD 0000                     add    %al,(%rax)
0000000000444ADF 00                       add    %dl,0x41(%rbx)

Assembler for

Code: [Select]

function Swar(Value: Longword): longword;
begin
  Value := Value - ((Value shr 1) and $55555555);
  Value := (Value and $33333333) + ((Value shr 2) and $33333333);
  result := (((Value + (Value shr 4)) and $0F0F0F0F) * $01010101) shr 24;
end;


Code: [Select]

.type UNIT1_$$_SWAR$LONGWORD$$LONGWORD,@function
UNIT1_$$_SWAR$LONGWORD$$LONGWORD:
.Lc1:
.Ll1:
# [unit1.pas]
# [39] begin
nop
# Var Value located in register eax
# Var $result located in register eax
.Ll2:
# [40] Value := Value - ((Value shr 1) and $55555555);
movl %edi,%eax
shrl $1,%eax
andl $1431655765,%eax
subl %eax,%edi
# Var Value located in register edi
.Ll3:
# [41] Value := (Value and $33333333) + ((Value shr 2) and $33333333);
movl %edi,%eax
shrl $2,%eax
andl $858993459,%eax
andl $858993459,%edi
leal (%eax,%edi),%eax
# Var Value located in register eax
.Ll4:
# [42] result := (((Value + (Value shr 4)) and $0F0F0F0F) * $01010101) shr 24;
movl %eax,%edx
shrl $4,%edx
andl $4294967295,%edx
andl $4294967295,%eax
leaq (%rdx,%rax),%rax
andq $252645135,%rax
imulq $16843009,%rax,%rax
shrq $24,%rax
# Var $result located in register eax
.Ll5:
# [43] end;
nop
ret

   The situation might worsen with qword. Apparently popcnt(qword) calls popcnt(dword) two times.

[BrunoK]

ChrisF is the winner.

Good timings for worst condition.

Beats all for more general cases .

Where did you find this algorithm ?

[ChrisF]

Where did you find this algorithm ?

The official name is the "variable-precision SWAR algorithm". Some infos about SWAR:
- http://en.wikipedia.org/wiki/SWAR
- http://www.aggregate.org/SWAR/
and more precisely about this particular algorithm:
- http://www.aggregate.org/MAGIC/#Population%20Count%20%28Ones%20Count%29

And a few more about its implementation and some explanations:
- http://stackoverflow.com/questions/109023/how-to-count-the-number-of-set-bits-in-a-32-bit-integer
- http://stackoverflow.com/questions/22081738/how-variable-precision-swar-algorithm-works
- http://www.playingwithpointers.com/swar.html

All the credit goes to the concerned authors...

Anyway, I guess that the popcnt assembly instruction(s) (at least for Intel and AMD processors) are probably faster.

[lagprogramming]

Minor changes.
pixmap.inc LazResourceXPMToPPChar contains "XPMSource:=LazarusResources.Find(ResourceName);".
XPMSource may be nil and the following line doesn't check for that. Modified code checks for nil.
gtk2widgetset.inc TGtk2WidgetSet.LoadPixbufFromLazResource calls for LazResourceXPMToPPChar within an "try...except...end;" block but after that it tries to continue as if no error has been raised in the meantime.

[lagprogramming]

LPTODP & DPtoLP

   These are two very often used functions. The functions return a "BOOL" result. "BOOL" is the equivalent of LongBool while "Boolean" is the equivalent of ByteBool. Obviosly, by using different sizes lots of useless assembler instructions appear, increasing size, decreasing speed. I see that this design is spread all over the lcl. Is this situation a consequence of copy/pasting code from one place to another, or there is an unknown(to me) reason behind this design. I really can't find a reason to use "BOOL" instead of "Boolean" for those functions.

[taazz]

LPTODP & DPtoLP

   These are two very often used functions. The functions return a "BOOL" result. "BOOL" is the equivalent of LongBool while "Boolean" is the equivalent of ByteBool. Obviosly, by using different sizes lots of useless assembler instructions appear, increasing size, decreasing speed. I see that this design is spread all over the lcl. Is this situation a consequence of copy/pasting code from one place to another, or there is an unknown(to me) reason behind this design. I really can't find a reason to use "BOOL" instead of "Boolean" for those functions.

http://msdn.microsoft.com/en-us/library/windows/desktop/dd145042%28v=vs.85%29.aspx