paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 17:21:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* C ABI fixes for the passing of records in WebAssembly

Browse Source
This commit is contained in:
Nikolay Nikolov 2021-10-14 08:29:16 +03:00
parent 236e10d03a
commit ee387f7c66
1 changed files with 54 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
compiler/wasm32/cpupara.pas
View File

@ -38,6 +38,7 @@ interface
function get_saved_registers_int(calloption: tproccalloption): tcpuregisterarray;override;
function keep_para_array_range(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean; override;
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
function push_size(varspez: tvarspez; def: tdef; calloption: tproccalloption): longint;override;
function create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
@ -48,6 +49,10 @@ interface
private
procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
var parasize:longint);
{ true if the record recursively (including through nested records and
arrays) contains just a single scalar value }
function is_singleton_scalar_record(def:trecorddef):boolean;
function is_singleton_scalar_array(def:tarraydef):boolean;
end;
implementation
@ -97,10 +102,7 @@ implementation
formaldef :
result:=true;
recorddef :
begin
{ Delphi stdcall passes records on the stack for call by value }
result:=(varspez=vs_const) or (not (def.size in [1,2,4{,8}]));
end;
result:=(varspez=vs_const) or not is_singleton_scalar_record(trecorddef(def));
arraydef :
begin
result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
@ -123,6 +125,18 @@ implementation
end;
function tcpuparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
begin
{ This handles all managed types, including COM interfaces and Variants }
if handle_common_ret_in_param(def,pd,result) then
exit;
if (def.typ=recorddef) and is_singleton_scalar_record(trecorddef(def)) then
result:=false
else
result:=inherited;
end;
function tcpuparamanager.push_size(varspez: tvarspez; def: tdef; calloption: tproccalloption): longint;
begin
{ all aggregate types are emulated using indirect pointer types }
@ -288,6 +302,42 @@ implementation
end;
function tcpuparamanager.is_singleton_scalar_record(def: trecorddef): boolean;
var
i,fields: Integer;
begin
if not (def.size in [1,2,4,8]) then
exit(false);
fields:=0;
for i:=0 to def.symtable.symlist.count-1 do
begin
if (tsym(def.symtable.symlist[i]).typ<>fieldvarsym) or
(sp_static in tsym(def.symtable.symlist[i]).symoptions) then
continue;
if assigned(tfieldvarsym(def.symtable.symlist[i]).vardef) then
begin
Inc(fields);
if fields>1 then
exit(false);
{ search recursively }
if (tstoreddef(tfieldvarsym(def.symtable.symlist[i]).vardef).typ=recorddef) and
not is_singleton_scalar_record(trecorddef(tfieldvarsym(def.symtable.symlist[i]).vardef)) then
exit(false);
if (tstoreddef(tfieldvarsym(def.symtable.symlist[i]).vardef).typ=arraydef) and
not is_singleton_scalar_array(tarraydef(tfieldvarsym(def.symtable.symlist[i]).vardef)) then
exit(false);
end;
end;
result:=true;
end;
function tcpuparamanager.is_singleton_scalar_array(def:tarraydef):boolean;
begin
result:=(def.size in [1,2,4,8]) and (def.elecount=1);
end;
function tcpuparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
var
parasize : longint;