[CLOSED] Code cleanup at function GetInterfaceProp
lazarus / 64-FPC development

----------------------------------------------------------------------
lagprogramming · 2023-04-24 13:36

rtl/objpas/typinfo.pp has function GetInterfaceProp(Instance: TObject;
PropInfo: PPropInfo): IInterface;
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i function
GetInterfaceProp(Instance: TObject; PropInfo: PPropInfo):
IInterface;type  TGetInterfaceProc=function:IInterface of object; 
TGetInterfaceProcIndex=function(index:longint):IInterface of
object;var  AMethod : TMethod;begin  Result:=nil;  case
(PropInfo^.PropProcs) and 3 of    ptField:      Result:=IInterface(PPo
inter(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^);    ptStatic,  
ptVirtual:      begin        if (PropInfo^.PropProcs and 3)=ptStatic
then          AMethod.Code:=PropInfo^.GetProc        else          AMe
thod.Code:=PCodePointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.
GetProc))^;        AMethod.Data:=Instance;        if
((PropInfo^.PropProcs shr 6) and 1)<>0 then         
Result:=TGetInterfaceProcIndex(AMethod)(PropInfo^.Index)        else 
       Result:=TGetInterfaceProc(AMethod)();      end;  else    raise
EPropertyError.CreateFmt(SErrCannotReadProperty, [PropInfo^.Name]); 
end;end;The following patch removes the initial "Result:=nil;" line.
If the patch is accepted, regarding result assignments, the patch will
make the function look closer to other functions in the same file like
Function IsStoredProp(Instance : TObject;PropInfo : PPropInfo) :
Boolean; or Function GetPointerProp(Instance: TObject; PropInfo :
PPropInfo): Pointer;.
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i diff --git
a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.ppindex
da6a889b08..7ffaefc081 100644--- a/rtl/objpas/typinfo.pp+++
b/rtl/objpas/typinfo.pp@@ -2302,7 +2302,6 @@ function
GetInterfaceProp(Instance: TObject; PropInfo: PPropInfo):
IInterface; var   AMethod : TMethod; begin-  Result:=nil;   case
(PropInfo^.PropProcs) and 3 of     ptField:       Result:=IInterface(P
Pointer(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^);

----------------------------------------------------------------------
AlexTP · 2023-04-24 14:56

Posted on bugtracker
https://gitlab.com/freepascal.org/fpc/source/-/issues/40249

----------------------------------------------------------------------
lagprogramming · 2023-04-25 08:23

https://gitlab.com/freepascal.org/fpc/source/-
/commit/f6a8b045c2f52740186feca3d50c3211c74c775c
https://gitlab.com/freepascal.org/fpc/source/-
/commit/abb7aebaba5721512c3d16857c78781c60259e66
https://gitlab.com/freepascal.org/fpc/source/-
/commit/d7d65fe0d7b62c61f4751b896eb6ab9271d03a0c
     
https://gitlab.com/freepascal.org/fpc/source/-/issues/40249

----------------------------------------------------------------------
wp · 2023-04-25 08:37

What's wrong with clearly assigning a result to a function? Even if
the assignment is unnecessary it improves readability of the code. I
agree with Michael's decision not to apply this.

----------------------------------------------------------------------
PascalDragon · 2023-04-25 09:58

Quote from: lagprogramming on April 25, 2023, 10:23:49 amhttps://gitla
b.com/freepascal.org/fpc/source/-
/commit/f6a8b045c2f52740186feca3d50c3211c74c775c
https://gitlab.com/freepascal.org/fpc/source/-
/commit/abb7aebaba5721512c3d16857c78781c60259e66
https://gitlab.com/freepascal.org/fpc/source/-
/commit/d7d65fe0d7b62c61f4751b896eb6ab9271d03a0cIs there a reason you
mention these commits in relation to that issue?

----------------------------------------------------------------------
AlexTP · 2023-04-25 11:58

I agree with Michael's decision.

----------------------------------------------------------------------
lagprogramming · 2023-04-25 16:09

Quote from: wp on April 25, 2023, 10:37:13 amWhat's wrong with clearly
assigning a result to a function? Even if the assignment is
unnecessary it improves readability of the code. I agree with
Michael's decision not to apply this.
Having a default result as the first line is a common practice. If you
got used to this practice, it's presence might increase readability
for you. I don't want to start a discussion on recommended(good)
programming practices for FreePascal because I know for sure it won't
be a polite discussion on the forum. Things will escalate almost
intantly because a good/recommended programming practice for
FreePascal would challenge most of the experienced developers here.
Readability(and maintenance) of the code is important beyond doubts.
But unlike the speed of the routines in LCL, the speed of the routines
in rtl is much more important. In the last three months, the forum had
about two topics regarding slow graphic routines. If we would make a
connection with fpc, the connection would be made to the fcl-image
package. Fcl-image is just a package, the rtl is more important. Look
at how many rtl optimizations are proposed in the bug tracker.
Sometimes the speed of rtl routines might be considered more important
than code readability.
Many years ago, independent of FPC developers, a number of rtl
routines have been modified. The modifications were based on
recommended programming practices for FreePascal. All those new for
you versions of graphic routines that improve CPU cache usage are in
fact ancient for others, many years old. Another programming practice
that has been used was to avoid the initial default result
assignments.
Here is an example, same optimization level, same fpc development
version, only the code of function TProcess.Terminate has been
changed.
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i Function
TProcess.Terminate(AExitCode : Integer) : Boolean; begin 
Result:=False;  Result:=fpkill(Handle,SIGTERM)=0;  If Result then   
begin    If Running then      Result:=fpkill(Handle,SIGKILL)=0;   
end;  { the fact that the signal has been sent does not    mean that
the process has already handled the    signal -> wait instead of
calling getexitstatus }  if Result then   
WaitOnExit;end; PROCESS$_$TPROCESS_$__$$_TERMINATE$LONGINT$$BOOLEAN
00000000006EC260 53                       push rbx00000000006EC261
4154                     push r1200000000006EC263 50                 
    push rax00000000006EC264 4889FB                   mov
rbx,rdi00000000006EC267 30C0                     xor
al,al00000000006EC269 8BBF30010000             mov
edi,[rdi+$00000130]00000000006EC26F BE0F000000               mov
esi,$0000000F00000000006EC274 E8C74AD7FF               call -$0028B539
   # $0000000000460D40
BASEUNIX_$$_FPKILL$LONGINT$LONGINT$$LONGINT00000000006EC279 85C0     
              test eax,eax00000000006EC27B 410F94C4                
setz r12b00000000006EC27F 752F                     jnz +$2F    #
$00000000006EC2B0
PROCESS$_$TPROCESS_$__$$_TERMINATE$LONGINT$$BOOLEAN+8000000000006EC281
4889DF                   mov rdi,rbx00000000006EC284 E807060000      
       call +$00000607    # $00000000006EC890
PROCESS$_$TPROCESS_$__$$_GETRUNNING$$BOOLEAN00000000006EC289 84C0    
               test al,al00000000006EC28B 7416                     jz
+$16    # $00000000006EC2A3
PROCESS$_$TPROCESS_$__$$_TERMINATE$LONGINT$$BOOLEAN+6700000000006EC28D
8BBB30010000             mov edi,[rbx+$00000130]00000000006EC293
BE09000000               mov esi,$0000000900000000006EC298 E8A34AD7FF
             call -$0028B55D    # $0000000000460D40
BASEUNIX_$$_FPKILL$LONGINT$LONGINT$$LONGINT00000000006EC29D 85C0     
              test eax,eax00000000006EC29F 410F94C4                
setz r12b00000000006EC2A3 4584E4                   test
r12b,r12b00000000006EC2A6 7408                     jz +$08    #
$00000000006EC2B0
PROCESS$_$TPROCESS_$__$$_TERMINATE$LONGINT$$BOOLEAN+8000000000006EC2A8
4889DF                   mov rdi,rbx00000000006EC2AB E8F0FDFFFF      
       call -$00000210    # $00000000006EC0A0
PROCESS$_$TPROCESS_$__$$_WAITONEXIT$$BOOLEAN00000000006EC2B0 4488E0  
               mov al,r12b00000000006EC2B3 59                      
pop rcx00000000006EC2B4 415C                     pop
r1200000000006EC2B6 5B                       pop rbx00000000006EC2B7
C3                       ret 00000000006EC2B8 0000                   
add [rax],al00000000006EC2BA 0000                     add
[rax],al00000000006EC2BC 0000                     add
[rax],al00000000006EC2BE 0000                     add [rax],alCode:
Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i Function
TProcess.Terminate(AExitCode:Integer):Boolean;begin  if
fpkill(Handle,SIGTERM)=0 then    if Running then      if
fpkill(Handle,SIGKILL)=0 then        begin          { the fact that
the signal has been sent does not           mean that the process has
already handled the           signal -> wait instead of calling
getexitstatus }          WaitOnExit;          Result:=True;         
Exit;        end; 
Result:=False;end; PROCESS$_$TPROCESS_$__$$_TERMINATE$LONGINT$$BOOLEAN
00000000006EC1C0 53                       push rbx00000000006EC1C1
4889FB                   mov rbx,rdi00000000006EC1C4 8BBF30010000    
       mov edi,[rdi+$00000130]00000000006EC1CA BE0F000000            
 mov esi,$0000000F00000000006EC1CF E8CC4AD7FF               call
-$0028B534    # $0000000000460CA0
BASEUNIX_$$_FPKILL$LONGINT$LONGINT$$LONGINT00000000006EC1D4 85C0     
              test eax,eax00000000006EC1D6 7530                    
jnz +$30    # $00000000006EC208
PROCESS$_$TPROCESS_$__$$_TERMINATE$LONGINT$$BOOLEAN+7200000000006EC1D8
4889DF                   mov rdi,rbx00000000006EC1DB E800060000      
       call +$00000600    # $00000000006EC7E0
PROCESS$_$TPROCESS_$__$$_GETRUNNING$$BOOLEAN00000000006EC1E0 84C0    
               test al,al00000000006EC1E2 7424                     jz
+$24    # $00000000006EC208
PROCESS$_$TPROCESS_$__$$_TERMINATE$LONGINT$$BOOLEAN+7200000000006EC1E4
8BBB30010000             mov edi,[rbx+$00000130]00000000006EC1EA
BE09000000               mov esi,$0000000900000000006EC1EF E8AC4AD7FF
             call -$0028B554    # $0000000000460CA0
BASEUNIX_$$_FPKILL$LONGINT$LONGINT$$LONGINT00000000006EC1F4 85C0     
              test eax,eax00000000006EC1F6 7510                    
jnz +$10    # $00000000006EC208
PROCESS$_$TPROCESS_$__$$_TERMINATE$LONGINT$$BOOLEAN+7200000000006EC1F8
4889DF                   mov rdi,rbx00000000006EC1FB E800FEFFFF      
       call -$00000200    # $00000000006EC000
PROCESS$_$TPROCESS_$__$$_WAITONEXIT$$BOOLEAN00000000006EC200 B001    
               mov al,$0100000000006EC202 EB06                     jmp
+$06    # $00000000006EC20A
PROCESS$_$TPROCESS_$__$$_TERMINATE$LONGINT$$BOOLEAN+7400000000006EC204
0F1F4000                 nop dword ptr [rax+$00]00000000006EC208 30C0
                   xor al,al00000000006EC20A 5B                      
pop rbx00000000006EC20B C3                       ret 00000000006EC20C
0000                     add [rax],al00000000006EC20E 0000           
        add [rax],alI couldn't find quick enough a function in rtl
that has only the initial result assignment removed, where it's value
fits the size of a register. Looking at the code produced, you would
want to run the code produced for the modified version of
TProcess.Terminate, not the official code. When the Result is
ansistring the situation gets worse because the Result:=''; assignment
calls fpc_ansistr_assign. Again, you would like to use the modified
version of function TStrings.Shift: String; not the official one.
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i function
TStrings.Shift: String; begin  Result:='';  if (Count > 0) then   
begin    Result:=Strings[0];    Delete(0);   
end;end;CLASSES$_$TSTRINGS_$__$$_SHIFT$$ANSISTRING 00000000004A1D40 53
                      push rbx00000000004A1D41 4154                  
 push r1200000000004A1D43 50                       push
rax00000000004A1D44 4889FB                   mov
rbx,rdi00000000004A1D47 4989F4                   mov
r12,rsi00000000004A1D4A 4889F7                   mov
rdi,rsi00000000004A1D4D 31F6                     xor
esi,esi00000000004A1D4F E84C51F8FF               call -$0007AEB4    #
$0000000000426EA0 fpc_ansistr_assign00000000004A1D54 4889DF          
       mov rdi,rbx00000000004A1D57 488B03                   mov
rax,[rbx]00000000004A1D5A FF9008010000             call qword ptr
[rax+$00000108]00000000004A1D60 85C0                     test
eax,eax00000000004A1D62 7E1F                     jle +$1F    #
$00000000004A1D83
CLASSES$_$TSTRINGS_$__$$_SHIFT$$ANSISTRING+6700000000004A1D64 4C89E6 
                mov rsi,r1200000000004A1D67 31D2                    
xor edx,edx00000000004A1D69 4889DF                   mov
rdi,rbx00000000004A1D6C 488B03                   mov
rax,[rbx]00000000004A1D6F FF90F8000000             call qword ptr
[rax+$000000F8]00000000004A1D75 31F6                     xor
esi,esi00000000004A1D77 4889DF                   mov
rdi,rbx00000000004A1D7A 488B03                   mov
rax,[rbx]00000000004A1D7D FF9090010000             call qword ptr
[rax+$00000190]00000000004A1D83 59                       pop
rcx00000000004A1D84 415C                     pop r1200000000004A1D86
5B                       pop rbx00000000004A1D87 C3                  
   ret 00000000004A1D88 0000                     add
[rax],al00000000004A1D8A 0000                     add
[rax],al00000000004A1D8C 0000                     add
[rax],al00000000004A1D8E 0000                     add [rax],alCode:
Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i function
TStrings.Shift: String;begin  if (Count > 0) then    begin   
Result:=Strings[0];    Delete(0);    end  else   
Result:='';end; CLASSES$_$TSTRINGS_$__$$_SHIFT$$ANSISTRING
00000000004A1D40 53                       push rbx00000000004A1D41
4154                     push r1200000000004A1D43 50                 
    push rax00000000004A1D44 4889FB                   mov
rbx,rdi00000000004A1D47 4989F4                   mov
r12,rsi00000000004A1D4A 488B07                   mov
rax,[rdi]00000000004A1D4D FF9008010000             call qword ptr
[rax+$00000108]00000000004A1D53 85C0                     test
eax,eax00000000004A1D55 7E29                     jle +$29    #
$00000000004A1D80
CLASSES$_$TSTRINGS_$__$$_SHIFT$$ANSISTRING+6400000000004A1D57 4C89E6 
                mov rsi,r1200000000004A1D5A 31D2                    
xor edx,edx00000000004A1D5C 4889DF                   mov
rdi,rbx00000000004A1D5F 488B03                   mov
rax,[rbx]00000000004A1D62 FF90F8000000             call qword ptr
[rax+$000000F8]00000000004A1D68 31F6                     xor
esi,esi00000000004A1D6A 4889DF                   mov
rdi,rbx00000000004A1D6D 488B03                   mov
rax,[rbx]00000000004A1D70 FF9090010000             call qword ptr
[rax+$00000190]00000000004A1D76 EB12                     jmp +$12    #
$00000000004A1D8A
CLASSES$_$TSTRINGS_$__$$_SHIFT$$ANSISTRING+7400000000004A1D78
0F1F840000000000         nop dword ptr
[rax+rax+$00000000]00000000004A1D80 4C89E7                   mov
rdi,r1200000000004A1D83 31F6                     xor
esi,esi00000000004A1D85 E81651F8FF               call -$0007AEEA    #
$0000000000426EA0 fpc_ansistr_assign00000000004A1D8A 59              
       pop rcx00000000004A1D8B 415C                     pop
r1200000000004A1D8D 5B                       pop rbx00000000004A1D8E
C3                       ret 00000000004A1D8F 00488D                 
add [rax-$73],cl
In addition, regarding code readability, I give you two examples:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i function
TCDWidgetSet.SetFocus(hWnd: HWND): HWND;var  lObject, lOldObject:
TCDBaseControl;  lOldControl: TWinControl;  lHandle:
TCDWinControl;begin  {$ifdef VerboseCDFocus} 
DebugLn(Format('[TCDWidgetSet.SetFocus] Handle=%x', [hWnd])); 
{$endif}  Result := 0;  // Strangly this breaks the Android Virtual
Keyboard =(  // Remove the ifdef only when we can guarantee that this
doesn't break Android Virtual Keyboard  {$ifndef CD_Android}  if hwnd
= 0 then  begin    Result := GetFocus();    Exit;  end;  lObject :=
TCDBaseControl(hWnd);   // SetFocus on a child control  if lObject is
TCDWinControl then  begin    lHandle := TCDWinControl(lObject);     //
Set focus in the parent window    //Result := BackendSetFocus(hWnd);  
  if lHandle.WinControl = nil then Exit;   
CDSetFocusToControl(lHandle.WinControl, lHandle.CDControl);    
{$ifdef VerboseCDFocus}    DebugLn(Format(':[TCDWidgetSet.SetFocus]
NewFocusedControl=%s NewFocusedIntfControl=%x', [FocusedControl.Name,
PtrUInt(FocusedIntfControl)]));    {$endif}  end  // SetFocus on a
form  else  begin    Result := BackendSetFocus(hWnd);  end; 
{$endif}end;function TCDWidgetSet.SetFocus(hWnd: HWND): HWND; has
"Result := 0;" as the first line. Look at the code, if lObject is
TCDWinControl should the result be zero!? Are you sure that the
developer didn't forgot to overwrite the result value!? If the result
assignment would have been done after "if lObject is TCDWinControl" I
wouldn't have had this kind of questions. Look at the comment line
"//Result := BackendSetFocus(hWnd);" Instead of helping me, the
initial result assignment makes me feel like the function has a bug.
The second example is:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
DefaultReaderDescription(AWidth, AHeight: Integer; ADepth: Byte; out
ADesc: TRawImageDescription);begin  // Default description, assume
24bit for palettebased  // Maybe when RawImage palette is supported,
other descriptions need to be adjusted.   
ADesc.Init_BPP24_B8G8R8_M1_BIO_TTB(AWidth, AHeight);   case ADepth of 
  1: begin      ADesc.Depth := 1;      ADesc.BitsPerPixel := 1;     
ADesc.Format := ricfGray;      ADesc.LineEnd := rileWordBoundary;    
ADesc.RedPrec := 1;      ADesc.RedShift := 0;      ADesc.GreenPrec :=
1;      ADesc.GreenShift := 0;      ADesc.BluePrec := 1;     
ADesc.BlueShift := 0;    end;    2..4: begin//      ADesc.Depth :=
4;//      ADesc.BitsPerPixel := 4;    end;    5..8: begin//    
 ADesc.Depth := 8;//      ADesc.BitsPerPixel := 8;    end;    9..15:
begin      ADesc.Depth := 15;      ADesc.BitsPerPixel := 16;     
ADesc.RedPrec := 5;      ADesc.RedShift := 10;      ADesc.GreenPrec :=
5;      ADesc.GreenShift := 5;      ADesc.BluePrec := 5;     
ADesc.BlueShift := 0;    end;    16: begin      ADesc.Depth := 16;   
 ADesc.BitsPerPixel := 16;      ADesc.RedPrec := 5;     
ADesc.RedShift := 10;      ADesc.GreenPrec := 6;      ADesc.GreenShift
:= 5;      ADesc.BluePrec := 5;      ADesc.BlueShift := 0;    end;   
17..24: begin      // already default    end;  else    ADesc.Depth :=
32;    ADesc.BitsPerPixel := 32;    ADesc.AlphaPrec := 8;   
ADesc.AlphaShift := 24;  end;end;The above code has a bug. Now that
I've told you that it has a bug, even though you realize it's related
to the initial ADesc.Init_BPP24_B8G8R8_M1_BIO_TTB(AWidth, AHeight);
line, it might not be easy to fix it. How much code do you think will
be changed in that routine. I think a lot.
Regarding code readability, the above two routines point to the fact
that sometimes those default lines at the start of routines, instead
of helping, might make the code even harder to understand.

----------------------------------------------------------------------
lagprogramming · 2023-04-25 16:11

Quote from: PascalDragon on April 25, 2023, 11:58:32 amQuote from:
lagprogramming on April 25, 2023, 10:23:49 amhttps://gitlab.com/freepa
scal.org/fpc/source/-/commit/f6a8b045c2f52740186feca3d50c3211c74c775c
https://gitlab.com/freepascal.org/fpc/source/-
/commit/abb7aebaba5721512c3d16857c78781c60259e66
https://gitlab.com/freepascal.org/fpc/source/-
/commit/d7d65fe0d7b62c61f4751b896eb6ab9271d03a0cIs there a reason you
mention these commits in relation to that issue?
The first links show that even if an improvement might be considered
minor, it is welcome in the official sources. That's what can be
understood from those links.
The last link shows something totally different. A file has a couple
of functions that look alike. A patch is presented that removes a
default result assignment from a function, making the functions in the
file one step closer to converging towards a single programming
practice. The patch is refused. Don't the compiler developers want to
have, one day, the same programming practice in that file!? Don't the
compiler developers know which programming practice is better for rtl:
having functions with default result assignments as the first line or
having functions without them!? Could it be that the compiler
developers want a patch that modifies all the functions at once(if
that would be true, it would be against the understanding of the first
links, where even a space character matters).
I don't know why the patch has been rejected. Maybe the compiler
developers love diversity in that file very much. To be frank, I've
presented the patch, job done.

----------------------------------------------------------------------
PascalDragon · 2023-04-26 13:55

Quote from: lagprogramming on April 25, 2023, 06:11:33 pmQuote from:
PascalDragon on April 25, 2023, 11:58:32 amQuote from: lagprogramming
on April 25, 2023, 10:23:49 amhttps://gitlab.com/freepascal.org/fpc/so
urce/-/commit/f6a8b045c2f52740186feca3d50c3211c74c775c
https://gitlab.com/freepascal.org/fpc/source/-
/commit/abb7aebaba5721512c3d16857c78781c60259e66
https://gitlab.com/freepascal.org/fpc/source/-
/commit/d7d65fe0d7b62c61f4751b896eb6ab9271d03a0cIs there a reason you
mention these commits in relation to that issue?
The first links show that even if an improvement might be considered
minor, it is welcome in the official sources. That's what can be
understood from those links.
Fixing typos is different from fixing code. A “superfluous” Result
assignment is much less annoying to me than a typo, cause those stand
out to me like a sore spot.

Quote from: lagprogramming on April 25, 2023, 06:11:33 pmThe last link
shows something totally different. A file has a couple of functions
that look alike. A patch is presented that removes a default result
assignment from a function, making the functions in the file one step
closer to converging towards a single programming practice. The patch
is refused.
And MvC said that he prefers the way that this function uses compared
to the others.

Quote from: lagprogramming on April 25, 2023, 06:11:33 pmDon't the
compiler developers want to have, one day, the same programming
practice in that file!?
That is honestly the least of our problems.