mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 18:08:17 +02:00
379 lines
14 KiB
ObjectPascal
379 lines
14 KiB
ObjectPascal
{
|
|
Copyright (c) 2019 by Dmtiry Boyarintsev
|
|
|
|
Calling conventions for the WebAssembly
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
*****************************************************************************}
|
|
unit cpupara;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
globtype,
|
|
cclasses,
|
|
aasmtai,aasmdata,
|
|
cpubase,cpuinfo,
|
|
symconst,symbase,symsym,symtype,symdef,paramgr,parabase,cgbase,cgutils;
|
|
|
|
type
|
|
|
|
{ tcpuparamanager }
|
|
|
|
tcpuparamanager=class(TParaManager)
|
|
function has_strict_proc_signature: boolean; override;
|
|
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;
|
|
function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
|
|
{ true if the location in paraloc can be reused as localloc }
|
|
function param_use_paraloc(const cgpara: tcgpara): boolean; override;
|
|
function is_stack_paraloc(paraloc: pcgparalocation): boolean;override;
|
|
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
|
|
|
|
uses
|
|
cutils,verbose,systems,
|
|
defutil,wasmdef,tgcpu,
|
|
aasmcpu,
|
|
hlcgobj;
|
|
|
|
|
|
function tcpuparamanager.has_strict_proc_signature: boolean;
|
|
begin
|
|
Result:=true;
|
|
end;
|
|
|
|
|
|
function tcpuparamanager.get_saved_registers_int(calloption: tproccalloption): tcpuregisterarray;
|
|
const
|
|
{ dummy, not used for WebAssembly }
|
|
saved_regs: tcpuregisterarray = (RS_NO);
|
|
begin
|
|
result:=saved_regs;
|
|
end;
|
|
|
|
|
|
function tcpuparamanager.keep_para_array_range(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
|
|
begin
|
|
{ even though these don't need a high parameter (see push_high_param),
|
|
we do have to keep the original parameter's array length because it's
|
|
used by the compiler (to determine the size of the array to construct
|
|
to pass to an array of const parameter) }
|
|
if not is_array_of_const(def) then
|
|
result:=inherited
|
|
else
|
|
result:=true;
|
|
end;
|
|
|
|
|
|
{ true if a parameter is too large to copy and only the address is pushed }
|
|
function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
|
begin
|
|
result:=false;
|
|
{ var,out,constref always require address }
|
|
if varspez in [vs_var,vs_out,vs_constref] then
|
|
begin
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
{ Only vs_const, vs_value here }
|
|
case def.typ of
|
|
variantdef,
|
|
formaldef :
|
|
result:=true;
|
|
recorddef :
|
|
result:=(varspez=vs_const) or not is_singleton_scalar_record(trecorddef(def));
|
|
arraydef :
|
|
begin
|
|
result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
|
|
is_open_array(def) or
|
|
is_array_of_const(def) or
|
|
is_array_constructor(def);
|
|
end;
|
|
objectdef :
|
|
result:=is_object(def);
|
|
stringdef :
|
|
result:= (tstringdef(def).stringtype in [st_shortstring,st_longstring]);
|
|
procvardef :
|
|
result:=not(calloption in cdecl_pocalls) and not tprocvardef(def).is_addressonly;
|
|
setdef :
|
|
result:=not is_smallset(def);
|
|
else
|
|
;
|
|
end;
|
|
|
|
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 }
|
|
result:=inherited;
|
|
end;
|
|
|
|
|
|
function tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
|
|
var
|
|
paraloc : pcgparalocation;
|
|
retcgsize : tcgsize;
|
|
begin
|
|
result.init;
|
|
result.alignment:=get_para_align(p.proccalloption);
|
|
if not assigned(forcetempdef) then
|
|
result.def:=p.returndef
|
|
else
|
|
begin
|
|
result.def:=forcetempdef;
|
|
result.temporary:=true;
|
|
end;
|
|
result.def:=get_para_push_size(result.def);
|
|
{ void has no location }
|
|
if is_void(result.def) then
|
|
begin
|
|
paraloc:=result.add_location;
|
|
result.size:=OS_NO;
|
|
result.intsize:=0;
|
|
paraloc^.size:=OS_NO;
|
|
paraloc^.def:=voidtype;
|
|
paraloc^.loc:=LOC_VOID;
|
|
exit;
|
|
end;
|
|
{ Constructors return self instead of a boolean }
|
|
if (p.proctypeoption=potype_constructor) then
|
|
begin
|
|
retcgsize:=OS_INT;
|
|
result.intsize:=sizeof(pint);
|
|
end
|
|
//todo: wasm should have the similar
|
|
{else if jvmimplicitpointertype(result.def) then
|
|
begin
|
|
retcgsize:=OS_ADDR;
|
|
result.def:=cpointerdef.getreusable_no_free(result.def);
|
|
end}
|
|
else
|
|
begin
|
|
retcgsize:=def_cgsize(result.def);
|
|
result.intsize:=result.def.size;
|
|
end;
|
|
result.size:=retcgsize;
|
|
|
|
paraloc:=result.add_location;
|
|
{ all values are returned on the evaluation stack }
|
|
paraloc^.loc:=LOC_REFERENCE;
|
|
paraloc^.reference.index:=NR_EVAL_STACK_BASE;
|
|
paraloc^.reference.offset:=0;
|
|
paraloc^.size:=result.size;
|
|
paraloc^.def:=result.def;
|
|
end;
|
|
|
|
function tcpuparamanager.param_use_paraloc(const cgpara: tcgpara): boolean;
|
|
begin
|
|
{ all parameters are copied to the linear stack, so that their address
|
|
can be taken }
|
|
result:=false;
|
|
end;
|
|
|
|
function tcpuparamanager.is_stack_paraloc(paraloc: pcgparalocation): boolean;
|
|
begin
|
|
{ all parameters are passed on the evaluation stack }
|
|
result:=true;
|
|
end;
|
|
|
|
|
|
function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
|
|
var
|
|
parasize : longint;
|
|
begin
|
|
parasize:=0;
|
|
{ calculate the registers for the normal parameters }
|
|
create_paraloc_info_intern(p,side,p.paras,parasize);
|
|
{ append the varargs }
|
|
if assigned(varargspara) then
|
|
begin
|
|
if side=callerside then
|
|
create_paraloc_info_intern(p,side,varargspara,parasize)
|
|
else
|
|
internalerror(2019021924);
|
|
end;
|
|
create_funcretloc_info(p,side);
|
|
result:=parasize;
|
|
end;
|
|
|
|
|
|
procedure tcpuparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
|
|
var parasize:longint);
|
|
var
|
|
paraloc : pcgparalocation;
|
|
i : integer;
|
|
hp : tparavarsym;
|
|
paracgsize : tcgsize;
|
|
paraofs : longint;
|
|
paradef : tdef;
|
|
wbt : TWasmBasicType;
|
|
begin
|
|
paraofs:=0;
|
|
for i:=0 to paras.count-1 do
|
|
begin
|
|
hp:=tparavarsym(paras[i]);
|
|
if push_copyout_param(hp.varspez,hp.vardef,p.proccalloption) then
|
|
begin
|
|
{ passed via array reference (instead of creating a new array
|
|
type for every single parameter, use java_jlobject) }
|
|
paracgsize:=OS_ADDR;
|
|
paradef:=ptruinttype;
|
|
end
|
|
else if push_addr_param(hp.varspez, hp.vardef,p.proccalloption) then
|
|
begin
|
|
paracgsize:=OS_ADDR;
|
|
paradef:=cpointerdef.getreusable_no_free(hp.vardef);
|
|
end
|
|
else
|
|
begin
|
|
if (hp.vardef.typ=recorddef) and
|
|
(trecorddef(hp.vardef).contains_float_field) and
|
|
defToWasmBasic(hp.vardef,wbt) then
|
|
begin
|
|
case wbt of
|
|
wbt_f32:
|
|
paracgsize:=OS_F32;
|
|
wbt_f64:
|
|
paracgsize:=OS_F64;
|
|
else
|
|
internalerror(2021101401);
|
|
end;
|
|
end
|
|
else
|
|
paracgsize:=def_cgsize(hp.vardef);
|
|
if paracgsize=OS_NO then
|
|
paracgsize:=OS_ADDR;
|
|
paradef:=hp.vardef;
|
|
end;
|
|
paradef:=get_para_push_size(paradef);
|
|
hp.paraloc[side].reset;
|
|
hp.paraloc[side].size:=paracgsize;
|
|
hp.paraloc[side].def:=paradef;
|
|
hp.paraloc[side].alignment:=std_param_align;
|
|
hp.paraloc[side].intsize:=tcgsize2size[paracgsize];
|
|
paraloc:=hp.paraloc[side].add_location;
|
|
{ All parameters are passed on the evaluation stack, pushed from
|
|
left to right (including self, if applicable). At the callee side,
|
|
they're available as local variables 0..n-1 }
|
|
paraloc^.loc:=LOC_REFERENCE;
|
|
paraloc^.reference.offset:=paraofs;
|
|
paraloc^.size:=paracgsize;
|
|
paraloc^.def:=paradef;
|
|
case side of
|
|
callerside:
|
|
begin
|
|
paraloc^.loc:=LOC_REFERENCE;
|
|
{ we use a fake loc_reference to indicate the stack location;
|
|
the offset (set above) will be used by ncal to order the
|
|
parameters so they will be pushed in the right order }
|
|
paraloc^.reference.index:=NR_EVAL_STACK_BASE;
|
|
end;
|
|
calleeside:
|
|
begin
|
|
paraloc^.loc:=LOC_REFERENCE;
|
|
paraloc^.reference.index:=NR_STACK_POINTER_REG;
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
inc(paraofs);
|
|
end;
|
|
parasize:=paraofs;
|
|
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:=(fields=1);
|
|
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;
|
|
begin
|
|
parasize:=0;
|
|
create_paraloc_info_intern(p,side,p.paras,parasize);
|
|
{ Create Function result paraloc }
|
|
create_funcretloc_info(p,side);
|
|
{ We need to return the size allocated on the stack }
|
|
result:=parasize;
|
|
end;
|
|
|
|
|
|
initialization
|
|
ParaManager:=tcpuparamanager.create;
|
|
end.
|