Delphi/pascalscript
Delphi/pascalscript
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

* Patch by Martin Friebe for PowerPC: 1/2 byte sets; string return types

Browse Source
This commit is contained in:
Carlo Kok 2012-12-19 19:55:14 +01:00
parent eacb338174
commit 9a4799fa0e
1 changed files with 34 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
Source/powerpc.inc
View File

@ -173,14 +173,14 @@ asmcall_end: { epilogue }
blr blr
end; end;
Procedure FlipHiLo1(v: byte): byte; function FlipHiLo(v: byte): byte;
var var
i: integer i: integer;
j, k: byte; j, k: byte;
begin begin
Result := 0; Result := 0;
j := 1;
k := $80; k := $80;
j := $01;
for i := 0 to 7 do begin for i := 0 to 7 do begin
if (v and k) <> 0 then if (v and k) <> 0 then
Result := Result or j; Result := Result or j;
@ -189,46 +189,17 @@ begin
end; end;
end; end;
Procedure FlipHiLo2(v: word): byte;
var
i: integer
j, k: word;
begin
Result := 0;
j := 1;
k := $8000;
for i := 0 to 15 do begin
if (v and k) <> 0 then
Result := Result or j;
k := k div 2;
j := j * 2;
end;
end;
Procedure FlipHiLo4(v: cardinal): byte;
var
i: integer
j, k: cardinal;
begin
Result := 0;
j := 1;
k := $80000000;
for i := 0 to 31 do begin
if (v and k) <> 0 then
Result := Result or j;
k := k div 2;
j := j * 2;
end;
end;
function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean; function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean;
var var
rint: Trint; { registers r3 to r10 } rint: Trint; { registers r3 to r10 }
rfloat: Trfloat; { registers f1 to f13 } rfloat: Trfloat; { registers f1 to f13 }
st: packed array of byte; { stack } st: packed array of byte; { stack }
i, j, rindex, findex, stindex: integer; i, j, n, m, rindex, findex, stindex: integer;
fvar: PPSVariantIFC; fvar: PPSVariantIFC;
IsConstructor: Boolean; IsConstructor: Boolean;
fSetHelper: dword;
fSetP1, fsetP2: PByte;
{ add a dword to stack } { add a dword to stack }
procedure addstackdword(value: dword); procedure addstackdword(value: dword);
begin begin
@ -266,7 +237,7 @@ var
inc(rindex); inc(rindex);
{$ifdef NeedRegCopyOnStack} {$ifdef NeedRegCopyOnStack}
addstackdword(value); addstackdword(value);
{$endif} {$endif}
end end
else begin else begin
addstackdword(value); addstackdword(value);
@ -284,7 +255,7 @@ var
inc(findex); inc(findex);
inc(rindex, size); inc(rindex, size);
{$ifdef NeedRegCopyOnStack} {$ifdef NeedRegCopyOnStack}
addstackfloat(value, size); addstackfloat(value, size);
{$endif} {$endif}
end end
else begin else begin
@ -301,7 +272,7 @@ begin
rindex := 1; rindex := 1;
findex := 1; findex := 1;
{$ifdef NeedRegCopyOnStack} {$ifdef NeedRegCopyOnStack}
stindex := 24; stindex := 24;
{$else} {$else}
stindex := 0; // do not create a stack, if only registers are used stindex := 0; // do not create a stack, if only registers are used
{$endif} {$endif}
@ -311,12 +282,12 @@ begin
if assigned(_Self) then begin if assigned(_Self) then begin
addgen(dword(_Self)); addgen(dword(_Self));
end; end;
{ the pointer of the result needs to be passed first in the case of some result types } { the pointer of the result needs to be passed first in the case of some result types }
if assigned(res) if assigned(res)
then begin then begin
case res.atype.basetype of case res.atype.basetype of
btStaticArray, btRecord: addgen(dword(res.dta)); btStaticArray, btRecord, btString: addgen(dword(res.dta));
end; end;
end; end;
@ -366,12 +337,27 @@ begin
addgen(pdword(fvar.dta + j*4)^); addgen(pdword(fvar.dta + j*4)^);
btArray: addgen(dword(fvar.dta^)); btArray: addgen(dword(fvar.dta^));
btSet: begin btSet: begin
case TPSTypeRec_Set(fvar.aType).aByteSize of
1: addgen(dword(FlipHiLo1(byte(fvar.dta^)))); fSetP1 := fvar.dta;
2: addgen(dword(FlipHiLo2(word(fvar.dta^)))); fSetP2 := @fSetHelper;
3, 4: addgen(dword(FlipHiLo4(cardinal(fvar.dta^)))); fSetHelper := 0;
for n := 1 to TPSTypeRec_Set(fvar.aType).aByteSize do
begin
fSetP2^ := fliphilo(fSetP1^);
inc(fSetP1);
inc(fSetP2);
if n and 3 = 0
then begin
addgen(fSetHelper);
fSetP2 := @fSetHelper;
fSetHelper := 0;
end;
end; end;
if TPSTypeRec_Set(fvar.aType).aByteSize and 3 <> 0
then addgen(fSetHelper);
end; end;
{ TODO add and test } { TODO add and test }
{ btVariant, btSet, btInterface, btClass } { btVariant, btSet, btInterface, btClass }
@ -382,10 +368,12 @@ begin
end; { case } end; { case }
end; { else } end; { else }
end; { for } end; { for }
if (stindex mod 16) <> 0 then begin if (stindex mod 16) <> 0 then begin
stindex := stindex + 16 - (stindex mod 16); stindex := stindex + 16 - (stindex mod 16);
setlength(st, stindex); setlength(st, stindex);
end; end;
if not assigned(res) if not assigned(res)
then begin then begin
ppcasmcall(rint, rfloat, address, st, stindex, rtINT); { ignore return } ppcasmcall(rint, rfloat, address, st, stindex, rtINT); { ignore return }
@ -393,7 +381,7 @@ begin
else begin else begin
case res.atype.basetype of case res.atype.basetype of
{ add result types here } { add result types here }
btString: pstring(res.dta)^ := pstring(ppcasmcall(rint, rfloat, address, st, stindex, rtINT))^; btString: ppcasmcall(rint, rfloat, address, st, stindex, rtINT);
btU8, btS8: pbyte(res.dta)^ := byte(pdword(ppcasmcall(rint, rfloat, address, st, stindex, rtINT))^); btU8, btS8: pbyte(res.dta)^ := byte(pdword(ppcasmcall(rint, rfloat, address, st, stindex, rtINT))^);
btU16, btS16: pword(res.dta)^ := word(pdword(ppcasmcall(rint, rfloat, address, st, stindex, rtINT))^); btU16, btS16: pword(res.dta)^ := word(pdword(ppcasmcall(rint, rfloat, address, st, stindex, rtINT))^);
btU32, btS32: pdword(res.dta)^ := pdword(ppcasmcall(rint, rfloat, address, st, stindex, rtINT))^; btU32, btS32: pdword(res.dta)^ := pdword(ppcasmcall(rint, rfloat, address, st, stindex, rtINT))^;