[SOLVED] Improvement of TBinaryObjectWriter.WriteIdent
lazarus / 64-FPC development

----------------------------------------------------------------------
lagprogramming · 2023-06-21 08:24

rtl/objpas/classes/writer.inc has procedure
TBinaryObjectWriter.WriteIdent(const Ident: string);

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
TBinaryObjectWriter.WriteIdent(const Ident: string);begin  { Check if
Ident is a special identifier before trying to just write    Ident
directly }  if UpperCase(Ident) = 'NIL' then    WriteValue(vaNil) 
else if UpperCase(Ident) = 'FALSE' then    WriteValue(vaFalse)  else
if UpperCase(Ident) = 'TRUE' then    WriteValue(vaTrue)  else if
UpperCase(Ident) = 'NULL' then    WriteValue(vaNull) else  begin   
WriteValue(vaIdent);    WriteStr(Ident);  end;end; The original code
may compute multiple times UpperCase(Ident), even though Ident remains
unchanged. The patch replaces the series of ifs with a "Case
UpperCase(Ident) of".

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/classes/writer.inc b/rtl/objpas/classes/writer.incindex
93e2d23734..64536cb29f 100644--- a/rtl/objpas/classes/writer.inc+++
b/rtl/objpas/classes/writer.inc@@ -214,17 +214,12 @@ procedure
TBinaryObjectWriter.WriteDate(const Value: TDateTime);  procedure
TBinaryObjectWriter.WriteIdent(const Ident: string); begin-  { Check
if Ident is a special identifier before trying to just write-    Ident
directly }-  if UpperCase(Ident) = 'NIL' then-    WriteValue(vaNil)-
 else if UpperCase(Ident) = 'FALSE' then-    WriteValue(vaFalse)-
 else if UpperCase(Ident) = 'TRUE' then-    WriteValue(vaTrue)-  else
if UpperCase(Ident) = 'NULL' then-    WriteValue(vaNull) else-  begin+
 Case UpperCase(Ident) of+    'NIL'   : WriteValue(vaNil);+    'FALSE'
: WriteValue(vaFalse);+    'TRUE'  : WriteValue(vaTrue);+    'NULL'  :
WriteValue(vaNull);+    else     WriteValue(vaIdent);   
 WriteStr(Ident);   end;

----------------------------------------------------------------------
Josh · 2023-06-21 19:58

Hi

I thought Case with Strings was a ObjFpc only feature, not supported
in delphi etc, unless I am wrong of course

----------------------------------------------------------------------
Bart · 2023-06-21 20:45

Quote from: Josh on June 21, 2023, 09:58:37 pmI thought Case with
Strings was a ObjFpc only feature, not supported in delphi etc, unless
I am wrong of course
Yes, but why would that matter? It's source for fpc, not for Dephi.
Case of string gets translated by the compiler to multiple
if..then..else IIRC.

A simpler apporach woud be to add a temporary variable to which
UpperCase (Ident) and use that one for the comparisons.

Bart

----------------------------------------------------------------------
lagprogramming · 2023-06-22 08:17

Quote from: Bart on June 21, 2023, 10:45:13 pmQuote from: Josh on June
21, 2023, 09:58:37 pmI thought Case with Strings was a ObjFpc only
feature, not supported in delphi etc, unless I am wrong of course
Yes, but why would that matter? It's source for fpc, not for Dephi.
Case of string gets translated by the compiler to multiple
if..then..else IIRC.

A simpler apporach woud be to add a temporary variable to which
UpperCase (Ident) and use that one for the comparisons.

Bart

Using the case statement I see a single call to uppercase. Assuming I
add a new variable to store the uppercase value, do you think the
pascal code would have an increased readability with a series of if
then elses instead of a single case?
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
CLASSES$_$TBINARYOBJECTWRITER_$__$$_WRITEIDENT$ANSISTRING
00000000004B7A20 53                       push rbx00000000004B7A21
4154                     push r1200000000004B7A23 488D642488         
    lea rsp,[rsp-$78]00000000004B7A28 4889FB                   mov
rbx,rdi00000000004B7A2B 4989F4                   mov
r12,rsi00000000004B7A2E 48C744246800000000       mov qword ptr
[rsp+$68],$0000000000000000004B7A37 48C744246000000000       mov qword
ptr [rsp+$60],$0000000000000000004B7A40 4889E2                   mov
rdx,rsp00000000004B7A43 488D742418               lea
rsi,[rsp+$18]00000000004B7A48 BF01000000               mov
edi,$0000000100000000004B7A4D E84E87F7FF               call -$000878B2
   # $00000000004301A0 fpc_pushexceptaddr00000000004B7A52 4889C7     
            mov rdi,rax00000000004B7A55 E88665F6FF               call
-$00099A7A    # $000000000041DFE0 fpc_setjmp00000000004B7A5A 89442458
               mov [rsp+$58],eax00000000004B7A5E 85C0                
   test eax,eax00000000004B7A60 0F85E2000000             jnz
+$000000E2    # $00000000004B7B48 CLASSES$_$TBINARYOBJECTWRITER_$__$$_
WRITEIDENT$ANSISTRING+29600000000004B7A66 488D7C2460               lea
rdi,[rsp+$60]00000000004B7A6B E8A0F3F6FF               call -$00090C60
   # $0000000000426E10 FPC_ANSISTR_DECR_REF00000000004B7A70 488D7C2468
              lea rdi,[rsp+$68]00000000004B7A75 4C89E6               
  mov rsi,r1200000000004B7A78 E833260100               call +$00012633
   # $00000000004CA0B0
SYSUTILS_$$_UPPERCASE$ANSISTRING$$ANSISTRING00000000004B7A7D
488B742468               mov rsi,[rsp+$68]00000000004B7A82 488D7C2460
             lea rdi,[rsp+$60]00000000004B7A87 E8E4F3F6FF            
 call -$00090C1C    # $0000000000426E70
fpc_ansistr_assign00000000004B7A8C 488D357D852F00           lea
rsi,[rip+$002F857D]00000000004B7A93 488B7C2460               mov
rdi,[rsp+$60]00000000004B7A98 E8B303F7FF               call -$0008FC4D
   # $0000000000427E50 FPC_ANSISTR_COMPARE_EQUAL00000000004B7A9D
4885C0                   test rax,rax00000000004B7AA0 7516           
        jnz +$16    # $00000000004B7AB8 CLASSES$_$TBINARYOBJECTWRITER_
$__$$_WRITEIDENT$ANSISTRING+15200000000004B7AA2 BE0D000000           
  mov esi,$0000000D00000000004B7AA7 4889DF                   mov
rdi,rbx00000000004B7AAA E851080000               call +$00000851    #
$00000000004B8300 CLASSES$_$TBINARYOBJECTWRITER_$__$$_WRITEVALUE$TVALU
ETYPE00000000004B7AAF E994000000               jmp +$00000094    #
$00000000004B7B48 CLASSES$_$TBINARYOBJECTWRITER_$__$$_WRITEIDENT$ANSIS
TRING+29600000000004B7AB4 0F1F4000                 nop dword ptr
[rax+$00]00000000004B7AB8 488D3521852F00           lea
rsi,[rip+$002F8521]00000000004B7ABF 488B7C2460               mov
rdi,[rsp+$60]00000000004B7AC4 E88703F7FF               call -$0008FC79
   # $0000000000427E50 FPC_ANSISTR_COMPARE_EQUAL00000000004B7AC9
4885C0                   test rax,rax00000000004B7ACC 7512           
        jnz +$12    # $00000000004B7AE0 CLASSES$_$TBINARYOBJECTWRITER_
$__$$_WRITEIDENT$ANSISTRING+19200000000004B7ACE BE08000000           
  mov esi,$0000000800000000004B7AD3 4889DF                   mov
rdi,rbx00000000004B7AD6 E825080000               call +$00000825    #
$00000000004B8300 CLASSES$_$TBINARYOBJECTWRITER_$__$$_WRITEVALUE$TVALU
ETYPE00000000004B7ADB E968000000               jmp +$00000068    #
$00000000004B7B48 CLASSES$_$TBINARYOBJECTWRITER_$__$$_WRITEIDENT$ANSIS
TRING+29600000000004B7AE0 488D3511852F00           lea
rsi,[rip+$002F8511]00000000004B7AE7 488B7C2460               mov
rdi,[rsp+$60]00000000004B7AEC E85F03F7FF               call -$0008FCA1
   # $0000000000427E50 FPC_ANSISTR_COMPARE_EQUAL00000000004B7AF1
4885C0                   test rax,rax00000000004B7AF4 7512           
        jnz +$12    # $00000000004B7B08 CLASSES$_$TBINARYOBJECTWRITER_
$__$$_WRITEIDENT$ANSISTRING+23200000000004B7AF6 BE09000000           
  mov esi,$0000000900000000004B7AFB 4889DF                   mov
rdi,rbx00000000004B7AFE E8FD070000               call +$000007FD    #
$00000000004B8300 CLASSES$_$TBINARYOBJECTWRITER_$__$$_WRITEVALUE$TVALU
ETYPE00000000004B7B03 EB43                     jmp +$43    #
$00000000004B7B48 CLASSES$_$TBINARYOBJECTWRITER_$__$$_WRITEIDENT$ANSIS
TRING+29600000000004B7B05 0F1F00                   nop dword ptr
[rax]00000000004B7B08 488D35B9842F00           lea
rsi,[rip+$002F84B9]00000000004B7B0F 488B7C2460               mov
rdi,[rsp+$60]00000000004B7B14 E83703F7FF               call -$0008FCC9
   # $0000000000427E50 FPC_ANSISTR_COMPARE_EQUAL00000000004B7B19
4885C0                   test rax,rax00000000004B7B1C 7512           
        jnz +$12    # $00000000004B7B30 CLASSES$_$TBINARYOBJECTWRITER_
$__$$_WRITEIDENT$ANSISTRING+27200000000004B7B1E 31F6                 
  xor esi,esi00000000004B7B20 4889DF                   mov
rdi,rbx00000000004B7B23 E8D8070000               call +$000007D8    #
$00000000004B8300 CLASSES$_$TBINARYOBJECTWRITER_$__$$_WRITEVALUE$TVALU
ETYPE00000000004B7B28 EB1E                     jmp +$1E    #
$00000000004B7B48 CLASSES$_$TBINARYOBJECTWRITER_$__$$_WRITEIDENT$ANSIS
TRING+29600000000004B7B2A 660F1F440000             nop word ptr
[rax+rax+$00]00000000004B7B30 BE07000000               mov
esi,$0000000700000000004B7B35 4889DF                   mov
rdi,rbx00000000004B7B38 E8C3070000               call +$000007C3    #
$00000000004B8300 CLASSES$_$TBINARYOBJECTWRITER_$__$$_WRITEVALUE$TVALU
ETYPE00000000004B7B3D 4C89E6                   mov
rsi,r1200000000004B7B40 4889DF                   mov
rdi,rbx00000000004B7B43 E8D8070000               call +$000007D8    #
$00000000004B8320 CLASSES$_$TBINARYOBJECTWRITER_$__$$_WRITESTR$ANSISTR
ING00000000004B7B48 E89389F7FF               call -$0008766D    #
$00000000004304E0 fpc_popaddrstack00000000004B7B4D 488D7C2468        
     lea rdi,[rsp+$68]00000000004B7B52 E8B9F2F6FF               call
-$00090D47    # $0000000000426E10 FPC_ANSISTR_DECR_REF00000000004B7B57
488D7C2460               lea rdi,[rsp+$60]00000000004B7B5C E8AFF2F6FF
             call -$00090D51    # $0000000000426E10
FPC_ANSISTR_DECR_REF00000000004B7B61 837C245800               cmp
dword ptr [rsp+$58],$0000000000004B7B66 740F                     jz
+$0F    # $00000000004B7B77 CLASSES$_$TBINARYOBJECTWRITER_$__$$_WRITEI
DENT$ANSISTRING+34300000000004B7B68 E8238BF7FF               call
-$000874DD    # $0000000000430690 FPC_RERAISE00000000004B7B6D
C744245800000000         mov [rsp+$58],$0000000000000000004B7B75 EBD1
                   jmp -$2F    # $00000000004B7B48 CLASSES$_$TBINARYOB
JECTWRITER_$__$$_WRITEIDENT$ANSISTRING+29600000000004B7B77 488D642478
             lea rsp,[rsp+$78]00000000004B7B7C 415C                  
 pop r1200000000004B7B7E 5B                       pop
rbx00000000004B7B7F C3                       ret

----------------------------------------------------------------------
Josh · 2023-06-22 08:50

Personally i prefer the existing (mainly because I dont use Case
Statements with Strings, i use if then else so its naturally readable
to me, others will disagree  ). but adding a temp var for optimize
speed would be fine.

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
TBinaryObjectWriter.WriteIdent(const Ident: string);var
TempIdent:String;begin  { Check if Ident is a special identifier
before trying to just write    Ident directly } 
TempIdent:=UpperCase(Ident);  if TempIdent = 'NIL' then    
WriteValue(vaNil)  else if TempIdent = 'FALSE' then   
WriteValue(vaFalse)  else if TempIdent = 'TRUE' then   
WriteValue(vaTrue)  else if TempIdent = 'NULL' then   
WriteValue(vaNull)   else  begin    WriteValue(vaIdent);   
WriteStr(Ident);  end;end;      
for readability curious as to why your removing the comment.
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 -  { Check
if Ident is a special identifier before trying to just write-    Ident
directly }

----------------------------------------------------------------------
lagprogramming · 2023-06-22 10:28

Quote from: Josh on June 22, 2023, 10:50:11 amfor readability curious
as to why your removing the comment.
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 -  { Check
if Ident is a special identifier before trying to just write-    Ident
directly }
When I removed it I was thinking that the comment makes sense only in
the presence of the if then else series, not in the presence of a case
statement. The presence of the case statement would imply the contents
of the existing comment because that's how the case statements work.

----------------------------------------------------------------------
Josh · 2023-06-22 10:45

I find the purpose of the comment is to explain what the following
code does; without having to analyze the code to work out what its
doing.

----------------------------------------------------------------------
Thaddy · 2023-06-22 10:56

The case statement with strings is actually translated by the compiler
into if then else.
Also note the introductary notes about this "feature". Any way you see
it, case with string introduces an indirection.
There was quite a discussion on the development forum about this too.

----------------------------------------------------------------------
AlexTP · 2023-06-29 19:33

Posted to https://gitlab.com/freepascal.org/fpc/source/-/issues/40334

----------------------------------------------------------------------
Stefan Glienke · 2023-07-04 09:33

Anyone who fancies compiler optimization might want to look into
switch lowering - see https://www.youtube.com/watch?v=gMqSinyL8uk