Recent

Author Topic: [SOLVED] Getting size of a value in an Generic method  (Read 892 times)

PascalDragon

  • Hero Member
  • *****
  • Posts: 2405
  • Compiler Developer
Re: Getting size of a value in an Generic method
« Reply #15 on: November 21, 2020, 05:40:55 pm »
What's wrong with using OVERLOADS ?

You need to write it correctly only once.

Those generics will recreate a complete block of that code per type;

They won't generate the complete code. Due to GetTypeKind being a compiler intrinsic the compiler can optimize this to only include the branches needed:

Code: ASM  [Select][+][-]
  1. .section .text.n_p$tgenfunc_$$_any2hex$1$crc6824777a$ansistring$$ansistring,"x"
  2.         .balign 16,0x90
  3. P$TGENFUNC_$$_ANY2HEX$1$CRC6824777A$ANSISTRING$$ANSISTRING:
  4. .Lc6:
  5. .seh_proc P$TGENFUNC_$$_ANY2HEX$1$CRC6824777A$ANSISTRING$$ANSISTRING
  6. # [17] begin
  7.         pushq   %rbp
  8. .seh_pushreg %rbp
  9. .Lc8:
  10. .Lc9:
  11.         movq    %rsp,%rbp
  12. .Lc10:
  13.         leaq    -64(%rsp),%rsp
  14. .seh_stackalloc 64
  15. .seh_endprologue
  16. # Var a located at rbp-8, size=OS_64
  17. # Var $result located at rbp-16, size=OS_64
  18. # Var p located at rbp-24, size=OS_64
  19. # Var Len located at rbp-32, size=OS_S64
  20.         movq    %rcx,-16(%rbp)
  21.         movq    %rdx,-8(%rbp)
  22. # [18] p := @a;
  23.         leaq    -8(%rbp),%rax
  24.         movq    %rax,-24(%rbp)
  25. # [26] Len := SizeOf(a);
  26.         movq    $8,-32(%rbp)
  27. # [28] System.SetLength(Result, Len*2);
  28.         movq    -32(%rbp),%rdx
  29.         shlq    $1,%rdx
  30.         movq    -16(%rbp),%rcx
  31.         movl    $0,%r8d
  32.         call    fpc_ansistr_setlength
  33. # [34] BinToHex(p, PChar(Result), Len);
  34.         movq    -16(%rbp),%rax
  35.         movq    (%rax),%rdx
  36.         testq   %rdx,%rdx
  37.         jne     .Lj9
  38.         leaq    FPC_EMPTYCHAR(%rip),%rdx
  39. .Lj9:
  40.         movq    -32(%rbp),%r8
  41.         movq    -24(%rbp),%rcx
  42.         call    P$TGENFUNC_$$_BINTOHEX$POINTER$PCHAR$INT64
  43. # [36] end;
  44.         nop
  45.         leaq    (%rbp),%rsp
  46.         popq    %rbp
  47.         ret
  48. .seh_endproc
  49. .Lc7:
  50.  
  51. .section .text.n_p$tgenfunc_$$_any2hex$1$crc9f312717$longint$$ansistring,"x"
  52.         .balign 16,0x90
  53. P$TGENFUNC_$$_ANY2HEX$1$CRC9F312717$LONGINT$$ANSISTRING:
  54. .Lc11:
  55. .seh_proc P$TGENFUNC_$$_ANY2HEX$1$CRC9F312717$LONGINT$$ANSISTRING
  56.         pushq   %rbp
  57. .seh_pushreg %rbp
  58. .Lc13:
  59. .Lc14:
  60.         movq    %rsp,%rbp
  61. .Lc15:
  62.         leaq    -64(%rsp),%rsp
  63. .seh_stackalloc 64
  64. .seh_endprologue
  65. # Var a located at rbp-8, size=OS_S32
  66. # Var $result located at rbp-16, size=OS_64
  67. # Var p located at rbp-24, size=OS_64
  68. # Var Len located at rbp-32, size=OS_S64
  69.         movq    %rcx,-16(%rbp)
  70.         movl    %edx,-8(%rbp)
  71.         leaq    -8(%rbp),%rax
  72.         movq    %rax,-24(%rbp)
  73.         movq    $4,-32(%rbp)
  74.         movq    -32(%rbp),%rdx
  75.         shlq    $1,%rdx
  76.         movq    -16(%rbp),%rcx
  77.         movl    $0,%r8d
  78.         call    fpc_ansistr_setlength
  79.         movq    -16(%rbp),%rax
  80.         movq    (%rax),%rdx
  81.         testq   %rdx,%rdx
  82.         jne     .Lj12
  83.         leaq    FPC_EMPTYCHAR(%rip),%rdx
  84. .Lj12:
  85.         movq    -32(%rbp),%r8
  86.         movq    -24(%rbp),%rcx
  87.         call    P$TGENFUNC_$$_BINTOHEX$POINTER$PCHAR$INT64
  88.         nop
  89.         leaq    (%rbp),%rsp
  90.         popq    %rbp
  91.         ret
  92. .seh_endproc
  93. .Lc12:
  94.  

The first part is for specialize Any2Hex<AnsiString>, the second for specialize Any2Hex<LongInt>.

What is true however is that the compiler will currently create this in each unit where they are specialized even if they are specialized with the same parameters. I hope to improve this in the future to avoid unnecessary duplicates (same is true for generic types as well, though there the compiler already has the potential to pick up an already existing type, e.g. if it's specialized in the interface section of some common unit).

ASerge

  • Hero Member
  • *****
  • Posts: 1693
Re: Getting size of a value in an Generic method
« Reply #16 on: November 22, 2020, 09:19:44 am »
By the way, the original version is incorrect.
Here's an improved(?) version:
I think it also needs to be improved. Read from Generics.Default unit "tkLString - only internal use / deprecated in compiler". And the test shows that this is true: for long strings, you need to use tkAString. Here is an example with corrections:
Code: Pascal  [Select][+][-]
  1. {$MODE OBJFPC}
  2. {$LONGSTRINGS ON}
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses Classes, SysUtils, TypInfo;
  6.  
  7. generic function Any2Hex<T>(const AValue: T): string;
  8. var
  9.   P: Pointer;
  10.   Len: SizeInt;
  11. begin
  12.   P := @AValue;
  13.   case GetTypeKind(AValue) of
  14.     tkAString: Len := Length(PAnsiString(P)^); // AnsiString
  15.     tkLString: Len := Length(PAnsiString(P)^); // Not used
  16.     tkSString: Len := Length(PShortString(P)^);
  17.     tkUString: Len := ByteLength(PUnicodeString(P)^);
  18.     tkWString: Len := ByteLength(PWideString(P)^);
  19.     tkDynArray: Len := DynArraySize(Pointer(P^)) * GetTypeData(TypeInfo(AValue))^.elSize;
  20.   else
  21.     Len := SizeOf(AValue);
  22.   end;
  23.   SetLength(Result, Len * 2);
  24.   case GetTypeKind(AValue) of
  25.     tkSString: BinToHex(@PShortString(P)^[1], Pointer(Result), Len);
  26.     tkAString, tkLString, tkUString, tkWString, tkDynArray:
  27.       BinToHex(Pointer(P^), Pointer(Result), Len);
  28.   else
  29.     BinToHex(P, Pointer(Result), Len);
  30.   end;
  31. end;
  32.  
  33. procedure Test;
  34. var
  35.   S: AnsiString;
  36.  
  37.   procedure Print(const What: string);
  38.   begin
  39.     Writeln(What:15, ': ', S);
  40.   end;
  41.  
  42. const
  43.   C = 'Test';
  44. var
  45.   U: UnicodeString;
  46.   W: WideString;
  47.   SS: ShortString;
  48. begin
  49.   S := specialize Any2Hex<AnsiString>(C);
  50.   Print('AnsiString');
  51.   U := C;
  52.   S := specialize Any2Hex<UnicodeString>(U);
  53.   Print('UnicodeString');
  54.   W := C;
  55.   S := specialize Any2Hex<WideString>(W);
  56.   Print('WideString');
  57.   SS := C;
  58.   S := specialize Any2Hex<ShortString>(SS);
  59.   Print('ShortString');
  60.   S := specialize Any2Hex<Byte>(123);
  61.   Print('Byte');
  62.   S := specialize Any2Hex<LongInt>(123);
  63.   Print('LongInt');
  64.   S := specialize Any2Hex<QWord>(123);
  65.   Print('QWord');
  66. end;
  67.  
  68. begin
  69.   Test;
  70.   Readln;
  71. end.

avk

  • Sr. Member
  • ****
  • Posts: 324
    • my self-education project
Re: Getting size of a value in an Generic method
« Reply #17 on: November 22, 2020, 09:45:11 am »
Yes, thanks, you are right.

OkobaPatino

  • Full Member
  • ***
  • Posts: 165
Re: Getting size of a value in an Generic method
« Reply #18 on: November 22, 2020, 10:48:04 am »
Thanks avk and ASerge.
So there is no built-in function for such a case, but reviewing it again seems wise to make a generic function and handle each type accordingly. It won't be effortless, especially for managed types like managed records, but it probably will be worth trying as using it will be easy and straight.

Warfley

  • Sr. Member
  • ****
  • Posts: 323
Re: [SOLVED] Getting size of a value in an Generic method
« Reply #19 on: November 22, 2020, 06:12:29 pm »
Does this code really do what you want to do?

What about the following type:
Code: Pascal  [Select][+][-]
  1. type
  2.   TTestRec = record
  3.     A: Integer;
  4.     B: String;
  5.   end;

As B is a string, you can have two records with the same string and integer value, but a different string pointer (i.e. different string location, same content), and you function would result in different encodings.
Your function only works on base types, as any composite type might have it's own semantics, this only works on them if they only consist of atomic types or composites of atomic types. It does also not work on classes and pointers.
So my question is, do you want to support any type? In this case your function does not what you want it to do. Or do you want to support only base types, in this case, why build the function in a way that it accepts any type? Don't you want your compiler to fail if that function is used with a type it does not support? I for myself rather have the compiler fail if I do something that is not allowed rather than having it accept and just produce inconsistent results

You have the problem that as soon as the user defines a custom type, your function does not work anymore. There are a few options, the first one would be to simply overload that function for all known types, and if the user wants to use it for a new, custom type, he has to overload it himself. The other option would be to parameterize this function, e.g. with another function that can turn a variable into a byte stream, which you can then encode. The default value for that parameter could then be the thing you just built, but the important part is, that the user can use a different parameter for his custom types.
« Last Edit: November 22, 2020, 06:14:16 pm by Warfley »

PascalDragon

  • Hero Member
  • *****
  • Posts: 2405
  • Compiler Developer
Re: [SOLVED] Getting size of a value in an Generic method
« Reply #20 on: November 22, 2020, 06:19:17 pm »
What about the following type:
Code: Pascal  [Select][+][-]
  1. type
  2.   TTestRec = record
  3.     A: Integer;
  4.     B: String;
  5.   end;

A record can be covered with a branch of the case-statement that then uses RTTI to print each element of the record.

Warfley

  • Sr. Member
  • ****
  • Posts: 323
Re: [SOLVED] Getting size of a value in an Generic method
« Reply #21 on: November 22, 2020, 06:23:34 pm »
A record can be covered with a branch of the case-statement that then uses RTTI to print each element of the record.
Does RTTI work on normal record fields? I thought it only works on published fields of classes.

OkobaPatino

  • Full Member
  • ***
  • Posts: 165
Re: [SOLVED] Getting size of a value in an Generic method
« Reply #22 on: November 22, 2020, 06:33:39 pm »
Published for classes. It supports records pretty nicely. And sure it will need more work to be bulletproof for every use case.

PascalDragon

  • Hero Member
  • *****
  • Posts: 2405
  • Compiler Developer
Re: [SOLVED] Getting size of a value in an Generic method
« Reply #23 on: November 22, 2020, 06:45:31 pm »
A record can be covered with a branch of the case-statement that then uses RTTI to print each element of the record.
Does RTTI work on normal record fields? I thought it only works on published fields of classes.
Yes, the RTTI provides access to all fields (type and offset) for a long time already (at least in FPC, in Delphi only fields of managed types are available).

Warfley

  • Sr. Member
  • ****
  • Posts: 323
Re: [SOLVED] Getting size of a value in an Generic method
« Reply #24 on: November 22, 2020, 09:58:16 pm »
So I got a little bit nerdsniped with this problem, so I built a few streaming classes that allow for this purpose:
Code: Pascal  [Select][+][-]
  1. unit Bitstreams;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Math, TypInfo, Generics.Collections;
  9.  
  10. type
  11.   EUnsupportedTypeException = class(Exception);
  12.  
  13.   TStreamList = class(specialize TObjectList<TStream>);
  14.  
  15.   { TMemoryBitstream }
  16.  
  17.   TMemoryBitstream = class(TStream)
  18.   private
  19.     FData: PByte;
  20.     FPosition: SizeInt;
  21.     FSize: SizeInt;
  22.   protected
  23.     function GetSize: int64; override;
  24.     function GetPosition: int64; override;
  25.   public
  26.     constructor Create(const AData: Pointer; ASize: SizeInt);
  27.     function Read(var Buffer; Count: longint): longint; override; overload;
  28.     function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
  29.       overload;
  30.     function Seek(Offset: longint; Origin: word): longint; override; overload;
  31.   end;
  32.  
  33.   { TCompositeBitstream }
  34.  
  35.   TCompositeBitstream = class(TStream)
  36.   private
  37.     FElementStreams: TStreamList;
  38.     FPosition: SizeInt;
  39.     FSize: SizeInt;
  40.     FCurrentElement: SizeInt;
  41.  
  42.     procedure SeekForward(Offset: SizeInt);
  43.     procedure SeekBackward(Offset: SizeInt);
  44.   protected
  45.     function GetSize: int64; override;
  46.     function GetPosition: int64; override;
  47.   public
  48.     constructor Create(Substreams: TStreamList; ownsObjects: Boolean=True);
  49.     function Read(var Buffer; Count: longint): longint; override; overload;
  50.     function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
  51.       overload;
  52.     function Seek(Offset: longint; Origin: word): longint; override; overload;
  53.  
  54.     destructor Destroy; override;
  55.   end;
  56.  
  57.   { TArrayBitstream }
  58.  
  59.   TArrayBitstream = class(TCompositeBitstream)
  60.   public
  61.     constructor Create(const AData: Pointer; AElementType: PTypeInfo; ACount: SizeInt);
  62.   end;
  63.  
  64.   { TRecordBitstream }
  65.  
  66.   TRecordBitstream = class(TCompositeBitstream)
  67.   public
  68.     constructor Create(const AData: Pointer; ATypeInfo: PTypeInfo);
  69.   end;
  70.  
  71. function RTTIBitStream(AData: Pointer; ATypeInfo: PTypeInfo; DataSize: SizeInt): TStream;
  72.  
  73. implementation
  74.  
  75. function FloatSize(AFloatType: TFloatType): SizeInt; inline;
  76. begin
  77.   case AFloatType of
  78.     ftSingle: Result := SizeOf(single);
  79.     ftDouble: Result := SizeOf(double);
  80.     ftExtended: Result := SizeOf(extended);
  81.     ftComp: Result := SizeOf(comp);
  82.     ftCurr: Result := SizeOf(currency);
  83.   end;
  84. end;
  85.  
  86. function RTTITypeSize(AInfo: PTypeInfo): SizeInt;
  87. var
  88.   OrdType: TOrdType;
  89. begin
  90.   case AInfo^.Kind of
  91.     tkInterface,
  92.     tkInterfaceRaw,
  93.     tkDynArray,
  94.     tkClass,
  95.     tkHelper,
  96.     tkLString,
  97.     tkAString,
  98.     tkWString,
  99.     tkUString,
  100.     tkProcVar,
  101.     tkClassRef,
  102.     tkPointer:
  103.       Result := SizeOf(Pointer);
  104.     tkChar, tkBool:
  105.       Result := SizeOf(char);
  106.     tkWChar, tkUChar:
  107.       Result := SizeOf(widechar);
  108.     tkSet,
  109.     tkEnumeration,
  110.     tkInteger:
  111.     begin
  112.       OrdType := GetTypeData(AInfo)^.OrdType;
  113.       case OrdType of
  114.         otSByte, otUByte: Result := SizeOf(byte);
  115.         otSWord, otUWord: Result := SizeOf(word);
  116.         else
  117.           Result := SizeOf(integer);
  118.       end;
  119.     end;
  120.     tkInt64, tkQword:
  121.       Result := SizeOf(int64);
  122.     tkFloat: FloatSize(GetTypeData(AInfo)^.FloatType);
  123.     tkMethod: Result := SizeOf(TMethod);
  124.     tkSString: Result := SizeOf(ShortString);
  125.     tkVariant: Result := SizeOf(variant);
  126.     tkArray: Result := GetTypeData(AInfo)^.ArrayData.Size;
  127.     tkRecord, tkObject: Result := GetTypeData(AInfo)^.RecSize;
  128.     tkFile: Result := SizeOf(TFileRec);
  129.     else
  130.       raise EUnsupportedTypeException.Create('Type not supported: ' + AInfo^.Name);
  131.   end;
  132. end;
  133.  
  134. function AnsiStringStream(AData: PAnsiString): TStream; inline;
  135. begin
  136.   Result := TMemoryBitstream.Create(Pointer(AData^), Length(AData^));
  137. end;
  138.  
  139. function ShortStringStream(AData: PShortString): TStream; inline;
  140. begin
  141.   Result := TMemoryBitstream.Create(Pointer(AData), Length(AData^));
  142. end;
  143.  
  144. function WideStringStream(AData: PWideString): TStream; inline;
  145. begin
  146.   Result := TMemoryBitstream.Create(Pointer(AData^), Length(AData^) * SizeOf(widechar));
  147. end;
  148.  
  149. function ArrayStream(AData: Pointer; ATypeInfo: PTypeInfo): TStream; inline;
  150. var
  151.   TypeData: PTypeData;
  152. begin
  153.   TypeData := GetTypeData(ATypeInfo);
  154.   Result := TArrayBitstream.Create(AData, TypeData^.ArrayData.ElType,
  155.     TypeData^.ArrayData.ElCount);
  156. end;
  157.  
  158. function DynArrayStream(AData: PPointer; ATypeInfo: PTypeInfo): TStream; inline;
  159. var
  160.   TypeData: PTypeData;
  161. begin
  162.   TypeData := GetTypeData(ATypeInfo);
  163.   Result := TArrayBitstream.Create(AData^, TypeData^.ElType, DynArraySize(AData^));
  164. end;
  165.  
  166. function RTTIBitStream(AData: Pointer; ATypeInfo: PTypeInfo; DataSize: SizeInt): TStream;
  167. begin
  168.   case ATypeInfo^.Kind of
  169.     tkSString: Result := ShortStringStream(AData);
  170.     tkLString,
  171.     tkAString: Result := AnsiStringStream(AData);
  172.     tkWString,
  173.     tkUString: Result := WideStringStream(AData);
  174.     tkRecord: Result := TRecordBitstream.Create(AData, ATypeInfo);
  175.     tkArray: Result := ArrayStream(AData, ATypeInfo);
  176.     tkDynArray: Result := DynArrayStream(AData, ATypeInfo);
  177.     tkObject, tkHelper, tkFile, tkClassRef, tkPointer, tkInterface, tkClass, tkInterfaceRaw:
  178.       raise EUnsupportedTypeException.Create('Type not supported: ' + ATypeInfo^.Name);
  179.     else
  180.       Result := TMemoryBitstream.Create(AData, DataSize);
  181.   end;
  182. end;
  183.  
  184. { TRecordBitstream }
  185.  
  186. constructor TRecordBitstream.Create(const AData: Pointer; ATypeInfo: PTypeInfo);
  187. var
  188.   TypeData: PTypeData;
  189.   i: Integer;
  190.   EStreams: TStreamList;
  191.   FieldArray: PManagedField;
  192.   FieldData: Pointer;
  193.   FieldType: PTypeInfo;
  194.   FieldSize: SizeInt;
  195. begin
  196.   TypeData := GetTypeData(ATypeInfo);
  197.   EStreams := TStreamList.Create(False);
  198.   try
  199.     FieldArray := @(TypeData^.TotalFieldCount) + SizeOf(TypeData^.TotalFieldCount);
  200.     for i:=0 to TypeData^.TotalFieldCount-1 do
  201.     begin
  202.       FieldData := AData + FieldArray[i].FldOffset;
  203.       FieldType := FieldArray[i].TypeRef;
  204.       FieldSize := RTTITypeSize(FieldType);
  205.       EStreams.Add(RTTIBitStream(FieldData, FieldType, FieldSize));
  206.     end;
  207.     inherited Create(EStreams);
  208.   finally
  209.     EStreams.Free;
  210.   end;
  211. end;
  212.  
  213. { TArrayBitstream }
  214.  
  215. constructor TArrayBitstream.Create(const AData: Pointer;
  216.   AElementType: PTypeInfo; ACount: SizeInt);
  217. var
  218.   EStreams: TStreamList;
  219.   i, ElemSize: SizeInt;
  220. begin
  221.   ElemSize := RTTITypeSize(AElementType);
  222.   EStreams := TStreamList.Create(False);
  223.   try
  224.     for i:=0 to ACount-1 do
  225.       EStreams.Add(RTTIBitStream(AData + ElemSize*i, AElementType, ElemSize));
  226.     inherited Create(EStreams);
  227.   finally
  228.     EStreams.Free;
  229.   end;
  230. end;
  231.  
  232. { TCompositeBitstream }
  233.  
  234. procedure TCompositeBitstream.SeekForward(Offset: SizeInt);
  235. var
  236.   CurrStream: TStream;
  237.   streamMove: SizeInt;
  238. begin
  239.   while (Offset > 0) and (FPosition < FSize) do
  240.   begin
  241.     Currstream := FElementStreams[FCurrentElement];
  242.     if CurrStream.Position >= CurrStream.Size then
  243.     begin
  244.       inc(FCurrentElement);
  245.       Continue;
  246.     end;
  247.     streamMove := Min(Offset, CurrStream.Size - CurrStream.Position);
  248.     CurrStream.Seek(streamMove, soCurrent);
  249.     FPosition += streamMove;
  250.     Offset -= streamMove;
  251.   end;
  252. end;
  253.  
  254. procedure TCompositeBitstream.SeekBackward(Offset: SizeInt);
  255. var
  256.   CurrStream: TStream;
  257.   streamMove: SizeInt;
  258. begin
  259.   while (Offset > 0) and (FPosition > 0) do
  260.   begin
  261.     Currstream := FElementStreams[FCurrentElement];
  262.     if CurrStream.Position <= 0 then
  263.     begin
  264.       Dec(FCurrentElement);
  265.       Continue;
  266.     end;
  267.     streamMove := Min(Offset, CurrStream.Position);
  268.     CurrStream.Seek(streamMove*-1, soCurrent);
  269.     FPosition -= streamMove;
  270.     Offset -= streamMove;
  271.   end;
  272. end;
  273.  
  274. function TCompositeBitstream.GetSize: int64;
  275. begin
  276.   Result := FSize;
  277. end;
  278.  
  279. function TCompositeBitstream.GetPosition: int64;
  280. begin
  281.   Result := FPosition;
  282. end;
  283.  
  284. constructor TCompositeBitstream.Create(Substreams: TStreamList;
  285.   ownsObjects: Boolean);
  286. var
  287.   EStream: TStream;
  288. begin
  289.   FElementStreams := TStreamList.Create(Substreams, ownsObjects);
  290.   FPosition:=0;
  291.   FCurrentElement:=0;
  292.   FSize := 0;
  293.   for EStream in FElementStreams do
  294.     FSize += EStream.Size;
  295. end;
  296.  
  297. function TCompositeBitstream.Read(var Buffer; Count: longint): longint;
  298. var
  299.   CurrStream: TStream;
  300.   BytesRead: LongInt;
  301. begin
  302.   Result := 0;
  303.   while (Result < Count) and (FPosition < FSize) do
  304.   begin
  305.     Currstream := FElementStreams[FCurrentElement];
  306.     if CurrStream.Position >= CurrStream.Size then
  307.     begin
  308.       inc(FCurrentElement);
  309.       Continue;
  310.     end;
  311.     BytesRead := CurrStream.Read(PByte(@Buffer)[Result], Count-Result);
  312.     FPosition += BytesRead;
  313.     Result += BytesRead;
  314.   end;
  315. end;
  316.  
  317. function TCompositeBitstream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
  318. var
  319.   toMove: SizeInt;
  320. begin
  321.   case Origin of
  322.     soBeginning: toMove := Offset - FPosition;
  323.     soCurrent: toMove:=Offset;
  324.     soEnd: toMove:=(FSize-Offset) - FPosition;
  325.   end;
  326.   if toMove > 0 then
  327.     SeekForward(toMove)
  328.   else if toMove < 0 then
  329.     SeekBackward(toMove * -1);
  330.   Result := FPosition;
  331. end;
  332.  
  333. function TCompositeBitstream.Seek(Offset: longint; Origin: word): longint;
  334. begin
  335.   Result := Seek(Int64(Offset), TSeekOrigin(Origin));
  336. end;
  337.  
  338. destructor TCompositeBitstream.Destroy;
  339. begin
  340.   FElementStreams.Free;
  341.   inherited Destroy;
  342. end;
  343.  
  344. { TMemoryBitstream }
  345.  
  346. function TMemoryBitstream.GetSize: int64;
  347. begin
  348.   Result := FSize;
  349. end;
  350.  
  351. function TMemoryBitstream.GetPosition: int64;
  352. begin
  353.   Result := FPosition;
  354. end;
  355.  
  356. constructor TMemoryBitstream.Create(const AData: Pointer; ASize: SizeInt);
  357. begin
  358.   FData := AData;
  359.   FPosition := 0;
  360.   FSize := ASize;
  361. end;
  362.  
  363. function TMemoryBitstream.Read(var Buffer; Count: longint): longint;
  364. begin
  365.   Result := Min(Count, FSize - FPosition);
  366.   Move(PByte(FData)[FPosition], Buffer, Result);
  367.   Inc(FPosition, Result);
  368. end;
  369.  
  370. function TMemoryBitstream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
  371. begin
  372.   case Origin of
  373.     soBeginning: FPosition := Min(Offset, FSize);
  374.     soCurrent: FPosition := Min(FPosition + Offset, FSize);
  375.     soEnd: FPosition := Max(FSize - Offset, 0);
  376.   end;
  377.   Result := FPosition;
  378. end;
  379.  
  380. function TMemoryBitstream.Seek(Offset: longint; Origin: word): longint;
  381. begin
  382.   Result := Seek(int64(Offset), TSeekOrigin(Origin));
  383. end;
  384.  
  385. end.

To solve the original problem now:
Code: Pascal  [Select][+][-]
  1. program BitstreamsTest;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   heaptrc,
  7.   sysutils, classes, Bitstreams;
  8.  
  9.  
  10. type
  11.   TTestRec = record
  12.     A: Integer;
  13.     B: String;
  14.   end;
  15.  
  16. var
  17.   input: TTestRec;
  18.   s: TStream;
  19.   output: String;
  20.   i: Integer;
  21. begin
  22.   input.A:=42;
  23.   input.B:='Foo';
  24.   s := RTTIBitStream(@input, TypeInfo(input), SizeOf(input));
  25.   try
  26.     output:='';
  27.     for i:=0 to s.Size -1 do
  28.       output += HexStr(s.ReadByte, 2);
  29.   finally
  30.     s.Free;
  31.   end;
  32.   WriteLn(output);
  33. end.

Probably one could use a function like this:
Code: Pascal  [Select][+][-]
  1. generic function Bitstream<T>(constref AData: T): TStream; inline;
  2. begin
  3.   Result := RTTIBitStream(@AData, TypeInfo(T), SizeOf(T));
  4. end;
to make the use more convinient.

Works with arrays, records, strings and base types, as well as combinations of them (e.g. array of records, record containing arrays and strings, etc)

Might be also interesting to build a generic serialization/deserialization unit
« Last Edit: November 22, 2020, 10:11:26 pm by Warfley »

OkobaPatino

  • Full Member
  • ***
  • Posts: 165
Re: [SOLVED] Getting size of a value in an Generic method
« Reply #25 on: November 23, 2020, 09:27:27 am »
Interesting approach Warfley. Thanks for sharing.

 

TinyPortal © 2005-2018