1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-26 11:12:14 -05:00

CPascal is now able to dynamically link in. TestUnit.pas 536 ish has the line to switch out CPascal and PascalScript

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@488 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
BenLand100 2010-01-27 05:44:43 +00:00
parent 5d859fd445
commit e4aa31d3bd
8 changed files with 46 additions and 77 deletions

Binary file not shown.

View File

@ -233,7 +233,7 @@
</Target> </Target>
<SearchPaths> <SearchPaths>
<IncludeFiles Value="$(ProjOutDir)/;$(ProjPath)../../Units/MMLAddon/PSInc/"/> <IncludeFiles Value="$(ProjOutDir)/;$(ProjPath)../../Units/MMLAddon/PSInc/"/>
<OtherUnitFiles Value="$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/;$(ProjPath)../../Units/Misc/;$(ProjPath)../../Units/MMLAddon/PSInc/;$(ProjPath)../../Units/Linux/;$(ProjPath)../../Units/Synapse/;$(LazarusDir)/components/mouseandkeyinput/"/> <OtherUnitFiles Value="$(ProjPath)/;$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/;$(ProjPath)../../Units/Misc/;$(ProjPath)../../Units/MMLAddon/PSInc/;$(ProjPath)../../Units/Linux/;$(ProjPath)../../Units/Synapse/;$(LazarusDir)/components/mouseandkeyinput/"/>
<UnitOutputDirectory Value="$(ProjPath)../../build/$(TargetOS)"/> <UnitOutputDirectory Value="$(ProjPath)../../build/$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<CodeGeneration> <CodeGeneration>

View File

@ -533,8 +533,7 @@ begin
PluginsPath := LoadSettingDef('Settings/Plugins/Path', ExpandFileName(MainDir + DS + '..' + DS + '..'+ DS + 'Plugins'+ DS)); PluginsPath := LoadSettingDef('Settings/Plugins/Path', ExpandFileName(MainDir + DS + '..' + DS + '..'+ DS + 'Plugins'+ DS));
ScriptErrorLine:= -1; ScriptErrorLine:= -1;
CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread; CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread;
//This SHOULD load CPascal, but it fails ***WIZZUP*** //ScriptThread := TCPThread.Create('libcpascal',True,@CurrentSyncInfo,PluginsPath);
//ScriptThread := TInterpreterThread.Create('libcpascal',True,@CurrentSyncInfo,PluginsPath);
ScriptThread := TPSThread.Create(True,@CurrentSyncInfo,PluginsPath); ScriptThread := TPSThread.Create(True,@CurrentSyncInfo,PluginsPath);
{$IFNDEF TERMINALWRITELN} {$IFNDEF TERMINALWRITELN}
ScriptThread.SetDebug(@formWriteln); ScriptThread.SetDebug(@formWriteln);

View File

@ -22,7 +22,7 @@
} }
AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;'); AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
AddFunction(nil,'procedure Writeln(x);'); //We use special function for this AddFunction(@pswriteln,'procedure Writeln(x: string);'); //PS defines a special, keep this for CPascal
{ DTM } { DTM }
SetCurrSection('DTM'); SetCurrSection('DTM');

View File

@ -24,7 +24,6 @@
unit mmlpsthread; unit mmlpsthread;
{$Define PS_USESSUPPORT} {$Define PS_USESSUPPORT}
{$define PS_StdCall}
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
@ -139,26 +138,9 @@ type
TPrecompiler_Callback = function(name, args: PChar): boolean; stdcall; TPrecompiler_Callback = function(name, args: PChar): boolean; stdcall;
TErrorHandeler_Callback = procedure(line, pos: integer; err: PChar); stdcall; TErrorHandeler_Callback = procedure(line, pos: integer; err: PChar); stdcall;
TInterpreter = record TCPThread = class(TMThread)
Create: function(ppg: PChar; precomp: TPrecompiler_Callback; err: TErrorHandeler_Callback): pointer; cdecl;
AddMethod: procedure(interp: pointer; address: pointer; def: PChar);
Run: procedure(interp: pointer);
Stop: procedure(interp: pointer);
Destroy: procedure(interp: pointer);
end;
TInterpreterLoader = class(TGenericLoader)
protected
interps: array of TInterpreter;
function InitPlugin(plugin: TLibHandle): boolean; override;
public
function GetInterpreter(idx: integer): TInterpreter;
end;
TInterpreterThread = class(TMThread)
protected protected
instance: pointer; instance: pointer;
interpreter: TInterpreter;
public public
constructor Create(libname: string; CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string); constructor Create(libname: string; CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string);
destructor Destroy; override; destructor Destroy; override;
@ -168,14 +150,27 @@ type
procedure AddMethod(meth: TExpMethod); override; procedure AddMethod(meth: TExpMethod); override;
end; end;
function interp_init(ppg: PChar; precomp: TPrecompiler_Callback; err: TErrorHandeler_Callback): Pointer; cdecl; external;
procedure interp_meth(interp: Pointer; addr: Pointer; def: PChar); cdecl; external;
function interp_run(interp: Pointer): boolean; cdecl; external;
procedure interp_free(interp: Pointer); cdecl; external;
threadvar threadvar
CurrThread : TMThread; CurrThread : TMThread;
var var
PluginsGlob: TMPlugins; PluginsGlob: TMPlugins;
interp_loader: TInterpreterLoader;
implementation implementation
{$ifdef LINUX}
{$linklib c}
{$linklib stdc++}
{$link ./libcpascal.so}
{$else}
{$linklib stdc++}
{$linklib ./libcpascal.dll}
{$endif}
uses uses
colour_conv,dtmutil, colour_conv,dtmutil,
{$ifdef mswindows}windows,{$endif} {$ifdef mswindows}windows,{$endif}
@ -193,6 +188,7 @@ uses
forms,//Forms forms,//Forms
lclintf; // for GetTickCount and others. lclintf; // for GetTickCount and others.
{$define PS_StdCall}
{$MACRO ON} {$MACRO ON}
{$ifdef PS_StdCall} {$ifdef PS_StdCall}
{$define ps_decl := stdcall} {$define ps_decl := stdcall}
@ -201,7 +197,7 @@ uses
{$endif} {$endif}
{Some General PS Functions here} {Some General PS Functions here}
procedure psWriteln(str : string); procedure psWriteln(str : string); ps_decl;
begin begin
if Assigned(CurrThread.DebugTo) then if Assigned(CurrThread.DebugTo) then
CurrThread.DebugTo(str) CurrThread.DebugTo(str)
@ -680,27 +676,24 @@ end;
{***implementation TCPThread***} {***implementation TCPThread***}
constructor TInterpreterThread.Create(libname: string; CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string); constructor TCPThread.Create(libname: string; CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string);
var var
plugin_idx: integer; plugin_idx: integer;
begin begin
interp_loader.AddPath(plugin_dir);
plugin_idx:= interp_loader.LoadPlugin(libname);
if plugin_idx < 0 then
raise Exception.Create(Format('Could not locate the interpreter library: %s',[libname]));
interpreter:= interp_loader.GetInterpreter(plugin_idx);
instance:= nil; instance:= nil;
inherited Create(CreateSuspended, TheSyncInfo, plugin_dir); inherited Create(CreateSuspended, TheSyncInfo, plugin_dir);
end; end;
destructor TInterpreterThread.Destroy; destructor TCPThread.Destroy;
begin begin
if instance <> nil then if instance <> nil then
interpreter.Destroy(instance); interp_free(instance);
inherited Destroy; inherited Destroy;
end; end;
function Interpreter_Precompiler(name, args: PChar): boolean; stdcall; function Interpreter_Precompiler(name, args: PChar): boolean; stdcall;
var
local_name, local_args: string;
begin begin
result:= CurrThread.ProcessDirective(name, args); result:= CurrThread.ProcessDirective(name, args);
end; end;
@ -710,70 +703,47 @@ begin
CurrThread.HandleError(line,pos,err,errRuntime,''); CurrThread.HandleError(line,pos,err,errRuntime,'');
end; end;
procedure TInterpreterThread.SetScript(script: string); procedure TCPThread.SetScript(script: string);
var var
i: integer; i: integer;
begin begin
if instance <> nil then if instance <> nil then
interpreter.Destroy(instance); interp_free(instance);
instance:= interpreter.Create(PChar(@script[1]), @Interpreter_Precompiler, @Interpreter_ErrorHandler); Starttime := lclintf.GetTickCount;
instance:= interp_init(PChar(@script[1]), @Interpreter_Precompiler, @Interpreter_ErrorHandler);
for i := 0 to high(ExportedMethods) do for i := 0 to high(ExportedMethods) do
if ExportedMethods[i].FuncPtr <> nil then if ExportedMethods[i].FuncPtr <> nil then
interpreter.AddMethod(instance,ExportedMethods[i].FuncPtr,PChar(ExportedMethods[i].FuncDecl)); interp_meth(instance,ExportedMethods[i].FuncPtr,PChar(ExportedMethods[i].FuncDecl));
end; end;
procedure TInterpreterThread.AddMethod(meth: TExpMethod); procedure TCPThread.AddMethod(meth: TExpMethod);
begin begin
if instance = nil then if instance = nil then
raise Exception.Create('Script not set, cannot add method'); raise Exception.Create('Script not set, cannot add method');
interpreter.AddMethod(instance,meth.FuncPtr,PChar(meth.FuncDecl)); interp_meth(instance,meth.FuncPtr,PChar(meth.FuncDecl));
end; end;
procedure TInterpreterThread.Execute; procedure TCPThread.Execute;
begin begin
if instance = nil then if instance = nil then
raise Exception.Create('Script not set, cannot run'); raise Exception.Create('Script not set, cannot run');
interpreter.Run(instance); CurrThread := Self;
Starttime := lclintf.GetTickCount;
psWriteln('Invoking CPascal Interpreter');
if interp_run(instance) then
psWriteln('Executed Successfully')
else
psWriteln('Execution Failed');
end; end;
procedure TInterpreterThread.Terminate; procedure TCPThread.Terminate;
begin begin
if @interpreter.Stop = nil then
raise Exception.Create('Stopping Interpreter not yet implemented'); raise Exception.Create('Stopping Interpreter not yet implemented');
interpreter.Stop(instance);
end;
{***implementation TInterpreterLoader***}
function TInterpreterLoader.InitPlugin(plugin: TLibHandle): boolean;
var
i: integer;
begin
result:= true;
i:= length(interps);
SetLength(interps,i+1);
Pointer(interps[i].Create) := GetProcAddress(plugin, PChar('interp_init'));
Pointer(interps[i].Destroy) := GetProcAddress(plugin, PChar('interp_free'));
Pointer(interps[i].Run) := GetProcAddress(plugin, PChar('interp_run'));
Pointer(interps[i].AddMethod) := GetProcAddress(plugin, PChar('interp_meth'));
//Optional methods...
Pointer(interps[i].Stop) := GetProcAddress(plugin, PChar('interp_stop'));
if (Pointer(interps[i].Create) = nil) or (Pointer(interps[i].Destroy) = nil) or
(Pointer(interps[i].Run) = nil) or (Pointer(interps[i].AddMethod) = nil) then
begin
SetLength(interps,i);
result:= false;
end;
end;
function TInterpreterLoader.GetInterpreter(idx: integer): TInterpreter;
begin
result:= interps[idx];
end; end;
initialization initialization
PluginsGlob := TMPlugins.Create; PluginsGlob := TMPlugins.Create;
interp_loader := TInterpreterLoader.Create;
finalization finalization
//PluginsGlob.Free; //PluginsGlob.Free;
//Its a nice idea, but it will segfault... the program is closing anyway. //Its a nice idea, but it will segfault... the program is closing anyway.

View File

@ -39,9 +39,9 @@ implementation
var var
idx: integer; idx: integer;
begin begin
if PluginDirs.Find(path,idx) then //IDK who changed this to loading a dir, but DON'T
LoadPluginsDir(idx) if not PluginDirs.Find(path,idx) then
else begin begin
writeln('Adding Plugin Path: ' + path); writeln('Adding Plugin Path: ' + path);
PluginDirs.Add(path); PluginDirs.Add(path);
end; end;