paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 19:59:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

PascalScript: powerpc, add string as result, and sets in param

Browse Source 
git-svn-id: trunk@39550 -
This commit is contained in:
martin 2012-12-15 17:32:37 +00:00
parent f2be37ded9
commit 18885a0cb2
1 changed files with 43 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
components/PascalScript/Source/powerpc.inc
View File

@ -175,14 +175,33 @@ asmcall_end: { epilogue }
blr blr
end; end;
function FlipHiLo(v: byte): byte;
var
i: integer;
j, k: byte;
begin
Result := 0;
k := $80;
j := $01;
for i := 0 to 7 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
@ -270,7 +289,7 @@ begin
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;
@ -319,6 +338,27 @@ begin
btRecord: for j := 0 to (fvar.atype.realsize div 4)-1 do btRecord: for j := 0 to (fvar.atype.realsize div 4)-1 do
addgen(pdword(fvar.dta + j*4)^); addgen(pdword(fvar.dta + j*4)^);
btArray: addgen(dword(fvar.dta^)); btArray: addgen(dword(fvar.dta^));
btSet: begin
fSetP1 := fvar.dta;
fSetP2 := @fSetHelper;
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;
if TPSTypeRec_Set(fvar.aType).aByteSize and 3 <> 0
then addgen(fSetHelper);
end;
{ TODO add and test } { TODO add and test }
{ btVariant, btSet, btInterface, btClass } { btVariant, btSet, btInterface, btClass }
@ -343,7 +383,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))^;