mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-22 09:12:19 -05:00
Bugs in CPascal: Error in passing by reference, error somewhere in maze.simb
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@491 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
BenLand100
parent
2df8dbe3df
commit
2b1c5f2e2c
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -1,7 +1,7 @@
|
||||
object Form1: TForm1
|
||||
Left = 593
|
||||
Left = 706
|
||||
Height = 557
|
||||
Top = 321
|
||||
Top = 373
|
||||
Width = 734
|
||||
ActiveControl = ScriptPanel
|
||||
Caption = 'THA FUKING SIMBA'
|
||||
|
||||
@ -1,10 +1,10 @@
|
||||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
LazarusResources.Add('TForm1','FORMDATA',[
|
||||
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'Q'#2#6'Height'#3'-'#2#3'Top'#3'A'#1#5'Wid'
|
||||
+'th'#3#222#2#13'ActiveControl'#7#11'ScriptPanel'#7'Caption'#6#16'THA FUKING '
|
||||
+'SIMBA'#12'ClientHeight'#3#20#2#11'ClientWidth'#3#222#2#10'KeyPreview'#9#4'M'
|
||||
+'enu'#7#8'MainMenu'#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9
|
||||
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#194#2#6'Height'#3'-'#2#3'Top'#3'u'#1#5'Wi'
|
||||
+'dth'#3#222#2#13'ActiveControl'#7#11'ScriptPanel'#7'Caption'#6#16'THA FUKING'
|
||||
+' SIMBA'#12'ClientHeight'#3#20#2#11'ClientWidth'#3#222#2#10'KeyPreview'#9#4
|
||||
+'Menu'#7#8'MainMenu'#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9
|
||||
+'OnDestroy'#7#11'FormDestroy'#10'OnShortCut'#7#13'FormShortCuts'#8'Position'
|
||||
+#7#14'poScreenCenter'#10'LCLVersion'#6#6'0.9.29'#7'Visible'#9#0#8'TToolBar'#8
|
||||
+'ToolBar1'#4'Left'#2#0#6'Height'#2#24#3'Top'#2#0#5'Width'#3#222#2#7'Caption'
|
||||
|
||||
354
trunk/Tests/CPascal/maze.simb
Normal file
354
trunk/Tests/CPascal/maze.simb
Normal file
@ -0,0 +1,354 @@
|
||||
program maze;
|
||||
|
||||
const small_maze =
|
||||
'25' + #10 +
|
||||
'13' + #10 +
|
||||
'0000000000000000000000000'+ #10 +
|
||||
'0301111101111110001000110'+ #10 +
|
||||
'0101010101000011111110100'+ #10 +
|
||||
'0111110101011010100010100'+ #10 +
|
||||
'0100011101010010111011111'+ #10 +
|
||||
'0101010001011010000010001'+ #10 +
|
||||
'0111011101001110110010101'+ #10 +
|
||||
'0010110101011000101110101'+ #10 +
|
||||
'0111100101010010101001101'+ #10 +
|
||||
'0100101111011111111001001'+ #10 +
|
||||
'0111101001000000011111001'+ #10 +
|
||||
'0010011111111111100000004'+ #10 +
|
||||
'0000000000000000000000000'+ #10 ;
|
||||
|
||||
const medium_maze ='61' + #10 +
|
||||
'61' + #10 +
|
||||
'0000000000000000000000000000000000000000000000000000000000000' + #10 +
|
||||
'0111111111111100111111111111111111111111111111111111111110000' + #10 +
|
||||
'0101000000000000100000000001000000000000000000000000000010000' + #10 +
|
||||
'0101000000000000100100000001000111110000000000000000000010000' + #10 +
|
||||
'0101000111111111100100000001000100000011111111111111110010000' + #10 +
|
||||
'0101011101000100000111110001000100000010000000000000010010000' + #10 +
|
||||
'0101010001000100000000010001000100000010000000000000010010000' + #10 +
|
||||
'0101010001000100111111110001111111111110011100000000010010000' + #10 +
|
||||
'0101011101011100000000010000000000000000000100000000010010000' + #10 +
|
||||
'0101000001000000000000010011111111111111100111111100010010000' + #10 +
|
||||
'0101111111111111111100010010000000000000000100000100010010000' + #10 +
|
||||
'0100010000000000000100010011111111111111111100000100010011110' + #10 +
|
||||
'0100011110000001000101110010000000000000000000000100010000010' + #10 +
|
||||
'0100010010100001000101010010000000000000000000000100010000010' + #10 +
|
||||
'0100010010111111111101010010011111111111111111111100010100010' + #10 +
|
||||
'0111010000000001000101010010010000000001000010000111110100010' + #10 +
|
||||
'0000011111100001000101011110010010000001000010000000000100010' + #10 +
|
||||
'0000010000001111000101010000010010000001001010111111111100010' + #10 +
|
||||
'3111111110100000000101010100010010000001001010100000000000010' + #10 +
|
||||
'0000000010101111111101010100011111100001111010100000111110010' + #10 +
|
||||
'0111111010101000001001010100010000100100000010100000100011110' + #10 +
|
||||
'0100001010101000001001010100010000100100000010100000100000000' + #10 +
|
||||
'0101101010101001001111010100010011100111110010100111100000000' + #10 +
|
||||
'0100101010101001001000010111110000000100000010100000100000100' + #10 +
|
||||
'0100101010101001001000010000100000000100000010100000100000100' + #10 +
|
||||
'0100101010101001111001110000100011111100111110100000111111100' + #10 +
|
||||
'0100111010101000001001000000100010000100100010100000100000000' + #10 +
|
||||
'0100000010101111101001000000100010000100100010111111100000000' + #10 +
|
||||
'0100000010100000101001001111100010000100100010000000100000000' + #10 +
|
||||
'0111111111100000101001001000100000000100000010000000100000000' + #10 +
|
||||
'0010100001000000101001001000111111111111111111111111111111114' + #10 +
|
||||
'0010100001000100101001001000100000000000001001010010000000000' + #10 +
|
||||
'0010111101010100101000001000100000000000001001010010000000000' + #10 +
|
||||
'0010000101010100101111101000100011111111101001010011111110000' + #10 +
|
||||
'0010000101010111101000101000100010000000001001010000000010000' + #10 +
|
||||
'0111110101010000001000101000100010011111001001011111110010000' + #10 +
|
||||
'0100000101011111111000100000100010010000001001000000010011110' + #10 +
|
||||
'0100111101000000001000000000100010111111111001000000010000010' + #10 +
|
||||
'0100000001111111111111111111111110100000000001110000010000010' + #10 +
|
||||
'0100000000000000000000000000000000100011110100011110010000010' + #10 +
|
||||
'0101111111111111111111111101111111100010000100010010010000010' + #10 +
|
||||
'0101000000000000000000000101000000100010010100010010010000010' + #10 +
|
||||
'0101000000111111111111100101100000100010010100010010010111110' + #10 +
|
||||
'0101000000100000000000100100111110111110010100010010010100000' + #10 +
|
||||
'0101000000100000000000100100000010101000010111110010010100000' + #10 +
|
||||
'0101011111111111111100100101111110101000010000000010010101110' + #10 +
|
||||
'0101010000000010000100100100000000101000010000000000010101010' + #10 +
|
||||
'0101010111111010000110100111111111101011111111111111110101010' + #10 +
|
||||
'0101010100001010000010100000000000001000100000000000000101010' + #10 +
|
||||
'0101010111101010000010100000000000001000100000000000000101010' + #10 +
|
||||
'0101010000101010000010100000111100001010111111111111111101010' + #10 +
|
||||
'0101011111101011111010100000100100101110100000000000000101010' + #10 +
|
||||
'0101000000001010001010111111100100100000100011111111100101010' + #10 +
|
||||
'0101111111111010101010100000000100100000100010000000000101010' + #10 +
|
||||
'0100000000000010101010100000000100100000100010000000000101010' + #10 +
|
||||
'0111111111111110101010100000000000101111100010000000000101010' + #10 +
|
||||
'0100000000000000101010100001111111100000100010111111111101010' + #10 +
|
||||
'0100111111111111101010100001000000000000100011100000100000010' + #10 +
|
||||
'0100100000000000001010111111111000000000100000000000100000010' + #10 +
|
||||
'0110111111111111111010000000001111111111101111111111111111110' + #10 +
|
||||
'0000000000000000000000000000000000000000000000000000000000000' + #10 ;
|
||||
|
||||
type Tpoint = record
|
||||
x,y: integer;
|
||||
end;
|
||||
|
||||
type TpointArray = array of TPoint;
|
||||
|
||||
type TpointArrayArray = array of TpointArray;
|
||||
|
||||
type TboolGrid = array of array of boolean;
|
||||
|
||||
function readLine(raw: string; var off: integer): string;
|
||||
begin
|
||||
result:= '';
|
||||
while raw[off] <> #10 do
|
||||
begin
|
||||
result:= result + raw[off];
|
||||
off:= off + 1;
|
||||
end;
|
||||
off:= off + 1;
|
||||
end;
|
||||
|
||||
|
||||
function ParseMaze(raw: string; var start, finish: TPoint): TboolGrid;
|
||||
var
|
||||
tiles: TboolGrid;
|
||||
c: char;
|
||||
i,w,h,x,y: integer;
|
||||
begin
|
||||
writeln(raw);
|
||||
writeln('Parsing...');
|
||||
i:= 1;
|
||||
w:= strtoint(readLine(raw,i));
|
||||
h:= strtoint(readLine(raw,i));
|
||||
SetLength(tiles,w);
|
||||
for x:= 0 to w - 1 do
|
||||
SetLength(tiles[x],h);
|
||||
x:= 0;
|
||||
y:= 0;
|
||||
writeln('W:' + inttostr(w) + ' H:' + inttostr(h));
|
||||
while y < h do
|
||||
begin
|
||||
c:= raw[i];
|
||||
i:= i + 1;
|
||||
case c of
|
||||
'0': begin
|
||||
tiles[x][y]:= false;
|
||||
x:= x + 1;
|
||||
end;
|
||||
'1': begin
|
||||
tiles[x][y]:= true;
|
||||
x:= x + 1;
|
||||
end;
|
||||
'3': begin
|
||||
Writeln('found start!');
|
||||
start.x:= x;
|
||||
start.y:= y;
|
||||
tiles[x][y]:= true;
|
||||
x:= x + 1;
|
||||
end;
|
||||
'4': begin
|
||||
Writeln('found finish!');
|
||||
finish.x:= x;
|
||||
finish.y:= y;
|
||||
tiles[x][y]:= true;
|
||||
x:= x + 1;
|
||||
end;
|
||||
end;
|
||||
if x = w then begin x:= 0; y:= y + 1; end;
|
||||
end;
|
||||
result:= tiles;
|
||||
writeln('Start = (' + inttostr(start.x) + ',' + inttostr(start.y) + ')');
|
||||
writeln('Finish = (' + inttostr(finish.x) + ',' + inttostr(finish.y) + ')');
|
||||
//writeln('a1:'+inttostr(length(tiles)));
|
||||
//writeln('a2:'+inttostr(length(tiles[0])));
|
||||
//writeln('b1:'+inttostr(length(result)));
|
||||
//writeln('b2:'+inttostr(length(result[0])));
|
||||
end;
|
||||
|
||||
|
||||
function notPassed(var passed: TpointArray; x,y: integer): boolean;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
result:= true;
|
||||
for i:= length(passed) - 1 downto 0 do
|
||||
if (passed[i].x = x) and (passed[i].y = y) then begin result:= false; exit; end;
|
||||
end;
|
||||
|
||||
type TghettoStack = record
|
||||
passed,my_path: TpointArray;
|
||||
x,y: integer;
|
||||
end;
|
||||
|
||||
function point(x,y:integer):TPoint;
|
||||
begin
|
||||
result.x:= x;
|
||||
result.y:= y;
|
||||
end;
|
||||
|
||||
function flood(var input: array of array of boolean; sx,sy,dx,dy,w,h: integer): array of TpointArray;
|
||||
var
|
||||
i,off,len,top,scrat:integer;
|
||||
stack: array of TghettoStack;
|
||||
my_path,passed: TpointArray;
|
||||
x,y: integer;
|
||||
begin
|
||||
len:= 1000;
|
||||
SetLength(stack,len);
|
||||
SetLength(stack[0].passed,0);
|
||||
stack[0].x:= sx;
|
||||
stack[0].y:= sy;
|
||||
writeln('pushing start: (' + inttostr(sx) + ',' + inttostr(sy) + ')');
|
||||
off:= 0;
|
||||
top:= 1;
|
||||
while top > 0 do
|
||||
begin
|
||||
if top+4 > len then
|
||||
begin
|
||||
writeln('Growing!');
|
||||
len:= len + 1000;
|
||||
SetLength(stack,len);
|
||||
end;
|
||||
top:= top - 1;
|
||||
passed:= stack[top].passed;
|
||||
x:= stack[top].x;
|
||||
y:= stack[top].y;
|
||||
SetLength(my_path,Length(passed)+1);
|
||||
//writeln('following (' + inttostr(x) + ',' + inttostr(y) + ') ' + inttostr(length(my_path)));
|
||||
for i:= 0 to Length(passed) - 1 do
|
||||
begin
|
||||
my_path[i]:= passed[i];
|
||||
end;
|
||||
my_path[Length(passed)]:= point(x,y);
|
||||
if (x = dx) and (y = dy) then
|
||||
begin
|
||||
writeln('found path! ' + inttostr(off));
|
||||
SetLength(result,off+1);
|
||||
result[off]:= my_path;
|
||||
off:= off + 1;
|
||||
//writeln('continuing search');
|
||||
end;
|
||||
if (y-1 >= 0) then if input[x][y-1] then if notPassed(my_path,x,y-1) then
|
||||
begin
|
||||
stack[top].passed:= my_path;
|
||||
stack[top].x:= x;
|
||||
stack[top].y:= y-1;
|
||||
top:= top + 1;
|
||||
end;
|
||||
if (y+1 < h) then if input[x][y+1] then if notPassed(my_path,x,y+1) then
|
||||
begin
|
||||
stack[top].passed:= my_path;
|
||||
stack[top].x:= x;
|
||||
stack[top].y:= y+1;
|
||||
top:= top + 1;
|
||||
end;
|
||||
if (x-1 >= 0) then if input[x-1][y] then if notPassed(my_path,x-1,y) then
|
||||
begin
|
||||
stack[top].passed:= my_path;
|
||||
stack[top].x:= x-1;
|
||||
stack[top].y:= y;
|
||||
top:= top + 1;
|
||||
end;
|
||||
if (x+1 < w) then if input[x+1][y] then if notPassed(my_path,x+1,y) then
|
||||
begin
|
||||
stack[top].passed:= my_path;
|
||||
stack[top].x:= x+1;
|
||||
stack[top].y:= y;
|
||||
top:= top + 1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure prune(var input: array of array of boolean; x,y,w,h: integer);
|
||||
var
|
||||
nx,ny,c: integer;
|
||||
begin
|
||||
nx:= x;
|
||||
ny:= y;
|
||||
repeat
|
||||
x:= nx;
|
||||
y:= ny;
|
||||
input[x][y]:= false;
|
||||
c:= 0;
|
||||
if (y-1 >= 0) then if input[x][y-1] then
|
||||
begin
|
||||
c:= c + 1;
|
||||
ny:= y - 1;
|
||||
end;
|
||||
if (y+1 < h) then if input[x][y+1] then
|
||||
begin
|
||||
c:= c + 1;
|
||||
ny:= y + 1;
|
||||
end;
|
||||
if (x-1 >= 0) then if input[x-1][y] then
|
||||
begin
|
||||
c:= c + 1;
|
||||
nx:= x - 1;
|
||||
end;
|
||||
if (x+1 < w) then if input[x+1][y] then
|
||||
begin
|
||||
c:= c + 1;
|
||||
nx:= x + 1;
|
||||
end;
|
||||
until c <> 1;
|
||||
input[x][y]:= true;
|
||||
end;
|
||||
|
||||
procedure thin(var input: array of array of boolean; sx,sy,fx,fy,w,h: integer);
|
||||
var
|
||||
x,y,c: integer;
|
||||
begin
|
||||
//writeln('examining maze');
|
||||
for x:= 0 to w-1 do
|
||||
for y:= 0 to h-1 do
|
||||
if input[x][y] then
|
||||
begin
|
||||
c:= 0;
|
||||
if (y-1 >= 0) then if input[x][y-1] then c:= c + 1;
|
||||
if (y+1 < h) then if input[x][y+1] then c:= c + 1;
|
||||
if (x-1 >= 0) then if input[x-1][y] then c:= c + 1;
|
||||
if (x+1 < w) then if input[x+1][y] then c:= c + 1;
|
||||
if c <= 1 then if ((x<>sx) or (y<>sy)) and ((x<>fx) or (y<>fy)) then prune(input,x,y,w,h);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure benland100_solver(var jacks_path: TPointArray; var jills_routes: Integer; input: array of array of Boolean; start, finish: TPoint);
|
||||
var
|
||||
all_paths: array of TpointArray;
|
||||
i,max_pos,max_len: integer;
|
||||
begin
|
||||
//writeln('d1:'+inttostr(length(maze)));
|
||||
//writeln('d2:'+inttostr(length(maze[0])));
|
||||
writeln('preparing to solve maze');
|
||||
thin(input,start.x,start.y,finish.x,finish.y,length(input),length(input[0]));
|
||||
writeln('thinned the maze');
|
||||
//writeln('start: (' + inttostr(start.x) + ',' + inttostr(start.y) + ') finish: (' + inttostr(finish.x) + ',' + inttostr(finish.y) + ')');
|
||||
all_paths:= flood(input,start.x,start.y,finish.x,finish.y,length(input),length(input[0]));
|
||||
writeln('found all possible paths');
|
||||
jills_routes:= Length(all_paths) - 1;
|
||||
max_pos:= 0;
|
||||
max_len:= length(all_paths[0]);
|
||||
writeln('Finding longest...');
|
||||
for i:= 1 to jills_routes do
|
||||
begin
|
||||
if length(all_paths[i]) > max_len then
|
||||
begin
|
||||
max_len:= length(all_paths[i]);
|
||||
max_pos:= i;
|
||||
end;
|
||||
end;
|
||||
jacks_path:= all_paths[max_pos];
|
||||
end;
|
||||
|
||||
var
|
||||
//maze: array of array of boolean;
|
||||
start,finish: TPoint;
|
||||
jack: TPointArray;
|
||||
i,jills,t: integer;
|
||||
begin
|
||||
writeln('Solving maze...');
|
||||
//writeln('c1:'+inttostr(length(maze)));
|
||||
//writeln('c2:'+inttostr(length(maze[0])));
|
||||
//t:= GetSystemTime();
|
||||
//writeln('start: (' + inttostr(start.x) + ',' + inttostr(start.y) + ') finish: (' + inttostr(finish.x) + ',' + inttostr(finish.y) + ')');
|
||||
benland100_solver(jack,jills,ParseMaze(small_maze,start,finish),start,finish);
|
||||
//t:= GetSystemTime() - t;
|
||||
//writeln('Took ' + realtostr(t / 1000.0) + ' seconds');
|
||||
writeln('Longest Path: ' + inttostr(length(jack)));
|
||||
writeln('#Other Paths: ' + inttostr(jills));
|
||||
end.
|
||||
@ -136,11 +136,12 @@ type
|
||||
end;
|
||||
|
||||
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; runtime: boolean); stdcall;
|
||||
|
||||
TCPThread = class(TMThread)
|
||||
protected
|
||||
instance: pointer;
|
||||
added_methods: array of TExpMethod;
|
||||
public
|
||||
constructor Create(libname: string; CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string);
|
||||
destructor Destroy; override;
|
||||
@ -150,8 +151,10 @@ type
|
||||
procedure AddMethod(meth: TExpMethod); override;
|
||||
end;
|
||||
|
||||
function interp_init(ppg: PChar; precomp: TPrecompiler_Callback; err: TErrorHandeler_Callback): Pointer; cdecl; external;
|
||||
function interp_init(precomp: TPrecompiler_Callback; err: TErrorHandeler_Callback): Pointer; cdecl; external;
|
||||
procedure interp_meth(interp: Pointer; addr: Pointer; def: PChar); cdecl; external;
|
||||
procedure interp_set(interp: Pointer; ppg: PChar); cdecl; external;
|
||||
function interp_comp(interp: Pointer): boolean; cdecl; external;
|
||||
function interp_run(interp: Pointer): boolean; cdecl; external;
|
||||
procedure interp_free(interp: Pointer); cdecl; external;
|
||||
|
||||
@ -163,11 +166,8 @@ var
|
||||
implementation
|
||||
|
||||
{$ifdef LINUX}
|
||||
{$linklib c}
|
||||
{$linklib stdc++}
|
||||
{$link ./libcpascal.so}
|
||||
{$else}
|
||||
{$linklib stdc++}
|
||||
{$linklib ./libcpascal.dll}
|
||||
{$endif}
|
||||
|
||||
@ -302,7 +302,8 @@ function TMThread.ProcessDirective(DirectiveName, DirectiveArgs: string): boolea
|
||||
var
|
||||
plugin_idx, i: integer;
|
||||
begin
|
||||
if DirectiveName= 'LOADDLL' then
|
||||
writeln('Running Directive: ' + DirectiveName);
|
||||
if CompareText(DirectiveName,'LOADDLL') = 0 then
|
||||
begin
|
||||
if DirectiveArgs <> '' then
|
||||
begin;
|
||||
@ -677,21 +678,6 @@ end;
|
||||
|
||||
{***implementation TCPThread***}
|
||||
|
||||
constructor TCPThread.Create(libname: string; CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string);
|
||||
var
|
||||
plugin_idx: integer;
|
||||
begin
|
||||
instance:= nil;
|
||||
inherited Create(CreateSuspended, TheSyncInfo, plugin_dir);
|
||||
end;
|
||||
|
||||
destructor TCPThread.Destroy;
|
||||
begin
|
||||
if instance <> nil then
|
||||
interp_free(instance);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function Interpreter_Precompiler(name, args: PChar): boolean; stdcall;
|
||||
var
|
||||
local_name, local_args: string;
|
||||
@ -699,42 +685,62 @@ begin
|
||||
result:= CurrThread.ProcessDirective(name, args);
|
||||
end;
|
||||
|
||||
procedure Interpreter_ErrorHandler(line, pos: integer; err: PChar); stdcall;
|
||||
procedure Interpreter_ErrorHandler(line, pos: integer; err: PChar; runtime: boolean); stdcall;
|
||||
begin
|
||||
CurrThread.HandleError(line,pos,err,errRuntime,'');
|
||||
if runtime then
|
||||
CurrThread.HandleError(line,pos,err,errRuntime,'')
|
||||
else
|
||||
CurrThread.HandleError(line,pos,err,errCompile,'')
|
||||
end;
|
||||
|
||||
constructor TCPThread.Create(libname: string; CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string);
|
||||
var
|
||||
plugin_idx: integer;
|
||||
begin
|
||||
instance:= interp_init(@Interpreter_Precompiler, @Interpreter_ErrorHandler);
|
||||
inherited Create(CreateSuspended, TheSyncInfo, plugin_dir);
|
||||
end;
|
||||
|
||||
destructor TCPThread.Destroy;
|
||||
begin
|
||||
interp_free(instance);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCPThread.SetScript(script: string);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
if instance <> nil then
|
||||
interp_free(instance);
|
||||
Starttime := lclintf.GetTickCount;
|
||||
instance:= interp_init(PChar(@script[1]), @Interpreter_Precompiler, @Interpreter_ErrorHandler);
|
||||
for i := 0 to high(ExportedMethods) do
|
||||
if ExportedMethods[i].FuncPtr <> nil then
|
||||
interp_meth(instance,ExportedMethods[i].FuncPtr,PChar(ExportedMethods[i].FuncDecl));
|
||||
interp_set(instance,PChar(script));
|
||||
end;
|
||||
|
||||
procedure TCPThread.AddMethod(meth: TExpMethod);
|
||||
begin
|
||||
if instance = nil then
|
||||
raise Exception.Create('Script not set, cannot add method');
|
||||
interp_meth(instance,meth.FuncPtr,PChar(meth.FuncDecl));
|
||||
end;
|
||||
|
||||
procedure TCPThread.Execute;
|
||||
var
|
||||
i,ii: integer;
|
||||
begin
|
||||
if instance = nil then
|
||||
raise Exception.Create('Script not set, cannot run');
|
||||
CurrThread := Self;
|
||||
Starttime := lclintf.GetTickCount;
|
||||
Starttime := GetTickCount;
|
||||
psWriteln('Invoking CPascal Interpreter');
|
||||
if interp_run(instance) then
|
||||
psWriteln('Executed Successfully')
|
||||
else
|
||||
psWriteln('Execution Failed');
|
||||
if interp_comp(instance) then
|
||||
begin
|
||||
for i := high(PluginsToLoad) downto 0 do
|
||||
for ii := 0 to PluginsGlob.MPlugins[PluginsToLoad[i]].MethodLen - 1 do
|
||||
with PluginsGlob.MPlugins[PluginsToLoad[i]].Methods[ii] do
|
||||
interp_meth(self.instance,FuncPtr,PChar(FuncStr));
|
||||
for i := 0 to high(ExportedMethods) do
|
||||
if ExportedMethods[i].FuncPtr <> nil then
|
||||
with ExportedMethods[i] do
|
||||
interp_meth(self.instance,FuncPtr,PChar(FuncDecl));
|
||||
psWriteln('Compiled Successfully in ' + IntToStr(GetTickCount - Starttime) + 'ms');
|
||||
if interp_run(instance) then
|
||||
psWriteln('Executed Successfully')
|
||||
else
|
||||
psWriteln('Execution Failed');
|
||||
end else
|
||||
psWriteln('Compile Failed');
|
||||
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user