mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-22 09:12:19 -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:
parent
5d859fd445
commit
e4aa31d3bd
BIN
trunk/Projects/SAMufasaGUI/libcpascal.a
Normal file
BIN
trunk/Projects/SAMufasaGUI/libcpascal.a
Normal file
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -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>
|
||||||
|
@ -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);
|
||||||
|
@ -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');
|
||||||
|
@ -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.
|
||||||
|
@ -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;
|
||||||
|
Loading…
Reference in New Issue
Block a user