Rework lib loading.

Villavu · Sep 26, 2023 · dd52156 · dd52156
1 parent 16e32ac
commit dd52156
Show file tree

Hide file tree

Showing 6 changed files with 117 additions and 81 deletions.
diff --git a/Source/codetools/simba.ide_codetools_utils.pas b/Source/codetools/simba.ide_codetools_utils.pas
@@ -47,7 +47,7 @@ function FindPluginExports(FileName: String): String;
 implementation
 
 uses
-  simba.mufasatypes, simba.env, simba.process;
+  simba.mufasatypes, simba.env, simba.process, simba.script_pluginloader;
 
 procedure TNullableString.SetValue(const AValue: String);
 begin

diff --git a/Source/script/simba.script.pas b/Source/script/simba.script.pas
@@ -68,7 +68,8 @@   TSimbaScript = class
 implementation
 
 uses
-  simba.env, simba.datetime, simba.httpclient, simba.target;
+  simba.env, simba.datetime, simba.httpclient, simba.target,
+  simba.script_pluginloader;
 
 procedure TSimbaScript.DoCompilerHint(Sender: TLapeCompilerBase; Hint: lpString);
 begin
@@ -107,12 +108,7 @@ function TSimbaScript.DoCompilerHandleDirective(Sender: TLapeCompiler; Directive
     if InIgnore or InPeek then
       Exit;
 
-    if not FindPlugin(Argument, [FCompiler.CurrentDir()]) then
-      raise Exception.Create('Plugin "' + Argument + '" not found');
-
-    CopyPlugin(Argument);
-
-    Plugin := TSimbaScriptPlugin.Create(Argument);
+    Plugin := TSimbaScriptPlugin.Create(Argument, [FCompiler.CurrentDir()]);
     Plugin.Import(FCompiler);
 
     FPlugins := FPlugins + [Plugin];
@@ -170,36 +166,38 @@ function TSimbaScript.DoCompilerHandleDirective(Sender: TLapeCompiler; Directive
 function TSimbaScript.DoFindMacro(Sender: TLapeCompiler; Name: lpString; var Value: lpString): Boolean;
 
   // {$MACRO ENV(HOME)}
-  function DoEnvVar: Boolean;
-  var
-    EnvVar: String;
+  function DoEnvVar(Param: String): Boolean;
   begin
-    EnvVar := Name.ToUpper().Between('ENV(', ')');
-
-    Result := EnvVar <> '';
+    Result := Param <> '';
     if Result then
-      Value := '"' + GetEnvironmentVariable(EnvVar) + '"';
+      Value := '"' + GetEnvironmentVariable(Param) + '"';
   end;
 
   // {$MACRO LIBPATH(plugin.dll)}
-  function DoLibPath: Boolean;
+  function DoLibPath(Param: String): Boolean;
   var
-    Lib: String;
+    I: Integer;
   begin
-    Lib :=  Name.ToUpper().Between('LIBPATH(', ')');
+    Result := FindPlugin(Param, [FCompiler.CurrentDir()]);
 
-    Result := Lib <> '';
     if Result then
     begin
-      if not FindPlugin(Lib, [FCompiler.CurrentDir()]) then
-        Lib := '';
+      for I := 0 to High(LoadedPlugins) do
+        if (LoadedPlugins[I].OrginalFileName = Param) then
+          Param := LoadedPlugins[I].FileName;
 
-      Value := '"' + Lib + '"';
+      Value := '"' + Param + '"';
     end;
   end;
 
 begin
-  Result := DoEnvVar() or DoLibPath();
+  Result := False;
+  Value := '';
+
+  case Name.Before('(').ToUpper() of
+    'LIBPATH': Result := DoLibPath(Name.Between('(', ')'));
+    'ENV':     Result := DoEnvVar(Name.Between('(', ')'));
+  end;
 end;
 
 function TSimbaScript.GetState: ESimbaScriptState;

diff --git a/Source/script/simba.script_plugin.pas b/Source/script/simba.script_plugin.pas
@@ -74,7 +74,7 @@   TSimbaScriptPlugin = class
     procedure Import(Compiler: TSimbaScript_Compiler);
     procedure Load;
 
-    constructor Create(FileName: String);
+    constructor Create(FileName: String; ExtraSearchDirs: TStringArray = nil);
     destructor Destroy; override;
   end;
 
@@ -89,7 +89,8 @@   TSimbaScriptPlugin = class
 implementation
 
 uses
-  ffi;
+  ffi,
+  simba.script_pluginloader;
 
 procedure TSimbaScriptPlugin.Load;
 
@@ -250,23 +251,12 @@ procedure TSimbaScriptPlugin.Import(Compiler: TSimbaScript_Compiler);
     FExports.RegisterSimbaPlugin(@FInfo, @SimbaPluginMethods);
 end;
 
-constructor TSimbaScriptPlugin.Create(FileName: String);
+constructor TSimbaScriptPlugin.Create(FileName: String; ExtraSearchDirs: TStringArray);
 begin
   inherited Create();
 
   FFileName := FileName;
-  if (not FileExists(FFileName)) then
-    raise Exception.CreateFmt('Loading plugin: File "%s" does not exist', [FFileName]);
-
-  FHandle := LoadLibrary(FFileName);
-
-  if (FHandle = 0) then
-  begin
-    DebugLn('Plugin filename: ' + FFileName);
-    DebugLn('Plugin load error: ' + GetLoadErrorStr());
-
-    raise Exception.Create('Loading plugin failed. Architecture mismatch? (expected a ' + {$IFDEF CPU32}'32'{$ELSE}'64'{$ENDIF} + ' bit plugin)');
-  end;
+  FHandle := LoadPlugin(FFileName, ExtraSearchDirs);
 
   Load();
 end;

diff --git a/Source/script/simba.script_pluginloader.pas b/Source/script/simba.script_pluginloader.pas
@@ -1,31 +1,97 @@
+{
+  Author: Raymond van Venetië and Merlijn Wajer
+  Project: Simba (https://github.com/MerlijnWajer/Simba)
+  License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0)
+
+  Handles locating and loading script plugins.
+}
 unit simba.script_pluginloader;
 
 {$i simba.inc}
 
 interface
 
 uses
-  Classes, SysUtils, dynlibs;
+  Classes, SysUtils;
+
+function FindPlugin(var FileName: String; ExtraSearchDirs: TStringArray = nil): Boolean;
+function LoadPlugin(var FileName: String; ExtraSearchDirs: TStringArray = nil): TLibHandle;
 
-function LoadPlugin(FileName: String; ExtraSearchDirs: TStringArray = nil): TLibHandle;
+var
+  LoadedPlugins: array of record
+    OrginalFileName: String;
+    FileName: String;
+    Handle: TLibHandle;
+  end;
 
 implementation
 
 uses
-  simba.mufasatypes, simba.env
-  {$IFDEF UNIX},
-  dl
-  {$ENDIF};
+  simba.mufasatypes, simba.files, simba.env;
 
-function LoadPlugin(FileName: String; ExtraSearchDirs: TStringArray): TLibHandle;
+function FindPlugin(var FileName: String; ExtraSearchDirs: TStringArray): Boolean;
+const
+  {$IF DEFINED(CPUAARCH64)}
+  SimbaSuffix = SharedSuffix + '.aarch64'; // lib.aarch64
+  {$ELSE}
+  SimbaSuffix = {$IFDEF CPU32}'32'{$ELSE}'64'{$ENDIF} + '.' + SharedSuffix; // lib32.dll / lib64.dll
+  {$ENDIF}
+var
+  OrginalFileName: String;
+  SearchDir, SearchFileName: String;
+begin
+  Result := False;
+
+  OrginalFileName := FileName;
+  if TSimbaFile.FileExists(OrginalFileName) then
+    Exit(True);
+
+  for SearchDir in ExtraSearchDirs + [SimbaEnv.PluginsPath, SimbaEnv.SimbaPath] do
+  begin
+    FileName := TSimbaPath.PathJoin([SearchDir, OrginalFileName]);
+    if TSimbaFile.FileExists(FileName) then
+      Exit(True);
+
+    FileName := TSimbaPath.PathJoin([SearchDir, OrginalFileName]) + '.' + SharedSuffix;
+    if TSimbaFile.FileExists(FileName) then
+      Exit(True);
+
+    FileName := TSimbaPath.PathJoin([SearchDir, OrginalFileName]) + SimbaSuffix;
+    if TSimbaFile.FileExists(FileName) then
+      Exit(True);
+  end;
+
+  FileName := OrginalFileName;
+end;
+
+// Make a copy of the plugin to data/plugins/ so we can delete/update if it's loaded
+procedure CopyPlugin(var FileName: String);
+var
+  NewFileName: String;
+begin
+  NewFileName := SimbaEnv.TempPath + TSimbaFile.FileHash(FileName) + TSimbaPath.PathExtractExt(FileName);
+  if TSimbaFile.FileExists(NewFileName) or TSimbaFile.FileCopy(FileName, NewFileName) then
+    FileName := NewFileName;
+end;
+
+function LoadPlugin(var FileName: String; ExtraSearchDirs: TStringArray): TLibHandle;
+var
+  OrginalFileName: String;
+  I: Integer;
 begin
   if (not FindPlugin(FileName, ExtraSearchDirs)) then
-    raise Exception.CreateFmt('Unable to find plugin "%s"', [FileName]);
+    SimbaException('Unable to find plugin "%s"', [FileName]);
 
-  {$IFDEF UNIX}
-  Result := TLibHandle(dlopen(PChar(FileName), RTLD_NOLOAD));
-  if (Result <> NilHandle) then
-    Exit;
+  OrginalFileName := FileName;
+  for I := 0 to High(LoadedPlugins) do
+    if (LoadedPlugins[I].OrginalFileName = OrginalFileName) then
+    begin
+      Result := LoadedPlugins[I].Handle;
+      Exit;
+    end;
+
+  {$IFDEF WINDOWS}
+  CopyPlugin(FileName);
   {$ENDIF}
 
   Result := LoadLibrary(FileName);
@@ -35,8 +101,13 @@ function LoadPlugin(FileName: String; ExtraSearchDirs: TStringArray): TLibHandle
     DebugLn('Loading plugin failed: ' + FileName);
     DebugLn('Error: ' + GetLoadErrorStr());
 
-    raise Exception.Create('Loading plugin failed. Architecture mismatch? (expected a ' + {$IFDEF CPU32}'32'{$ELSE}'64'{$ENDIF} + ' bit plugin)');
+    SimbaException('Loading plugin failed. Architecture mismatch? (expected a ' + {$IFDEF CPU32}'32'{$ELSE}'64'{$ENDIF} + ' bit plugin)');
   end;
+
+  SetLength(LoadedPlugins, Length(LoadedPlugins) + 1);
+  LoadedPlugins[High(LoadedPlugins)].OrginalFileName := OrginalFileName;
+  LoadedPlugins[High(LoadedPlugins)].FileName := FileName;
+  LoadedPlugins[High(LoadedPlugins)].Handle := Result;
 end;
 
 end.

diff --git a/Source/simba.env.pas b/Source/simba.env.pas
@@ -14,8 +14,6 @@ interface
   simba.mufasatypes;
 
   function FindInclude(var FileName: String; ExtraSearchDirs: TStringArray): Boolean;
-  function FindPlugin(var FileName: String; ExtraSearchDirs: TStringArray): Boolean;
-  procedure CopyPlugin(var FileName: String);
 
 type
   SimbaEnv = class
@@ -81,34 +79,6 @@ function FindInclude(var FileName: String; ExtraSearchDirs: TStringArray): Boole
   Result := FindFile(FileName, '', ExtraSearchDirs + [SimbaEnv.IncludesPath, SimbaEnv.SimbaPath]);
 end;
 
-function FindPlugin(var FileName: String; ExtraSearchDirs: TStringArray): Boolean;
-const
-  {$IF DEFINED(CPUAARCH64)}
-  // lib.aarch64
-  SimbaSuffix = SharedSuffix + '.aarch64';
-  {$ELSE}
-  // lib32.dll
-  // lib64.dll
-  SimbaSuffix = {$IFDEF CPU32}'32'{$ELSE}'64'{$ENDIF} + '.' + SharedSuffix;
-  {$ENDIF}
-begin
-  ExtraSearchDirs := ExtraSearchDirs + [SimbaEnv.PluginsPath, SimbaEnv.SimbaPath];
-
-  Result := FindFile(FileName, '',                 ExtraSearchDirs) or
-            FindFile(FileName, '.' + SharedSuffix, ExtraSearchDirs) or
-            FindFile(FileName, SimbaSuffix,        ExtraSearchDirs);
-end;
-
-// Make a copy of the plugin to data/plugins/ so we can delete/update if it's loaded
-procedure CopyPlugin(var FileName: String);
-var
-  NewFileName: String;
-begin
-  NewFileName := SimbaEnv.TempPath + TSimbaFile.FileHash(FileName) + TSimbaPath.PathExtractExt(FileName);
-  if TSimbaFile.FileExists(NewFileName) or TSimbaFile.FileCopy(FileName, NewFileName) then
-    FileName := NewFileName;
-end;
-
 class function SimbaEnv.WriteTempFile(const Contents, Prefix: String): String;
 var
   Number: Integer = 0;

diff --git a/Source/targets/simba.target_plugin.pas b/Source/targets/simba.target_plugin.pas
@@ -1,3 +1,10 @@
+{
+  Author: Raymond van Venetië and Merlijn Wajer
+  Project: Simba (https://github.com/MerlijnWajer/Simba)
+  License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0)
+
+  Simba plugin target interface.
+}
 unit simba.target_plugin;
 
 {$i simba.inc}