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

[PATCH 17/83] adding support for wasm if-else-block

Browse Source 
From 3de374be5fcd29b9a57a43073ccc4f7fe8425805 Mon Sep 17 00:00:00 2001
From: Dmitry Boyarintsev <skalogryz.lists@gmail.com>
Date: Mon, 9 Sep 2019 11:22:56 -0400

git-svn-id: branches/wasm@45894 -
This commit is contained in:
nickysn 2020-07-29 16:48:23 +00:00
parent d496755ffb
commit f0f55f1b60
7 changed files with 367 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -931,6 +931,8 @@ compiler/wasm/cpupi.pas svneol=native#text/plain
compiler/wasm/cputarg.pas svneol=native#text/plain
compiler/wasm/hlcgcpu.pas svneol=native#text/plain
compiler/wasm/itcpuwasm.pas svneol=native#text/plain
compiler/wasm/nwasmadd.pas svneol=native#text/plain
compiler/wasm/nwasmflw.pas svneol=native#text/plain
compiler/wasm/rgcpu.pas svneol=native#text/plain
compiler/wasm/rwasmcon.inc svneol=native#text/plain
compiler/wasm/rwasmnor.inc svneol=native#text/plain

4
compiler/wasm/agwat.pas
View File

@ -213,6 +213,10 @@ implementation
cpu := taicpu(hp);
writer.AsmWrite(#9);
writer.AsmWrite(wasm_op2str[cpu.opcode] );
if (cpu.opcode = a_if) then
writer.AsmWrite(' (result i32)'); //todo: this is a hardcode, but shouldn't
cpu := taicpu(hp);
if cpu.ops<>0 then
begin

6
compiler/wasm/cpunode.pas
View File

@ -1,7 +1,7 @@
{******************************************************************************
Copyright (c) 2000-2010 by Florian Klaempfl and Jonas Maebe
Copyright (c) 2019 by Dmitry Boyarintsev
Includes the JVM code generator
Includes the WebAssembly code generator
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
@ -32,6 +32,8 @@ implementation
uses
ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset,
ncgadd, ncgcal,ncgmat,ncginl,
nwasmadd, nwasmflw,
(* todo: WASM
njvmadd,njvmcal,njvmmat,njvmcnv,njvmcon,njvminl,njvmmem,njvmflw,njvmld,
njvmset,njvmvmt

4
compiler/wasm/cpupara.pas
View File

@ -48,7 +48,9 @@ interface
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;
{ Returns true if the return value is actually a parameter pointer }
function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
function is_stack_paraloc(paraloc: pcgparalocation): boolean;override;
private
@ -73,7 +75,7 @@ implementation
function tcpuparamanager.get_saved_registers_int(calloption: tproccalloption): tcpuregisterarray;
const
{ dummy, not used for JVM }
{ dummy, not used for WebAssembly }
saved_regs: {$ifndef VER3_0}tcpuregisterarray{$else}array [0..0] of tsuperregister{$endif} = (RS_NO);
begin
result:=saved_regs;

19
compiler/wasm/hlcgcpu.pas
View File

@ -832,6 +832,13 @@ implementation
var
cgsize: tcgsize;
begin
// WASM doesn't have compare+jump (to label) operation
// thus even though this is a_cmp_stack_label()
// label operrand is ommited
//
// todo: it should NOT be ommitted when we're leaving a block
// (i.e. Exit or break or continue operators)
case def2regtyp(size) of
R_INTREGISTER:
begin
@ -841,14 +848,16 @@ implementation
OS_16,OS_S16,
OS_S32,OS_32:
begin
list.concat(taicpu.op_sym(opcmp32[cmp_op],lab));
//list.concat(taicpu.op_sym(opcmp32[cmp_op],lab));
list.concat(taicpu.op_none(opcmp32[cmp_op]));
decstack(list,2);
end;
OS_64,OS_S64:
begin
//list.concat(taicpu.op_none(a_lcmp));
//decstack(list,3);
list.concat(taicpu.op_sym(opcmp64[cmp_op],lab));
//list.concat(taicpu.op_sym(opcmp64[cmp_op],lab));
list.concat(taicpu.op_none(opcmp64[cmp_op]));
decstack(list,2);
end;
else
@ -859,9 +868,11 @@ implementation
begin
case cmp_op of
OC_EQ:
list.concat(taicpu.op_sym(a_i64_eq,lab));
//list.concat(taicpu.op_sym(a_i64_eq,lab));
list.concat(taicpu.op_none(a_i64_eq));
OC_NE:
list.concat(taicpu.op_sym(a_i64_ne,lab));
//list.concat(taicpu.op_sym(a_i64_ne,lab));
list.concat(taicpu.op_none(a_i64_ne));
else
internalerror(2010120537);
end;

254
compiler/wasm/nwasmadd.pas Normal file
View File

@ -0,0 +1,254 @@
{
Copyright (c) 2019 by Dmitry Boyarintsev
Code generation for add nodes on 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 nwasmadd;
{$i fpcdefs.inc}
interface
uses
cgbase,
node,ncgadd,cpubase;
type
{ twasmaddnode }
twasmaddnode = class(tcgaddnode)
protected
procedure second_generic_compare(unsigned: boolean);
procedure pass_left_right;override;
procedure second_addfloat;override;
procedure second_cmpfloat;override;
procedure second_cmpboolean;override;
procedure second_cmp64bit;override;
procedure second_add64bit; override;
procedure second_cmpordinal;override;
end;
implementation
uses
systems,
cutils,verbose,constexp,globtype,compinnr,
symconst,symtable,symdef,symcpu,
paramgr,procinfo,pass_1,
aasmbase,aasmtai,aasmdata,aasmcpu,defutil,
hlcgobj,hlcgcpu,cgutils,
cpupara,
nbas,ncon,nset,nadd,ncal,ncnv,ninl,nld,nmat,nmem,
//njvmcon,
cgobj;
{*****************************************************************************
tjvmaddnode
*****************************************************************************}
procedure twasmaddnode.pass_left_right;
begin
//if not((nodetype in [orn,andn]) and
// is_boolean(left.resultdef)) then
// swapleftright;
inherited pass_left_right;
end;
procedure twasmaddnode.second_addfloat;
//var
// op : TAsmOp;
// commutative : boolean;
begin
//pass_left_right;
//
//location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
//location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
//
//commutative:=false;
//case nodetype of
// addn :
// begin
// if location.size=OS_F64 then
// op:=a_dadd
// else
// op:=a_fadd;
// commutative:=true;
// end;
// muln :
// begin
// if location.size=OS_F64 then
// op:=a_dmul
// else
// op:=a_fmul;
// commutative:=true;
// end;
// subn :
// begin
// if location.size=OS_F64 then
// op:=a_dsub
// else
// op:=a_fsub;
// end;
// slashn :
// begin
// if location.size=OS_F64 then
// op:=a_ddiv
// else
// op:=a_fdiv;
// end;
// else
// internalerror(2011010402);
//end;
//
//{ swap the operands to make it easier for the optimizer to optimize
// the operand stack slot reloading (non-commutative operations must
// always be in the correct order though) }
//if (commutative and
// (left.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
// (right.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER])) or
// (not commutative and
// (nf_swapped in flags)) then
// swapleftright;
//
//thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
//thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location);
//
//current_asmdata.CurrAsmList.concat(taicpu.op_none(op));
//thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1+ord(location.size=OS_F64));
//{ could be optimized in the future by keeping the results on the stack,
// if we add code to swap the operands when necessary (a_swap for
// singles, store/load/load for doubles since there is no swap for
// 2-slot elements -- also adjust expectloc in that case! }
//thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
end;
procedure twasmaddnode.second_cmpfloat;
//var
// truelabel,
// falselabel: tasmlabel;
// op: tasmop;
// cmpop: TOpCmp;
begin
//truelabel:=nil;
//falselabel:=nil;
//pass_left_right;
//{ swap the operands to make it easier for the optimizer to optimize
// the operand stack slot reloading in case both are in a register }
//if (left.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
// (right.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
// swapleftright;
//cmpop:=cmpnode2topcmp(false);
//if (nf_swapped in flags) then
// cmpop:=swap_opcmp(cmpop);
//
//current_asmdata.getjumplabel(truelabel);
//current_asmdata.getjumplabel(falselabel);
//location_reset_jump(location,truelabel,falselabel);
//
//thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
//thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location);
//
//{ compares two floating point values and puts 1/0/-1 on stack depending
// on whether value1 >/=/< value2 }
//if left.location.size=OS_F64 then
// { make sure that comparisons with NaNs always return false for </> }
// if nodetype in [ltn,lten] then
// op:=a_dcmpg
// else
// op:=a_dcmpl
//else if nodetype in [ltn,lten] then
// op:=a_fcmpg
//else
// op:=a_fcmpl;
//current_asmdata.CurrAsmList.concat(taicpu.op_none(op));
//thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,(1+ord(left.location.size=OS_F64))*2-1);
//
//current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcmp2if[cmpop],location.truelabel));
//thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
//hlcg.a_jmp_always(current_asmdata.CurrAsmList,location.falselabel);
end;
procedure twasmaddnode.second_cmpboolean;
begin
//second_generic_compare(true);
end;
procedure twasmaddnode.second_cmp64bit;
begin
//second_generic_compare(not is_signed(left.resultdef));
end;
procedure twasmaddnode.second_add64bit;
begin
//second_opordinal;
end;
procedure twasmaddnode.second_cmpordinal;
begin
second_generic_compare(not is_signed(left.resultdef));
end;
procedure twasmaddnode.second_generic_compare(unsigned: boolean);
var
truelabel,
falselabel: tasmlabel;
cmpop: TOpCmp;
begin
truelabel:=nil;
falselabel:=nil;
pass_left_right;
{ swap the operands to make it easier for the optimizer to optimize
the operand stack slot reloading in case both are in a register }
if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) and
(right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
swapleftright;
cmpop:=cmpnode2topcmp(unsigned);
if (nf_swapped in flags) then
cmpop:=swap_opcmp(cmpop);
// must generate those labels...
current_asmdata.getjumplabel(truelabel);
current_asmdata.getjumplabel(falselabel);
location_reset_jump(location,truelabel,falselabel);
if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
hlcg.a_cmp_loc_reg_label(current_asmdata.CurrAsmList,left.resultdef,cmpop,right.location,left.location.register,location.truelabel)
else case right.location.loc of
LOC_REGISTER,LOC_CREGISTER:
hlcg.a_cmp_reg_loc_label(current_asmdata.CurrAsmList,left.resultdef,cmpop,right.location.register,left.location,location.truelabel);
LOC_REFERENCE,LOC_CREFERENCE:
hlcg.a_cmp_ref_loc_label(current_asmdata.CurrAsmList,left.resultdef,cmpop,right.location.reference,left.location,location.truelabel);
LOC_CONSTANT:
hlcg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,left.resultdef,cmpop,right.location.value,left.location,location.truelabel);
else
internalerror(2011010413);
end;
end;
begin
caddnode:=twasmaddnode;
end.

85
compiler/wasm/nwasmflw.pas Normal file
View File

@ -0,0 +1,85 @@
unit nwasmflw;
interface
uses
aasmbase,node,nflw,ncgflw;
type
{ twasmifnode }
// Wasm doesn't have any jump(+offset) operations
// It only provide structured blockes to handle jumps
// (It's possible to jump-out-of-block at any time)
// "If" is also implemented as a block, identical to high-level language.
// Another thing to consider is "if" block also "returns" a value on the stack.
// Such value should be substituteed (it's hard-coded to be type i32)
twasmifnode = class(tcgifnode)
public
procedure pass_generate_code;override;
end;
tifnodeclass = class of tifnode;
implementation
uses
verbose,globals,systems,globtype,constexp,
symconst,symdef,symsym,aasmtai,aasmdata,aasmcpu,defutil,defcmp,
procinfo,cgbase,pass_1,pass_2,parabase,
cpubase,cpuinfo,
nbas,nld,ncon,ncnv,
tgobj,paramgr,
cgutils,hlcgobj,hlcgcpu;
{ twasmifnode }
procedure twasmifnode.pass_generate_code;
var
oldflowcontrol: tflowcontrol;
begin
// left - condition
// right - then
// t1 - else (optional)
//todo: MOVE all current_asm_data actions to Wasm HL CodeGen
secondpass(left); // condition exprssions
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if)); // IF
secondpass(right); // then branchs
if Assigned(t1) then // else branch
begin
// 0 const on stack if used to return IF value
current_asmdata.CurrAsmList.concat(taicpu.op_const(a_i32_const, 0));
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_else));
secondpass(t1);
end
else // else dummy-branch
begin
// dummy else branch! todo: to be removed, when it's decided
// how to handle typeless-IF instructions (If without else)
current_asmdata.CurrAsmList.concat(taicpu.op_const(a_i32_const, 0));
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_else));
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_nop));
end;
// 0 const on stack if used to return IF value
current_asmdata.CurrAsmList.concat(taicpu.op_const(a_i32_const, 0));
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end));
// clearing IF return value
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_drop));
end;
initialization
//cfornode:=tjvmfornode;
//craisenode:=tjvmraisenode;
//ctryexceptnode:=tjvmtryexceptnode;
//ctryfinallynode:=tjvmtryfinallynode;
//connode:=tjvmonnode;
cifnode:=twasmifnode;
end.