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

trunk/Projects/SAMufasaGUI/testunit.lfm

@@ -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'

trunk/Projects/SAMufasaGUI/testunit.lrs

@@ -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'
+  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#194#2#6'Height'#3'-'#2#3'Top'#3'u'#1#5'Wi'
-  +'th'#3#222#2#13'ActiveControl'#7#11'ScriptPanel'#7'Caption'#6#16'THA FUKING '
+  +'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'M'
+  +' SIMBA'#12'ClientHeight'#3#20#2#11'ClientWidth'#3#222#2#10'KeyPreview'#9#4
-  +'enu'#7#8'MainMenu'#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9
+  +'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'

trunk/Tests/CPascal/maze.simb

@@ -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.

trunk/Units/MMLAddon/mmlpsthread.pas

@@ -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_set(instance,PChar(script));
-    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));
 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
+  if interp_comp(instance) then
-     psWriteln('Executed Successfully')
+  begin
-  else
+    for i := high(PluginsToLoad) downto 0 do
-     psWriteln('Execution Failed');
+      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;