hlcgcpu.pas 74 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934
  1. {
  2. Copyright (c) 1998-2010 by Florian Klaempfl and Jonas Maebe
  3. Member of the Free Pascal development team
  4. This unit implements the WebAssembly high level code generator
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit hlcgcpu;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. globtype,
  23. aasmbase,aasmdata,
  24. symbase,symconst,symtype,symdef,symsym,
  25. node,
  26. cpubase, hlcgobj, cgbase, cgutils, parabase, wasmdef;
  27. type
  28. { thlcgwasm }
  29. thlcgwasm = class(thlcgobj)
  30. private
  31. fevalstackheight,
  32. fmaxevalstackheight: longint;
  33. public
  34. br_blocks: integer;
  35. loopContBr: integer; // the value is different depending of the condition test
  36. // if it's in the beggning the jump should be done to the loop (1)
  37. // if the condition at the end, the jump should done to the end of block (0)
  38. loopBreakBr: integer;
  39. exitBr: integer;
  40. fntypelookup : TWasmProcTypeLookup;
  41. constructor create;
  42. destructor Destroy; override;
  43. procedure incblock;
  44. procedure decblock;
  45. procedure incstack(list : TAsmList;slots: longint);
  46. procedure decstack(list : TAsmList;slots: longint);
  47. procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : tcgint;const cgpara : TCGPara);override;
  48. function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
  49. function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; override;
  50. { move instructions - a_load_FROM_TO }
  51. procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override;
  52. procedure a_load_const_ref(list : TAsmList;tosize : tdef;a : tcgint;const ref : treference);override;
  53. procedure a_load_reg_ref(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);override;
  54. procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tdef;reg1,reg2 : tregister);override;
  55. procedure a_load_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);override;
  56. procedure a_load_ref_ref(list : TAsmList;fromsize, tosize : tdef;const sref : treference;const dref : treference);override;
  57. procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
  58. { basic arithmetic operations }
  59. procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister); override;
  60. procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister); override;
  61. procedure a_op_const_ref(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; const ref: TReference); override;
  62. procedure a_op_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister); override;
  63. procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); override;
  64. procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); override;
  65. procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
  66. procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
  67. procedure a_cmp_const_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference; l: tasmlabel); override;
  68. procedure a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); override;
  69. procedure a_cmp_ref_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; l: tasmlabel); override;
  70. procedure a_cmp_reg_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; l: tasmlabel); override;
  71. procedure a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); override;
  72. procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
  73. procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);override;
  74. procedure g_copyshortstring(list : TAsmList;const source,dest : treference;strdef:tstringdef);override;
  75. procedure a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference); override;
  76. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override;
  77. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); override;
  78. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); override;
  79. procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
  80. procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override;
  81. procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); override;
  82. procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
  83. procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override;
  84. procedure maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean); override;
  85. procedure gen_entry_code(list: TAsmList); override;
  86. procedure gen_exit_code(list: TAsmList); override;
  87. { unimplemented/unnecessary routines }
  88. procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister); override;
  89. procedure a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle: pmmshuffle); override;
  90. procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle); override;
  91. procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); override;
  92. procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); override;
  93. procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle); override;
  94. procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); override;
  95. procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle); override;
  96. procedure g_stackpointer_alloc(list: TAsmList; size: longint); override;
  97. procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); override;
  98. procedure g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint); override;
  99. procedure g_local_unwind(list: TAsmList; l: TAsmLabel); override;
  100. { Wasm-specific routines }
  101. procedure g_procdef(list:TAsmList;pd: tprocdef);
  102. procedure a_load_stack_reg(list : TAsmList;size: tdef;reg: tregister);
  103. { extra_slots are the slots that are used by the reference, and that
  104. will be removed by the store operation }
  105. procedure a_load_stack_ref(list : TAsmList;size: tdef;const ref: treference;extra_slots: longint);
  106. procedure a_load_reg_stack(list : TAsmList;size: tdef;reg: tregister);
  107. { extra_slots are the slots that are used by the reference, and that
  108. will be removed by the load operation }
  109. procedure a_load_ref_stack(list : TAsmList;size: tdef;const ref: treference;extra_slots: longint);
  110. procedure a_load_const_stack(list : TAsmList;size: tdef;a :tcgint; typ: TRegisterType);
  111. procedure a_load_stack_loc(list : TAsmList;size: tdef;const loc: tlocation);
  112. procedure a_load_loc_stack(list : TAsmList;size: tdef;const loc: tlocation);
  113. procedure a_loadfpu_const_stack(list : TAsmList;size: tdef;a :double);
  114. procedure a_op_stack(list : TAsmList;op: topcg; size: tdef; trunc32: boolean);
  115. procedure a_op_const_stack(list : TAsmList;op: topcg; size: tdef;a : tcgint);
  116. procedure a_op_reg_stack(list : TAsmList;op: topcg; size: tdef;reg: tregister);
  117. procedure a_op_ref_stack(list : TAsmList;op: topcg; size: tdef;const ref: treference);
  118. procedure a_op_loc_stack(list : TAsmList;op: topcg; size: tdef;const loc: tlocation);
  119. procedure g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation); override;
  120. { this routine expects that all values are already massaged into the
  121. required form (sign bits xor'ed for gt/lt comparisons for OS_32/OS_64,
  122. see http://stackoverflow.com/questions/4068973/c-performing-signed-comparison-in-unsigned-variables-without-casting ) }
  123. procedure a_cmp_stack_stack(list : TAsmlist; size: tdef; cmp_op: topcmp);
  124. { these 2 routines perform the massaging expected by the previous one }
  125. procedure maybe_adjust_cmp_stackval(list : TAsmlist; size: tdef; cmp_op: topcmp);
  126. function maybe_adjust_cmp_constval(size: tdef; cmp_op: topcmp; a: tcgint): tcgint;
  127. { truncate/sign extend after performing operations on values < 32 bit
  128. that may have overflowed outside the range }
  129. procedure maybe_adjust_op_result(list: TAsmList; op: TOpCg; size: tdef);
  130. { performs sign/zero extension as required }
  131. procedure resize_stack_int_val(list: TAsmList;fromsize,tosize: tdef; formemstore: boolean);
  132. { 8/16 bit unsigned parameters and return values must be sign-extended on
  133. the producer side, because the JVM does not support unsigned variants;
  134. then they have to be zero-extended again on the consumer side }
  135. procedure maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean);
  136. { adjust the stack height after a call based on the specified number of
  137. slots used for parameters and the provided resultdef }
  138. procedure g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef; paraheight: longint; forceresdef: tdef);
  139. property maxevalstackheight: longint read fmaxevalstackheight;
  140. protected
  141. procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
  142. //procedure g_copyvalueparas(p: TObject; arg: pointer); override;
  143. procedure inittempvariables(list:TAsmList);override;
  144. function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; override;
  145. { in case of an array, the array base address and index have to be
  146. put on the evaluation stack before the stored value; similarly, for
  147. fields the self pointer has to be loaded first. Also checks whether
  148. the reference is valid. If dup is true, the necessary values are stored
  149. twice. Returns how many stack slots have been consumed, disregarding
  150. the "dup". }
  151. function prepare_stack_for_ref(list: TAsmList; var ref: treference; dup: boolean): longint;
  152. { return the load/store opcode to load/store from/to ref; if the result
  153. has to be and'ed after a load to get the final value, that constant
  154. is returned in finishandval (otherwise that value is set to -1) }
  155. function loadstoreopcref(def: tdef; isload: boolean; const ref: treference; out finishandval: tcgint): tasmop;
  156. { return the load/store opcode to load/store from/to reg; if the result
  157. has to be and'ed after a load to get the final value, that constant
  158. is returned in finishandval (otherwise that value is set to -1) }
  159. function loadstoreopc(def: tdef; isload, isarray: boolean; out finishandval: tcgint): tasmop;
  160. procedure resizestackfpuval(list: TAsmList; fromsize, tosize: tcgsize);
  161. { in case of an OS_32 OP_DIV, we have to use an OS_S64 OP_IDIV because the
  162. JVM does not support unsigned divisions }
  163. procedure maybepreparedivu32(list: TAsmList; var op: topcg; size: tdef; out isdivu32: boolean);
  164. { concatcopy helpers }
  165. procedure concatcopy_normal_array(list: TAsmList; size: tdef; const source, dest: treference);
  166. procedure concatcopy_record(list: TAsmList; size: tdef; const source, dest: treference);
  167. procedure concatcopy_set(list: TAsmList; size: tdef; const source, dest: treference);
  168. procedure concatcopy_shortstring(list: TAsmList; size: tdef; const source, dest: treference);
  169. end;
  170. implementation
  171. uses
  172. verbose,cutils,globals,fmodule,constexp,
  173. defutil,
  174. aasmtai,aasmcpu,
  175. symtable,symcpu,
  176. procinfo,cpuinfo,cgcpu,tgobj,tgcpu;
  177. const
  178. TOpCG2IAsmOp : array[topcg] of TAsmOp=(
  179. A_None, {OP_NONE}
  180. A_None, {OP_MOVE, replaced operation with direct load }
  181. a_i32_add, {OP_ADD, simple addition }
  182. a_i32_and, {OP_AND, simple logical and }
  183. a_i32_div_u, {OP_DIV, simple unsigned division }
  184. a_i32_div_s, {OP_IDIV, simple signed division }
  185. a_i32_mul, {OP_IMUL, simple signed multiply }
  186. a_i32_mul, {OP_MUL, simple unsigned multiply }
  187. A_None, {OP_NEG, simple negate } // neg = xor + 1
  188. A_None, {OP_NOT, simple logical not } // not = xor - 1
  189. a_i32_or, {OP_OR, simple logical or }
  190. a_i32_shr_s, {OP_SAR, arithmetic shift-right }
  191. a_i32_shl, {OP_SHL, logical shift left }
  192. a_i32_shr_u, {OP_SHR, logical shift right }
  193. a_i32_sub, {OP_SUB, simple subtraction }
  194. a_i32_xor, {OP_XOR, simple exclusive or }
  195. a_i32_rotl, {OP_ROL, rotate left }
  196. a_i32_rotr {OP_ROR rotate right }
  197. );
  198. TOpCG2LAsmOp : array[topcg] of TAsmOp=(
  199. A_None, {OP_NONE}
  200. a_i64_load, {OP_MOVE, replaced operation with direct load }
  201. a_i64_add, {OP_ADD, simple addition }
  202. a_i64_and, {OP_AND, simple logical and }
  203. a_i64_div_u, {OP_DIV, simple unsigned division }
  204. a_i64_div_s, {OP_IDIV, simple signed division }
  205. a_i64_mul, {OP_IMUL, simple signed multiply }
  206. a_i64_mul, {OP_MUL, simple unsigned multiply }
  207. A_None, {OP_NEG, simple negate } // neg = xor + 1
  208. A_None, {OP_NOT, simple logical not } // not = xor - 1
  209. a_i64_or, {OP_OR, simple logical or }
  210. a_i64_shr_s, {OP_SAR, arithmetic shift-right }
  211. a_i64_shl, {OP_SHL, logical shift left }
  212. a_i64_shr_u, {OP_SHR, logical shift right }
  213. a_i64_sub, {OP_SUB, simple subtraction }
  214. a_i64_xor, {OP_XOR, simple exclusive or }
  215. a_i64_rotl, {OP_ROL, rotate left }
  216. a_i64_rotr {OP_ROR rotate right }
  217. );
  218. constructor thlcgwasm.create;
  219. begin
  220. fevalstackheight:=0;
  221. fmaxevalstackheight:=0;
  222. fntypelookup:=TWasmProcTypeLookup.Create;
  223. end;
  224. destructor thlcgwasm.Destroy;
  225. begin
  226. fntypelookup.Free;
  227. inherited Destroy;
  228. end;
  229. procedure thlcgwasm.incblock;
  230. begin
  231. inc(br_blocks);
  232. end;
  233. procedure thlcgwasm.decblock;
  234. begin
  235. dec(br_blocks);
  236. if br_blocks<0 then Internalerror(2019091807); // out of block
  237. end;
  238. procedure thlcgwasm.incstack(list: TAsmList; slots: longint);
  239. begin
  240. if slots=0 then
  241. exit;
  242. inc(fevalstackheight,slots);
  243. if (fevalstackheight>fmaxevalstackheight) then
  244. fmaxevalstackheight:=fevalstackheight;
  245. if cs_asm_regalloc in current_settings.globalswitches then
  246. list.concat(tai_comment.Create(strpnew(' allocated '+tostr(slots)+', stack height = '+tostr(fevalstackheight))));
  247. end;
  248. procedure thlcgwasm.decstack(list: TAsmList;slots: longint);
  249. begin
  250. if slots=0 then
  251. exit;
  252. dec(fevalstackheight,slots);
  253. if (fevalstackheight<0) and
  254. not(cs_no_regalloc in current_settings.globalswitches) then
  255. internalerror(2010120501);
  256. if cs_asm_regalloc in current_settings.globalswitches then
  257. list.concat(tai_comment.Create(strpnew(' freed '+tostr(slots)+', stack height = '+tostr(fevalstackheight))));
  258. end;
  259. procedure thlcgwasm.a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; const cgpara: TCGPara);
  260. begin
  261. tosize:=get_para_push_size(tosize);
  262. if tosize=s8inttype then
  263. a:=shortint(a)
  264. else if tosize=s16inttype then
  265. a:=smallint(a);
  266. inherited a_load_const_cgpara(list, tosize, a, cgpara);
  267. end;
  268. function thlcgwasm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
  269. begin
  270. list.concat(taicpu.op_sym(a_call,current_asmdata.RefAsmSymbol(s,AT_FUNCTION)));
  271. result:=get_call_result_cgpara(pd,forceresdef);
  272. end;
  273. function thlcgwasm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
  274. begin
  275. a_load_reg_stack(list, ptrsinttype, reg);
  276. current_asmdata.CurrAsmList.Concat(taicpu.op_functype(a_call_indirect,tcpuprocdef(pd).create_functype));
  277. result:=hlcg.get_call_result_cgpara(pd, nil);
  278. end;
  279. procedure thlcgwasm.a_load_const_stack(list : TAsmList;size : tdef;a : tcgint; typ: TRegisterType);
  280. begin
  281. case typ of
  282. R_INTREGISTER,
  283. R_ADDRESSREGISTER:
  284. begin
  285. case def_cgsize(size) of
  286. OS_8,OS_16,OS_32,
  287. OS_S8,OS_S16,OS_S32:
  288. begin
  289. { convert cardinals to longints }
  290. list.concat(taicpu.op_const(a_i32_const, a));
  291. end;
  292. OS_64,OS_S64:
  293. begin
  294. list.concat(taicpu.op_const(a_i64_const, a));
  295. end;
  296. else
  297. internalerror(2010110702);
  298. end;
  299. end;
  300. else
  301. internalerror(2010110703);
  302. end;
  303. incstack(list,1);
  304. end;
  305. procedure thlcgwasm.a_load_stack_loc(list: TAsmList; size: tdef; const loc: tlocation);
  306. var
  307. tmpref: treference;
  308. begin
  309. case loc.loc of
  310. LOC_REGISTER,LOC_CREGISTER,
  311. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  312. a_load_stack_reg(list,size,loc.register);
  313. LOC_REFERENCE:
  314. begin
  315. tmpref:=loc.reference;
  316. a_load_stack_ref(list,size,loc.reference,prepare_stack_for_ref(list,tmpref,false));
  317. end;
  318. else
  319. internalerror(2011020501);
  320. end;
  321. end;
  322. procedure thlcgwasm.a_load_loc_stack(list: TAsmList;size: tdef;const loc: tlocation);
  323. var
  324. tmpref: treference;
  325. extra_slots: LongInt;
  326. begin
  327. case loc.loc of
  328. LOC_REGISTER,LOC_CREGISTER,
  329. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  330. a_load_reg_stack(list,size,loc.register);
  331. LOC_REFERENCE,LOC_CREFERENCE:
  332. begin
  333. tmpref:=loc.reference;
  334. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  335. a_load_ref_stack(list,size,tmpref,extra_slots);
  336. end;
  337. LOC_CONSTANT:
  338. a_load_const_stack(list,size,loc.value,def2regtyp(size));
  339. else
  340. internalerror(2011010401);
  341. end;
  342. end;
  343. procedure thlcgwasm.a_loadfpu_const_stack(list: TAsmList; size: tdef; a: double);
  344. begin
  345. case tfloatdef(size).floattype of
  346. s32real:
  347. begin
  348. list.concat(taicpu.op_single(a_f32_const, a));
  349. incstack(list,1);
  350. end;
  351. s64real:
  352. begin
  353. list.concat(taicpu.op_double(a_f64_const,a));
  354. incstack(list,1);
  355. end
  356. else
  357. internalerror(2011010501);
  358. end;
  359. end;
  360. procedure thlcgwasm.a_op_stack(list: TAsmList; op: topcg; size: tdef; trunc32: boolean);
  361. var
  362. cgsize: tcgsize;
  363. begin
  364. if not trunc32 then
  365. cgsize:=def_cgsize(size)
  366. else
  367. begin
  368. resize_stack_int_val(list,u32inttype,s64inttype,false);
  369. cgsize:=OS_S64;
  370. end;
  371. case cgsize of
  372. OS_8,OS_S8,
  373. OS_16,OS_S16,
  374. OS_32,OS_S32:
  375. begin
  376. { not = xor 1 for boolean, xor -1 for the rest}
  377. if op=OP_NOT then
  378. begin
  379. if not is_pasbool(size) then
  380. a_load_const_stack(list,s32inttype,high(cardinal),R_INTREGISTER)
  381. else
  382. a_load_const_stack(list,size,1,R_INTREGISTER);
  383. op:=OP_XOR;
  384. end;
  385. if TOpCG2IAsmOp[op]=A_None then
  386. internalerror(2010120532);
  387. list.concat(taicpu.op_none(TOpCG2IAsmOp[op]));
  388. maybe_adjust_op_result(list,op,size);
  389. if op<>OP_NEG then
  390. decstack(list,1);
  391. end;
  392. OS_64,OS_S64:
  393. begin
  394. { unsigned 64 bit division must be done via a helper }
  395. if op=OP_DIV then
  396. internalerror(2010120530);
  397. { not = xor 1 for boolean, xor -1 for the rest}
  398. if op=OP_NOT then
  399. begin
  400. if not is_pasbool(size) then
  401. a_load_const_stack(list,s64inttype,-1,R_INTREGISTER)
  402. else
  403. a_load_const_stack(list,s64inttype,1,R_INTREGISTER);
  404. op:=OP_XOR;
  405. end;
  406. if TOpCG2LAsmOp[op]=A_None then
  407. internalerror(2010120533);
  408. list.concat(taicpu.op_none(TOpCG2LAsmOp[op]));
  409. case op of
  410. OP_NOT,
  411. OP_NEG:
  412. ;
  413. else
  414. decstack(list,1);
  415. end;
  416. end;
  417. else
  418. internalerror(2010120531);
  419. end;
  420. if trunc32 then
  421. begin
  422. list.concat(taicpu.op_none(a_i32_trunc_s_f32)); // todo: there are several truncs
  423. end;
  424. end;
  425. procedure thlcgwasm.a_op_const_stack(list: TAsmList;op: topcg;size: tdef;a: tcgint);
  426. var
  427. trunc32: boolean;
  428. begin
  429. maybepreparedivu32(list,op,size,trunc32);
  430. case op of
  431. OP_NEG,OP_NOT:
  432. internalerror(2011010801);
  433. OP_SHL,OP_SHR,OP_SAR:
  434. { the second argument here is an int rather than a long }
  435. a_load_const_stack(list,s32inttype,a,R_INTREGISTER);
  436. else
  437. a_load_const_stack(list,size,a,R_INTREGISTER);
  438. end;
  439. a_op_stack(list,op,size,trunc32);
  440. end;
  441. procedure thlcgwasm.a_op_reg_stack(list: TAsmList; op: topcg; size: tdef; reg: tregister);
  442. var
  443. trunc32: boolean;
  444. begin
  445. maybepreparedivu32(list,op,size,trunc32);
  446. case op of
  447. OP_SHL,OP_SHR,OP_SAR:
  448. if not is_64bitint(size) then
  449. a_load_reg_stack(list,size,reg)
  450. else
  451. begin
  452. { the second argument here is an int rather than a long }
  453. if getsubreg(reg)=R_SUBQ then
  454. internalerror(2011010802);
  455. a_load_reg_stack(list,s32inttype,reg)
  456. end
  457. else
  458. a_load_reg_stack(list,size,reg);
  459. end;
  460. a_op_stack(list,op,size,trunc32);
  461. end;
  462. procedure thlcgwasm.a_op_ref_stack(list: TAsmList; op: topcg; size: tdef; const ref: treference);
  463. var
  464. trunc32: boolean;
  465. tmpref: treference;
  466. begin
  467. { ref must not be the stack top, because that may indicate an error
  468. (it means that we will perform an operation of the stack top onto
  469. itself, so that means the two values have been loaded manually prior
  470. to calling this routine, instead of letting this routine load one of
  471. them; if something like that is needed, call a_op_stack() directly) }
  472. if ref.base=NR_EVAL_STACK_BASE then
  473. internalerror(2010121102);
  474. tmpref:=ref;
  475. maybepreparedivu32(list,op,size,trunc32);
  476. case op of
  477. OP_SHL,OP_SHR,OP_SAR:
  478. begin
  479. if not is_64bitint(size) then
  480. a_load_ref_stack(list,size,ref,prepare_stack_for_ref(list,tmpref,false))
  481. else
  482. a_load_ref_stack(list,s32inttype,ref,prepare_stack_for_ref(list,tmpref,false));
  483. end;
  484. else
  485. a_load_ref_stack(list,size,ref,prepare_stack_for_ref(list,tmpref,false));
  486. end;
  487. a_op_stack(list,op,size,trunc32);
  488. end;
  489. procedure thlcgwasm.a_op_loc_stack(list: TAsmList; op: topcg; size: tdef; const loc: tlocation);
  490. begin
  491. case loc.loc of
  492. LOC_REGISTER,LOC_CREGISTER:
  493. a_op_reg_stack(list,op,size,loc.register);
  494. LOC_REFERENCE,LOC_CREFERENCE:
  495. a_op_ref_stack(list,op,size,loc.reference);
  496. LOC_CONSTANT:
  497. a_op_const_stack(list,op,size,loc.value);
  498. else
  499. internalerror(2011011415)
  500. end;
  501. end;
  502. procedure thlcgwasm.g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation);
  503. begin
  504. case fromloc.loc of
  505. LOC_CREFERENCE,
  506. LOC_REFERENCE:
  507. begin
  508. toloc:=fromloc;
  509. if (fromloc.reference.base<>NR_NO) and
  510. (fromloc.reference.base<>current_procinfo.framepointer) and
  511. (fromloc.reference.base<>NR_STACK_POINTER_REG) then
  512. g_allocload_reg_reg(list,voidpointertype,fromloc.reference.base,toloc.reference.base,R_ADDRESSREGISTER);
  513. end;
  514. else
  515. inherited;
  516. end;
  517. end;
  518. procedure thlcgwasm.a_cmp_stack_stack(list: TAsmlist; size: tdef; cmp_op: topcmp);
  519. const
  520. opcmp32: array[topcmp] of tasmop = (
  521. A_None, { OC_NONE, }
  522. a_i32_eq, { OC_EQ, equality comparison }
  523. a_i32_gt_s, { OC_GT, greater than (signed) }
  524. a_i32_lt_s, { OC_LT, less than (signed) }
  525. a_i32_ge_s, { OC_GTE, greater or equal than (signed) }
  526. a_i32_le_s, { OC_LTE, less or equal than (signed) }
  527. a_i32_ne, { OC_NE, not equal }
  528. a_i32_le_u, { OC_BE, less or equal than (unsigned) }
  529. a_i32_lt_u, { OC_B, less than (unsigned) }
  530. a_i32_ge_u, { OC_AE, greater or equal than (unsigned) }
  531. a_i32_gt_u { OC_A greater than (unsigned) }
  532. );
  533. const
  534. opcmp64: array[TOpCmp] of TAsmOp = (A_None,
  535. a_i64_eq, // OC_EQ
  536. a_i64_gt_s, a_i64_lt_s, // OC_GT, OC_LT
  537. a_i64_ge_s, a_i64_le_s, // OC_GTE, OC_LTE
  538. a_i64_ne, // OC_NE
  539. a_i64_le_u, a_i64_lt_u, // OC_BE, OC_B
  540. a_i64_ge_u, a_i64_gt_u // OC_AE, OC_A
  541. );
  542. var
  543. cgsize: tcgsize;
  544. begin
  545. // WASM doesn't have compare+jump (to label) operation
  546. // thus even though this is a_cmp_stack_stack()
  547. // label operrand is ommited
  548. //
  549. // todo: it should NOT be ommitted when we're leaving a block
  550. // (i.e. Exit or break or continue operators)
  551. case def2regtyp(size) of
  552. R_INTREGISTER,
  553. R_ADDRESSREGISTER:
  554. begin
  555. cgsize:=def_cgsize(size);
  556. case cgsize of
  557. OS_S8,OS_8,
  558. OS_16,OS_S16,
  559. OS_S32,OS_32:
  560. begin
  561. list.concat(taicpu.op_none(opcmp32[cmp_op]));
  562. decstack(list,1);
  563. end;
  564. OS_64,OS_S64:
  565. begin
  566. list.concat(taicpu.op_none(opcmp64[cmp_op]));
  567. decstack(list,1);
  568. end;
  569. else
  570. internalerror(2010120538);
  571. end;
  572. end;
  573. else
  574. internalerror(2010120538);
  575. end;
  576. end;
  577. procedure thlcgwasm.maybe_adjust_cmp_stackval(list: TAsmlist; size: tdef; cmp_op: topcmp);
  578. begin
  579. { use cmp_op because eventually that's what indicates the
  580. signed/unsigned character of the operation, not the size... }
  581. if (cmp_op in [OC_EQ,OC_NE,OC_LT,OC_LTE,OC_GT,OC_GTE]) or
  582. (def2regtyp(size)<>R_INTREGISTER) then
  583. exit;
  584. { http://stackoverflow.com/questions/4068973/c-performing-signed-comparison-in-unsigned-variables-without-casting }
  585. case def_cgsize(size) of
  586. OS_32,OS_S32:
  587. a_op_const_stack(list,OP_XOR,size,cardinal($80000000));
  588. OS_64,OS_S64:
  589. a_op_const_stack(list,OP_XOR,size,tcgint($8000000000000000));
  590. else
  591. ;
  592. end;
  593. end;
  594. function thlcgwasm.maybe_adjust_cmp_constval(size: tdef; cmp_op: topcmp; a: tcgint): tcgint;
  595. begin
  596. result:=a;
  597. { use cmp_op because eventually that's what indicates the
  598. signed/unsigned character of the operation, not the size... }
  599. if (cmp_op in [OC_EQ,OC_NE,OC_LT,OC_LTE,OC_GT,OC_GTE]) or
  600. (def2regtyp(size)<>R_INTREGISTER) then
  601. exit;
  602. case def_cgsize(size) of
  603. OS_32,OS_S32:
  604. result:=a xor cardinal($80000000);
  605. OS_64,OS_S64:
  606. {$push}{$r-}
  607. result:=a xor tcgint($8000000000000000);
  608. {$pop}
  609. else
  610. ;
  611. end;
  612. end;
  613. procedure thlcgwasm.maybe_adjust_op_result(list: TAsmList; op: TOpCg; size: tdef);
  614. const
  615. overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG];
  616. begin
  617. if (op in overflowops) and
  618. (def_cgsize(size) in [OS_8,OS_S8,OS_16,OS_S16]) then
  619. resize_stack_int_val(list,s32inttype,size,false);
  620. end;
  621. procedure thlcgwasm.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
  622. begin
  623. { constructors don't return anything in Java }
  624. if pd.proctypeoption=potype_constructor then
  625. exit;
  626. { must return a value of the correct type on the evaluation stack }
  627. case def2regtyp(resdef) of
  628. R_INTREGISTER,
  629. R_ADDRESSREGISTER:
  630. a_load_const_cgpara(list,resdef,0,resloc);
  631. R_FPUREGISTER:
  632. case tfloatdef(resdef).floattype of
  633. s32real:
  634. begin
  635. list.concat(taicpu.op_single(a_f32_const, 0));
  636. incstack(list,1);
  637. end;
  638. s64real:
  639. begin
  640. list.concat(taicpu.op_double(a_f64_const, 0));
  641. incstack(list,1);
  642. end;
  643. else
  644. internalerror(2011010302);
  645. end
  646. else
  647. internalerror(2011010301);
  648. end;
  649. end;
  650. //procedure thlcgwasm.g_copyvalueparas(p: TObject; arg: pointer);
  651. // var
  652. // list: tasmlist;
  653. // tmpref: treference;
  654. // begin
  655. // { zero-extend < 32 bit primitive types (FPC can zero-extend when calling,
  656. // but that doesn't help when we're called from Java code or indirectly
  657. // as a procvar -- exceptions: widechar (Java-specific type) and ordinal
  658. // types whose upper bound does not set the sign bit }
  659. // if (tsym(p).typ=paravarsym) and
  660. // (tparavarsym(p).varspez in [vs_value,vs_const]) and
  661. // (tparavarsym(p).vardef.typ=orddef) and
  662. // not is_pasbool(tparavarsym(p).vardef) and
  663. // not is_widechar(tparavarsym(p).vardef) and
  664. // (tparavarsym(p).vardef.size<4) and
  665. // not is_signed(tparavarsym(p).vardef) and
  666. // (torddef(tparavarsym(p).vardef).high>=(1 shl (tparavarsym(p).vardef.size*8-1))) then
  667. // begin
  668. // list:=TAsmList(arg);
  669. // { store value in new location to keep Android verifier happy }
  670. // tg.gethltemp(list,tparavarsym(p).vardef,tparavarsym(p).vardef.size,tt_persistent,tmpref);
  671. // a_load_loc_stack(list,tparavarsym(p).vardef,tparavarsym(p).initialloc);
  672. // a_op_const_stack(list,OP_AND,tparavarsym(p).vardef,(1 shl (tparavarsym(p).vardef.size*8))-1);
  673. // a_load_stack_ref(list,tparavarsym(p).vardef,tmpref,prepare_stack_for_ref(list,tmpref,false));
  674. // location_reset_ref(tparavarsym(p).localloc,LOC_REFERENCE,def_cgsize(tparavarsym(p).vardef),4,tmpref.volatility);
  675. // tparavarsym(p).localloc.reference:=tmpref;
  676. // end;
  677. //
  678. // inherited g_copyvalueparas(p, arg);
  679. // end;
  680. procedure thlcgwasm.inittempvariables(list: TAsmList);
  681. begin
  682. { these are automatically initialised when allocated if necessary }
  683. end;
  684. function thlcgwasm.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
  685. begin
  686. result:=inherited;
  687. pd.init_paraloc_info(callerside);
  688. g_adjust_stack_after_call(list,pd,pd.callerargareasize,forceresdef);
  689. end;
  690. function thlcgwasm.prepare_stack_for_ref(list: TAsmList; var ref: treference; dup: boolean): longint;
  691. begin
  692. result:=0;
  693. { fake location that indicates the value is already on the stack? }
  694. if (ref.base=NR_EVAL_STACK_BASE) or (ref.base=NR_LOCAL_STACK_POINTER_REG) then
  695. exit;
  696. // setting up memory offset
  697. if assigned(ref.symbol) and (ref.base=NR_NO) and (ref.index=NR_NO) then
  698. begin
  699. list.Concat(taicpu.op_const(a_i32_const,0));
  700. incstack(list,1);
  701. if dup then
  702. begin
  703. list.Concat(taicpu.op_const(a_i32_const,0));
  704. incstack(list,1);
  705. end;
  706. result:=1;
  707. end
  708. else if ref.index <> NR_NO then // array access
  709. begin
  710. // it's just faster to sum two of those together
  711. list.Concat(taicpu.op_reg(a_get_local, ref.base));
  712. list.Concat(taicpu.op_reg(a_get_local, ref.index));
  713. list.Concat(taicpu.op_none(a_i32_add));
  714. incstack(list,1);
  715. if dup then
  716. begin
  717. list.Concat(taicpu.op_reg(a_get_local, ref.base));
  718. list.Concat(taicpu.op_reg(a_get_local, ref.index));
  719. list.Concat(taicpu.op_none(a_i32_add));
  720. incstack(list,1);
  721. end;
  722. ref.base:=NR_NO;
  723. ref.index:=NR_NO;
  724. result:=1;
  725. end
  726. else if (ref.base<>NR_NO) then
  727. begin
  728. if (ref.base<>NR_STACK_POINTER_REG) then
  729. begin
  730. { regular field -> load self on the stack }
  731. a_load_reg_stack(list,voidpointertype,ref.base);
  732. if dup then
  733. a_load_reg_stack(list,voidpointertype,ref.base);
  734. { field name/type encoded in symbol, no index/offset }
  735. result:=1;
  736. ref.base:=NR_NO;
  737. end
  738. else // if (ref.base = NR_FRAME_POINTER_REG) then
  739. begin
  740. list.Concat(taicpu.op_sym(a_get_local, current_asmdata.RefAsmSymbol(FRAME_POINTER_SYM,AT_ADDR) ));
  741. end;
  742. end
  743. else
  744. begin
  745. { static field -> nothing to do here, except for validity check }
  746. {if not assigned(ref.symbol) or
  747. (ref.offset<>0) then
  748. begin
  749. internalerror(2010120525);
  750. end;}
  751. end;
  752. end;
  753. procedure thlcgwasm.a_load_const_reg(list: TAsmList; tosize: tdef; a: tcgint; register: tregister);
  754. begin
  755. a_load_const_stack(list,tosize,a,def2regtyp(tosize));
  756. a_load_stack_reg(list,tosize,register);
  757. end;
  758. procedure thlcgwasm.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);
  759. var
  760. extra_slots: longint;
  761. tmpref: treference;
  762. begin
  763. tmpref:=ref;
  764. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  765. a_load_const_stack(list,tosize,a,def2regtyp(tosize));
  766. a_load_stack_ref(list,tosize,tmpref,extra_slots);
  767. end;
  768. procedure thlcgwasm.a_load_reg_ref(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference);
  769. var
  770. extra_slots: longint;
  771. tmpref: treference;
  772. begin
  773. tmpref:=ref;
  774. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  775. a_load_reg_stack(list,fromsize,register);
  776. if def2regtyp(fromsize)=R_INTREGISTER then
  777. resize_stack_int_val(list,fromsize,tosize,assigned(tmpref.symbol));
  778. a_load_stack_ref(list,tosize,tmpref,extra_slots);
  779. end;
  780. procedure thlcgwasm.a_load_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  781. begin
  782. a_load_reg_stack(list,fromsize,reg1);
  783. if def2regtyp(fromsize)=R_INTREGISTER then
  784. resize_stack_int_val(list,fromsize,tosize,false);
  785. a_load_stack_reg(list,tosize,reg2);
  786. end;
  787. procedure thlcgwasm.a_load_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister);
  788. var
  789. extra_slots: longint;
  790. tmpref: treference;
  791. begin
  792. tmpref:=ref;
  793. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  794. a_load_ref_stack(list,fromsize,tmpref,extra_slots);
  795. if def2regtyp(fromsize)=R_INTREGISTER then
  796. resize_stack_int_val(list,fromsize,tosize,false);
  797. a_load_stack_reg(list,tosize,register);
  798. end;
  799. procedure thlcgwasm.a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference);
  800. var
  801. extra_sslots,
  802. extra_dslots: longint;
  803. tmpsref, tmpdref: treference;
  804. begin
  805. if sref.base<>NR_EVAL_STACK_BASE then
  806. begin
  807. tmpsref:=sref;
  808. tmpdref:=dref;
  809. { make sure the destination reference is on top, since in the end the
  810. order has to be "destref, value" -> first create "destref, sourceref" }
  811. extra_dslots:=prepare_stack_for_ref(list,tmpdref,false);
  812. extra_sslots:=prepare_stack_for_ref(list,tmpsref,false);
  813. a_load_ref_stack(list,fromsize,tmpsref,extra_sslots);
  814. if def2regtyp(fromsize)=R_INTREGISTER then
  815. resize_stack_int_val(list,fromsize,tosize,assigned(tmpdref.symbol));
  816. a_load_stack_ref(list,tosize,tmpdref,extra_dslots);
  817. end
  818. else
  819. inherited;
  820. end;
  821. procedure thlcgwasm.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister);
  822. var
  823. tmpref: treference;
  824. begin
  825. { you can't take the address of references, that are on the local stack }
  826. if (ref.base=NR_EVAL_STACK_BASE) or (ref.index=NR_EVAL_STACK_BASE) or
  827. (ref.base=NR_LOCAL_STACK_POINTER_REG) or (ref.index=NR_LOCAL_STACK_POINTER_REG) then
  828. internalerror(2021010101);
  829. tmpref:=ref;
  830. tmpref.base:=NR_NO;
  831. tmpref.index:=NR_NO;
  832. list.Concat(taicpu.op_ref(a_i32_const, tmpref));
  833. if ref.base<>NR_NO then
  834. begin
  835. list.Concat(taicpu.op_reg(a_get_local,ref.base));
  836. list.Concat(taicpu.op_none(a_i32_add));
  837. end;
  838. if ref.index<>NR_NO then
  839. begin
  840. list.Concat(taicpu.op_reg(a_get_local,ref.index));
  841. if ref.scalefactor>1 then
  842. begin
  843. list.Concat(taicpu.op_const(a_i32_const,ref.scalefactor));
  844. list.Concat(taicpu.op_none(a_i32_mul));
  845. end;
  846. list.Concat(taicpu.op_none(a_i32_add));
  847. end;
  848. incstack(list, 1);
  849. a_load_stack_reg(list, tosize, r);
  850. end;
  851. procedure thlcgwasm.a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister);
  852. begin
  853. a_op_const_reg_reg(list,op,size,a,reg,reg);
  854. end;
  855. procedure thlcgwasm.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister);
  856. begin
  857. a_load_reg_stack(list,size,src);
  858. a_op_const_stack(list,op,size,a);
  859. a_load_stack_reg(list,size,dst);
  860. end;
  861. procedure thlcgwasm.a_op_const_ref(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; const ref: TReference);
  862. var
  863. extra_slots: longint;
  864. tmpref: treference;
  865. begin
  866. tmpref:=ref;
  867. extra_slots:=prepare_stack_for_ref(list,tmpref,true);
  868. { TODO, here or in peepholeopt: use iinc when possible }
  869. a_load_ref_stack(list,size,tmpref,extra_slots);
  870. a_op_const_stack(list,op,size,a);
  871. { for android verifier }
  872. if (def2regtyp(size)=R_INTREGISTER) and
  873. (assigned(tmpref.symbol)) then
  874. resize_stack_int_val(list,size,size,true);
  875. a_load_stack_ref(list,size,tmpref,extra_slots);
  876. end;
  877. procedure thlcgwasm.a_op_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister);
  878. begin
  879. if not(op in [OP_NOT,OP_NEG]) then
  880. a_load_reg_stack(list,size,reg);
  881. a_op_ref_stack(list,op,size,ref);
  882. a_load_stack_reg(list,size,reg);
  883. end;
  884. procedure thlcgwasm.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister);
  885. begin
  886. if not(op in [OP_NOT,OP_NEG]) then
  887. a_load_reg_stack(list,size,src2);
  888. a_op_reg_stack(list,op,size,src1);
  889. a_load_stack_reg(list,size,dst);
  890. end;
  891. procedure thlcgwasm.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister);
  892. begin
  893. a_op_reg_reg_reg(list,op,size,reg1,reg2,reg2);
  894. end;
  895. procedure thlcgwasm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
  896. var
  897. tmpreg: tregister;
  898. begin
  899. if not setflags then
  900. begin
  901. inherited;
  902. exit;
  903. end;
  904. tmpreg:=getintregister(list,size);
  905. a_load_const_reg(list,size,a,tmpreg);
  906. a_op_reg_reg_reg_checkoverflow(list,op,size,tmpreg,src,dst,true,ovloc);
  907. end;
  908. procedure thlcgwasm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
  909. var
  910. orgsrc1, orgsrc2: tregister;
  911. docheck: boolean;
  912. lab: tasmlabel;
  913. begin
  914. if not setflags then
  915. begin
  916. inherited;
  917. exit;
  918. end;
  919. { anything else cannot overflow }
  920. docheck:=size.size in [4,8];
  921. if docheck then
  922. begin
  923. orgsrc1:=src1;
  924. orgsrc2:=src2;
  925. if src1=dst then
  926. begin
  927. orgsrc1:=getintregister(list,size);
  928. a_load_reg_reg(list,size,size,src1,orgsrc1);
  929. end;
  930. if src2=dst then
  931. begin
  932. orgsrc2:=getintregister(list,size);
  933. a_load_reg_reg(list,size,size,src2,orgsrc2);
  934. end;
  935. end;
  936. a_op_reg_reg_reg(list,op,size,src1,src2,dst);
  937. if docheck then
  938. begin
  939. { * signed overflow for addition iff
  940. - src1 and src2 are negative and result is positive (excep in case of
  941. subtraction, then sign of src1 has to be inverted)
  942. - src1 and src2 are positive and result is negative
  943. -> Simplified boolean equivalent (in terms of sign bits):
  944. not(src1 xor src2) and (src1 xor dst)
  945. for subtraction, multiplication: invert src1 sign bit
  946. for division: handle separately (div by zero, low(inttype) div -1),
  947. not supported by this code
  948. * unsigned overflow iff carry out, aka dst < src1 or dst < src2
  949. }
  950. location_reset(ovloc,LOC_REGISTER,OS_S32);
  951. { not pasbool8, because then we'd still have to convert the integer to
  952. a boolean via branches for Dalvik}
  953. ovloc.register:=getintregister(list,s32inttype);
  954. if not ((size.typ=pointerdef) or
  955. ((size.typ=orddef) and
  956. (torddef(size).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
  957. pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
  958. begin
  959. a_load_reg_stack(list,size,src1);
  960. if op in [OP_SUB,OP_IMUL] then
  961. a_op_stack(list,OP_NOT,size,false);
  962. a_op_reg_stack(list,OP_XOR,size,src2);
  963. a_op_stack(list,OP_NOT,size,false);
  964. a_load_reg_stack(list,size,src1);
  965. a_op_reg_stack(list,OP_XOR,size,dst);
  966. a_op_stack(list,OP_AND,size,false);
  967. a_op_const_stack(list,OP_SHR,size,(size.size*8)-1);
  968. if size.size=8 then
  969. begin
  970. //todo: any operands needed?
  971. list.concat(taicpu.op_none(a_i32_wrap_i64));
  972. end;
  973. end
  974. else
  975. begin
  976. a_load_const_stack(list,s32inttype,0,R_INTREGISTER);
  977. current_asmdata.getjumplabel(lab);
  978. { can be optimized by removing duplicate xor'ing to convert dst from
  979. signed to unsigned quadrant }
  980. a_cmp_reg_reg_label(list,size,OC_B,dst,src1,lab);
  981. a_cmp_reg_reg_label(list,size,OC_B,dst,src2,lab);
  982. a_op_const_stack(list,OP_XOR,s32inttype,1);
  983. a_label(list,lab);
  984. end;
  985. a_load_stack_reg(list,s32inttype,ovloc.register);
  986. end
  987. else
  988. ovloc.loc:=LOC_VOID;
  989. end;
  990. procedure thlcgwasm.a_cmp_const_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference; l: tasmlabel);
  991. var
  992. tmpref: treference;
  993. begin
  994. tmpref:=ref;
  995. if tmpref.base<>NR_EVAL_STACK_BASE then
  996. a_load_ref_stack(list,size,tmpref,prepare_stack_for_ref(list,tmpref,false));
  997. maybe_adjust_cmp_stackval(list,size,cmp_op);
  998. a_load_const_stack(list,size,maybe_adjust_cmp_constval(size,cmp_op,a),def2regtyp(size));
  999. a_cmp_stack_stack(list,size,cmp_op);
  1000. end;
  1001. procedure thlcgwasm.a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel);
  1002. begin
  1003. a_load_reg_stack(list,size,reg);
  1004. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1005. a_load_const_stack(list,size,maybe_adjust_cmp_constval(size,cmp_op,a),def2regtyp(size));
  1006. a_cmp_stack_stack(list,size,cmp_op);
  1007. end;
  1008. procedure thlcgwasm.a_cmp_ref_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; l: tasmlabel);
  1009. var
  1010. tmpref: treference;
  1011. begin
  1012. tmpref:=ref;
  1013. a_load_reg_stack(list,size,reg);
  1014. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1015. if tmpref.base<>NR_EVAL_STACK_BASE then
  1016. a_load_ref_stack(list,size,tmpref,prepare_stack_for_ref(list,tmpref,false))
  1017. else begin
  1018. // todo: need a swap operation?
  1019. //list.concat(taicpu.op_none(a_swap));
  1020. Internalerror(2019083003);
  1021. end;
  1022. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1023. a_cmp_stack_stack(list,size,cmp_op);
  1024. end;
  1025. procedure thlcgwasm.a_cmp_reg_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; l: tasmlabel);
  1026. var
  1027. tmpref: treference;
  1028. begin
  1029. tmpref:=ref;
  1030. if tmpref.base<>NR_EVAL_STACK_BASE then
  1031. a_load_ref_stack(list,size,ref,prepare_stack_for_ref(list,tmpref,false));
  1032. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1033. a_load_reg_stack(list,size,reg);
  1034. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1035. a_cmp_stack_stack(list,size,cmp_op);
  1036. end;
  1037. procedure thlcgwasm.a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);
  1038. begin
  1039. a_load_reg_stack(list,size,reg2);
  1040. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1041. a_load_reg_stack(list,size,reg1);
  1042. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1043. a_cmp_stack_stack(list,size,cmp_op);
  1044. end;
  1045. procedure thlcgwasm.a_jmp_always(list: TAsmList; l: tasmlabel);
  1046. begin
  1047. if l=current_procinfo.CurrBreakLabel then
  1048. list.concat(taicpu.op_const(a_br,br_blocks-loopBreakBr))
  1049. else if l=current_procinfo.CurrContinueLabel then
  1050. list.concat(taicpu.op_const(a_br,br_blocks-loopContBr))
  1051. else if l=current_procinfo.CurrExitLabel then
  1052. list.concat(taicpu.op_const(a_br,br_blocks-exitBr))
  1053. else
  1054. Internalerror(2019091806); // unexpected jump
  1055. end;
  1056. procedure thlcgwasm.concatcopy_normal_array(list: TAsmList; size: tdef; const source, dest: treference);
  1057. var
  1058. procname: string;
  1059. eledef: tdef;
  1060. ndim: longint;
  1061. adddefaultlenparas: boolean;
  1062. tmpsource, tmpdest: treference;
  1063. begin
  1064. tmpsource:=source;
  1065. tmpdest:=dest;
  1066. { load copy helper parameters on the stack }
  1067. a_load_ref_stack(list,ptruinttype,source,prepare_stack_for_ref(list,tmpsource,false));
  1068. a_load_ref_stack(list,ptruinttype,dest,prepare_stack_for_ref(list,tmpdest,false));
  1069. { call copy helper }
  1070. eledef:=tarraydef(size).elementdef;
  1071. ndim:=1;
  1072. adddefaultlenparas:=true;
  1073. case eledef.typ of
  1074. orddef:
  1075. begin
  1076. case torddef(eledef).ordtype of
  1077. pasbool1,pasbool8,s8bit,u8bit,bool8bit,uchar,
  1078. s16bit,u16bit,bool16bit,pasbool16,
  1079. uwidechar,
  1080. s32bit,u32bit,bool32bit,pasbool32,
  1081. s64bit,u64bit,bool64bit,pasbool64,scurrency:
  1082. procname:='FPC_COPY_SHALLOW_ARRAY'
  1083. else
  1084. internalerror(2011020504);
  1085. end;
  1086. end;
  1087. arraydef:
  1088. begin
  1089. { call fpc_setlength_dynarr_multidim with deepcopy=true, and extra
  1090. parameters }
  1091. while (eledef.typ=arraydef) and
  1092. not is_dynamic_array(eledef) do
  1093. begin
  1094. eledef:=tarraydef(eledef).elementdef;
  1095. inc(ndim)
  1096. end;
  1097. if (ndim=1) then
  1098. procname:='FPC_COPY_SHALLOW_ARRAY'
  1099. else
  1100. begin
  1101. { deepcopy=true }
  1102. a_load_const_stack(list,pasbool1type,1,R_INTREGISTER);
  1103. { ndim }
  1104. a_load_const_stack(list,s32inttype,ndim,R_INTREGISTER);
  1105. { eletype }
  1106. { todo: WASM
  1107. a_load_const_stack(list,cwidechartype,ord(jvmarrtype_setlength(eledef)),R_INTREGISTER);
  1108. }
  1109. adddefaultlenparas:=false;
  1110. procname:='FPC_SETLENGTH_DYNARR_MULTIDIM';
  1111. end;
  1112. end;
  1113. recorddef:
  1114. procname:='FPC_COPY_JRECORD_ARRAY';
  1115. procvardef:
  1116. if tprocvardef(eledef).is_addressonly then
  1117. procname:='FPC_COPY_SHALLOW_ARRAY'
  1118. else
  1119. procname:='FPC_COPY_JPROCVAR_ARRAY';
  1120. setdef:
  1121. if tsetdef(eledef).elementdef.typ=enumdef then
  1122. procname:='FPC_COPY_JENUMSET_ARRAY'
  1123. else
  1124. procname:='FPC_COPY_JBITSET_ARRAY';
  1125. floatdef:
  1126. procname:='FPC_COPY_SHALLOW_ARRAY';
  1127. stringdef:
  1128. if is_shortstring(eledef) then
  1129. procname:='FPC_COPY_JSHORTSTRING_ARRAY'
  1130. else
  1131. procname:='FPC_COPY_SHALLOW_ARRAY';
  1132. variantdef:
  1133. begin
  1134. {$ifndef nounsupported}
  1135. procname:='FPC_COPY_SHALLOW_ARRAY';
  1136. {$else}
  1137. { todo: make a deep copy via clone... }
  1138. internalerror(2011020505);
  1139. {$endif}
  1140. end;
  1141. else
  1142. procname:='FPC_COPY_SHALLOW_ARRAY';
  1143. end;
  1144. if adddefaultlenparas then
  1145. begin
  1146. { -1, -1 means "copy entire array" }
  1147. a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
  1148. a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
  1149. end;
  1150. g_call_system_proc(list,procname,[],nil);
  1151. if ndim<>1 then
  1152. begin
  1153. { pop return value, must be the same as dest }
  1154. //list.concat(taicpu.op_none(a_pop));
  1155. Internalerror(2019083001); // no support for arrays
  1156. decstack(list,1);
  1157. end;
  1158. end;
  1159. procedure thlcgwasm.concatcopy_record(list: TAsmList; size: tdef; const source, dest: treference);
  1160. var
  1161. srsym: tsym;
  1162. pd: tprocdef;
  1163. tmpsource, tmpdest: treference;
  1164. begin
  1165. tmpsource:=source;
  1166. tmpdest:=dest;
  1167. { self }
  1168. a_load_ref_stack(list,size,tmpsource,prepare_stack_for_ref(list,tmpsource,false));
  1169. { result }
  1170. a_load_ref_stack(list,size,tmpdest,prepare_stack_for_ref(list,tmpdest,false));
  1171. { call fpcDeepCopy helper }
  1172. srsym:=search_struct_member(tabstractrecorddef(size),'FPCDEEPCOPY');
  1173. if not assigned(srsym) or
  1174. (srsym.typ<>procsym) then
  1175. Message1(cg_f_unknown_compilerproc,size.typename+'.fpcDeepCopy');
  1176. pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
  1177. a_call_name(list,pd,pd.mangledname,[],nil,false);
  1178. { both parameters are removed, no function result }
  1179. decstack(list,2);
  1180. end;
  1181. procedure thlcgwasm.concatcopy_set(list: TAsmList; size: tdef; const source, dest: treference);
  1182. var
  1183. tmpsource, tmpdest: treference;
  1184. begin
  1185. tmpsource:=source;
  1186. tmpdest:=dest;
  1187. a_load_ref_stack(list,size,tmpsource,prepare_stack_for_ref(list,tmpsource,false));
  1188. a_load_ref_stack(list,size,tmpdest,prepare_stack_for_ref(list,tmpdest,false));
  1189. { call set copy helper }
  1190. if tsetdef(size).elementdef.typ=enumdef then
  1191. g_call_system_proc(list,'fpc_enumset_copy',[],nil)
  1192. else
  1193. g_call_system_proc(list,'fpc_bitset_copy',[],nil);
  1194. end;
  1195. procedure thlcgwasm.concatcopy_shortstring(list: TAsmList; size: tdef; const source, dest: treference);
  1196. var
  1197. srsym: tsym;
  1198. pd: tprocdef;
  1199. tmpsource, tmpdest: treference;
  1200. begin
  1201. tmpsource:=source;
  1202. tmpdest:=dest;
  1203. { self }
  1204. a_load_ref_stack(list,size,tmpsource,prepare_stack_for_ref(list,tmpsource,false));
  1205. { result }
  1206. a_load_ref_stack(list,size,tmpdest,prepare_stack_for_ref(list,tmpdest,false));
  1207. { call fpcDeepCopy helper }
  1208. srsym:=search_struct_member(java_shortstring,'FPCDEEPCOPY');
  1209. if not assigned(srsym) or
  1210. (srsym.typ<>procsym) then
  1211. Message1(cg_f_unknown_compilerproc,'ShortstringClass.FpcDeepCopy');
  1212. pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
  1213. a_call_name(list,pd,pd.mangledname,[],nil,false);
  1214. { both parameters are removed, no function result }
  1215. decstack(list,2);
  1216. end;
  1217. procedure thlcgwasm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
  1218. var
  1219. handled: boolean;
  1220. begin
  1221. handled:=false;
  1222. case size.typ of
  1223. arraydef:
  1224. begin
  1225. if not is_dynamic_array(size) then
  1226. begin
  1227. concatcopy_normal_array(list,size,source,dest);
  1228. handled:=true;
  1229. end;
  1230. end;
  1231. recorddef:
  1232. begin
  1233. concatcopy_record(list,size,source,dest);
  1234. handled:=true;
  1235. end;
  1236. setdef:
  1237. begin
  1238. concatcopy_set(list,size,source,dest);
  1239. handled:=true;
  1240. end;
  1241. stringdef:
  1242. begin
  1243. if is_shortstring(size) then
  1244. begin
  1245. concatcopy_shortstring(list,size,source,dest);
  1246. handled:=true;
  1247. end;
  1248. end;
  1249. else
  1250. ;
  1251. end;
  1252. if not handled then
  1253. inherited;
  1254. end;
  1255. procedure thlcgwasm.g_copyshortstring(list: TAsmList; const source, dest: treference; strdef: tstringdef);
  1256. begin
  1257. concatcopy_shortstring(list,strdef,source,dest);
  1258. end;
  1259. procedure thlcgwasm.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference);
  1260. var
  1261. dstack_slots: longint;
  1262. tmpref1, tmpref2: treference;
  1263. begin
  1264. tmpref1:=ref1;
  1265. tmpref2:=ref2;
  1266. dstack_slots:=prepare_stack_for_ref(list,tmpref2,false);
  1267. a_load_ref_stack(list,fromsize,tmpref1,prepare_stack_for_ref(list,tmpref1,false));
  1268. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1269. a_load_stack_ref(list,tosize,tmpref2,dstack_slots);
  1270. end;
  1271. procedure thlcgwasm.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister);
  1272. var
  1273. tmpref: treference;
  1274. begin
  1275. tmpref:=ref;
  1276. a_load_ref_stack(list,fromsize,tmpref,prepare_stack_for_ref(list,tmpref,false));
  1277. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1278. a_load_stack_reg(list,tosize,reg);
  1279. end;
  1280. procedure thlcgwasm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference);
  1281. var
  1282. dstack_slots: longint;
  1283. tmpref: treference;
  1284. begin
  1285. tmpref:=ref;
  1286. dstack_slots:=prepare_stack_for_ref(list,tmpref,false);
  1287. a_load_reg_stack(list,fromsize,reg);
  1288. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1289. a_load_stack_ref(list,tosize,tmpref,dstack_slots);
  1290. end;
  1291. procedure thlcgwasm.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  1292. begin
  1293. a_load_reg_stack(list,fromsize,reg1);
  1294. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1295. a_load_stack_reg(list,tosize,reg2);
  1296. end;
  1297. procedure thlcgwasm.g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean);
  1298. var
  1299. pd: tcpuprocdef;
  1300. begin
  1301. pd:=tcpuprocdef(current_procinfo.procdef);
  1302. g_procdef(list,pd);
  1303. ttgwasm(tg).allocframepointer(list,pd.frame_pointer_ref);
  1304. ttgwasm(tg).allocbasepointer(list,pd.base_pointer_ref);
  1305. { the localsize is based on tg.lasttemp -> already in terms of stack
  1306. slots rather than bytes }
  1307. //list.concat(tai_directive.Create(asd_jlimit,'locals '+tostr(localsize)));
  1308. { we insert the unit initialisation code afterwards in the proginit code,
  1309. and it uses one stack slot }
  1310. //if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1311. //fmaxevalstackheight:=max(1,fmaxevalstackheight);
  1312. list.Concat(tai_local.create(wbt_i32,FRAME_POINTER_SYM)); //TWasmBasicType
  1313. list.Concat(tai_local.create(wbt_i32,BASE_POINTER_SYM)); //TWasmBasicType
  1314. list.Concat(taicpu.op_sym(a_get_global,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_LABEL)));
  1315. incstack(list,1);
  1316. list.Concat(taicpu.op_ref(a_set_local,pd.base_pointer_ref));
  1317. decstack(list,1);
  1318. if (localsize>0) then begin
  1319. list.Concat(taicpu.op_ref(a_get_local,pd.base_pointer_ref));
  1320. incstack(list,1);
  1321. list.concat(taicpu.op_const(a_i32_const, localsize ));
  1322. incstack(list,1);
  1323. list.concat(taicpu.op_none(a_i32_sub));
  1324. decstack(list,1);
  1325. list.Concat(taicpu.op_ref(a_set_local,pd.frame_pointer_ref));
  1326. decstack(list,1);
  1327. list.Concat(taicpu.op_ref(a_get_local,pd.frame_pointer_ref));
  1328. incstack(list,1);
  1329. list.Concat(taicpu.op_sym(a_set_global,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_LABEL)));
  1330. decstack(list,1);
  1331. end;
  1332. //list.concat(tai_directive.Create(asd_jlimit,'stack '+tostr(fmaxevalstackheight)));
  1333. end;
  1334. procedure thlcgwasm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
  1335. var
  1336. pd: tcpuprocdef;
  1337. begin
  1338. pd:=tcpuprocdef(current_procinfo.procdef);
  1339. list.Concat(taicpu.op_ref(a_get_local,pd.base_pointer_ref));
  1340. incstack(list,1);
  1341. list.Concat(taicpu.op_sym(a_set_global,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_LABEL)));
  1342. decstack(list,1);
  1343. list.concat(taicpu.op_none(a_return));
  1344. list.concat(taicpu.op_none(a_end_function));
  1345. end;
  1346. procedure thlcgwasm.record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList);
  1347. begin
  1348. { add something to the al_procedures list as well, because if all al_*
  1349. lists are empty, the assembler writer isn't called }
  1350. if not code.empty and
  1351. current_asmdata.asmlists[al_procedures].empty then
  1352. current_asmdata.asmlists[al_procedures].concat(tai_align.Create(4));
  1353. tcpuprocdef(pd).exprasmlist:=TAsmList.create;
  1354. new_section(tcpuprocdef(pd).exprasmlist,sec_code,lower(pd.mangledname),current_settings.alignment.procalign);
  1355. tcpuprocdef(pd).exprasmlist.concatlist(code);
  1356. if assigned(data) and
  1357. not data.empty then
  1358. internalerror(2010122801);
  1359. end;
  1360. procedure thlcgwasm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
  1361. begin
  1362. { not possible, need the original operands }
  1363. internalerror(2012102101);
  1364. end;
  1365. procedure thlcgwasm.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation);
  1366. var
  1367. hl : tasmlabel;
  1368. begin
  1369. if not(cs_check_overflow in current_settings.localswitches) then
  1370. exit;
  1371. current_asmdata.getjumplabel(hl);
  1372. a_cmp_const_loc_label(list,s32inttype,OC_EQ,0,ovloc,hl);
  1373. g_call_system_proc(list,'fpc_overflow',[],nil);
  1374. a_label(list,hl);
  1375. end;
  1376. procedure thlcgwasm.maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean);
  1377. begin
  1378. { don't do anything, all registers become stack locations anyway }
  1379. end;
  1380. procedure thlcgwasm.gen_entry_code(list: TAsmList);
  1381. begin
  1382. list.concat(Tai_force_line.Create);
  1383. { todo: inherited? }
  1384. list.concat(taicpu.op_none(a_block));
  1385. incblock;
  1386. exitBr:=br_blocks;
  1387. end;
  1388. procedure thlcgwasm.gen_exit_code(list: TAsmList);
  1389. begin
  1390. list.concat(taicpu.op_none(a_end_block));
  1391. decblock;
  1392. { todo: inherited? }
  1393. end;
  1394. procedure thlcgwasm.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister);
  1395. begin
  1396. internalerror(2012090201);
  1397. end;
  1398. procedure thlcgwasm.a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle: pmmshuffle);
  1399. begin
  1400. internalerror(2012090202);
  1401. end;
  1402. procedure thlcgwasm.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle);
  1403. begin
  1404. internalerror(2012060130);
  1405. end;
  1406. procedure thlcgwasm.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle);
  1407. begin
  1408. internalerror(2012060131);
  1409. end;
  1410. procedure thlcgwasm.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle);
  1411. begin
  1412. internalerror(2012060132);
  1413. end;
  1414. procedure thlcgwasm.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle);
  1415. begin
  1416. internalerror(2012060133);
  1417. end;
  1418. procedure thlcgwasm.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle);
  1419. begin
  1420. internalerror(2012060134);
  1421. end;
  1422. procedure thlcgwasm.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle);
  1423. begin
  1424. internalerror(2012060135);
  1425. end;
  1426. procedure thlcgwasm.g_stackpointer_alloc(list: TAsmList; size: longint);
  1427. begin
  1428. internalerror(2012090203);
  1429. end;
  1430. procedure thlcgwasm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  1431. begin
  1432. internalerror(2012090204);
  1433. end;
  1434. procedure thlcgwasm.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint);
  1435. begin
  1436. internalerror(2012090205);
  1437. end;
  1438. procedure thlcgwasm.g_local_unwind(list: TAsmList; l: TAsmLabel);
  1439. begin
  1440. internalerror(2012090206);
  1441. end;
  1442. procedure thlcgwasm.g_procdef(list: TAsmList; pd: tprocdef);
  1443. begin
  1444. list.Concat(tai_functype.create(pd.mangledname,tcpuprocdef(pd).create_functype));
  1445. end;
  1446. procedure thlcgwasm.a_load_stack_reg(list: TAsmList; size: tdef; reg: tregister);
  1447. var
  1448. opc: tasmop;
  1449. finishandval: tcgint;
  1450. begin
  1451. opc:=loadstoreopc(size,false,false,finishandval);
  1452. list.concat(taicpu.op_reg(opc,reg));
  1453. { avoid problems with getting the size of an open array etc }
  1454. if wasmAlwayInMem(size) then
  1455. size:=ptruinttype;
  1456. decstack(list,1);
  1457. end;
  1458. procedure thlcgwasm.a_load_stack_ref(list: TAsmList; size: tdef; const ref: treference; extra_slots: longint);
  1459. var
  1460. opc: tasmop;
  1461. finishandval: tcgint;
  1462. begin
  1463. { fake location that indicates the value has to remain on the stack }
  1464. if ref.base=NR_EVAL_STACK_BASE then
  1465. exit;
  1466. opc:=loadstoreopcref(size,false,ref,finishandval);
  1467. list.concat(taicpu.op_ref(opc,ref));
  1468. { avoid problems with getting the size of an open array etc }
  1469. if wasmAlwayInMem(size) then
  1470. size:=ptruinttype;
  1471. decstack(list,1+extra_slots);
  1472. end;
  1473. procedure thlcgwasm.a_load_reg_stack(list: TAsmList; size: tdef; reg: tregister);
  1474. var
  1475. opc: tasmop;
  1476. finishandval: tcgint;
  1477. begin
  1478. opc:=loadstoreopc(size,true,false,finishandval);
  1479. list.concat(taicpu.op_reg(opc,reg));
  1480. { avoid problems with getting the size of an open array etc }
  1481. if wasmAlwayInMem(size) then
  1482. size:=ptruinttype;
  1483. incstack(list,1);
  1484. if finishandval<>-1 then
  1485. a_op_const_stack(list,OP_AND,size,finishandval);
  1486. end;
  1487. procedure thlcgwasm.a_load_ref_stack(list: TAsmList; size: tdef; const ref: treference; extra_slots: longint);
  1488. var
  1489. opc: tasmop;
  1490. finishandval: tcgint;
  1491. begin
  1492. { fake location that indicates the value is already on the stack? }
  1493. if (ref.base=NR_EVAL_STACK_BASE) then
  1494. exit;
  1495. opc:=loadstoreopcref(size,true,ref,finishandval);
  1496. list.concat(taicpu.op_ref(opc,ref));
  1497. { avoid problems with getting the size of an open array etc }
  1498. if wasmAlwayInMem(size) then
  1499. size:=ptruinttype;
  1500. incstack(list,1-extra_slots);
  1501. if finishandval<>-1 then
  1502. a_op_const_stack(list,OP_AND,size,finishandval);
  1503. // there's no cast check in Wasm
  1504. //if ref.checkcast then
  1505. // gen_typecheck(list,a_checkcast,size);
  1506. end;
  1507. function thlcgwasm.loadstoreopcref(def: tdef; isload: boolean; const ref: treference; out finishandval: tcgint): tasmop;
  1508. const
  1509. {iisload} {issigned}
  1510. getputmem8 : array [boolean, boolean] of TAsmOp = ((a_i32_store8, a_i32_store8), (a_i32_load8_u, a_i32_load8_s));
  1511. getputmem16 : array [boolean, boolean] of TAsmOp = ((a_i32_store16, a_i32_store16), (a_i32_load16_u ,a_i32_load16_s));
  1512. getputmem32 : array [boolean, boolean] of TAsmOp = ((a_i32_store, a_i32_store), (a_i32_load, a_i32_load));
  1513. getputmem64 : array [boolean, boolean] of TAsmOp = ((a_i64_store, a_i64_store), (a_i64_load, a_i64_load));
  1514. getputmemf32 : array [boolean] of TAsmOp = (a_f32_store, a_f32_load);
  1515. getputmemf64 : array [boolean] of TAsmOp = (a_f64_store, a_f64_load);
  1516. begin
  1517. if (ref.base<>NR_LOCAL_STACK_POINTER_REG) or assigned(ref.symbol) then
  1518. begin
  1519. { -> either a global (static) field, or a regular field. If a regular
  1520. field, then ref.base contains the self pointer, otherwise
  1521. ref.base=NR_NO. In both cases, the symbol contains all other
  1522. information (combined field name and type descriptor) }
  1523. case def.size of
  1524. 1: result := getputmem8[isload, is_signed(def)];
  1525. 2: result := getputmem16[isload, is_signed(def)];
  1526. 4:
  1527. if is_single(def) then
  1528. result := getputmemf32[isload]
  1529. else
  1530. result := getputmem32[isload, is_signed(def)];
  1531. 8: if is_double(def) then
  1532. result := getputmemf64[isload]
  1533. else
  1534. result := getputmem64[isload, is_signed(def)];
  1535. else
  1536. Internalerror(2019091501);
  1537. end;
  1538. //result:=getputopc[isload,ref.base=NR_NO];
  1539. finishandval:=-1;
  1540. { erase sign extension for byte/smallint loads }
  1541. if (def2regtyp(def)=R_INTREGISTER) and
  1542. not is_signed(def) and
  1543. (def.typ=orddef) and
  1544. not is_widechar(def) then
  1545. case def.size of
  1546. 1: if (torddef(def).high>127) then
  1547. finishandval:=255;
  1548. 2: if (torddef(def).high>32767) then
  1549. finishandval:=65535;
  1550. end;
  1551. end
  1552. else
  1553. result:=loadstoreopc(def,isload,false,finishandval);
  1554. end;
  1555. function thlcgwasm.loadstoreopc(def: tdef; isload, isarray: boolean; out finishandval: tcgint): tasmop;
  1556. var
  1557. size: longint;
  1558. begin
  1559. finishandval:=-1;
  1560. if isload then result := a_get_local
  1561. else result := a_set_local;
  1562. {case def2regtyp(def) of
  1563. R_INTREGISTER:
  1564. begin
  1565. size:=def.size;
  1566. case size of
  1567. 1,2,3,4:
  1568. if isload then
  1569. result:=a_i32_load
  1570. else
  1571. result:=a_i32_store;
  1572. 8:
  1573. if isload then
  1574. result:=a_i64_load
  1575. else
  1576. result:=a_i64_store;
  1577. else
  1578. internalerror(2011032814);
  1579. end;
  1580. end;
  1581. R_ADDRESSREGISTER:
  1582. if isload then
  1583. result:=a_i32_load
  1584. else
  1585. result:=a_i32_store;
  1586. R_FPUREGISTER:
  1587. begin
  1588. case tfloatdef(def).floattype of
  1589. s32real:
  1590. if isload then
  1591. result:=a_f32_load
  1592. else
  1593. result:=a_f32_store;
  1594. s64real:
  1595. if isload then
  1596. result:=a_f32_load
  1597. else
  1598. result:=a_f32_store
  1599. else
  1600. internalerror(2010120504);
  1601. end
  1602. end
  1603. else
  1604. internalerror(2010120502);
  1605. end;}
  1606. end;
  1607. procedure thlcgwasm.resize_stack_int_val(list: TAsmList; fromsize, tosize: tdef; formemstore: boolean);
  1608. var
  1609. fromcgsize, tocgsize: tcgsize;
  1610. begin
  1611. { When storing to an array, field or global variable, make sure the
  1612. static type verification can determine that the stored value fits
  1613. within the boundaries of the declared type (to appease the Dalvik VM).
  1614. Local variables either get their type upgraded in the debug info,
  1615. or have no type information at all }
  1616. if formemstore and
  1617. (tosize.typ=orddef) then
  1618. if (torddef(tosize).ordtype in [u8bit,uchar]) then
  1619. tosize:=s8inttype
  1620. else if torddef(tosize).ordtype=u16bit then
  1621. tosize:=s16inttype;
  1622. fromcgsize:=def_cgsize(fromsize);
  1623. tocgsize:=def_cgsize(tosize);
  1624. if fromcgsize in [OS_S64,OS_64] then
  1625. begin
  1626. if not(tocgsize in [OS_S64,OS_64]) then
  1627. begin
  1628. { truncate }
  1629. list.concat(taicpu.op_none(a_i32_wrap_i64));
  1630. end;
  1631. end
  1632. else if tocgsize in [OS_S64,OS_64] then
  1633. begin
  1634. { extend }
  1635. case fromcgsize of
  1636. OS_8:
  1637. begin
  1638. a_op_const_stack(list,OP_AND,s32inttype,255);
  1639. list.concat(taicpu.op_none(a_i64_extend_u_i32));
  1640. end;
  1641. OS_S8:
  1642. list.concat(taicpu.op_none(a_i64_extend_s_8));
  1643. OS_16:
  1644. begin
  1645. a_op_const_stack(list,OP_AND,s32inttype,65535);
  1646. list.concat(taicpu.op_none(a_i64_extend_u_i32));
  1647. end;
  1648. OS_S16:
  1649. list.concat(taicpu.op_none(a_i64_extend_s_16));
  1650. OS_32:
  1651. list.concat(taicpu.op_none(a_i64_extend_u_i32));
  1652. OS_S32:
  1653. list.concat(taicpu.op_none(a_i64_extend_s_i32));
  1654. OS_64,OS_S64:
  1655. ;
  1656. else
  1657. internalerror(2021010301);
  1658. end;
  1659. end;
  1660. { Conversions between 32 and 64 bit types have been completely handled
  1661. above. We still may have to truncate or sign extend in case the
  1662. destination type is smaller that the source type, or has a different
  1663. sign. In case the destination is a widechar and the source is not, we
  1664. also have to insert a conversion to widechar.
  1665. }
  1666. case fromcgsize of
  1667. OS_8:
  1668. a_op_const_stack(list,OP_AND,s32inttype,255);
  1669. OS_S8:
  1670. list.concat(taicpu.op_none(a_i32_extend_s_8));
  1671. OS_16:
  1672. a_op_const_stack(list,OP_AND,s32inttype,65535);
  1673. OS_S16:
  1674. list.concat(taicpu.op_none(a_i32_extend_s_16));
  1675. OS_32,OS_S32,OS_64,OS_S64:
  1676. ;
  1677. else
  1678. internalerror(2021010302);
  1679. end;
  1680. end;
  1681. procedure thlcgwasm.maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean);
  1682. var
  1683. convsize: tdef;
  1684. begin
  1685. if (retdef.typ=orddef) then
  1686. begin
  1687. if (torddef(retdef).ordtype in [u8bit,u16bit,uchar]) and
  1688. (torddef(retdef).high>=(1 shl (retdef.size*8-1))) then
  1689. begin
  1690. convsize:=nil;
  1691. if callside then
  1692. if torddef(retdef).ordtype in [u8bit,uchar] then
  1693. convsize:=s8inttype
  1694. else
  1695. convsize:=s16inttype
  1696. else if torddef(retdef).ordtype in [u8bit,uchar] then
  1697. convsize:=u8inttype
  1698. else
  1699. convsize:=u16inttype;
  1700. if assigned(convsize) then
  1701. resize_stack_int_val(list,s32inttype,convsize,false);
  1702. end;
  1703. end;
  1704. end;
  1705. procedure thlcgwasm.g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef; paraheight: longint; forceresdef: tdef);
  1706. var
  1707. totalremovesize: longint;
  1708. realresdef: tdef;
  1709. begin
  1710. if not assigned(forceresdef) then
  1711. realresdef:=pd.returndef
  1712. else
  1713. realresdef:=forceresdef;
  1714. { a constructor doesn't actually return a value in the jvm }
  1715. if (tabstractprocdef(pd).proctypeoption=potype_constructor) then
  1716. totalremovesize:=paraheight
  1717. else
  1718. { even a byte takes up a full stackslot -> align size to multiple of 4 }
  1719. totalremovesize:=paraheight-(align(realresdef.size,4) shr 2);
  1720. { remove parameters from internal evaluation stack counter (in case of
  1721. e.g. no parameters and a result, it can also increase) }
  1722. if totalremovesize>0 then
  1723. decstack(list,totalremovesize)
  1724. else if totalremovesize<0 then
  1725. incstack(list,-totalremovesize);
  1726. end;
  1727. procedure thlcgwasm.resizestackfpuval(list: TAsmList; fromsize, tosize: tcgsize);
  1728. begin
  1729. if (fromsize=OS_F32) and
  1730. (tosize=OS_F64) then
  1731. begin
  1732. list.concat(taicpu.op_none(a_f64_promote_f32));
  1733. end
  1734. else if (fromsize=OS_F64) and
  1735. (tosize=OS_F32) then
  1736. begin
  1737. list.concat(taicpu.op_none(a_f32_demote_f64));
  1738. end;
  1739. end;
  1740. procedure thlcgwasm.maybepreparedivu32(list: TAsmList; var op: topcg; size: tdef; out isdivu32: boolean);
  1741. begin
  1742. if (op=OP_DIV) and
  1743. (def_cgsize(size)=OS_32) then
  1744. begin
  1745. { needs zero-extension to 64 bit, because the JVM only supports
  1746. signed divisions }
  1747. resize_stack_int_val(list,u32inttype,s64inttype,false);
  1748. op:=OP_IDIV;
  1749. isdivu32:=true;
  1750. end
  1751. else
  1752. isdivu32:=false;
  1753. end;
  1754. procedure create_hlcodegen_cpu;
  1755. begin
  1756. hlcg:=thlcgwasm.create;
  1757. create_codegen;
  1758. end;
  1759. initialization
  1760. chlcgobj:=thlcgwasm;
  1761. create_hlcodegen:=@create_hlcodegen_cpu;
  1762. end.