What's the proper way to pass a record to a dynamic package procedure?

[Marsil 4]

Hi,

(note: complete project in attachment)

 

Was experimenting with dynamically loaded packages and call routines there.

while it seems everything works properly I got  problem which is the executable (project1.exe) stays in memory after

closing the application.

 

Running the app under the debugger shows AVs occurring during the call to UnloadPackage (PkgHandle)

and the debugger jumps to GETMEM.INC showing assembly code YIIIIKES!!!, oh no not for me!

and the call stack shows only 3 lines but nothing of my source code 

 

System.InsertMediumBlockIntoBin(???,???)

System.SysFreeMem(???)

:0092557a InsertMediumBlockIntoBin + $2A

 

I saw the the AV dialog when I moved UnloadPackage (PkgHandle) from TForm1.FormDestroy to right after the calling code in TForm1.Button1Click

and exe did not stay in memory.

 

the shared definition unit:

unit TestApi;

interface
type
  TIdentRec = record
    Name : string;
    Guid : string;
    Version : Integer;
    ApiVersion : Integer;
  end;

type
  TPlugIdentifier = procedure (var IdentRec : TIdentRec);

const
  PlugIdentifierName = 'Identify';

implementation

end.

 

In a package I have only one procedure

 

unit TestPlugIn;

interface
uses
  TestApi;

procedure Identify (var IdentRec : TIdentRec);

exports
  Identify;

implementation

procedure Identify (var IdentRec : TIdentRec);
begin
  IdentRec.Name := 'Sample PlugIn';
  IdentRec.Guid := 'F84E4265C05D4854A2BD781ED7A1BA66';
  IdentRec.Version := 1;
  IdentRec.ApiVersion := 1;
end;

 

 

Calling code:

procedure TForm1.Button1Click (Sender: TObject);
begin
  var Identify : TPlugIdentifier;
  @Identify := GetProcAddress (PkgHandle, PlugIdentifierName);
  if @Identify = nil then
    begin
      Log ('Cannot find Identifier proc!');
      Exit;
    end;

  var IdentRec : TIdentRec := Default (TIdentRec);
  
  Identify (IdentRec);

  Log ('PlugIn Name: ' + IdentRec.Name);
  Log ('PlugIn Guid: ' + IdentRec.Guid);
  Log ('PlugIn Version: ' + IdentRec.Version.ToString);
  Log ('PlugIn API Version: ' + IdentRec.ApiVersion.ToString);
end;

 

Package loaded in TForm1.OnCreate and unloaded inTForm1.FormDestroy

procedure TForm1.FormCreate (Sender : TObject);
begin
  ReportMemoryLeaksOnShutdown := True;

  try
    PkgHandle := LoadPackage ('PlugInPkg.bpl');
    Button1.Enabled := True;

  except
    on E : EPackageError do
      Log ('Cannot load package: ' + E.Message);
  end;
end;

// ---------------------------------

procedure TForm1.FormDestroy (Sender : TObject);
begin
  if PkgHandle <> 0 then
    UnloadPackage (PkgHandle)
end;

 

 

I noticed if I comment out the lines then problem goes away, so it seems it is related to strings :

procedure Identify (var IdentRec : TIdentRec);
begin
//  IdentRec.Name := 'Sample PlugIn';
//  IdentRec.Guid := 'F84E4265C05D4854A2BD781ED7A1BA66';
  IdentRec.Version := 1;
  IdentRec.ApiVersion := 1;
end;

 

I tried to reset the record after the call  but no luck!:

 IdentRec := Default (TIdentRec);

 

 

 

Pass Record to package 4.zip

Edited December 2, 2023 by Marsil

[Marsil 4]

There are some changes to the question but I cannot edit my post above!!

I'm working to apply suggestions Peter mentioned  in the post below.

 

 

 

Edited December 2, 2023 by Marsil

[PeterBelow 218]

Packages are an all or nothing thing. In your case the TIdentRec type used by host and package are not the same type, despite of the same name. The package and the host app each contain their own copy of the TestApi unit. To make this work you have to place this unit into its own run-time package, which is then named in the package list of the application and the requires clause of the dynamically loaded package. This way both use the same "instance" of the unit.

 

If you load packages dynamically it is also more reliable to not unload them explicitely but leave that to the RTL package management when the application closes. This avoids some arcane problems with premature unit finalizations. In your case unloading the package seems to mess up the memory manager.

 

[Marsil 4]

 

13 hours ago, PeterBelow said:

Packages are an all or nothing thing. In your case the TIdentRec type used by host and package are not the same type, despite of the same name. The package and the host app each contain their own copy of the TestApi unit. To make this work you have to place this unit into its own run-time package, which is then named in the package list of the application and the requires clause of the dynamically loaded package. This way both use the same "instance" of the unit.

 

If you load packages dynamically it is also more reliable to not unload them explicitely but leave that to the RTL package management when the application closes. This avoids some arcane problems with premature unit finalizations. In your case unloading the package seems to mess up the memory manager.

 

 

Thanks Peter!, useful information! indeed!

 

I will try what you suggested soon, but for now I have a question:

 

I used to unload/destroy anything I load /create, if I use LoadLibrary () I need to use UnLoadLibrary () and

If I use LoadPackage I need to use UnloadPackage, ... but you said:

13 hours ago, PeterBelow said:

If you load packages dynamically it is also more reliable to not unload them explicitely but leave that to the RTL package management when the application closes. 

if I remove the UnloadPackage  from my code, the app does not report any memory leak which is good!, but handles are

a Windows thing which Delphi memory manager does not have control of them.

 

But it seems the package did not get unloaded because the finalization section of package unit did not get executed!

I created a small test app and package, the package contains only one unit like this:

unit PkgUnit1;

interface

implementation
uses
  SysUtils, Classes;

var FileName : string;

procedure FinalizeProc;
begin
  var slTest := TStringList.Create;
  try
    slTest.Add ('Finalizing PkgUnit1');
    slTest.SaveToFile (FileName);

  finally
    slTest.Free;
  end;
end;

initialization

  FileName := ExtractFilePath (ParamStr(0)) + '_TestPlugIn.txt';
  DeleteFile (FileName);

finalization

  FinalizeProc;

end.

 

If I don't explicitly unload the package the _TestPlugIn.txt will not be created which means the finalization section did not

execute which means the package was not unloaded  by the RTL package management 

If I call UnloadPackage the file will be created.  How is that?

 

I'm using Delphi 11 Community.

 

Edited December 3, 2023 by Marsil

[Kas Ob. 91]

6 hours ago, Marsil said:

If I don't explicitly unload the package the _TestPlugIn.txt will not be created which means the finalization section did not

execute which means the package was not unloaded  by the RTL package management 

If I call UnloadPackage the file will be created.  How is that?

That is correct behavior.

 

See, even Windows OS while loads and unload all the needed libraries (DLL) for application and their dependencies too, require explicit call to FreeLibrary if you called LoadLibrary on your own https://learn.microsoft.com/en-us/windows/win32/api/libloaderapi/nf-libloaderapi-freelibrary

So the shortcoming from the RTL management from not reference counting the libraries from the manual load, i think it is a bless and prevent many hidden bugs and memory leaks, in other words you load it, you unload it.

[Marsil 4]

I just found if I use SysUtils in any unit contained in the package then the problem is solved, no more AVs while closing the app!!! 

But what exactly SysUtils do to fix the problem ? no idea! 

 

I checked SysUtils and found some code related to package support in initialization section: 

{$IFDEF PACKAGE_SUPPORT}
  AddModuleUnloadProc(ModuleUnloaded);
{$ENDIF PACKAGE_SUPPORT}

finalization section

{$IFDEF PACKAGE_SUPPORT}
  RemoveModuleUnloadProc(ModuleUnloaded);
  ClearHashTables;
{$ENDIF PACKAGE_SUPPORT}

 

So, it seems some packages need to use SysUtils to work correctly!

Anyone knows if this is documented somewhere?!

 

Just for testing I went a step further and extracted the package support code from SysUtils into a standalone unit named PackageSupport

and then used this unit instead of SysUtils and the result is success too!, no more AVs. This unit is just for testing only, I will be using SysUtils of course.

 

Here is the PackageSupport unit source , Sorry for the a bit long code but  I don't know how

to add collapse/expand on click feature like some other forums : 

 

 

unit PackageSupport;

interface

implementation
uses
  Winapi.Windows;

const
  cBucketSize = 1021; // better distribution than 1024

type
  PUnitHashEntry = ^TUnitHashEntry;
  TUnitHashEntry = record
    Next, Prev: PUnitHashEntry;
    LibModule: PLibModule;
    UnitName: MarshaledAString;
    DupsAllowed: Boolean;
    FullHash: Cardinal;
  end;

  TUnitHashArray = TArray<TUnitHashEntry>;
  TUnitHashBuckets = array[0..cBucketSize-1] of PUnitHashEntry;

  PModuleInfo = ^TModuleInfo;
  TModuleInfo = record
    Validated: Boolean;
    UnitHashArray: TUnitHashArray;
  end;

var
  SysInitHC: Cardinal;
  ValidatedUnitHashBuckets: TUnitHashBuckets;
  UnitHashBuckets: TUnitHashBuckets;

function AnsiStrUpper(Str: PWideChar): PWideChar;
begin
  Result := CharUpperW(Str);
end;

function FindLibModule(Module: HModule): PLibModule; inline;
begin
  Result := LibModuleList;
  while Result <> nil do
  begin
    if Result.Instance = Cardinal(Module) then Exit;
    Result := Result.Next;
  end;
end;

function HashNameMBCS(Name: MarshaledAString): Cardinal;
const
  BufferLen = 261;
var
  Len, NameLen: Cardinal;
  Data: PWideChar;
  Buffer: array[0..BufferLen - 1] of WideChar;
  I: Integer;
begin
  NameLen := Length(Name);
  Len := UnicodeFromLocaleChars(CP_UTF8, 0, Name, NameLen, nil, 0);
  if Len > BufferLen then
    GetMem(Data, Len * SizeOf(Char))
  else
    Data := @Buffer[0];

  UnicodeFromLocaleChars(CP_UTF8, 0, Name, NameLen, Data, Len);
  AnsiStrUpper(Data);

  Result := 0;
  for I := 0 to Len - 1 do
  begin
    Result := (Result shl 5) or (Result shr 27); //ROL Result, 5
    Result := Result xor Cardinal(Data[I]);
  end;

  if Data <> @Buffer[0] then
    FreeMem(Data);
end;

{$DEFINE X86ASM}
function HashName(Name: MarshaledAString): Cardinal;
{$IFDEF PUREPASCAL}
var
  LCurr: MarshaledAString;
begin
  { ESI -> Name }
  Result := 0;
  LCurr := Name;

  while LCurr^ <> #0 do
  begin
    { Abort on a MBCS character }
    if Ord(LCurr^) > 127 then
    begin
      Result := HashNameMBCS(LCurr);
      Exit;
    end;

    { Update the hash. Lowercase the uppercased charaters in the process }
    if LCurr^ in ['A' .. 'Z'] then
      Result := Result xor (Ord(LCurr^) or $20)
    else
      Result := Result xor Ord(LCurr^);

    { Go to next }
    Inc(LCurr);

    { Update the hashed value }
    Result := (Result shr 27) or (Result shl 5);
  end;
end;
{$ELSE !PUREPASCAL}
{$IFDEF X86ASM}
asm
        PUSH  ESI
        PUSH  EBX
        MOV   ESI, Name
        XOR   EAX, EAX
        PUSH  ESI

@@loop:
        ROL   EAX, 5
        MOV   BL, [ESI]
        TEST  BL, $80   // abort if there is a multibyte character and call HashNameMBCS
        JNZ   @@MBCS
        CMP   BL, 0
        JE    @@done
        CMP   BL, 'A'
        JL    @@LowerCased
        CMP   BL, 'Z'
        JG    @@LowerCased
        OR    BL, 20H // make lower case
@@LowerCased:
        XOR   AL, BL
        INC   ESI
        JMP   @@loop
@@done:
        POP   ECX
        POP   EBX
        POP   ESI
        RET
@@MBCS:
        POP   EAX
        POP   EBX
        POP   ESI
        JMP   HashNameMBCS
end;
{$ENDIF X86ASM}
{$ENDIF !PUREPASCAL}


procedure ModuleUnloaded(Module: HINST);
var
  LibModule: PLibModule;
  ModuleInfo: PModuleInfo;
  I: Integer;
  HC: Cardinal;
  Buckets: ^TUnitHashBuckets;
begin
  LibModule := FindLibModule(Module);
  if (LibModule <> nil) and (LibModule.Reserved <> 0) then
  begin
    ModuleInfo := PModuleInfo(LibModule.Reserved);
    if ModuleInfo.Validated then
      Buckets := @ValidatedUnitHashBuckets
    else
      Buckets := @UnitHashBuckets;
    for I := Low(ModuleInfo.UnitHashArray) to High(ModuleInfo.UnitHashArray) do
    begin
      if ModuleInfo.UnitHashArray[I].Prev <> nil then
        ModuleInfo.UnitHashArray[I].Prev.Next := ModuleInfo.UnitHashArray[I].Next
      else if ModuleInfo.UnitHashArray[I].UnitName <> nil then
      begin
        HC := HashName(ModuleInfo.UnitHashArray[I].UnitName) mod cBucketSize;
        if Buckets[HC] = @ModuleInfo.UnitHashArray[I] then
          Buckets[HC] := ModuleInfo.UnitHashArray[I].Next;
      end;
      if ModuleInfo.UnitHashArray[I].Next <> nil then
        ModuleInfo.UnitHashArray[I].Next.Prev := ModuleInfo.UnitHashArray[I].Prev;
    end;
    Dispose(ModuleInfo);
    LibModule.Reserved := 0;
  end;
end;

procedure ClearHashTables;
var
  Module: PLibModule;
begin
  Module := LibModuleList;
  while Module <> nil do
  begin
    if Module.Reserved <> 0 then
    begin
      Dispose(PModuleInfo(Module.Reserved));
      Module.Reserved := 0;
    end;
    Module := Module.Next;
  end;
end;


initialization

{$IFDEF PACKAGE_SUPPORT}
  AddModuleUnloadProc(ModuleUnloaded);
{$ENDIF PACKAGE_SUPPORT}
 

finalization

{$IFDEF PACKAGE_SUPPORT}
  RemoveModuleUnloadProc(ModuleUnloaded);
  ClearHashTables;
{$ENDIF PACKAGE_SUPPORT}

end.

 

Edited December 3, 2023 by Marsil