{ Copyright (c) 1998-2002, 2021 by Florian Klaempfl and Nikolay Nikolov Generate WebAssembly inline nodes 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 nwasminl; {$i fpcdefs.inc} interface uses node,ncginl; type { twasminlinenode } twasminlinenode = class(tcginlinenode) private function first_abs_real:tnode;override; function first_int_real:tnode;override; function first_sqrt_real:tnode;override; function first_trunc_real:tnode;override; function first_round_real:tnode;override; procedure second_abs_real;override; procedure second_int_real;override; procedure second_sqrt_real;override; procedure second_trunc_real;override; procedure second_round_real;override; procedure second_high; override; procedure second_memory_size; procedure second_memory_grow; procedure second_memory_fill; procedure second_memory_copy; procedure second_unreachable; procedure second_throw_fpcexception; protected function first_sqr_real: tnode; override; public function pass_typecheck_cpu: tnode; override; function first_cpu: tnode; override; procedure pass_generate_code_cpu; override; procedure second_length;override; procedure second_sqr_real; override; end; implementation uses ninl,ncal,compinnr, cpubase, aasmbase,aasmdata,aasmcpu, cgbase,cgutils, hlcgobj,hlcgcpu, defutil,pass_2,verbose, symtype,symdef; {***************************************************************************** twasminlinenode *****************************************************************************} function twasminlinenode.first_abs_real: tnode; begin expectloc:=LOC_FPUREGISTER; result:=nil; end; function twasminlinenode.first_int_real: tnode; begin expectloc:=LOC_FPUREGISTER; result:=nil; end; function twasminlinenode.first_sqrt_real: tnode; begin expectloc:=LOC_FPUREGISTER; result:=nil; end; function twasminlinenode.first_trunc_real: tnode; begin expectloc:=LOC_REGISTER; result:=nil; end; function twasminlinenode.first_round_real: tnode; begin expectloc:=LOC_REGISTER; result:=nil; end; procedure twasminlinenode.second_abs_real; begin secondpass(left); hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true); thlcgwasm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location); case left.location.size of OS_F32: current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_f32_abs)); OS_F64: current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_f64_abs)); else internalerror(2021092902); end; location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); location.register:=hlcg.getregisterfordef(current_asmdata.CurrAsmList,resultdef); thlcgwasm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,resultdef,location); end; procedure twasminlinenode.second_int_real; begin secondpass(left); hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true); thlcgwasm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location); case left.location.size of OS_F32: current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_f32_trunc)); OS_F64: current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_f64_trunc)); else internalerror(2021092903); end; location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); location.register:=hlcg.getregisterfordef(current_asmdata.CurrAsmList,resultdef); thlcgwasm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,resultdef,location); end; procedure twasminlinenode.second_sqrt_real; begin secondpass(left); hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true); thlcgwasm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location); case left.location.size of OS_F32: current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_f32_sqrt)); OS_F64: current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_f64_sqrt)); else internalerror(2021092901); end; location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); location.register:=hlcg.getregisterfordef(current_asmdata.CurrAsmList,resultdef); thlcgwasm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,resultdef,location); end; procedure twasminlinenode.second_trunc_real; begin secondpass(left); hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true); thlcgwasm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location); case left.location.size of OS_F32: current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_i64_trunc_f32_s)); OS_F64: current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_i64_trunc_f64_s)); else internalerror(2021092904); end; location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); location.register:=hlcg.getregisterfordef(current_asmdata.CurrAsmList,resultdef); thlcgwasm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,resultdef,location); end; procedure twasminlinenode.second_round_real; begin secondpass(left); hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true); thlcgwasm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location); case left.location.size of OS_F32: begin current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_f32_nearest)); current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_i64_trunc_f32_s)); end; OS_F64: begin current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_f64_nearest)); current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_i64_trunc_f64_s)); end else internalerror(2021092905); end; location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); location.register:=hlcg.getregisterfordef(current_asmdata.CurrAsmList,resultdef); thlcgwasm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,resultdef,location); end; procedure twasminlinenode.second_high; var hightype: TWasmBasicType; begin secondpass(left); if not(is_dynamic_array(left.resultdef)) then Internalerror(2019122801); { determine the WasmBasicType of the result } if is_64bit(resultdef) then hightype:=wbt_i64 else hightype:=wbt_i32; { length in dynamic arrays is at offset -sizeof(pint) } thlcgwasm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location); { 64-bit pointer values need a <>0 comparison to produce a 32-bit int on the stack (0 or 1) for the 'if' instruction. 32-bit pointer values don't need it, because 'if' already expects and pops a 32-bit int and checks for <>0. } if is_64bit(left.resultdef) then begin thlcgwasm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,left.resultdef,0,R_INTREGISTER); thlcgwasm(hlcg).a_cmp_stack_stack(current_asmdata.CurrAsmList,left.resultdef,OC_NE); end; { if not nil } current_asmdata.CurrAsmList.Concat(taicpu.op_functype(a_if,TWasmFuncType.Create([],[hightype]))); thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1); { volatility of the dyn. array refers to the volatility of the string pointer, not of the string data } thlcgwasm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location); { length in dynamic arrays is at offset -ossinttype.size } thlcgwasm(hlcg).a_op_const_stack(current_asmdata.CurrAsmList,OP_SUB,left.resultdef,ossinttype.size); { load length } if ossinttype.size=8 then current_asmdata.CurrAsmList.Concat(taicpu.op_const(a_i64_load,0)) else current_asmdata.CurrAsmList.Concat(taicpu.op_const(a_i32_load,0)); { else } current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_else)); thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1); { high=-1 } thlcgwasm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,resultdef,-1,R_INTREGISTER); { endif } current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_end_if)); location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)} if location.size in [OS_64,OS_S64] then begin location.register64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_32); location.register64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_32); end else {$endif} location.register := hlcg.getintregister(current_asmdata.CurrAsmList,resultdef); thlcgwasm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,resultdef,location); end; procedure twasminlinenode.second_memory_size; begin current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_memory_size)); thlcgwasm(hlcg).incstack(current_asmdata.CurrAsmList,1); location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); location.register:=hlcg.getregisterfordef(current_asmdata.CurrAsmList,resultdef); thlcgwasm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,resultdef,location); end; procedure twasminlinenode.second_memory_grow; begin secondpass(left); hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false); thlcgwasm(hlcg).a_load_reg_stack(current_asmdata.CurrAsmList,left.resultdef,left.location.register); current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_memory_grow)); location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); location.register:=hlcg.getregisterfordef(current_asmdata.CurrAsmList,resultdef); thlcgwasm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,resultdef,location); end; procedure twasminlinenode.second_memory_fill; begin location_reset(location,LOC_VOID,OS_NO); secondpass(tcallparanode(tcallparanode(tcallparanode(left).right).right).left); hlcg.location_force_reg(current_asmdata.CurrAsmList, tcallparanode(tcallparanode(tcallparanode(left).right).right).left.location, tcallparanode(tcallparanode(tcallparanode(left).right).right).left.resultdef, tcallparanode(tcallparanode(tcallparanode(left).right).right).left.resultdef,false); thlcgwasm(hlcg).a_load_reg_stack(current_asmdata.CurrAsmList, tcallparanode(tcallparanode(tcallparanode(left).right).right).left.resultdef, tcallparanode(tcallparanode(tcallparanode(left).right).right).left.location.register); secondpass(tcallparanode(tcallparanode(left).right).left); hlcg.location_force_reg(current_asmdata.CurrAsmList, tcallparanode(tcallparanode(left).right).left.location, tcallparanode(tcallparanode(left).right).left.resultdef, tcallparanode(tcallparanode(left).right).left.resultdef,false); thlcgwasm(hlcg).a_load_reg_stack(current_asmdata.CurrAsmList, tcallparanode(tcallparanode(left).right).left.resultdef, tcallparanode(tcallparanode(left).right).left.location.register); secondpass(tcallparanode(left).left); hlcg.location_force_reg(current_asmdata.CurrAsmList, tcallparanode(left).left.location, tcallparanode(left).left.resultdef, tcallparanode(left).left.resultdef,false); thlcgwasm(hlcg).a_load_reg_stack(current_asmdata.CurrAsmList, tcallparanode(left).left.resultdef, tcallparanode(left).left.location.register); current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_memory_fill)); thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,3); end; procedure twasminlinenode.second_memory_copy; begin location_reset(location,LOC_VOID,OS_NO); secondpass(tcallparanode(tcallparanode(tcallparanode(left).right).right).left); hlcg.location_force_reg(current_asmdata.CurrAsmList, tcallparanode(tcallparanode(tcallparanode(left).right).right).left.location, tcallparanode(tcallparanode(tcallparanode(left).right).right).left.resultdef, tcallparanode(tcallparanode(tcallparanode(left).right).right).left.resultdef,false); thlcgwasm(hlcg).a_load_reg_stack(current_asmdata.CurrAsmList, tcallparanode(tcallparanode(tcallparanode(left).right).right).left.resultdef, tcallparanode(tcallparanode(tcallparanode(left).right).right).left.location.register); secondpass(tcallparanode(tcallparanode(left).right).left); hlcg.location_force_reg(current_asmdata.CurrAsmList, tcallparanode(tcallparanode(left).right).left.location, tcallparanode(tcallparanode(left).right).left.resultdef, tcallparanode(tcallparanode(left).right).left.resultdef,false); thlcgwasm(hlcg).a_load_reg_stack(current_asmdata.CurrAsmList, tcallparanode(tcallparanode(left).right).left.resultdef, tcallparanode(tcallparanode(left).right).left.location.register); secondpass(tcallparanode(left).left); hlcg.location_force_reg(current_asmdata.CurrAsmList, tcallparanode(left).left.location, tcallparanode(left).left.resultdef, tcallparanode(left).left.resultdef,false); thlcgwasm(hlcg).a_load_reg_stack(current_asmdata.CurrAsmList, tcallparanode(left).left.resultdef, tcallparanode(left).left.location.register); current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_memory_copy)); thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,3); end; procedure twasminlinenode.second_unreachable; begin location_reset(location,LOC_VOID,OS_NO); current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_unreachable)); end; procedure twasminlinenode.second_throw_fpcexception; begin location_reset(location,LOC_VOID,OS_NO); current_asmdata.CurrAsmList.Concat(taicpu.op_sym(a_throw,current_asmdata.WeakRefAsmSymbol(FPC_EXCEPTION_TAG_SYM,AT_WASM_EXCEPTION_TAG))); end; function twasminlinenode.first_sqr_real: tnode; begin expectloc:=LOC_FPUREGISTER; first_sqr_real:=nil; end; function twasminlinenode.pass_typecheck_cpu: tnode; begin Result:=nil; case inlinenumber of in_wasm32_memory_size: begin CheckParameters(0); resultdef:=u32inttype; end; in_wasm32_memory_grow: begin CheckParameters(1); resultdef:=u32inttype; end; in_wasm32_unreachable: begin CheckParameters(0); resultdef:=voidtype; end; in_wasm32_throw_fpcexception: begin CheckParameters(0); resultdef:=voidtype; end; in_wasm32_memory_fill: begin CheckParameters(3); resultdef:=voidtype; end; in_wasm32_memory_copy: begin CheckParameters(3); resultdef:=voidtype; end; else Result:=inherited pass_typecheck_cpu; end; end; function twasminlinenode.first_cpu: tnode; begin Result:=nil; case inlinenumber of in_wasm32_memory_size, in_wasm32_memory_grow: expectloc:=LOC_REGISTER; in_wasm32_memory_fill, in_wasm32_memory_copy, in_wasm32_unreachable, in_wasm32_throw_fpcexception: expectloc:=LOC_VOID; else Result:=inherited first_cpu; end; end; procedure twasminlinenode.pass_generate_code_cpu; begin case inlinenumber of in_wasm32_memory_size: second_memory_size; in_wasm32_memory_grow: second_memory_grow; in_wasm32_memory_fill: second_memory_fill; in_wasm32_memory_copy: second_memory_copy; in_wasm32_unreachable: second_unreachable; in_wasm32_throw_fpcexception: second_throw_fpcexception; else inherited pass_generate_code_cpu; end; end; procedure twasminlinenode.second_length; var lendef : tdef; href : treference; extra_slots: LongInt; begin secondpass(left); if is_shortstring(left.resultdef) then begin location_copy(location,left.location); location.size:=OS_8; end else begin { length in ansi/wide strings and high in dynamic arrays is at offset -sizeof(pint) } hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false); thlcgwasm(hlcg).a_cmp_const_reg_stack(current_asmdata.CurrAsmList,left.resultdef,OC_EQ,0,left.location.register); current_asmdata.CurrAsmList.Concat(taicpu.op_functype(a_if,TWasmFuncType.Create([],[wbt_i32]))); thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1); current_asmdata.CurrAsmList.Concat(taicpu.op_const(a_i32_const,0)); thlcgwasm(hlcg).incstack(current_asmdata.CurrAsmList,1); current_asmdata.CurrAsmList.Concat( taicpu.op_none(a_else) ); thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1); { the length of a widestring is a 32 bit unsigned int. Since every character occupies 2 bytes, on a 32 bit platform you can express the maximum length using 31 bits. On a 64 bit platform, it may be 32 bits. This means that regardless of the platform, a location with size OS_SINT/ossinttype can hold the length without overflowing (this code returns an ossinttype value) } if is_widestring(left.resultdef) then lendef:=u32inttype else lendef:=ossinttype; { volatility of the ansistring/widestring refers to the volatility of the string pointer, not of the string data } hlcg.reference_reset_base(href,left.resultdef,left.location.register,-lendef.size,ctempposinvalid,lendef.alignment,[]); extra_slots:=thlcgwasm(hlcg).prepare_stack_for_ref(current_asmdata.CurrAsmList,href,false); thlcgwasm(hlcg).a_load_ref_stack(current_asmdata.CurrAsmList,lendef,href,extra_slots); if is_widestring(left.resultdef) then thlcgwasm(hlcg).a_op_const_stack(current_asmdata.CurrAsmList,OP_SHR,resultdef,1); { Dynamic arrays do not have their length attached but their maximum index } if is_dynamic_array(left.resultdef) then thlcgwasm(hlcg).a_op_const_stack(current_asmdata.CurrAsmList,OP_ADD,resultdef,1); current_asmdata.CurrAsmList.Concat( taicpu.op_none(a_end_if) ); location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); location.register:=hlcg.getregisterfordef(current_asmdata.CurrAsmList,resultdef); thlcgwasm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,resultdef,location); end; end; procedure twasminlinenode.second_sqr_real; begin secondpass(left); hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true); thlcgwasm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location); thlcgwasm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location); case left.location.size of OS_F32: current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_f32_mul)); OS_F64: current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_f64_mul)); else internalerror(2021060102); end; thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1); location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); location.register:=hlcg.getregisterfordef(current_asmdata.CurrAsmList,resultdef); thlcgwasm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,resultdef,location); end; begin cinlinenode:=twasminlinenode; end.