[fpc-devel] Missing DLLProc

[Pavel V. Ozerski]

Hello all,

in freepascal.ru forum a problem has been discussed. FPC 2.1 does not
understand DllProc predefined variable presenting in Delphi RTL:

> Unit
>
> System
>
> Category
>
> miscellaneous routines
>
> var DLLProc: Pointer;
>
> Description
>
> DLLProc is used to specify a procedure that is invoked every time a DLL's entry point is called. A procedure assigned to DLLProc must take one parameter of type Integerint. For example,
>
> procedure LibraryProc(Reason: Integer);
>
> When the procedure is invoked, this single parameter contains a value between 0 and 3 as defined by the following group of constants in the Windows unit:
>
> const
>
>   DLL_PROCESS_DETACH = 0;
>   DLL_PROCESS_ATTACH = 1;
>   DLL_THREAD_ATTACH  = 2;
>   DLL_THREAD_DETACH  = 3;
>
> For further details on the meaning of these constants, refer to the description of the DllEntryPoint function in the Win32 API online help.
>
> Note:      DLL_PROCESS_ATTACH is passed to the procedure only if the DLL’s initialization code calls the procedure and specifies DLL_PROCESS_ATTACH as a parameter.

I think, for some platforms this problem could be easily solved. Note:
although in Delphi Help this variable is described as a pointer,
actually it is declared in 7.0 RTL as
> type
>   TDLLProc = procedure (Reason: Integer);
>   // TDLLProcEx provides the reserved param returned by WinNT
>   TDLLProcEx = procedure (Reason: Integer; Reserved: Integer);
...
>   DllProc: TDLLProc;            { Called whenever DLL entry point is called }
>   { DllProcEx passes the Reserved param provided by WinNT on DLL load & exit }
>   DllProcEx: TDLLProcEx absolute DllProc;

I think, these declarations could be easily added into systemh.inc. To
avoid Borland copyright, they could be declared a bit else :) (and
there extst also some reasons for multi-platform RTL where may be
different default calling conventions etc):

type
  TDLLProc = procedure (Reason: integer);
  TDLLProcEx = procedure (Reason, Reserved: integer);
var
  DllProc_Ptr: pointer = nil;
  DllProc: TDLLProc absolute DllProc_Ptr;

  DllProcEx_Ptr: pointer = nil;
  DllProcEx: TDLLProcEx absolute DllProcEx_Ptr;

The next step should be a modification of Dll_entry function in
system.pp.

for win32, win64 and winCe:

function Dll_entry : longbool;[public, alias : '_FPC_DLL_Entry'];
var
  res : longbool;
  procedure CallDllProc;
  begin
    if Assigned(DllProcEx_Ptr) then
      DllProcEx(DLLreason, DLLparam);
    if Assigned(DllProc_Ptr) then
      DllProc(DLLreason);
  end;
  begin
     IsLibrary:=true;
     Dll_entry:=false;
     case DLLreason of
       DLL_PROCESS_ATTACH :
         begin
           If SetJmp(DLLBuf) = 0 then
             begin
               if assigned(Dll_Process_Attach_Hook) then
                 begin
                   res:=Dll_Process_Attach_Hook(DllParam);
                   if not res then
                     exit(false);
                 end;
               PASCALMAIN;
               Dll_entry:=true;
             end
           else
             Dll_entry:=DLLExitOK;
         end;
       DLL_THREAD_ATTACH :
         begin
           inc(Thread_count);
{$warning Allocate Threadvars !}
           if assigned(Dll_Thread_Attach_Hook) then
             Dll_Thread_Attach_Hook(DllParam);
           CallDllProc;
           Dll_entry:=true; { return value is ignored }
         end;
       DLL_THREAD_DETACH :
         begin
           dec(Thread_count);
           if assigned(Dll_Thread_Detach_Hook) then
             Dll_Thread_Detach_Hook(DllParam);
           CallDllProc;
{$warning Release Threadvars !}
           Dll_entry:=true; { return value is ignored }
         end;
       DLL_PROCESS_DETACH :
         begin
           Dll_entry:=true; { return value is ignored }
           If SetJmp(DLLBuf) = 0 then
             begin
               FPC_DO_EXIT;
             end;
           if assigned(Dll_Process_Detach_Hook) then
             Dll_Process_Detach_Hook(DllParam);
           CallDllProc;
         end;
     end;
  end;

for netwlibc:

function _DLLMain (hInstDLL:pointer; fdwReason:dword; DLLParam:longint):longbool; cdecl;
[public, alias : '_FPC_DLL_Entry'];
var res : longbool;
  procedure CallDllProc;
  begin
    if Assigned(DllProcEx_Ptr) then
      DllProcEx(fdwreason, DLLparam);
    if Assigned(DllProc_Ptr) then
      DllProc(fdwreason);
  end;
begin
  {$ifdef DEBUG_MT}
  _ConsolePrintf ('_FPC_DLL_Entry called');
  {$endif}
  _DLLMain := false;
  isLibrary := true;
  case fdwReason of
    DLL_ACTUAL_DLLMAIN  : _DLLMain := true;
    DLL_NLM_STARTUP     : begin
                            //_ConsolePrintf ('DLL_NLM_STARTUP');
                            if assigned(Dll_Process_Attach_Hook) then
                            begin
                              res:=Dll_Process_Attach_Hook(DllParam);
                              if not res then
                                exit(false);
                            end;
                            PASCALMAIN;
                            _DLLMain := true;
                          end;
    DLL_NLM_SHUTDOWN    : begin
                            //_ConsolePrintf ('DLL_NLM_SHUTDOWN');
                            TermSigHandler(0);
                            _DLLMain := true;
                          end;
     { standard DllMain() messages...  }
    DLL_THREAD_ATTACH,
    DLL_PROCESS_ATTACH  : begin
                            //__ConsolePrintf ('DLL_PROCESS/THREAD_ATTACH');
                            if assigned(AllocateThreadVars) then
                              AllocateThreadVars;
                            if assigned(Dll_Thread_Attach_Hook) then
                              Dll_Thread_Attach_Hook(DllParam);
                            CallDllProc;
                            _DLLMain := true;
                          end;
    DLL_THREAD_DETACH,
    DLL_PROCESS_DETACH  : begin
                            //__ConsolePrintf ('DLL_PROCESS/THREAD_DETACH');
                            if assigned(Dll_Thread_Detach_Hook) then
                              Dll_Thread_Detach_Hook(DllParam);
                            CallDllProc;
                            if assigned(ReleaseThreadVars) then
                              ReleaseThreadVars;
                            _DLLMain := true;
                          end;
  end;
end;


An important difference between Delphi and this FPC patch behaviour
exists: if we shall assign a value to DllProc and then to DllProcEx,
in Delphi DllProc value will be lost, but in this FPC patch both
handlers will work. But I think, this Borland solution seems to be an
ugly hack which will work only until default calling conventions are
REGISTER or CDECL, otherwise using DllProcEx instead DllProc will
corrupt stack.

--
Best regards,
 Pavel                            mailto:pavel at insect.mail.iephb.ru