moparisthebest
/
Simba
mirror of https://github.com/moparisthebest/Simba
1
0
Fork 0
Code Issues Releases Wiki Activity

I think I've fixed PS for the array-result bug.. :)

This commit is contained in:
Raymond 2010-04-08 00:40:28 +02:00
parent 2d58a145fc
commit deef894757
4 changed files with 22 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Units/MMLAddon/PSInc/pscompile.inc
View File

@ -31,6 +31,7 @@ Sender.Comp.AddTypeS('TReplaceFlags','set of TReplaceFlag');
Sender.Comp.AddTypeS('StrExtr','(Numbers, Letters, Others);');
Sender.Comp.AddTypeS('TDateTime','Double');
Sender.Comp.AddTypeS('TIntegerArray', 'Array of LongInt');
Sender.Comp.AddTypeS('TByteArray','Array of byte');
Sender.Comp.AddTypeS('TExtendedArray','Array of extended');
Sender.Comp.AddTypeS('TBoolArray', 'Array of Boolean');
Sender.Comp.AddTypes('TBox', 'record X1,Y1,X2,Y2 : Integer; end;');

13
Units/MMLAddon/mmlpsthread.pas
View File

@ -215,17 +215,18 @@ uses
lclintf // for GetTickCount and others.
;
{$ifdef Linux}
//{$define PS_StdCall}
{$define PS_SafeCall}
{$else}
//{$define PS_StdCall}
//{$define PS_SafeCall}
{$endif}
{$MACRO ON}
{$ifdef PS_StdCall}
{$define extdecl := stdcall}
{$else}
{$ifdef PS_SafeCall}
{$define extdecl := safecall}
{$else}
{$define extdecl := register}
{$endif}
{Some General PS Functions here}
procedure psWriteln(str : string); extdecl;
begin
@ -614,7 +615,7 @@ begin
for i := 0 to high(ExportedMethods) do
if ExportedMethods[i].FuncPtr <> nil then
Sender.AddFunctionEx(ExportedMethods[i].FuncPtr,ExportedMethods[i].FuncDecl,
{$ifdef PS_StdCall}cdStdCall{$else}cdSafeCall{$endif});
{$ifdef PS_SafeCall}cdSafeCall{$else}cdRegister{$endif});
end;
function TPSThread.RequireFile(Sender: TObject;

3
Units/PascalScript/PascalScriptFPC.inc
View File

@ -8,8 +8,7 @@
{$DEFINE PS_STACKALIGN}
{$UNDEF PS_FPCSTRINGWORKAROUND}
{$DEFINE PS_RESBEFOREPARAMETERS}
{$DEFINE x64_string_result_as_varparameter}
{$DEFINE PS_RESULTFIRST}
{$DEFINE x64_string_result_as_varparameter}
{FreePascal 2.3.1 and above has much Delphi compatibility bugs fixed}
{$else}
{$DEFINE FPC_OLD_FIX}

19
Units/PascalScript/x86.inc
View File

@ -251,7 +251,9 @@ var
RegUsage: Byte;
CallData: TPSList;
pp: ^Byte;
{$IFDEF FPC}
IsConstructor: Boolean;
{$ENDIF}
EAX, EDX, ECX: Longint;
@ -502,10 +504,15 @@ var
end;
begin
if (Integer(CallingConv) and 64) <> 0 then begin
IsConstructor := true;
{$IFDEF FPC}
IsConstructor := true;
{$ENDIF}
CAllingConv := TPSCallingConvention(Integer(CallingConv) and not 64);
end else IsConstructor := false;
end else begin
{$IFDEF FPC}
IsConstructor := false;
{$ENDIF}
end;
InnerfuseCall := False;
if Address = nil then
exit; // need address
@ -566,7 +573,7 @@ begin
btchar,btU8, btS8: tbtu8(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
btClass :
{$IFDEF FPC}
{$IFDEF FPC_OLD_FIX}
tbtu32(res.dta^) := RealCall_Register(Address, EDX, EAX, ECX,
@Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil);
{$ELSE}
@ -574,7 +581,7 @@ begin
@Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil);
{$ENDIF}
btu32,bts32: tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
btu32,bts32{$IFDEF FPC},btArray{$ENDIF}: tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
btPChar: pansichar(res.dta^) := Pansichar(RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
{$IFNDEF PS_NOINT64}bts64:
begin
@ -586,7 +593,7 @@ begin
btInterface,
btVariant,
{$IFNDEF PS_NOWIDESTRING}btWidestring,btUnicodestring, {$ENDIF}
btStaticArray, btArray, btrecord{$IFNDEF PS_FPCSTRINGWORKAROUND}, btstring {$ENDIF}: RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
btStaticArray, {$IFNDEF FPC} btArray,{$ENDIF} btrecord{$IFNDEF PS_FPCSTRINGWORKAROUND}, btstring {$ENDIF}: RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
{$IFDEF PS_FPCSTRINGWORKAROUND}
btstring: begin
eax := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);