Jump to content

Mahdi Safsafi

Members
 View Profile  See their activity

  • Content Count

    383

  • Joined

  • Last visited

  • Days Won

    10

Posts posted by Mahdi Safsafi

  2. Posted

    For me, I found it useful in the following cases: 

    - The Sync mode utility works great with EmptyStr.

    - I edit a lot of my pas files manually using Notepad, so I just select one EmptyStr and I can clearly see all places where the EmptyStr was implemented. 

    - Last thing, it's a mind trick, I pay much more attention for arguments that use EmptyStr. 

      Blabla(... , EmptyStr);    // focus on that call.
  Blabla(... , '');          // usually I ignore it.

     

    • Like 1

  3. Posted

    On 7/7/2019 at 1:27 PM, dummzeuch said:

    One of the first things I do is delete those annoying comments the IDE inserts: Private/Protected etc. declarations.

    Apart from that I sometimes use the GExperts sort expert to sort the methods inside a section alphabetically. But normally I just let the IDE put them in whatever order it uses.

    Didn't know that GExperts implements such functionality. 

    Does it sort function implementation too ?

  6. Posted

    10 minutes ago, David Heffernan said:

    C++ compilers are generally far better at optimisation than any Delphi compilers 

    of course ! But you know : the MSVC's output didn't impressed me since I was expecting to get such result(especially with the constexpr specifier). However, Delphi did ! I never thought that it can do function evaluation on the fly. 

  7. Posted · Edited by Mahdi Safsafi

    Hello guys,

    I always thought that the Delphi compiler takes the inlined function and TRIES to insert it (without making a call instruction) where the call to that function occurs. However for some circumstances it can do better ! it TRIES to evaluate the function (just like constexpr in c++) !

    Here is an example : 

    program Console1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

function Max(a, b: Integer): Integer; inline;
begin
  if (a > b) then
    Result := a
  else
    Result := b;
end;

var
  a: Integer = 5;
  b: Integer = 9;
  i: Integer;

begin
  Writeln('--------------------------------');
  i := Max(5, 9); // evaluated
  Writeln(Format('max=%d', [i]));
  i := Max(a, b); // not evaluated
  Writeln(Format('max=%d', [i]));
  Writeln('--------------------------------');
  Readln;
end.

    After compiling the above example (x64, Release mode), the compiler generates the following code: 

    
//------------------------------------------------------ Delphi ------------------------------------------------------------
0000000000428510 | 48:8B0D 59880000         | mov rcx,qword ptr ds:[430D70]           |
0000000000428517 | 48:8D15 6E010000         | lea rdx,qword ptr ds:[42868C]           | rdx:EntryPoint, 000000000042868C:L"--------------------------------"
000000000042851E | E8 2DEFFDFF              | call <console1.sub_407450>              |
0000000000428523 | 48:89C1                  | mov rcx,rax                             | rax:EntryPoint
0000000000428526 | E8 85F0FDFF              | call <console1.sub_4075B0>              |
000000000042852B | E8 60D4FDFF              | call <console1.sub_405990>              |
0000000000428530 | B8 09000000              | mov eax,9                               | eax:EntryPoint, 9:'\t'
0000000000428535 | 8905 3D420100            | mov dword ptr ds:[43C778],eax           | eax:EntryPoint
000000000042853B | 8B05 37420100            | mov eax,dword ptr ds:[43C778]           | eax:EntryPoint
0000000000428541 | 8945 28                  | mov dword ptr ss:[rbp+28],eax           | eax:EntryPoint
0000000000428544 | C645 30 00               | mov byte ptr ss:[rbp+30],0              |
0000000000428548 | 48:8D4D 38               | lea rcx,qword ptr ss:[rbp+38]           |
000000000042854C | 48:8D15 89010000         | lea rdx,qword ptr ds:[<sub_4286DC>]     | rdx:EntryPoint, 00000000004286DC:L"max=%d"
0000000000428553 | 4C:8D45 28               | lea r8,qword ptr ss:[rbp+28]            |
0000000000428557 | 4D:33C9                  | xor r9,r9                               | r9:EntryPoint
000000000042855A | E8 C16AFFFF              | call <console1.sub_41F020>              |
000000000042855F | 48:8B0D 0A880000         | mov rcx,qword ptr ds:[430D70]           |
0000000000428566 | 48:8B55 38               | mov rdx,qword ptr ss:[rbp+38]           | rdx:EntryPoint
000000000042856A | E8 E1EEFDFF              | call <console1.sub_407450>              |
000000000042856F | 48:89C1                  | mov rcx,rax                             | rax:EntryPoint
0000000000428572 | E8 39F0FDFF              | call <console1.sub_4075B0>              |
0000000000428577 | E8 14D4FDFF              | call <console1.sub_405990>              |
000000000042857C | 8B05 72860000            | mov eax,dword ptr ds:[430BF4]           | eax:EntryPoint
0000000000428582 | 3B05 70860000            | cmp eax,dword ptr ds:[430BF8]           | eax:EntryPoint
0000000000428588 | 7E 08                    | jle console1.428592                     |
000000000042858A | 8B05 64860000            | mov eax,dword ptr ds:[430BF4]           | eax:EntryPoint
0000000000428590 | EB 06                    | jmp console1.428598                     |
0000000000428592 | 8B05 60860000            | mov eax,dword ptr ds:[430BF8]           | eax:EntryPoint
0000000000428598 | 8905 DA410100            | mov dword ptr ds:[43C778],eax           | eax:EntryPoint
000000000042859E | 8B05 D4410100            | mov eax,dword ptr ds:[43C778]           | eax:EntryPoint
00000000004285A4 | 8945 28                  | mov dword ptr ss:[rbp+28],eax           | eax:EntryPoint
00000000004285A7 | C645 30 00               | mov byte ptr ss:[rbp+30],0              |
00000000004285AB | 48:8D4D 20               | lea rcx,qword ptr ss:[rbp+20]           |
00000000004285AF | 48:8D15 26010000         | lea rdx,qword ptr ds:[<sub_4286DC>]     | rdx:EntryPoint, 00000000004286DC:L"max=%d"
00000000004285B6 | 4C:8D45 28               | lea r8,qword ptr ss:[rbp+28]            |
00000000004285BA | 4D:33C9                  | xor r9,r9                               | r9:EntryPoint
00000000004285BD | E8 5E6AFFFF              | call <console1.sub_41F020>              |
00000000004285C2 | 48:8B0D A7870000         | mov rcx,qword ptr ds:[430D70]           |
00000000004285C9 | 48:8B55 20               | mov rdx,qword ptr ss:[rbp+20]           | rdx:EntryPoint
00000000004285CD | E8 7EEEFDFF              | call <console1.sub_407450>              |
00000000004285D2 | 48:89C1                  | mov rcx,rax                             | rax:EntryPoint
00000000004285D5 | E8 D6EFFDFF              | call <console1.sub_4075B0>              |
00000000004285DA | E8 B1D3FDFF              | call <console1.sub_405990>              |
00000000004285DF | 48:8B0D 8A870000         | mov rcx,qword ptr ds:[430D70]           |
00000000004285E6 | 48:8D15 9F000000         | lea rdx,qword ptr ds:[42868C]           | rdx:EntryPoint, 000000000042868C:L"--------------------------------"
00000000004285ED | E8 5EEEFDFF              | call <console1.sub_407450>              |
00000000004285F2 | 48:89C1                  | mov rcx,rax                             | rax:EntryPoint
00000000004285F5 | E8 B6EFFDFF              | call <console1.sub_4075B0>              |
00000000004285FA | E8 91D3FDFF              | call <console1.sub_405990>              |
00000000004285FF | 48:8B0D 9A880000         | mov rcx,qword ptr ds:[430EA0]           |
0000000000428606 | E8 45E6FDFF              | call <console1.sub_406C50>              |
000000000042860B | E8 80D3FDFF              | call <console1.sub_405990>              |
0000000000428610 | 90                       | nop                                     |

    You can see that the compiler was able to evaluate the first expression "i := Max(5, 9);" and just generated one single instruction "mov eax, 9".

    For the second call "i := Max(a, b);" the compiler didn't make any evaluation and it just inlined the function.

    This is really impressive ! the first call was completely evaluated at the compiling time.

    I also tested the above example with MSVC and the result was quite different (I was expecting that before running my debugger):  

    #include "pch.h"
#include <iostream>

inline int max(int a, int b) {
	return a > b ? a : b;
}

constexpr int max2(int a, int b) {
	return a > b ? a : b;
}

int a = 5;
int b = 9;
int i;
int main()
{
	printf("--------------------------------\n");


	i = max(5, 9);    // evaluated
	printf("max=%d\n", i);
	i = max(a, b);    // evaluated
	printf("max=%d\n", i);
	i = max2(5, 9);   // evaluated
	printf("max=%d\n", i);
	i = max2(a, b);   // evaluated
	printf("max=%d\n", i);
	printf("--------------------------------\n");
}
    //------------------------------------------------------ CPP ------------------------------------------------------------
00007FF7DB431070 | 48:83EC 28               | sub rsp,28                              | consoleapplication4.cpp:19
00007FF7DB431074 | 48:8D0D 85110000         | lea rcx,qword ptr ds:[7FF7DB432200]     | consoleapplication4.cpp:20, 00007FF7DB432200:"--------------------------------\n"
00007FF7DB43107B | E8 90FFFFFF              | call <consoleapplication4.printf>       |
00007FF7DB431080 | BA 09000000              | mov edx,9                               | consoleapplication4.cpp:24, 9:'\t'
00007FF7DB431085 | C705 91250000 09000000   | mov dword ptr ds:[<i>],9                | 9:'\t'
00007FF7DB43108F | 48:8D0D 92110000         | lea rcx,qword ptr ds:[7FF7DB432228]     | 00007FF7DB432228:"max=%d\n"
00007FF7DB431096 | E8 75FFFFFF              | call <consoleapplication4.printf>       |
00007FF7DB43109B | BA 09000000              | mov edx,9                               | consoleapplication4.cpp:26, 9:'\t'
00007FF7DB4310A0 | C705 76250000 09000000   | mov dword ptr ds:[<i>],9                | 9:'\t'
00007FF7DB4310AA | 48:8D0D 77110000         | lea rcx,qword ptr ds:[7FF7DB432228]     | 00007FF7DB432228:"max=%d\n"
00007FF7DB4310B1 | E8 5AFFFFFF              | call <consoleapplication4.printf>       |
00007FF7DB4310B6 | BA 09000000              | mov edx,9                               | consoleapplication4.cpp:28, 9:'\t'
00007FF7DB4310BB | C705 5B250000 09000000   | mov dword ptr ds:[<i>],9                | 9:'\t'
00007FF7DB4310C5 | 48:8D0D 5C110000         | lea rcx,qword ptr ds:[7FF7DB432228]     | 00007FF7DB432228:"max=%d\n"
00007FF7DB4310CC | E8 3FFFFFFF              | call <consoleapplication4.printf>       |
00007FF7DB4310D1 | BA 09000000              | mov edx,9                               | consoleapplication4.cpp:30, 9:'\t'
00007FF7DB4310D6 | C705 40250000 09000000   | mov dword ptr ds:[<i>],9                | 9:'\t'
00007FF7DB4310E0 | 48:8D0D 41110000         | lea rcx,qword ptr ds:[7FF7DB432228]     | 00007FF7DB432228:"max=%d\n"
00007FF7DB4310E7 | E8 24FFFFFF              | call <consoleapplication4.printf>       |
00007FF7DB4310EC | 48:8D0D 0D110000         | lea rcx,qword ptr ds:[7FF7DB432200]     | consoleapplication4.cpp:31, 00007FF7DB432200:"--------------------------------\n"
00007FF7DB4310F3 | E8 18FFFFFF              | call <consoleapplication4.printf>       |
00007FF7DB4310F8 | 33C0                     | xor eax,eax                             | consoleapplication4.cpp:32
00007FF7DB4310FA | 48:83C4 28               | add rsp,28                              |
00007FF7DB4310FE | C3                       | ret                                     |

    Note that MSVC also generated a very short routine compared to what Delphi generated!

  10. Posted

    Hello guys, I started this thread with hope to get advises and feedback.

    I have a large complex data (splitted into fields and many of those fields share common properties) that must be saved on files. XML was the best choice but since I need to edit those files manually … it’s out of question to use XML (it just not user friendly).  Neither YAML was(I’m not a big fun of languages that use space and tab) ! So I found my self using JSON. But I got many issues : my files got very big(because there is no reference/template support) and not mentioning that I was desperately lacking for comments.

    So I decided to write a custom language that inherits all JSON spec and provides additional supports for reference and templates.

    Here is an example : 

    # templates:
# ---------
class TPerson<Name, Sex>{
  name: Name,
  sex : Sex,
}

class TMan<Name>  : TPerson<Name, "male">;
class TWoman<Name>: TPerson<Name, "female">;

class TChild<Name, Sex, Father, Mother> : TPerson<Name, Sex>{
  father: Father,
  mother: Mother,
}

class TBoy<Name, Father, Mother>  : TChild<Name, "male", Father, Mother>;
class TGirl<Name, Father, Mother> : TChild<Name, "female", Father, Mother>;

class TFamily<Name, Father, Mother, Childs>{
  name  : Name,
  father: Father,
  mother: Mother,
  childs: Childs,
}

# references:
# ----------
def mike : TMan<"mike">;
def mira : TWoman<"mira">;
def jaky : TBoy<"jaky", mike, mira>;
def lila : TGirl<"lila", mike, mira>;

# public (just like json):
[TFamily<"FamilyName", mike, mira, [jaky, lila]>]

    After my language runs the above example, actually it’s able to generate a Perl object that supports reference so if I change the father name of the first child in run-time … the father’s name will change for all fields: 

    my $file   = 'test.xjson';
my $parser = XJSON::Parser->new();
my $xjson  = $parser->parse($file);
$xjson->[0]->{childs}->[0]->{father}->{name} = "NotMike"; # mike's name changed for all fields.

    And converting it to JSON will dump the following: 

    [
   {
      "name" : "FamilyName",
      "father" : {
         "name" : "mike",
         "sex" : "male"
      },
      "childs" : [
         {
            "name" : "jaky",
            "sex" : "male",
            "mother" : {
               "sex" : "female",
               "name" : "mira"
            },
            "father" : {
               "name" : "mike",
               "sex" : "male"
            }
         },
         {
            "name" : "lila",
            "sex" : "female",
            "father" : {
               "name" : "mike",
               "sex" : "male"
            },
            "mother" : {
               "sex" : "female",
               "name" : "mira"
            }
         }
      ],
      "mother" : {
         "sex" : "female",
         "name" : "mira"
      }
   }
]

    Right now, my language is draft and many things are implemented in a no proper way. I may rewrite it in C and consume it from Perl and probably Pascal.

    So what do you think guys about the language ? and any idea about improving it ? and if you were at my situation what kind of solution you may think to use ?  

  12. Posted

    I think that the syntax  was always there and I use it a lot. I found it more useful especially it provides a compiler check about the indexing type.

    This code : 

    NodeNames: array [TInfoType] of string = ('itProject', 'itContacts', 'itWorker', 'itWorkers');

    Is exactly equivalent to this one : 

    NodeNames2: array [Ord(Low(TInfoType)) .. Ord(High(TInfoType))] of string = ('itProject', 'itContacts', 'itWorker', 'itWorkers');

    Note that you can also use range: 

    NodeNames3: array [itContacts .. itWorkers] of string = ('itContacts', 'itWorker','itWorkers');

     

    • Like 1
    • Thanks 2

  13. Posted

    Hello guys, 

    Here is the v2 of my ImmersiveColors  project:

    • Added FPC and lazarus support.
    • Replaced TImmersiveColors class with a simplified functions: GetImmersiveColorSetCount, GetImmersiveColor, GetActiveImmersiveColor, ...
    • Added default return value to make the library work on platform that do not have immersive colors support (XP, Win7, macOS, ...).
    • Added many new function such as IsDarkThemeActive, GetRivalColorType,...
    • Added three new components : TImmersiveColorsListBox, TImmersiveColorSetListBox, TImmersiveNotify.
    • Improved Explorer.

     

    You can find the v2 on the "next" branch : 

    https://github.com/MahdiSafsafi/ImmersiveColors/tree/next  

    • Thanks 1

  15. Posted

    Quote

    Packages will not contain any scripts (ie to build during install) for security reasons (I don't want to be running random scripts). 

    Please reconsider this point ! Nowadays it's really important to use scripts (we're no longer on 19xx).

    Also for the package name, it's important to have a formal rule for name. e.g a package's name may look like this : TMS::VCL::SomeProduct. Also we can group names by category (like cpan packages which I really like its concept) e.g: XML::MyXmlLib. So all XML stuffs are under XML::.

     

     

  16. Posted

    Quote

    What I don't get is how the range of Codepoints that goes from 0..$10FFFF is exactly reduced so that the table is only about 36664 bytes

    That's because Unicode code-points are organised in ranges. Meaning, for a given code-point, if you can know its range, you can get its category without implementing a full 0xFFFF table. 

    I don't know what algorithm Delphi uses (I'm not in a mood to debug the System.Character unit). The good news, I wrote a simple demonstration that do what the InternalGetUnicodeCategory does. The principle is to regroup all similar category and then do a binary filtering. 

    I assumed that my Unicode code-points lies from 0x0000 to 0xFFFF. First I grouped them by ranges and then I did a binary indexing and finally I setup my table. My final table size is 19200 bytes rather than ‭65535 bytes! 

    program Console2;

{$APPTYPE CONSOLE}

{$R *.res}


uses
  System.SysUtils,
  System.TypInfo,
  System.Classes,
  System.Character;

type
  TRange = record
    Min: Integer;
    Max: Integer;
    Category: Integer;
    Mask: Integer;
  public
    procedure Increase(Value: Integer);
    procedure Compute(); inline;
    class function Create(AMin, AMax: Integer): TRange; static;
  end;

  PRange = ^TRange;

var
  CatIndexPrimary: array [0 .. $FF] of SmallInt;
  CatIndexSecondary: array [0 .. $FF] of SmallInt;
  Table: array of ShortInt;

const
  MAX_CODEPOINT = $FFFF;

function MyGetUnicodeCategory(C: UCS4Char): TUnicodeCategory;
begin
  // similar to InternalGetUnicodeCategory.
  Result := TUnicodeCategory(
    Table[CatIndexPrimary[C shr 8] + CatIndexSecondary[C and $FF]]);
end;

function GetPrimaryKey(Value: Integer): Integer; inline;
begin
  Result := Value shr $08;
end;

function GetSecondaryKey(Value: Integer): Integer; inline;
begin
  Result := Value and $FF;
end;

function GetUnicodeCategoryName(Value: TUnicodeCategory): string;
begin
  Result := GetEnumName(TypeInfo(TUnicodeCategory), Integer(Value));
end;

procedure BuildTable();
var
  i, k, j, p, s, index: Integer;
  Category: TUnicodeCategory;
  List: TList;
  Range: PRange;
  SeenList: TList;
  size: Integer;
  LTable: array [0 .. MAX_CODEPOINT] of ShortInt;
  LCatIndexPrimary: array [0 .. $FF] of Integer;
  LCatIndexSecondary: array [0 .. $FF] of Integer;
  CategoryValue, PreviousCategoryValue: Integer;
begin
  { initialization }
  List := TList.Create();
  SeenList := TList.Create();
  PreviousCategoryValue := -1;
  Range := nil;
  size := 0;
  for i := 0 to $FF do
  begin
    LCatIndexPrimary[i] := 0;
    LCatIndexSecondary[i] := 0;
  end;

  { build codepoint ranges }
  for i := 0 to MAX_CODEPOINT do
  begin
    LTable[i] := -1;
    Category := GetUnicodeCategory(i);
    CategoryValue := Integer(Category);
    if (PreviousCategoryValue <> CategoryValue) then
    begin
      PreviousCategoryValue := CategoryValue;
      Range := PRange(GetMemory(sizeof(TRange)));
      Range^ := TRange.Create(i, i);
      Range^.Category := CategoryValue;
      List.Add(Range);
    end
    else
    begin
      // continued range.
      Range^.Increase(1);
    end;
  end;
  {
    // debug ranges
    for i := 0 to List.Count - 1 do
    begin
    Range := List[i];
    Writeln(Format('category=%s range[%d..%d] mask=0x%x', [GetUnicodeCategoryName(TUnicodeCategory(Range^.Category)),
    Range^.Min, Range^.Max, Range^.Max]));
    end;
  }

  { setup a uniq mask for LCatIndexPrimary and LCatIndexSecondary }
  for i := 0 to List.Count - 1 do
  begin
    Range := List[i];
    for j := Range^.Min to Range^.Max do
    begin
      p := GetPrimaryKey(j);
      s := GetSecondaryKey(j);
      LCatIndexPrimary[p] := LCatIndexPrimary[p] or Range^.Mask or Range^.Category;
      LCatIndexSecondary[s] := s;
    end;
  end;

  { normalize masks to indexes }
  for i := 0 to $FF do
  begin
    k := SeenList.IndexOf(Pointer(LCatIndexPrimary[i]));
    if (k = -1) then
    begin
      k := SeenList.Count;
      SeenList.Add(Pointer(LCatIndexPrimary[i]));
    end;
    LCatIndexPrimary[i] := k shl 8;
  end;

  { fill table }
  for i := 0 to List.Count - 1 do
  begin
    Range := List[i];
    for j := Range^.Min to Range^.Max do
    begin
      p := GetPrimaryKey(j);
      s := GetSecondaryKey(j);
      index := LCatIndexPrimary[p] + LCatIndexSecondary[s];
      Assert((LTable[index] = -1) or (LTable[index] = Range^.Category));
      LTable[index] := Range^.Category;
    end;
  end;

  { clone all L* tables }
  for i := 0 to MAX_CODEPOINT do
  begin
    if (LTable[i] <> -1) then
      Inc(size);
  end;
  SetLength(Table, size);
  for i := 0 to size - 1 do
    Table[i] := LTable[i];

  for i := 0 to $FF do
  begin
    Assert((LCatIndexPrimary[i] >= Low(SmallInt)) and (LCatIndexPrimary[i] <= High(SmallInt)));
    Assert((LCatIndexSecondary[i] >= Low(SmallInt)) and (LCatIndexSecondary[i] <= High(SmallInt)));
    CatIndexPrimary[i] := LCatIndexPrimary[i];
    CatIndexSecondary[i] := LCatIndexSecondary[i];
  end;

  { output results }
  Writeln('---------------------------------');
  Writeln(Format('size of table             = %d bytes', [Length(Table) * sizeof(ShortInt)]));
  Writeln(Format('size of CatIndexPrimary   = %d bytes', [sizeof(CatIndexPrimary)]));
  Writeln(Format('size of CatIndexSecondary = %d bytes', [sizeof(CatIndexSecondary)]));
  size := (Length(Table) * sizeof(ShortInt)) +
    sizeof(CatIndexPrimary) + sizeof(CatIndexSecondary);
  Writeln(Format('total size = %d bytes (rather than %d) => we won %d bytes !', [size, $FFFF, $FFFF - size]));

  { clean-up }
  for i := 0 to List.Count - 1 do
  begin
    Range := List[i];
    FreeMem(Range);
  end;
  List.Free();
  SeenList.Free();
end;

{ TRange }

procedure TRange.Compute();
var
  i: Integer;
begin
  for i := Min to Max do
    Mask := Mask and i;
end;

class function TRange.Create(AMin, AMax: Integer): TRange;
begin
  Result.Mask := -1;
  Result.Min := AMin;
  Result.Max := AMax;
  Result.Compute();
end;

procedure TRange.Increase(Value: Integer);
begin
  Inc(Max, Value);
  Compute();
end;

var
  i: Integer;
  Category, Category2: TUnicodeCategory;

begin
  ReportMemoryLeaksOnShutdown := True;
  BuildTable();
  { tests }
  for i := 0 to MAX_CODEPOINT do
  begin
    Category := MyGetUnicodeCategory(i);
    Category2 := GetUnicodeCategory(i);
    Assert(Category = Category2);
  end;
  Readln;

end.

    NB: I ignored all optimisation/memory good practices. You might need to optimise the code yourself.

  18. Posted

    32 minutes ago, David Heffernan said:

    You are quite wrong. No point freeing it. No point even creating it. 

    I believe that you didn't understand me clearly. My answer wasn't about whether is pointless or not ! my answer was about the coding style (and I gave an example about the Win32 api). 

    Suppose I made a library that have a record like this : 

    
type
  TDummy = record
    // ...
  public
    function Create(): TDummy;
    procedure Free();
  end;

  { TDummy }

function TDummy.Create: TDummy;
begin
  // FOR NOW ... do nothing here   !
end;

procedure TDummy.Free;
begin
  // on this platform do nothing for now !
  // feature platform do something.
end;

    Currently Create and Free do nothing on Win32(x86). Yep there is no need to use them. But I use them just for future compatibility.

    Now after 1 year, I decided to port my library to let say WinRT or MIPS. Now my Free must do something here (really)!

    Quote

    procedure TDummy.Free;
    begin
     {$IF DEFINED(MIPS) || DEFINED(WINRT)}

       DoSeriousJob(); 

    {$ENDIF}
    end;

    Now, from your approach, you must track all variables and free them if you want your code to run successfully on WinRT, MIPS.

    For me, because I used them on all configurations, I wan't going to track them !

     

    Also, is there any guaranties that "FContextToken" won't change to something else on future ? 

  20. Posted

    Quote

    1. Do you need to create/Free TRTTIContext? All the books/articles I've seen they just use the record

    I saw many people using TRTTIContext without freeing it. That's wrong ! The Free function wasn't there for nothing. I just check it and found that it assigns a nil to interface ! 

    procedure TRttiContext.Free;
begin
  FContextToken := nil;
end;

    You should always use Free when a record implements it even if it does nothing !!! It might do nothing currently ... but maybe the developer introduce it to use it later or it does something on other configuration (ARM ?)!

    As an example, from the Win32 api FlushInstructionCache function does nothing on x86 but it's important on ARM ! 

    Quote

    2. The TypeInfo variable in DoSomething conflicts with TypeInfo from RTTI. It should use a different name, right?

    My bad ... Sorry.

    Quote

    3. How do I get the value of the fields now? I tried this:

    You're missing "@" ! 

    Writeln(' '+lFields.Name + ': '+lFields.GetValue(TypeInfo(@Rec)).AsString);

    I just played a little with the above code : 

    
uses
  System.SysUtils,
  System.Rtti,
  System.TypInfo,
  System.Generics.Collections;

type
  TRecord1 = record
  private
  var
    FTypeInfo: Pointer; // this must be the first field and all record must implement it.
  public
  var
    FField1: Integer; // Record fields.
    class function Create: TRecord1; static;
  end;

  TRecord2 = record
  private
  var
    FTypeInfo: Pointer;
  public
  var
    FField1: Integer;
    FField2: string;
    FField3: Boolean;
    class function Create: TRecord2; static;
  end;

procedure DoSomething(const Rec);
type
  TRecordHack = record
    FTypeInfo: Pointer; // since FTypeInfo is the first field in all records, we can hack it !
  end;

  PRecordHack = ^TRecordHack;
var
  PHack: PRecordHack;
  LTypeInfo: Pointer;
  LCntx: TRttiContext;
  LType: TRttiType;
  LField: TRttiField;
  LValue: TValue;
  LKind: TTypeKind;
  SValue: string;
begin
  PHack := PRecordHack(@Rec);
  LTypeInfo := PHack^.FTypeInfo;

  // RTTI:
  LCntx := TRttiContext.Create();
  try
    LType := LCntx.GetType(LTypeInfo);
    Writeln(Format('record (%s):', [LType.Name]));
    for LField in LType.GetFields do
    begin
      if (LField.Visibility = mvPrivate) then   // skip private (FTypeInfo).
        Continue;
      LValue := LField.GetValue(@Rec);
      LKind := LValue.Kind;
      case LKind of
        tkInteger:
          SValue := IntToStr(LValue.AsInteger);
        tkString, tkUString:
          SValue := LValue.AsString;
        tkEnumeration:
          SValue := GetEnumName(LValue.TypeInfo, TValueData(LValue).FAsSLong);
      else
        SValue := '??';
      end;
      Writeln(Format('  field (%s) = %s', [LField.Name, SValue]));
    end;
  finally
    LCntx.Free();
  end;
end;

{ TRecord1 }

class
  function TRecord1.Create: TRecord1;
begin
  Result.FTypeInfo := TypeInfo(TRecord1);
end;

{ TRecord2 }

class
  function TRecord2.Create: TRecord2;
begin
  Result.FTypeInfo := TypeInfo(TRecord2);
end;

var
  a: TRecord1;
  b: TRecord2;

begin
  a := TRecord1.Create();
  a.FField1 := 1;
  DoSomething(a);
  b := TRecord2.Create();
  b.FField1 := -10;
  b.FField2 := 'foo';
  DoSomething(b);
  Readln;
end.

     

    • Like 1

  21. Posted

    1 hour ago, John Kouraklis said:

     

    I would be great if this were possible...

    What about that : 

    type
  TRecord1 = record
  private
  var
    FTypeInfo: Pointer; // this must be the first field and all record must implement it.
  public
  var
    FField1: Integer; // Record fields.
    class function Create: TRecord1; static;
  end;

  TRecord2 = record
  private
  var
    FTypeInfo: Pointer;
  public
  var
    FField1: Integer;
    FField2: string;
    class function Create: TRecord2; static;
  end;

procedure DoSomething(const Rec);
type
  TRecordHack = record
    FTypeInfo: Pointer; // since FTypeInfo is the first field in all records, we can hack it !
  end;

  PRecordHack = ^TRecordHack;
var
  PHack: PRecordHack;
  TypeInfo: Pointer;
  LCntx: TRttiContext;
  LType: TRttiType;
begin
  PHack := PRecordHack(@Rec);
  TypeInfo := PHack^.FTypeInfo;
  // RTTI:
  LCntx := TRttiContext.Create();
  try
    LType := LCntx.GetType(TypeInfo);
    ShowMessage(LType.Name);
  finally
    LCntx.Free();
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  a: TRecord1;
  b: TRecord2;
begin
  a := TRecord1.Create();
  DoSomething(a);
  b := TRecord2.Create();
  DoSomething(b);
end;

{ TRecord1 }

class function TRecord1.Create: TRecord1;
begin
  Result.FTypeInfo := TypeInfo(TRecord1);
end;

{ TRecord2 }

class function TRecord2.Create: TRecord2;
begin
  Result.FTypeInfo := TypeInfo(TRecord2);
end;

     

    • Like 2

  23. Posted

    I believe that complete expression evaluation was made for lazy people ! The only useful scenario is that your condition contains a function call that must run on all situations.

    Otherwise it's just useless: 

    Result := Variable and (Variable2 = 5) and Variable3; // completely useless ! additional CPU-time for nothing !
Result := Variable and OtherWork();  // maybe useful.

    It's important to mention that many programming language do not support full expression evaluation and some of them provide logical operators (such && and ||) and name long-circuit (complete expression evaluation) as a flow control (they use 'and', 'or' keyword). Here is an example: 

    exists($filename) and doWork() or error("Could not open file filename"); // parsed as (exists($filename) and doWork()) or error("Could not open file filename");
exists($filename) and doWork() || error("Could not open file filename"); // parsed as exists($filename) and (doWork() || error("Could not open file filename"));

     

  24. Posted

    36 minutes ago, David Schwartz said:

    Rudy said: I think this order is guaranteed, but I would not really count on it.

    There's a compiler switch that overrides this, so it's not really "guaranteed".

     

    No one will switch to complete circuit evaluation. There is a rare case when it makes sense to use it. 

    function DoSomething(): Boolean;
begin
  // ...
  Result := (not HasError) and DumpStatus();
end;

    DumpStatus is a function that will dump the status whether there was an error or not. 

    If error exists, DumpStatus will dump the error status. If not it will dump a success status. 

    DoSomething's result depends on HasError. So it's important to do a full evaluation of the expression  "(not HasError) and DumpStatus()".

  25. Posted

    19 minutes ago, Mike Torrettinni said:

    Thank you for the example! I'm not really new to Delphi, but never grew out of the beginners's level of thinking, I guess... you can find a thread here me questioning about why should I use classes at all 🙂

    Don't worry everything is gonna be alright by the time. When I was beginner I asked a similar question : what's the purpose of interface. I got many answers but it took me a lot of time to understand what they were saying.

     

    Here is a free advice : first get familiar about the basic of program's life from the loader-time to the cpu-time (just get the basic things) and then master the fundamental stuff of Delphi (also just learn the basic things : statements, functions, array, records, RTL, ...). Now join the open source community and share your first library/app, fork other project and analyse people coding styles (it will be a great experience to you as was mine). after that you will find yourself understanding things quickly even you can master new language with just few days.

    Good Luck.  

    • Thanks 1
×