[fpc-pascal] Generic type conflicts

Thu Nov 7 08:58:07 CET 2019

Am 07.11.2019 um 01:42 schrieb Ben Grasset via fpc-pascal:
> On Wed, Nov 6, 2019 at 7:33 PM Ben Grasset <operator97 at gmail.com 
> <mailto:operator97 at gmail.com>> wrote:
>
>     Encouraging typecasting (which cares only about the sizes of the
>     types involved, nothing else) at the programmer level is far more
>     error-prone in a variety of ways.
>
>
> Also: it's slower in many cases, because it tends to involve "if" 
> statements that *remain* as if statements in the final generated 
> assembly code, whereas a static check would allow for simply 
> generating *only* the code for the path that's actually taken.
This is not true. If the compiler can prove at compile time that the 
if-condition is constant then the branch that is not taken is removed at 
the node level. It doesn't even remotely reach the code generation 
phase. (I just checked that yesterday when I implemented IsManagedType() 
and wondered about missing "unreachable code" warnings).

Take a look at the test for IsManagedType():

=== code begin ===

program tismngd1;

{$mode objfpc}
{$modeswitch advancedrecords}

uses
   TypInfo;

var
   gError: LongInt = 0;

function NextErrorCode: LongInt; inline;
begin
   Inc(gError);
   Result := gError;
end;

generic procedure TestType<T>(aIsMngd: Boolean); inline;
begin
   if IsManagedType(T) <> aIsMngd then begin
     Writeln('IsManagedType(', PTypeInfo(TypeInfo(T))^.Name, ') failure; 
expected: ', aIsMngd, ', got: ', IsManagedType(T));
     Halt(NextErrorCode);
   end;
   NextErrorCode;
end;

type
   TTestLongInt = record
     a: LongInt;
   end;

   TTestAnsiString = record
     a: AnsiString;
   end;

   TTestManaged = record
     a: LongInt;
     class operator Initialize(var aTestManaged: TTestManaged);
   end;

   TTestObj = object
     a: LongInt;
   end;

   TTestObjAnsiString = object
     a: AnsiString;
   end;

class operator TTestManaged.Initialize(var aTestManaged: TTestManaged);
begin
   aTestManaged.a := 42;
end;

type
   TProcVar = procedure;
   TMethodVar = procedure of object;

   TDynArrayLongInt = array of LongInt;
   TStaticArrayLongInt = array[0..4] of LongInt;
   TStaticArrayAnsiString = array[0..4] of AnsiString;

   TEnum = (eOne, eTwo, eThree);
   TSet = set of (sOne, sTwo, sThree);

begin
   specialize TestType<LongInt>(False);
   specialize TestType<Boolean>(False);
   specialize TestType<ShortString>(False);
   specialize TestType<AnsiString>(True);
   specialize TestType<UnicodeString>(True);
   specialize TestType<WideString>(True);
   specialize TestType<Single>(False);
   specialize TestType<TProcVar>(False);
   specialize TestType<TMethodVar>(False);
   specialize TestType<Pointer>(False);
   specialize TestType<IInterface>(True);
   specialize TestType<TObject>(False);
   specialize TestType<TTestLongInt>(False);
   specialize TestType<TTestAnsiString>(True);
   specialize TestType<TTestManaged>(True);
   specialize TestType<TTestObj>(False);
   specialize TestType<TTestObjAnsiString>(True);
   specialize TestType<TDynArrayLongInt>(True);
   specialize TestType<TStaticArrayLongInt>(False);
   specialize TestType<TStaticArrayAnsiString>(True);
   specialize TestType<TEnum>(False);
   specialize TestType<TSet>(False);
   Writeln('Ok');
end.

=== code end ===

Thanks to the node level optimization I mentioned the assembly code of 
the main function will look like this (in this case x86_64-win64):

=== code begin ===

.section .text.n_main,"ax"
     .balign 16,0x90
.globl    main
main:
.globl    PASCALMAIN
PASCALMAIN:
.Lc122:
.Lc123:
# Temps allocated between rbp-8 and rbp+0
.seh_proc main
# [62] begin
     pushq    %rbp
.seh_pushreg %rbp
.Lc124:
.Lc125:
     movq    %rsp,%rbp
.Lc126:
     leaq    -48(%rsp),%rsp
.seh_stackalloc 48
     movq    %rbx,-8(%rbp)
.seh_savereg %rbx, 40
.seh_endprologue
     call    fpc_initializeunits
# [63] specialize TestType<LongInt>(False);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [64] specialize TestType<Boolean>(False);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [65] specialize TestType<ShortString>(False);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [66] specialize TestType<AnsiString>(True);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [67] specialize TestType<UnicodeString>(True);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [68] specialize TestType<WideString>(True);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [69] specialize TestType<Single>(False);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [70] specialize TestType<TProcVar>(False);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [71] specialize TestType<TMethodVar>(False);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [72] specialize TestType<Pointer>(False);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [73] specialize TestType<IInterface>(True);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [74] specialize TestType<TObject>(False);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [75] specialize TestType<TTestLongInt>(False);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [76] specialize TestType<TTestAnsiString>(True);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [77] specialize TestType<TTestManaged>(True);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [78] specialize TestType<TTestObj>(False);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [79] specialize TestType<TTestObjAnsiString>(True);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [80] specialize TestType<TDynArrayLongInt>(True);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [81] specialize TestType<TStaticArrayLongInt>(False);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [82] specialize TestType<TStaticArrayAnsiString>(True);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [83] specialize TestType<TEnum>(False);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [84] specialize TestType<TSet>(False);
     addl    $1,TC_$P$TISMNGD1_$$_GERROR(%rip)
     movl    TC_$P$TISMNGD1_$$_GERROR(%rip),%eax
# [85] Writeln('Ok');
     call    fpc_get_output
     movq    %rax,%rbx
     leaq    _$TISMNGD1$_Ld3(%rip),%r8
     movq    %rbx,%rdx
     movl    $0,%ecx
     call    fpc_write_text_shortstr
     call    fpc_iocheck
     movq    %rbx,%rcx
     call    fpc_writeln_end
     call    fpc_iocheck
# [86] end.
     call    fpc_do_exit
     movq    -8(%rbp),%rbx
     leaq    (%rbp),%rsp
     popq    %rbp
     ret
.seh_endproc
.Lc121:

=== code end ===

As you can see the compiler basically optimized everything except the 
increment of the gError variable away, because it determined it can do 
so. And this was *without* any explicit optimizations enabled.

Regards,
Sven
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20191107/d7d99fb9/attachment-0001.html>