hlcgcpu.pas 83 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106
  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 a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference); override;
  74. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override;
  75. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); override;
  76. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); override;
  77. procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference); override;
  78. procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
  79. procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override;
  80. procedure g_rangecheck(list: TAsmList; const l:tlocation; fromdef,todef: tdef); override;
  81. procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
  82. procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override;
  83. procedure maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean); override;
  84. procedure gen_entry_code(list: TAsmList); override;
  85. procedure gen_exit_code(list: TAsmList); override;
  86. { unimplemented/unnecessary routines }
  87. procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister); override;
  88. procedure a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle: pmmshuffle); override;
  89. procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle); override;
  90. procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); override;
  91. procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); override;
  92. procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle); override;
  93. procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); override;
  94. procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle); override;
  95. procedure g_stackpointer_alloc(list: TAsmList; size: longint); override;
  96. procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); override;
  97. procedure g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint); override;
  98. procedure g_local_unwind(list: TAsmList; l: TAsmLabel); override;
  99. { Wasm-specific routines }
  100. procedure g_procdef(list:TAsmList;pd: tprocdef);
  101. procedure a_load_stack_reg(list : TAsmList;size: tdef;reg: tregister);
  102. { extra_slots are the slots that are used by the reference, and that
  103. will be removed by the store operation }
  104. procedure a_load_stack_ref(list : TAsmList;size: tdef;const ref: treference;extra_slots: longint);
  105. procedure a_load_reg_stack(list : TAsmList;size: tdef;reg: tregister);
  106. { extra_slots are the slots that are used by the reference, and that
  107. will be removed by the load operation }
  108. procedure a_load_ref_stack(list : TAsmList;size: tdef;const ref: treference;extra_slots: longint);
  109. procedure a_load_const_stack(list : TAsmList;size: tdef;a :tcgint; typ: TRegisterType);
  110. procedure a_loadaddr_ref_stack(list : TAsmList;fromsize, tosize : tdef;const ref : treference);
  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);
  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 a_cmp_const_loc_stack(list: TAsmList; size: tdef;cmp_op: topcmp; a: tcgint; const loc: tlocation);
  120. procedure a_cmp_const_ref_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference);
  121. procedure a_cmp_const_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister);
  122. procedure a_cmp_ref_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister);
  123. procedure a_cmp_reg_ref_stack(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference);
  124. procedure a_cmp_reg_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister);
  125. procedure a_cmp_subsetreg_reg_stack(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister);
  126. procedure a_cmp_subsetref_reg_stack(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister);
  127. procedure a_cmp_loc_reg_stack(list : TAsmList;size : tdef;cmp_op : topcmp; const loc: tlocation; reg : tregister);
  128. procedure a_cmp_reg_loc_stack(list : TAsmList;size : tdef;cmp_op : topcmp; reg: tregister; const loc: tlocation);
  129. procedure a_cmp_ref_loc_stack(list: TAsmList; size: tdef;cmp_op: topcmp; const ref: treference; const loc: tlocation);
  130. procedure a_cmp_const_loc_br(list: TAsmList; size: tdef;cmp_op: topcmp; a: tcgint; const loc: tlocation; br: Integer);
  131. procedure a_cmp_const_ref_br(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference; br: Integer);
  132. procedure a_cmp_const_reg_br(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; br: Integer);
  133. procedure a_cmp_ref_reg_br(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; br: Integer);
  134. procedure a_cmp_reg_ref_br(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; br: Integer);
  135. procedure a_cmp_reg_reg_br(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; br: Integer);
  136. procedure a_cmp_subsetreg_reg_br(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister; br: Integer);
  137. procedure a_cmp_subsetref_reg_br(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister; br: Integer);
  138. procedure a_cmp_loc_reg_br(list : TAsmList;size : tdef;cmp_op : topcmp; const loc: tlocation; reg : tregister; br: Integer);
  139. procedure a_cmp_reg_loc_br(list : TAsmList;size : tdef;cmp_op : topcmp; reg: tregister; const loc: tlocation; br: Integer);
  140. procedure a_cmp_ref_loc_br(list: TAsmList; size: tdef;cmp_op: topcmp; const ref: treference; const loc: tlocation; br: Integer);
  141. procedure g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation); override;
  142. procedure a_cmp_stack_stack(list : TAsmlist; size: tdef; cmp_op: topcmp);
  143. { truncate/sign extend after performing operations on values < 32 bit
  144. that may have overflowed outside the range }
  145. procedure maybe_adjust_op_result(list: TAsmList; op: TOpCg; size: tdef);
  146. { performs sign/zero extension as required }
  147. procedure resize_stack_int_val(list: TAsmList;fromsize,tosize: tdef; formemstore: boolean);
  148. { 8/16 bit unsigned parameters and return values must be sign-extended on
  149. the producer side, because the JVM does not support unsigned variants;
  150. then they have to be zero-extended again on the consumer side }
  151. procedure maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean);
  152. { adjust the stack height after a call based on the specified number of
  153. slots used for parameters and the provided resultdef }
  154. procedure g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef);
  155. { because WebAssembly has no spec for any sort of debug info, and the
  156. only linker that we support (LLVM's wasm-ld) does not support creating
  157. map files in its stable version, and crashes when attempting to create
  158. a map file in its development version from git, we have no way to
  159. identify which procedure a crash occurred in. So, to identify the
  160. procedure, we call this procedure on proc entry, which generates a few
  161. useless loads of random numbers on the stack, that are immediately
  162. discarded, so they are essentially equivalent to a nop. This allows
  163. finding the procedure in the FPC output assembly, produced with -al by
  164. searching for these random numbers, as taken from the disassembly of the
  165. final binary. }
  166. procedure g_fingerprint(list: TAsmList);
  167. property maxevalstackheight: longint read fmaxevalstackheight;
  168. protected
  169. procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
  170. function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; override;
  171. public
  172. { in case of an array, the array base address and index have to be
  173. put on the evaluation stack before the stored value; similarly, for
  174. fields the self pointer has to be loaded first. Also checks whether
  175. the reference is valid. If dup is true, the necessary values are stored
  176. twice. Returns how many stack slots have been consumed, disregarding
  177. the "dup". }
  178. function prepare_stack_for_ref(list: TAsmList; var ref: treference; dup: boolean): longint;
  179. protected
  180. { return the load/store opcode to load/store from/to ref; if the result
  181. has to be and'ed after a load to get the final value, that constant
  182. is returned in finishandval (otherwise that value is set to -1) }
  183. function loadstoreopcref(def: tdef; isload: boolean; const ref: treference; out finishandval: tcgint): tasmop;
  184. procedure resizestackfpuval(list: TAsmList; fromsize, tosize: tcgsize);
  185. end;
  186. implementation
  187. uses
  188. verbose,cutils,globals,fmodule,constexp,
  189. defutil,
  190. aasmtai,aasmcpu,
  191. symtable,symcpu,
  192. procinfo,cpuinfo,cgcpu,tgobj,tgcpu,paramgr;
  193. const
  194. TOpCG2IAsmOp : array[topcg] of TAsmOp=(
  195. A_None, {OP_NONE}
  196. A_None, {OP_MOVE, replaced operation with direct load }
  197. a_i32_add, {OP_ADD, simple addition }
  198. a_i32_and, {OP_AND, simple logical and }
  199. a_i32_div_u, {OP_DIV, simple unsigned division }
  200. a_i32_div_s, {OP_IDIV, simple signed division }
  201. a_i32_mul, {OP_IMUL, simple signed multiply }
  202. a_i32_mul, {OP_MUL, simple unsigned multiply }
  203. A_None, {OP_NEG, simple negate } // neg = xor + 1
  204. A_None, {OP_NOT, simple logical not } // not = xor - 1
  205. a_i32_or, {OP_OR, simple logical or }
  206. a_i32_shr_s, {OP_SAR, arithmetic shift-right }
  207. a_i32_shl, {OP_SHL, logical shift left }
  208. a_i32_shr_u, {OP_SHR, logical shift right }
  209. a_i32_sub, {OP_SUB, simple subtraction }
  210. a_i32_xor, {OP_XOR, simple exclusive or }
  211. a_i32_rotl, {OP_ROL, rotate left }
  212. a_i32_rotr {OP_ROR rotate right }
  213. );
  214. TOpCG2LAsmOp : array[topcg] of TAsmOp=(
  215. A_None, {OP_NONE}
  216. a_i64_load, {OP_MOVE, replaced operation with direct load }
  217. a_i64_add, {OP_ADD, simple addition }
  218. a_i64_and, {OP_AND, simple logical and }
  219. a_i64_div_u, {OP_DIV, simple unsigned division }
  220. a_i64_div_s, {OP_IDIV, simple signed division }
  221. a_i64_mul, {OP_IMUL, simple signed multiply }
  222. a_i64_mul, {OP_MUL, simple unsigned multiply }
  223. A_None, {OP_NEG, simple negate } // neg = xor + 1
  224. A_None, {OP_NOT, simple logical not } // not = xor - 1
  225. a_i64_or, {OP_OR, simple logical or }
  226. a_i64_shr_s, {OP_SAR, arithmetic shift-right }
  227. a_i64_shl, {OP_SHL, logical shift left }
  228. a_i64_shr_u, {OP_SHR, logical shift right }
  229. a_i64_sub, {OP_SUB, simple subtraction }
  230. a_i64_xor, {OP_XOR, simple exclusive or }
  231. a_i64_rotl, {OP_ROL, rotate left }
  232. a_i64_rotr {OP_ROR rotate right }
  233. );
  234. constructor thlcgwasm.create;
  235. begin
  236. fevalstackheight:=0;
  237. fmaxevalstackheight:=0;
  238. fntypelookup:=TWasmProcTypeLookup.Create;
  239. end;
  240. destructor thlcgwasm.Destroy;
  241. begin
  242. fntypelookup.Free;
  243. inherited Destroy;
  244. end;
  245. procedure thlcgwasm.incblock;
  246. begin
  247. inc(br_blocks);
  248. end;
  249. procedure thlcgwasm.decblock;
  250. begin
  251. dec(br_blocks);
  252. if br_blocks<0 then
  253. Internalerror(2019091807); // out of block
  254. end;
  255. procedure thlcgwasm.incstack(list: TAsmList; slots: longint);
  256. begin
  257. if slots=0 then
  258. exit;
  259. inc(fevalstackheight,slots);
  260. if (fevalstackheight>fmaxevalstackheight) then
  261. fmaxevalstackheight:=fevalstackheight;
  262. if cs_asm_regalloc in current_settings.globalswitches then
  263. list.concat(tai_comment.Create(strpnew(' allocated '+tostr(slots)+', stack height = '+tostr(fevalstackheight))));
  264. end;
  265. procedure thlcgwasm.decstack(list: TAsmList;slots: longint);
  266. begin
  267. if slots=0 then
  268. exit;
  269. dec(fevalstackheight,slots);
  270. if (fevalstackheight<0) and
  271. not(cs_no_regalloc in current_settings.globalswitches) then
  272. internalerror(2010120501);
  273. if cs_asm_regalloc in current_settings.globalswitches then
  274. list.concat(tai_comment.Create(strpnew(' freed '+tostr(slots)+', stack height = '+tostr(fevalstackheight))));
  275. end;
  276. procedure thlcgwasm.a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; const cgpara: TCGPara);
  277. begin
  278. tosize:=get_para_push_size(tosize);
  279. if tosize=s8inttype then
  280. a:=shortint(a)
  281. else if tosize=s16inttype then
  282. a:=smallint(a);
  283. inherited a_load_const_cgpara(list, tosize, a, cgpara);
  284. end;
  285. function thlcgwasm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
  286. begin
  287. list.concat(taicpu.op_sym(a_call,current_asmdata.RefAsmSymbol(s,AT_FUNCTION)));
  288. result:=get_call_result_cgpara(pd,forceresdef);
  289. end;
  290. function thlcgwasm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
  291. begin
  292. a_load_reg_stack(list, ptrsinttype, reg);
  293. if pd.typ=procvardef then
  294. current_asmdata.CurrAsmList.Concat(taicpu.op_functype(a_call_indirect,tcpuprocvardef(pd).create_functype))
  295. else
  296. current_asmdata.CurrAsmList.Concat(taicpu.op_functype(a_call_indirect,tcpuprocdef(pd).create_functype));
  297. decstack(list,1);
  298. result:=hlcg.get_call_result_cgpara(pd, nil);
  299. end;
  300. procedure thlcgwasm.a_load_const_stack(list : TAsmList;size : tdef;a : tcgint; typ: TRegisterType);
  301. begin
  302. case typ of
  303. R_INTREGISTER,
  304. R_ADDRESSREGISTER:
  305. begin
  306. case def_cgsize(size) of
  307. OS_8,OS_16,OS_32,
  308. OS_S8,OS_S16,OS_S32:
  309. begin
  310. { convert cardinals to longints }
  311. list.concat(taicpu.op_const(a_i32_const, a));
  312. end;
  313. OS_64,OS_S64:
  314. begin
  315. list.concat(taicpu.op_const(a_i64_const, a));
  316. end;
  317. else
  318. internalerror(2010110702);
  319. end;
  320. end;
  321. else
  322. internalerror(2010110703);
  323. end;
  324. incstack(list,1);
  325. end;
  326. procedure thlcgwasm.a_loadaddr_ref_stack(list : TAsmList;fromsize, tosize : tdef;const ref : treference);
  327. var
  328. tmpref: treference;
  329. begin
  330. { you can't take the address of references, that are on the local stack }
  331. if (ref.base=NR_EVAL_STACK_BASE) or (ref.index=NR_EVAL_STACK_BASE) or
  332. (ref.base=NR_LOCAL_STACK_POINTER_REG) or (ref.index=NR_LOCAL_STACK_POINTER_REG) then
  333. internalerror(2021010101);
  334. tmpref:=ref;
  335. tmpref.base:=NR_NO;
  336. tmpref.index:=NR_NO;
  337. list.Concat(taicpu.op_ref(a_i32_const, tmpref));
  338. incstack(list, 1);
  339. if ref.base<>NR_NO then
  340. begin
  341. list.Concat(taicpu.op_reg(a_local_get,ref.base));
  342. incstack(list, 1);
  343. list.Concat(taicpu.op_none(a_i32_add));
  344. decstack(list, 1);
  345. end;
  346. if ref.index<>NR_NO then
  347. begin
  348. list.Concat(taicpu.op_reg(a_local_get,ref.index));
  349. incstack(list, 1);
  350. if ref.scalefactor>1 then
  351. begin
  352. list.Concat(taicpu.op_const(a_i32_const,ref.scalefactor));
  353. incstack(list, 1);
  354. list.Concat(taicpu.op_none(a_i32_mul));
  355. decstack(list, 1);
  356. end;
  357. list.Concat(taicpu.op_none(a_i32_add));
  358. decstack(list, 1);
  359. end;
  360. end;
  361. procedure thlcgwasm.a_load_stack_loc(list: TAsmList; size: tdef; const loc: tlocation);
  362. var
  363. tmpref: treference;
  364. begin
  365. case loc.loc of
  366. LOC_REGISTER,LOC_CREGISTER,
  367. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  368. a_load_stack_reg(list,size,loc.register);
  369. LOC_REFERENCE:
  370. begin
  371. tmpref:=loc.reference;
  372. a_load_stack_ref(list,size,loc.reference,prepare_stack_for_ref(list,tmpref,false));
  373. end;
  374. else
  375. internalerror(2011020501);
  376. end;
  377. end;
  378. procedure thlcgwasm.a_load_loc_stack(list: TAsmList;size: tdef;const loc: tlocation);
  379. var
  380. tmpref: treference;
  381. extra_slots: LongInt;
  382. begin
  383. case loc.loc of
  384. LOC_REGISTER,LOC_CREGISTER,
  385. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  386. a_load_reg_stack(list,size,loc.register);
  387. LOC_REFERENCE,LOC_CREFERENCE:
  388. begin
  389. tmpref:=loc.reference;
  390. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  391. a_load_ref_stack(list,size,tmpref,extra_slots);
  392. end;
  393. LOC_CONSTANT:
  394. a_load_const_stack(list,size,loc.value,def2regtyp(size));
  395. else
  396. internalerror(2011010401);
  397. end;
  398. end;
  399. procedure thlcgwasm.a_loadfpu_const_stack(list: TAsmList; size: tdef; a: double);
  400. begin
  401. case tfloatdef(size).floattype of
  402. s32real:
  403. begin
  404. list.concat(taicpu.op_single(a_f32_const, a));
  405. incstack(list,1);
  406. end;
  407. s64real:
  408. begin
  409. list.concat(taicpu.op_double(a_f64_const,a));
  410. incstack(list,1);
  411. end
  412. else
  413. internalerror(2011010501);
  414. end;
  415. end;
  416. procedure thlcgwasm.a_op_stack(list: TAsmList; op: topcg; size: tdef);
  417. begin
  418. case def_cgsize(size) of
  419. OS_8,OS_S8,
  420. OS_16,OS_S16,
  421. OS_32,OS_S32:
  422. begin
  423. { boolean not: =0? for boolean }
  424. { todo: should we also do this for cbool? }
  425. if (op=OP_NOT) and is_pasbool(size) then
  426. list.concat(taicpu.op_none(a_i32_eqz))
  427. else
  428. begin
  429. if op=OP_NOT then
  430. begin
  431. { not = xor -1 for integer }
  432. a_load_const_stack(list,s32inttype,high(cardinal),R_INTREGISTER);
  433. op:=OP_XOR;
  434. end
  435. else if op=OP_NEG then
  436. begin
  437. { neg = *(-1) }
  438. a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
  439. op:=OP_MUL;
  440. end;
  441. if TOpCG2IAsmOp[op]=A_None then
  442. internalerror(2010120532);
  443. list.concat(taicpu.op_none(TOpCG2IAsmOp[op]));
  444. decstack(list,1);
  445. end;
  446. maybe_adjust_op_result(list,op,size);
  447. end;
  448. OS_64,OS_S64:
  449. begin
  450. { unsigned 64 bit division must be done via a helper }
  451. if op=OP_DIV then
  452. internalerror(2010120530);
  453. { boolean not: =0? for boolean }
  454. { todo: should we also do this for cbool? }
  455. if (op=OP_NOT) and is_pasbool(size) then
  456. list.concat(taicpu.op_none(a_i64_eqz))
  457. else
  458. begin
  459. if op=OP_NOT then
  460. begin
  461. { not = xor -1 for integer }
  462. a_load_const_stack(list,s64inttype,-1,R_INTREGISTER);
  463. op:=OP_XOR;
  464. end
  465. else if op=OP_NEG then
  466. begin
  467. { neg = *(-1) }
  468. a_load_const_stack(list,s64inttype,-1,R_INTREGISTER);
  469. op:=OP_MUL;
  470. end;
  471. if TOpCG2LAsmOp[op]=A_None then
  472. internalerror(2010120533);
  473. list.concat(taicpu.op_none(TOpCG2LAsmOp[op]));
  474. decstack(list,1);
  475. end;
  476. end;
  477. else
  478. internalerror(2010120531);
  479. end;
  480. end;
  481. procedure thlcgwasm.a_op_const_stack(list: TAsmList;op: topcg;size: tdef;a: tcgint);
  482. begin
  483. case op of
  484. OP_NEG,OP_NOT:
  485. internalerror(2011010801);
  486. else
  487. a_load_const_stack(list,size,a,R_INTREGISTER);
  488. end;
  489. a_op_stack(list,op,size);
  490. end;
  491. procedure thlcgwasm.a_op_reg_stack(list: TAsmList; op: topcg; size: tdef; reg: tregister);
  492. begin
  493. a_load_reg_stack(list,size,reg);
  494. a_op_stack(list,op,size);
  495. end;
  496. procedure thlcgwasm.a_op_ref_stack(list: TAsmList; op: topcg; size: tdef; const ref: treference);
  497. var
  498. tmpref: treference;
  499. begin
  500. { ref must not be the stack top, because that may indicate an error
  501. (it means that we will perform an operation of the stack top onto
  502. itself, so that means the two values have been loaded manually prior
  503. to calling this routine, instead of letting this routine load one of
  504. them; if something like that is needed, call a_op_stack() directly) }
  505. if ref.base=NR_EVAL_STACK_BASE then
  506. internalerror(2010121102);
  507. tmpref:=ref;
  508. a_load_ref_stack(list,size,tmpref,prepare_stack_for_ref(list,tmpref,false));
  509. a_op_stack(list,op,size);
  510. end;
  511. procedure thlcgwasm.a_op_loc_stack(list: TAsmList; op: topcg; size: tdef; const loc: tlocation);
  512. begin
  513. case loc.loc of
  514. LOC_REGISTER,LOC_CREGISTER:
  515. a_op_reg_stack(list,op,size,loc.register);
  516. LOC_REFERENCE,LOC_CREFERENCE:
  517. a_op_ref_stack(list,op,size,loc.reference);
  518. LOC_CONSTANT:
  519. a_op_const_stack(list,op,size,loc.value);
  520. else
  521. internalerror(2011011415)
  522. end;
  523. end;
  524. procedure thlcgwasm.a_cmp_const_loc_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const loc: tlocation);
  525. var
  526. tmpreg: tregister;
  527. begin
  528. case loc.loc of
  529. LOC_REGISTER,LOC_CREGISTER:
  530. a_cmp_const_reg_stack(list,size,cmp_op,a,loc.register);
  531. LOC_REFERENCE,LOC_CREFERENCE:
  532. a_cmp_const_ref_stack(list,size,cmp_op,a,loc.reference);
  533. LOC_SUBSETREG, LOC_CSUBSETREG:
  534. begin
  535. tmpreg:=getintregister(list,size);
  536. a_load_subsetreg_reg(list,size,size,loc.sreg,tmpreg);
  537. a_cmp_const_reg_stack(list,size,cmp_op,a,tmpreg);
  538. end;
  539. LOC_SUBSETREF, LOC_CSUBSETREF:
  540. begin
  541. tmpreg:=getintregister(list,size);
  542. a_load_subsetref_reg(list,size,size,loc.sref,tmpreg);
  543. a_cmp_const_reg_stack(list,size,cmp_op,a,tmpreg);
  544. end;
  545. else
  546. internalerror(2010120430);
  547. end;
  548. end;
  549. procedure thlcgwasm.a_cmp_const_ref_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference);
  550. var
  551. tmpref: treference;
  552. begin
  553. tmpref:=ref;
  554. if tmpref.base<>NR_EVAL_STACK_BASE then
  555. a_load_ref_stack(list,size,tmpref,prepare_stack_for_ref(list,tmpref,false));
  556. a_load_const_stack(list,size,a,def2regtyp(size));
  557. a_cmp_stack_stack(list,size,cmp_op);
  558. end;
  559. procedure thlcgwasm.a_cmp_const_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister);
  560. begin
  561. a_load_reg_stack(list,size,reg);
  562. a_load_const_stack(list,size,a,def2regtyp(size));
  563. a_cmp_stack_stack(list,size,cmp_op);
  564. end;
  565. procedure thlcgwasm.a_cmp_ref_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister);
  566. var
  567. tmpref: treference;
  568. begin
  569. tmpref:=ref;
  570. a_load_reg_stack(list,size,reg);
  571. if tmpref.base<>NR_EVAL_STACK_BASE then
  572. a_load_ref_stack(list,size,tmpref,prepare_stack_for_ref(list,tmpref,false))
  573. else
  574. cmp_op:=swap_opcmp(cmp_op);
  575. a_cmp_stack_stack(list,size,cmp_op);
  576. end;
  577. procedure thlcgwasm.a_cmp_reg_ref_stack(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference);
  578. var
  579. tmpref: treference;
  580. begin
  581. tmpref:=ref;
  582. if tmpref.base<>NR_EVAL_STACK_BASE then
  583. a_load_ref_stack(list,size,ref,prepare_stack_for_ref(list,tmpref,false));
  584. a_load_reg_stack(list,size,reg);
  585. a_cmp_stack_stack(list,size,cmp_op);
  586. end;
  587. procedure thlcgwasm.a_cmp_reg_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister);
  588. begin
  589. a_load_reg_stack(list,size,reg2);
  590. a_load_reg_stack(list,size,reg1);
  591. a_cmp_stack_stack(list,size,cmp_op);
  592. end;
  593. procedure thlcgwasm.a_cmp_subsetreg_reg_stack(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister);
  594. var
  595. tmpreg: tregister;
  596. begin
  597. tmpreg:=getintregister(list,cmpsize);
  598. a_load_subsetreg_reg(list,fromsubsetsize,cmpsize,sreg,tmpreg);
  599. a_cmp_reg_reg_stack(list,cmpsize,cmp_op,tmpreg,reg);
  600. end;
  601. procedure thlcgwasm.a_cmp_subsetref_reg_stack(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister);
  602. var
  603. tmpreg: tregister;
  604. begin
  605. tmpreg:=getintregister(list,cmpsize);
  606. a_load_subsetref_reg(list,fromsubsetsize,cmpsize,sref,tmpreg);
  607. a_cmp_reg_reg_stack(list,cmpsize,cmp_op,tmpreg,reg);
  608. end;
  609. procedure thlcgwasm.a_cmp_loc_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; const loc: tlocation; reg: tregister);
  610. begin
  611. case loc.loc of
  612. LOC_REGISTER,
  613. LOC_CREGISTER:
  614. a_cmp_reg_reg_stack(list,size,cmp_op,loc.register,reg);
  615. LOC_REFERENCE,
  616. LOC_CREFERENCE :
  617. a_cmp_ref_reg_stack(list,size,cmp_op,loc.reference,reg);
  618. LOC_CONSTANT:
  619. a_cmp_const_reg_stack(list,size,cmp_op,loc.value,reg);
  620. LOC_SUBSETREG,
  621. LOC_CSUBSETREG:
  622. a_cmp_subsetreg_reg_stack(list,size,size,cmp_op,loc.sreg,reg);
  623. LOC_SUBSETREF,
  624. LOC_CSUBSETREF:
  625. a_cmp_subsetref_reg_stack(list,size,size,cmp_op,loc.sref,reg);
  626. else
  627. internalerror(2010120431);
  628. end;
  629. end;
  630. procedure thlcgwasm.a_cmp_reg_loc_stack(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const loc: tlocation);
  631. begin
  632. a_cmp_loc_reg_stack(list,size,swap_opcmp(cmp_op),loc,reg);
  633. end;
  634. procedure thlcgwasm.a_cmp_ref_loc_stack(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; const loc: tlocation);
  635. var
  636. tmpreg: tregister;
  637. begin
  638. case loc.loc of
  639. LOC_REGISTER,LOC_CREGISTER:
  640. a_cmp_ref_reg_stack(list,size,cmp_op,ref,loc.register);
  641. LOC_REFERENCE,LOC_CREFERENCE:
  642. begin
  643. tmpreg:=getintregister(list,size);
  644. a_load_ref_reg(list,size,size,loc.reference,tmpreg);
  645. a_cmp_ref_reg_stack(list,size,cmp_op,ref,tmpreg);
  646. end;
  647. LOC_CONSTANT:
  648. begin
  649. a_cmp_const_ref_stack(list,size,swap_opcmp(cmp_op),loc.value,ref);
  650. end;
  651. LOC_SUBSETREG, LOC_CSUBSETREG:
  652. begin
  653. tmpreg:=getintregister(list,size);
  654. a_load_ref_reg(list,size,size,loc.reference,tmpreg);
  655. a_cmp_subsetreg_reg_stack(list,size,size,swap_opcmp(cmp_op),loc.sreg,tmpreg);
  656. end;
  657. LOC_SUBSETREF, LOC_CSUBSETREF:
  658. begin
  659. tmpreg:=getintregister(list,size);
  660. a_load_ref_reg(list,size,size,loc.reference,tmpreg);
  661. a_cmp_subsetref_reg_stack(list,size,size,swap_opcmp(cmp_op),loc.sref,tmpreg);
  662. end;
  663. else
  664. internalerror(2010120432);
  665. end;
  666. end;
  667. procedure thlcgwasm.a_cmp_const_loc_br(list: TAsmList; size: tdef;cmp_op: topcmp; a: tcgint; const loc: tlocation; br: Integer);
  668. begin
  669. a_cmp_const_loc_stack(list,size,cmp_op,a,loc);
  670. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  671. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  672. end;
  673. procedure thlcgwasm.a_cmp_const_ref_br(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference; br: Integer);
  674. begin
  675. a_cmp_const_ref_stack(list,size,cmp_op,a,ref);
  676. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  677. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  678. end;
  679. procedure thlcgwasm.a_cmp_const_reg_br(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; br: Integer);
  680. begin
  681. a_cmp_const_reg_stack(list,size,cmp_op,a,reg);
  682. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  683. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  684. end;
  685. procedure thlcgwasm.a_cmp_ref_reg_br(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; br: Integer);
  686. begin
  687. a_cmp_ref_reg_stack(list,size,cmp_op,ref,reg);
  688. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  689. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  690. end;
  691. procedure thlcgwasm.a_cmp_reg_ref_br(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; br: Integer);
  692. begin
  693. a_cmp_reg_ref_stack(list,size,cmp_op,reg,ref);
  694. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  695. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  696. end;
  697. procedure thlcgwasm.a_cmp_reg_reg_br(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; br: Integer);
  698. begin
  699. a_cmp_reg_reg_stack(list,size,cmp_op,reg1,reg2);
  700. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  701. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  702. end;
  703. procedure thlcgwasm.a_cmp_subsetreg_reg_br(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister; br: Integer);
  704. begin
  705. a_cmp_subsetreg_reg_stack(list,fromsubsetsize,cmpsize,cmp_op,sreg,reg);
  706. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  707. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  708. end;
  709. procedure thlcgwasm.a_cmp_subsetref_reg_br(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister; br: Integer);
  710. begin
  711. a_cmp_subsetref_reg_stack(list,fromsubsetsize,cmpsize,cmp_op,sref,reg);
  712. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  713. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  714. end;
  715. procedure thlcgwasm.a_cmp_loc_reg_br(list : TAsmList;size : tdef;cmp_op : topcmp; const loc: tlocation; reg : tregister; br: Integer);
  716. begin
  717. a_cmp_loc_reg_stack(list,size,cmp_op,loc,reg);
  718. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  719. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  720. end;
  721. procedure thlcgwasm.a_cmp_reg_loc_br(list : TAsmList;size : tdef;cmp_op : topcmp; reg: tregister; const loc: tlocation; br: Integer);
  722. begin
  723. a_cmp_reg_loc_stack(list,size,cmp_op,reg,loc);
  724. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  725. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  726. end;
  727. procedure thlcgwasm.a_cmp_ref_loc_br(list: TAsmList; size: tdef;cmp_op: topcmp; const ref: treference; const loc: tlocation; br: Integer);
  728. begin
  729. a_cmp_ref_loc_stack(list,size,cmp_op,ref,loc);
  730. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  731. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  732. end;
  733. procedure thlcgwasm.g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation);
  734. begin
  735. case fromloc.loc of
  736. LOC_CREFERENCE,
  737. LOC_REFERENCE:
  738. begin
  739. toloc:=fromloc;
  740. if (fromloc.reference.base<>NR_NO) and
  741. (fromloc.reference.base<>current_procinfo.framepointer) and
  742. (fromloc.reference.base<>NR_STACK_POINTER_REG) then
  743. g_allocload_reg_reg(list,voidpointertype,fromloc.reference.base,toloc.reference.base,R_ADDRESSREGISTER);
  744. end;
  745. else
  746. inherited;
  747. end;
  748. end;
  749. procedure thlcgwasm.a_cmp_stack_stack(list: TAsmlist; size: tdef; cmp_op: topcmp);
  750. const
  751. opcmp32: array[topcmp] of tasmop = (
  752. A_None, { OC_NONE, }
  753. a_i32_eq, { OC_EQ, equality comparison }
  754. a_i32_gt_s, { OC_GT, greater than (signed) }
  755. a_i32_lt_s, { OC_LT, less than (signed) }
  756. a_i32_ge_s, { OC_GTE, greater or equal than (signed) }
  757. a_i32_le_s, { OC_LTE, less or equal than (signed) }
  758. a_i32_ne, { OC_NE, not equal }
  759. a_i32_le_u, { OC_BE, less or equal than (unsigned) }
  760. a_i32_lt_u, { OC_B, less than (unsigned) }
  761. a_i32_ge_u, { OC_AE, greater or equal than (unsigned) }
  762. a_i32_gt_u { OC_A greater than (unsigned) }
  763. );
  764. const
  765. opcmp64: array[TOpCmp] of TAsmOp = (A_None,
  766. a_i64_eq, // OC_EQ
  767. a_i64_gt_s, a_i64_lt_s, // OC_GT, OC_LT
  768. a_i64_ge_s, a_i64_le_s, // OC_GTE, OC_LTE
  769. a_i64_ne, // OC_NE
  770. a_i64_le_u, a_i64_lt_u, // OC_BE, OC_B
  771. a_i64_ge_u, a_i64_gt_u // OC_AE, OC_A
  772. );
  773. var
  774. cgsize: tcgsize;
  775. begin
  776. case def2regtyp(size) of
  777. R_INTREGISTER,
  778. R_ADDRESSREGISTER:
  779. begin
  780. cgsize:=def_cgsize(size);
  781. case cgsize of
  782. OS_S8,OS_8,
  783. OS_16,OS_S16,
  784. OS_S32,OS_32:
  785. begin
  786. list.concat(taicpu.op_none(opcmp32[cmp_op]));
  787. decstack(list,1);
  788. end;
  789. OS_64,OS_S64:
  790. begin
  791. list.concat(taicpu.op_none(opcmp64[cmp_op]));
  792. decstack(list,1);
  793. end;
  794. else
  795. internalerror(2010120538);
  796. end;
  797. end;
  798. else
  799. internalerror(2010120538);
  800. end;
  801. end;
  802. procedure thlcgwasm.maybe_adjust_op_result(list: TAsmList; op: TOpCg; size: tdef);
  803. const
  804. overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG];
  805. begin
  806. if (op in overflowops) and
  807. (def_cgsize(size) in [OS_8,OS_S8,OS_16,OS_S16]) then
  808. resize_stack_int_val(list,s32inttype,size,false);
  809. end;
  810. procedure thlcgwasm.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
  811. begin
  812. { nothing to do for ret_in_param results }
  813. if paramanager.ret_in_param(pd.returndef,pd) then
  814. exit;
  815. { constructors don't return anything in Java }
  816. if pd.proctypeoption=potype_constructor then
  817. exit;
  818. { must return a value of the correct type on the evaluation stack }
  819. case def2regtyp(resdef) of
  820. R_INTREGISTER,
  821. R_ADDRESSREGISTER:
  822. a_load_const_cgpara(list,resdef,0,resloc);
  823. R_FPUREGISTER:
  824. case tfloatdef(resdef).floattype of
  825. s32real:
  826. begin
  827. list.concat(taicpu.op_single(a_f32_const, 0));
  828. incstack(list,1);
  829. end;
  830. s64real:
  831. begin
  832. list.concat(taicpu.op_double(a_f64_const, 0));
  833. incstack(list,1);
  834. end;
  835. else
  836. internalerror(2011010302);
  837. end
  838. else
  839. internalerror(2011010301);
  840. end;
  841. end;
  842. function thlcgwasm.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
  843. begin
  844. result:=inherited;
  845. pd.init_paraloc_info(callerside);
  846. g_adjust_stack_after_call(list,pd);
  847. end;
  848. function thlcgwasm.prepare_stack_for_ref(list: TAsmList; var ref: treference; dup: boolean): longint;
  849. begin
  850. result:=0;
  851. { fake location that indicates the value is already on the stack? }
  852. if (ref.base=NR_EVAL_STACK_BASE) or (ref.base=NR_LOCAL_STACK_POINTER_REG) then
  853. exit;
  854. if (ref.base=NR_NO) and (ref.index<>NR_NO) and (ref.scalefactor<=1) then
  855. begin
  856. ref.base:=ref.index;
  857. ref.index:=NR_NO;
  858. end;
  859. // setting up memory offset
  860. if assigned(ref.symbol) and (ref.base=NR_NO) and (ref.index=NR_NO) then
  861. begin
  862. list.Concat(taicpu.op_const(a_i32_const,ref.offset));
  863. incstack(list,1);
  864. if dup then
  865. begin
  866. list.Concat(taicpu.op_const(a_i32_const,ref.offset));
  867. incstack(list,1);
  868. end;
  869. ref.offset:=0;
  870. result:=1;
  871. end
  872. else if ref.index <> NR_NO then // array access
  873. begin
  874. // it's just faster to sum two of those together
  875. list.Concat(taicpu.op_reg(a_local_get, ref.base));
  876. incstack(list,1);
  877. list.Concat(taicpu.op_reg(a_local_get, ref.index));
  878. incstack(list,1);
  879. list.Concat(taicpu.op_none(a_i32_add));
  880. decstack(list,1);
  881. if ref.offset<0 then
  882. begin
  883. list.Concat(taicpu.op_const(a_i32_const,-ref.offset));
  884. incstack(list,1);
  885. list.Concat(taicpu.op_none(a_i32_sub));
  886. decstack(list,1);
  887. end;
  888. if dup then
  889. begin
  890. list.Concat(taicpu.op_reg(a_local_get, ref.base));
  891. incstack(list,1);
  892. list.Concat(taicpu.op_reg(a_local_get, ref.index));
  893. incstack(list,1);
  894. list.Concat(taicpu.op_none(a_i32_add));
  895. decstack(list,1);
  896. if ref.offset<0 then
  897. begin
  898. list.Concat(taicpu.op_const(a_i32_const,-ref.offset));
  899. incstack(list,1);
  900. list.Concat(taicpu.op_none(a_i32_sub));
  901. decstack(list,1);
  902. end;
  903. end;
  904. ref.base:=NR_NO;
  905. ref.index:=NR_NO;
  906. if ref.offset<0 then
  907. ref.offset:=0;
  908. result:=1;
  909. end
  910. else if (ref.base<>NR_NO) then
  911. begin
  912. if (ref.base<>NR_STACK_POINTER_REG) then
  913. begin
  914. { regular field -> load self on the stack }
  915. a_load_reg_stack(list,voidpointertype,ref.base);
  916. if ref.offset<0 then
  917. begin
  918. list.Concat(taicpu.op_const(a_i32_const,-ref.offset));
  919. incstack(list,1);
  920. list.Concat(taicpu.op_none(a_i32_sub));
  921. decstack(list,1);
  922. end;
  923. if dup then
  924. begin
  925. a_load_reg_stack(list,voidpointertype,ref.base);
  926. if ref.offset<0 then
  927. begin
  928. list.Concat(taicpu.op_const(a_i32_const,-ref.offset));
  929. incstack(list,1);
  930. list.Concat(taicpu.op_none(a_i32_sub));
  931. decstack(list,1);
  932. end;
  933. end;
  934. if ref.offset<0 then
  935. ref.offset:=0;
  936. ref.base:=NR_NO;
  937. result:=1;
  938. end
  939. else // if (ref.base = NR_FRAME_POINTER_REG) then
  940. begin
  941. internalerror(2021012202);
  942. //list.Concat(taicpu.op_sym(a_local_get, current_asmdata.RefAsmSymbol(FRAME_POINTER_SYM,AT_ADDR) ));
  943. //incstack(list,1);
  944. end;
  945. end
  946. else
  947. begin
  948. { static field -> nothing to do here, except for validity check }
  949. {if not assigned(ref.symbol) or
  950. (ref.offset<>0) then
  951. begin
  952. internalerror(2010120525);
  953. end;}
  954. end;
  955. end;
  956. procedure thlcgwasm.a_load_const_reg(list: TAsmList; tosize: tdef; a: tcgint; register: tregister);
  957. begin
  958. a_load_const_stack(list,tosize,a,def2regtyp(tosize));
  959. a_load_stack_reg(list,tosize,register);
  960. end;
  961. procedure thlcgwasm.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);
  962. var
  963. extra_slots: longint;
  964. tmpref: treference;
  965. begin
  966. tmpref:=ref;
  967. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  968. a_load_const_stack(list,tosize,a,def2regtyp(tosize));
  969. a_load_stack_ref(list,tosize,tmpref,extra_slots);
  970. end;
  971. procedure thlcgwasm.a_load_reg_ref(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference);
  972. var
  973. extra_slots: longint;
  974. tmpref: treference;
  975. begin
  976. tmpref:=ref;
  977. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  978. a_load_reg_stack(list,fromsize,register);
  979. if def2regtyp(fromsize)=R_INTREGISTER then
  980. resize_stack_int_val(list,fromsize,tosize,assigned(tmpref.symbol));
  981. a_load_stack_ref(list,tosize,tmpref,extra_slots);
  982. end;
  983. procedure thlcgwasm.a_load_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  984. begin
  985. a_load_reg_stack(list,fromsize,reg1);
  986. if def2regtyp(fromsize)=R_INTREGISTER then
  987. resize_stack_int_val(list,fromsize,tosize,false);
  988. a_load_stack_reg(list,tosize,reg2);
  989. end;
  990. procedure thlcgwasm.a_load_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister);
  991. var
  992. extra_slots: longint;
  993. tmpref: treference;
  994. begin
  995. tmpref:=ref;
  996. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  997. a_load_ref_stack(list,fromsize,tmpref,extra_slots);
  998. if def2regtyp(fromsize)=R_INTREGISTER then
  999. resize_stack_int_val(list,fromsize,tosize,false);
  1000. a_load_stack_reg(list,tosize,register);
  1001. end;
  1002. procedure thlcgwasm.a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference);
  1003. var
  1004. extra_sslots,
  1005. extra_dslots: longint;
  1006. tmpsref, tmpdref: treference;
  1007. tmpreg: tregister;
  1008. begin
  1009. if sref.base<>NR_EVAL_STACK_BASE then
  1010. begin
  1011. tmpsref:=sref;
  1012. tmpdref:=dref;
  1013. { make sure the destination reference is on top, since in the end the
  1014. order has to be "destref, value" -> first create "destref, sourceref" }
  1015. extra_dslots:=prepare_stack_for_ref(list,tmpdref,false);
  1016. extra_sslots:=prepare_stack_for_ref(list,tmpsref,false);
  1017. a_load_ref_stack(list,fromsize,tmpsref,extra_sslots);
  1018. if def2regtyp(fromsize)=R_INTREGISTER then
  1019. resize_stack_int_val(list,fromsize,tosize,assigned(tmpdref.symbol));
  1020. a_load_stack_ref(list,tosize,tmpdref,extra_dslots);
  1021. end
  1022. else
  1023. begin
  1024. { verify if we have the same reference }
  1025. if references_equal(sref,dref) then
  1026. exit;
  1027. tmpreg:=getregisterfordef(list,tosize);
  1028. a_load_ref_reg(list,fromsize,tosize,sref,tmpreg);
  1029. a_load_reg_ref(list,tosize,tosize,tmpreg,dref);
  1030. end;
  1031. end;
  1032. procedure thlcgwasm.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister);
  1033. begin
  1034. a_loadaddr_ref_stack(list,fromsize,tosize,ref);
  1035. a_load_stack_reg(list, tosize, r);
  1036. end;
  1037. procedure thlcgwasm.a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister);
  1038. begin
  1039. a_op_const_reg_reg(list,op,size,a,reg,reg);
  1040. end;
  1041. procedure thlcgwasm.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister);
  1042. begin
  1043. a_load_reg_stack(list,size,src);
  1044. a_op_const_stack(list,op,size,a);
  1045. a_load_stack_reg(list,size,dst);
  1046. end;
  1047. procedure thlcgwasm.a_op_const_ref(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; const ref: TReference);
  1048. var
  1049. extra_slots: longint;
  1050. tmpref: treference;
  1051. begin
  1052. tmpref:=ref;
  1053. extra_slots:=prepare_stack_for_ref(list,tmpref,true);
  1054. { TODO, here or in peepholeopt: use iinc when possible }
  1055. a_load_ref_stack(list,size,tmpref,extra_slots);
  1056. a_op_const_stack(list,op,size,a);
  1057. { for android verifier }
  1058. if (def2regtyp(size)=R_INTREGISTER) and
  1059. (assigned(tmpref.symbol)) then
  1060. resize_stack_int_val(list,size,size,true);
  1061. a_load_stack_ref(list,size,tmpref,extra_slots);
  1062. end;
  1063. procedure thlcgwasm.a_op_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister);
  1064. begin
  1065. if not(op in [OP_NOT,OP_NEG]) then
  1066. a_load_reg_stack(list,size,reg);
  1067. a_op_ref_stack(list,op,size,ref);
  1068. a_load_stack_reg(list,size,reg);
  1069. end;
  1070. procedure thlcgwasm.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister);
  1071. begin
  1072. if not(op in [OP_NOT,OP_NEG]) then
  1073. a_load_reg_stack(list,size,src2);
  1074. a_op_reg_stack(list,op,size,src1);
  1075. a_load_stack_reg(list,size,dst);
  1076. end;
  1077. procedure thlcgwasm.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister);
  1078. begin
  1079. a_op_reg_reg_reg(list,op,size,reg1,reg2,reg2);
  1080. end;
  1081. procedure thlcgwasm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
  1082. var
  1083. tmpreg: tregister;
  1084. begin
  1085. if not setflags then
  1086. begin
  1087. inherited;
  1088. exit;
  1089. end;
  1090. tmpreg:=getintregister(list,size);
  1091. a_load_const_reg(list,size,a,tmpreg);
  1092. a_op_reg_reg_reg_checkoverflow(list,op,size,tmpreg,src,dst,true,ovloc);
  1093. end;
  1094. procedure thlcgwasm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
  1095. var
  1096. orgsrc1, orgsrc2: tregister;
  1097. docheck: boolean;
  1098. lab: tasmlabel;
  1099. begin
  1100. if not setflags then
  1101. begin
  1102. inherited;
  1103. exit;
  1104. end;
  1105. { anything else cannot overflow }
  1106. docheck:=size.size in [4,8];
  1107. if docheck then
  1108. begin
  1109. orgsrc1:=src1;
  1110. orgsrc2:=src2;
  1111. if src1=dst then
  1112. begin
  1113. orgsrc1:=getintregister(list,size);
  1114. a_load_reg_reg(list,size,size,src1,orgsrc1);
  1115. end;
  1116. if src2=dst then
  1117. begin
  1118. orgsrc2:=getintregister(list,size);
  1119. a_load_reg_reg(list,size,size,src2,orgsrc2);
  1120. end;
  1121. end;
  1122. a_op_reg_reg_reg(list,op,size,src1,src2,dst);
  1123. if docheck then
  1124. begin
  1125. { * signed overflow for addition iff
  1126. - src1 and src2 are negative and result is positive (excep in case of
  1127. subtraction, then sign of src1 has to be inverted)
  1128. - src1 and src2 are positive and result is negative
  1129. -> Simplified boolean equivalent (in terms of sign bits):
  1130. not(src1 xor src2) and (src1 xor dst)
  1131. for subtraction, multiplication: invert src1 sign bit
  1132. for division: handle separately (div by zero, low(inttype) div -1),
  1133. not supported by this code
  1134. * unsigned overflow iff carry out, aka dst < src1 or dst < src2
  1135. }
  1136. location_reset(ovloc,LOC_REGISTER,OS_S32);
  1137. { not pasbool8, because then we'd still have to convert the integer to
  1138. a boolean via branches for Dalvik}
  1139. ovloc.register:=getintregister(list,s32inttype);
  1140. if not ((size.typ=pointerdef) or
  1141. ((size.typ=orddef) and
  1142. (torddef(size).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
  1143. pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
  1144. begin
  1145. a_load_reg_stack(list,size,src1);
  1146. if op in [OP_SUB,OP_IMUL] then
  1147. a_op_stack(list,OP_NOT,size);
  1148. a_op_reg_stack(list,OP_XOR,size,src2);
  1149. a_op_stack(list,OP_NOT,size);
  1150. a_load_reg_stack(list,size,src1);
  1151. a_op_reg_stack(list,OP_XOR,size,dst);
  1152. a_op_stack(list,OP_AND,size);
  1153. a_op_const_stack(list,OP_SHR,size,(size.size*8)-1);
  1154. if size.size=8 then
  1155. begin
  1156. //todo: any operands needed?
  1157. list.concat(taicpu.op_none(a_i32_wrap_i64));
  1158. end;
  1159. end
  1160. else
  1161. begin
  1162. a_load_const_stack(list,s32inttype,0,R_INTREGISTER);
  1163. current_asmdata.getjumplabel(lab);
  1164. { can be optimized by removing duplicate xor'ing to convert dst from
  1165. signed to unsigned quadrant }
  1166. a_cmp_reg_reg_label(list,size,OC_B,dst,src1,lab);
  1167. a_cmp_reg_reg_label(list,size,OC_B,dst,src2,lab);
  1168. a_op_const_stack(list,OP_XOR,s32inttype,1);
  1169. a_label(list,lab);
  1170. end;
  1171. a_load_stack_reg(list,s32inttype,ovloc.register);
  1172. end
  1173. else
  1174. ovloc.loc:=LOC_VOID;
  1175. end;
  1176. procedure thlcgwasm.a_cmp_const_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference; l: tasmlabel);
  1177. begin
  1178. internalerror(2021011802);
  1179. end;
  1180. procedure thlcgwasm.a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel);
  1181. begin
  1182. internalerror(2021011802);
  1183. end;
  1184. procedure thlcgwasm.a_cmp_ref_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; l: tasmlabel);
  1185. begin
  1186. internalerror(2021011802);
  1187. end;
  1188. procedure thlcgwasm.a_cmp_reg_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; l: tasmlabel);
  1189. begin
  1190. internalerror(2021011802);
  1191. end;
  1192. procedure thlcgwasm.a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);
  1193. begin
  1194. internalerror(2021011802);
  1195. end;
  1196. procedure thlcgwasm.a_jmp_always(list: TAsmList; l: tasmlabel);
  1197. begin
  1198. if l=current_procinfo.CurrBreakLabel then
  1199. list.concat(taicpu.op_const(a_br,br_blocks-loopBreakBr))
  1200. else if l=current_procinfo.CurrContinueLabel then
  1201. list.concat(taicpu.op_const(a_br,br_blocks-loopContBr))
  1202. else if l=current_procinfo.CurrExitLabel then
  1203. list.concat(taicpu.op_const(a_br,br_blocks-exitBr))
  1204. else
  1205. Internalerror(2019091806); // unexpected jump
  1206. end;
  1207. procedure thlcgwasm.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference);
  1208. var
  1209. dstack_slots: longint;
  1210. tmpref1, tmpref2: treference;
  1211. begin
  1212. tmpref1:=ref1;
  1213. tmpref2:=ref2;
  1214. dstack_slots:=prepare_stack_for_ref(list,tmpref2,false);
  1215. a_load_ref_stack(list,fromsize,tmpref1,prepare_stack_for_ref(list,tmpref1,false));
  1216. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1217. a_load_stack_ref(list,tosize,tmpref2,dstack_slots);
  1218. end;
  1219. procedure thlcgwasm.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister);
  1220. var
  1221. tmpref: treference;
  1222. begin
  1223. tmpref:=ref;
  1224. a_load_ref_stack(list,fromsize,tmpref,prepare_stack_for_ref(list,tmpref,false));
  1225. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1226. a_load_stack_reg(list,tosize,reg);
  1227. end;
  1228. procedure thlcgwasm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference);
  1229. var
  1230. dstack_slots: longint;
  1231. tmpref: treference;
  1232. begin
  1233. tmpref:=ref;
  1234. dstack_slots:=prepare_stack_for_ref(list,tmpref,false);
  1235. a_load_reg_stack(list,fromsize,reg);
  1236. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1237. a_load_stack_ref(list,tosize,tmpref,dstack_slots);
  1238. end;
  1239. procedure thlcgwasm.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  1240. begin
  1241. a_load_reg_stack(list,fromsize,reg1);
  1242. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1243. a_load_stack_reg(list,tosize,reg2);
  1244. end;
  1245. procedure thlcgwasm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
  1246. var
  1247. pd: tprocdef;
  1248. cgpara1,cgpara2,cgpara3 : TCGPara;
  1249. begin
  1250. if (source.base=NR_EVAL_STACK_BASE) or (source.base=NR_LOCAL_STACK_POINTER_REG) or
  1251. (source.index=NR_EVAL_STACK_BASE) or (source.index=NR_LOCAL_STACK_POINTER_REG) or
  1252. (dest.base=NR_EVAL_STACK_BASE) or (dest.base=NR_LOCAL_STACK_POINTER_REG) or
  1253. (dest.index=NR_EVAL_STACK_BASE) or (dest.index=NR_LOCAL_STACK_POINTER_REG) or
  1254. (size.size in [1,2,4,8]) then
  1255. inherited
  1256. else
  1257. begin
  1258. pd:=search_system_proc('MOVE');
  1259. cgpara1.init;
  1260. cgpara2.init;
  1261. cgpara3.init;
  1262. paramanager.getcgtempparaloc(list,pd,1,cgpara1);
  1263. paramanager.getcgtempparaloc(list,pd,2,cgpara2);
  1264. paramanager.getcgtempparaloc(list,pd,3,cgpara3);
  1265. if pd.is_pushleftright then
  1266. begin
  1267. { load source }
  1268. a_loadaddr_ref_cgpara(list,voidtype,source,cgpara1);
  1269. { load destination }
  1270. a_loadaddr_ref_cgpara(list,voidtype,dest,cgpara2);
  1271. { load size }
  1272. a_load_const_cgpara(list,sizesinttype,size.size,cgpara3);
  1273. end
  1274. else
  1275. begin
  1276. { load size }
  1277. a_load_const_cgpara(list,sizesinttype,size.size,cgpara3);
  1278. { load destination }
  1279. a_loadaddr_ref_cgpara(list,voidtype,dest,cgpara2);
  1280. { load source }
  1281. a_loadaddr_ref_cgpara(list,voidtype,source,cgpara1);
  1282. end;
  1283. paramanager.freecgpara(list,cgpara3);
  1284. paramanager.freecgpara(list,cgpara2);
  1285. paramanager.freecgpara(list,cgpara1);
  1286. g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil).resetiftemp;
  1287. cgpara3.done;
  1288. cgpara2.done;
  1289. cgpara1.done;
  1290. end;
  1291. end;
  1292. procedure thlcgwasm.g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean);
  1293. var
  1294. pd: tcpuprocdef;
  1295. begin
  1296. pd:=tcpuprocdef(current_procinfo.procdef);
  1297. g_procdef(list,pd);
  1298. ttgwasm(tg).allocframepointer(list,pd.frame_pointer_ref);
  1299. ttgwasm(tg).allocbasepointer(list,pd.base_pointer_ref);
  1300. g_fingerprint(list);
  1301. list.Concat(taicpu.op_sym(a_global_get,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_LABEL)));
  1302. incstack(list,1);
  1303. list.Concat(taicpu.op_ref(a_local_set,pd.base_pointer_ref));
  1304. decstack(list,1);
  1305. if (localsize>0) then begin
  1306. list.Concat(taicpu.op_ref(a_local_get,pd.base_pointer_ref));
  1307. incstack(list,1);
  1308. list.concat(taicpu.op_const(a_i32_const, localsize ));
  1309. incstack(list,1);
  1310. list.concat(taicpu.op_none(a_i32_sub));
  1311. decstack(list,1);
  1312. list.Concat(taicpu.op_ref(a_local_set,pd.frame_pointer_ref));
  1313. decstack(list,1);
  1314. list.Concat(taicpu.op_ref(a_local_get,pd.frame_pointer_ref));
  1315. incstack(list,1);
  1316. list.Concat(taicpu.op_sym(a_global_set,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_LABEL)));
  1317. decstack(list,1);
  1318. end;
  1319. end;
  1320. procedure thlcgwasm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
  1321. var
  1322. pd: tcpuprocdef;
  1323. begin
  1324. pd:=tcpuprocdef(current_procinfo.procdef);
  1325. list.Concat(taicpu.op_ref(a_local_get,pd.base_pointer_ref));
  1326. incstack(list,1);
  1327. list.Concat(taicpu.op_sym(a_global_set,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_LABEL)));
  1328. decstack(list,1);
  1329. list.concat(taicpu.op_none(a_return));
  1330. list.concat(taicpu.op_none(a_end_function));
  1331. end;
  1332. procedure thlcgwasm.g_rangecheck(list: TAsmList; const l: tlocation; fromdef, todef: tdef);
  1333. var
  1334. {$if defined(cpuhighleveltarget)}
  1335. aintmax: tcgint;
  1336. {$elseif defined(cpu64bitalu) or defined(cpu32bitalu)}
  1337. aintmax: aint;
  1338. {$else}
  1339. aintmax: longint;
  1340. {$endif}
  1341. //neglabel : tasmlabel;
  1342. //hreg : tregister;
  1343. lto,hto,
  1344. lfrom,hfrom : TConstExprInt;
  1345. fromsize, tosize: cardinal;
  1346. maxdef: tdef;
  1347. from_signed, to_signed: boolean;
  1348. begin
  1349. { range checking on and range checkable value? }
  1350. if not(cs_check_range in current_settings.localswitches) or
  1351. not(fromdef.typ in [orddef,enumdef]) or
  1352. { C-style booleans can't really fail range checks, }
  1353. { all values are always valid }
  1354. is_cbool(todef) then
  1355. exit;
  1356. {$if not defined(cpuhighleveltarget) and not defined(cpu64bitalu)}
  1357. { handle 64bit rangechecks separate for 32bit processors }
  1358. if is_64bit(fromdef) or is_64bit(todef) then
  1359. begin
  1360. cg64.g_rangecheck64(list,l,fromdef,todef);
  1361. exit;
  1362. end;
  1363. {$endif ndef cpuhighleveltarget and ndef cpu64bitalu}
  1364. { only check when assigning to scalar, subranges are different, }
  1365. { when todef=fromdef then the check is always generated }
  1366. getrange(fromdef,lfrom,hfrom);
  1367. getrange(todef,lto,hto);
  1368. from_signed := is_signed(fromdef);
  1369. to_signed := is_signed(todef);
  1370. { check the rangedef of the array, not the array itself }
  1371. { (only change now, since getrange needs the arraydef) }
  1372. if (todef.typ = arraydef) then
  1373. todef := tarraydef(todef).rangedef;
  1374. { no range check if from and to are equal and are both longint/dword }
  1375. { (if we have a 32bit processor) or int64/qword, since such }
  1376. { operations can at most cause overflows (JM) }
  1377. { Note that these checks are mostly processor independent, they only }
  1378. { have to be changed once we introduce 64bit subrange types }
  1379. {$if defined(cpuhighleveltarget) or defined(cpu64bitalu)}
  1380. if (fromdef=todef) and
  1381. (fromdef.typ=orddef) and
  1382. (((((torddef(fromdef).ordtype=s64bit) and
  1383. (lfrom = low(int64)) and
  1384. (hfrom = high(int64))) or
  1385. ((torddef(fromdef).ordtype=u64bit) and
  1386. (lfrom = low(qword)) and
  1387. (hfrom = high(qword))) or
  1388. ((torddef(fromdef).ordtype=scurrency) and
  1389. (lfrom = low(int64)) and
  1390. (hfrom = high(int64)))))) then
  1391. exit;
  1392. {$endif cpuhighleveltarget or cpu64bitalu}
  1393. { 32 bit operations are automatically widened to 64 bit on 64 bit addr
  1394. targets }
  1395. {$ifdef cpu32bitaddr}
  1396. if (fromdef = todef) and
  1397. (fromdef.typ=orddef) and
  1398. (((((torddef(fromdef).ordtype = s32bit) and
  1399. (lfrom = int64(low(longint))) and
  1400. (hfrom = int64(high(longint)))) or
  1401. ((torddef(fromdef).ordtype = u32bit) and
  1402. (lfrom = low(cardinal)) and
  1403. (hfrom = high(cardinal)))))) then
  1404. exit;
  1405. {$endif cpu32bitaddr}
  1406. { optimize some range checks away in safe cases }
  1407. fromsize := fromdef.size;
  1408. tosize := todef.size;
  1409. if ((from_signed = to_signed) or
  1410. (not from_signed)) and
  1411. (lto<=lfrom) and (hto>=hfrom) and
  1412. (fromsize <= tosize) then
  1413. begin
  1414. { if fromsize < tosize, and both have the same signed-ness or }
  1415. { fromdef is unsigned, then all bit patterns from fromdef are }
  1416. { valid for todef as well }
  1417. if (fromsize < tosize) then
  1418. exit;
  1419. if (fromsize = tosize) and
  1420. (from_signed = to_signed) then
  1421. { only optimize away if all bit patterns which fit in fromsize }
  1422. { are valid for the todef }
  1423. begin
  1424. {$ifopt Q+}
  1425. {$define overflowon}
  1426. {$Q-}
  1427. {$endif}
  1428. {$ifopt R+}
  1429. {$define rangeon}
  1430. {$R-}
  1431. {$endif}
  1432. if to_signed then
  1433. begin
  1434. { calculation of the low/high ranges must not overflow 64 bit
  1435. otherwise we end up comparing with zero for 64 bit data types on
  1436. 64 bit processors }
  1437. if (lto = (int64(-1) << (tosize * 8 - 1))) and
  1438. (hto = (-((int64(-1) << (tosize * 8 - 1))+1))) then
  1439. exit
  1440. end
  1441. else
  1442. begin
  1443. { calculation of the low/high ranges must not overflow 64 bit
  1444. otherwise we end up having all zeros for 64 bit data types on
  1445. 64 bit processors }
  1446. if (lto = 0) and
  1447. (qword(hto) = (qword(-1) >> (64-(tosize * 8))) ) then
  1448. exit
  1449. end;
  1450. {$ifdef overflowon}
  1451. {$Q+}
  1452. {$undef overflowon}
  1453. {$endif}
  1454. {$ifdef rangeon}
  1455. {$R+}
  1456. {$undef rangeon}
  1457. {$endif}
  1458. end
  1459. end;
  1460. { depending on the types involved, we perform the range check for 64 or
  1461. for 32 bit }
  1462. if fromsize=8 then
  1463. maxdef:=fromdef
  1464. else
  1465. maxdef:=todef;
  1466. {$if sizeof(aintmax) = 8}
  1467. if maxdef.size=8 then
  1468. aintmax:=high(int64)
  1469. else
  1470. {$endif}
  1471. begin
  1472. aintmax:=high(longint);
  1473. maxdef:=u32inttype;
  1474. end;
  1475. { generate the rangecheck code for the def where we are going to }
  1476. { store the result }
  1477. { use the trick that }
  1478. { a <= x <= b <=> 0 <= x-a <= b-a <=> unsigned(x-a) <= unsigned(b-a) }
  1479. { To be able to do that, we have to make sure however that either }
  1480. { fromdef and todef are both signed or unsigned, or that we leave }
  1481. { the parts < 0 and > maxlongint out }
  1482. if from_signed xor to_signed then
  1483. begin
  1484. if from_signed then
  1485. { from is signed, to is unsigned }
  1486. begin
  1487. { if high(from) < 0 -> always range error }
  1488. if (hfrom < 0) or
  1489. { if low(to) > maxlongint also range error }
  1490. (lto > aintmax) then
  1491. begin
  1492. g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
  1493. exit
  1494. end;
  1495. { from is signed and to is unsigned -> when looking at to }
  1496. { as an signed value, it must be < maxaint (otherwise }
  1497. { it will become negative, which is invalid since "to" is unsigned) }
  1498. if hto > aintmax then
  1499. hto := aintmax;
  1500. end
  1501. else
  1502. { from is unsigned, to is signed }
  1503. begin
  1504. if (lfrom > aintmax) or
  1505. (hto < 0) then
  1506. begin
  1507. g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
  1508. exit
  1509. end;
  1510. { from is unsigned and to is signed -> when looking at to }
  1511. { as an unsigned value, it must be >= 0 (since negative }
  1512. { values are the same as values > maxlongint) }
  1513. if lto < 0 then
  1514. lto := 0;
  1515. end;
  1516. end;
  1517. a_load_loc_stack(list,fromdef,l);
  1518. resize_stack_int_val(list,fromdef,maxdef,false);
  1519. a_load_const_stack(list,maxdef,tcgint(int64(lto)),R_INTREGISTER);
  1520. a_op_stack(list,OP_SUB,maxdef);
  1521. {
  1522. if from_signed then
  1523. a_cmp_const_reg_label(list,OS_INT,OC_GTE,aint(hto-lto),hreg,neglabel)
  1524. else
  1525. }
  1526. if qword(hto-lto)>qword(aintmax) then
  1527. a_load_const_stack(list,maxdef,aintmax,R_INTREGISTER)
  1528. else
  1529. a_load_const_stack(list,maxdef,tcgint(int64(hto-lto)),R_INTREGISTER);
  1530. a_cmp_stack_stack(list,maxdef,OC_A);
  1531. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
  1532. thlcgwasm(hlcg).incblock;
  1533. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  1534. g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
  1535. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
  1536. thlcgwasm(hlcg).decblock;
  1537. end;
  1538. procedure thlcgwasm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
  1539. begin
  1540. { not possible, need the original operands }
  1541. internalerror(2012102101);
  1542. end;
  1543. procedure thlcgwasm.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation);
  1544. var
  1545. hl : tasmlabel;
  1546. begin
  1547. if not(cs_check_overflow in current_settings.localswitches) then
  1548. exit;
  1549. current_asmdata.getjumplabel(hl);
  1550. a_cmp_const_loc_label(list,s32inttype,OC_EQ,0,ovloc,hl);
  1551. g_call_system_proc(list,'fpc_overflow',[],nil);
  1552. a_label(list,hl);
  1553. end;
  1554. procedure thlcgwasm.maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean);
  1555. begin
  1556. { don't do anything, all registers become stack locations anyway }
  1557. end;
  1558. procedure thlcgwasm.gen_entry_code(list: TAsmList);
  1559. begin
  1560. inherited;
  1561. list.concat(taicpu.op_none(a_block));
  1562. incblock;
  1563. exitBr:=br_blocks;
  1564. end;
  1565. procedure thlcgwasm.gen_exit_code(list: TAsmList);
  1566. begin
  1567. list.concat(taicpu.op_none(a_end_block));
  1568. decblock;
  1569. if fevalstackheight<>0 then
  1570. list.concat(tai_comment.Create(strpnew('!!! values remaining on stack at end of block !!!')));
  1571. inherited;
  1572. end;
  1573. procedure thlcgwasm.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister);
  1574. begin
  1575. internalerror(2012090201);
  1576. end;
  1577. procedure thlcgwasm.a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle: pmmshuffle);
  1578. begin
  1579. internalerror(2012090202);
  1580. end;
  1581. procedure thlcgwasm.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle);
  1582. begin
  1583. internalerror(2012060130);
  1584. end;
  1585. procedure thlcgwasm.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle);
  1586. begin
  1587. internalerror(2012060131);
  1588. end;
  1589. procedure thlcgwasm.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle);
  1590. begin
  1591. internalerror(2012060132);
  1592. end;
  1593. procedure thlcgwasm.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle);
  1594. begin
  1595. internalerror(2012060133);
  1596. end;
  1597. procedure thlcgwasm.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle);
  1598. begin
  1599. internalerror(2012060134);
  1600. end;
  1601. procedure thlcgwasm.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle);
  1602. begin
  1603. internalerror(2012060135);
  1604. end;
  1605. procedure thlcgwasm.g_stackpointer_alloc(list: TAsmList; size: longint);
  1606. begin
  1607. internalerror(2012090203);
  1608. end;
  1609. procedure thlcgwasm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  1610. begin
  1611. internalerror(2012090204);
  1612. end;
  1613. procedure thlcgwasm.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint);
  1614. begin
  1615. internalerror(2012090205);
  1616. end;
  1617. procedure thlcgwasm.g_local_unwind(list: TAsmList; l: TAsmLabel);
  1618. begin
  1619. internalerror(2012090206);
  1620. end;
  1621. procedure thlcgwasm.g_procdef(list: TAsmList; pd: tprocdef);
  1622. begin
  1623. list.Concat(tai_functype.create(pd.mangledname,tcpuprocdef(pd).create_functype));
  1624. end;
  1625. procedure thlcgwasm.a_load_stack_reg(list: TAsmList; size: tdef; reg: tregister);
  1626. begin
  1627. list.concat(taicpu.op_reg(a_local_set,reg));
  1628. decstack(list,1);
  1629. end;
  1630. procedure thlcgwasm.a_load_stack_ref(list: TAsmList; size: tdef; const ref: treference; extra_slots: longint);
  1631. var
  1632. opc: tasmop;
  1633. finishandval: tcgint;
  1634. begin
  1635. { fake location that indicates the value has to remain on the stack }
  1636. if ref.base=NR_EVAL_STACK_BASE then
  1637. exit;
  1638. opc:=loadstoreopcref(size,false,ref,finishandval);
  1639. list.concat(taicpu.op_ref(opc,ref));
  1640. { avoid problems with getting the size of an open array etc }
  1641. if wasmAlwayInMem(size) then
  1642. size:=ptruinttype;
  1643. decstack(list,1+extra_slots);
  1644. end;
  1645. procedure thlcgwasm.a_load_reg_stack(list: TAsmList; size: tdef; reg: tregister);
  1646. begin
  1647. list.concat(taicpu.op_reg(a_local_get,reg));
  1648. incstack(list,1);
  1649. end;
  1650. procedure thlcgwasm.a_load_ref_stack(list: TAsmList; size: tdef; const ref: treference; extra_slots: longint);
  1651. var
  1652. opc: tasmop;
  1653. finishandval: tcgint;
  1654. begin
  1655. { fake location that indicates the value is already on the stack? }
  1656. if (ref.base=NR_EVAL_STACK_BASE) then
  1657. exit;
  1658. opc:=loadstoreopcref(size,true,ref,finishandval);
  1659. list.concat(taicpu.op_ref(opc,ref));
  1660. { avoid problems with getting the size of an open array etc }
  1661. if wasmAlwayInMem(size) then
  1662. size:=ptruinttype;
  1663. incstack(list,1-extra_slots);
  1664. if finishandval<>-1 then
  1665. a_op_const_stack(list,OP_AND,size,finishandval);
  1666. // there's no cast check in Wasm
  1667. //if ref.checkcast then
  1668. // gen_typecheck(list,a_checkcast,size);
  1669. end;
  1670. function thlcgwasm.loadstoreopcref(def: tdef; isload: boolean; const ref: treference; out finishandval: tcgint): tasmop;
  1671. const
  1672. {iisload} {issigned}
  1673. getputmem8 : array [boolean, boolean] of TAsmOp = ((a_i32_store8, a_i32_store8), (a_i32_load8_u, a_i32_load8_s));
  1674. getputmem16 : array [boolean, boolean] of TAsmOp = ((a_i32_store16, a_i32_store16), (a_i32_load16_u ,a_i32_load16_s));
  1675. getputmem32 : array [boolean, boolean] of TAsmOp = ((a_i32_store, a_i32_store), (a_i32_load, a_i32_load));
  1676. getputmem64 : array [boolean, boolean] of TAsmOp = ((a_i64_store, a_i64_store), (a_i64_load, a_i64_load));
  1677. getputmemf32 : array [boolean] of TAsmOp = (a_f32_store, a_f32_load);
  1678. getputmemf64 : array [boolean] of TAsmOp = (a_f64_store, a_f64_load);
  1679. begin
  1680. if (ref.base<>NR_LOCAL_STACK_POINTER_REG) or assigned(ref.symbol) then
  1681. begin
  1682. { -> either a global (static) field, or a regular field. If a regular
  1683. field, then ref.base contains the self pointer, otherwise
  1684. ref.base=NR_NO. In both cases, the symbol contains all other
  1685. information (combined field name and type descriptor) }
  1686. case def.size of
  1687. 1: result := getputmem8[isload, is_signed(def)];
  1688. 2: result := getputmem16[isload, is_signed(def)];
  1689. 4:
  1690. if is_single(def) then
  1691. result := getputmemf32[isload]
  1692. else
  1693. result := getputmem32[isload, is_signed(def)];
  1694. 8: if is_double(def) then
  1695. result := getputmemf64[isload]
  1696. else
  1697. result := getputmem64[isload, is_signed(def)];
  1698. else
  1699. Internalerror(2019091501);
  1700. end;
  1701. //result:=getputopc[isload,ref.base=NR_NO];
  1702. finishandval:=-1;
  1703. { erase sign extension for byte/smallint loads }
  1704. if (def2regtyp(def)=R_INTREGISTER) and
  1705. not is_signed(def) and
  1706. (def.typ=orddef) and
  1707. not is_widechar(def) then
  1708. case def.size of
  1709. 1: if (torddef(def).high>127) then
  1710. finishandval:=255;
  1711. 2: if (torddef(def).high>32767) then
  1712. finishandval:=65535;
  1713. end;
  1714. end
  1715. else
  1716. begin
  1717. finishandval:=-1;
  1718. if isload then
  1719. result := a_local_get
  1720. else
  1721. result := a_local_set;
  1722. end;
  1723. end;
  1724. procedure thlcgwasm.resize_stack_int_val(list: TAsmList; fromsize, tosize: tdef; formemstore: boolean);
  1725. var
  1726. fromcgsize, tocgsize: tcgsize;
  1727. begin
  1728. { When storing to an array, field or global variable, make sure the
  1729. static type verification can determine that the stored value fits
  1730. within the boundaries of the declared type (to appease the Dalvik VM).
  1731. Local variables either get their type upgraded in the debug info,
  1732. or have no type information at all }
  1733. if formemstore and
  1734. (tosize.typ=orddef) then
  1735. if (torddef(tosize).ordtype in [u8bit,uchar]) then
  1736. tosize:=s8inttype
  1737. else if torddef(tosize).ordtype=u16bit then
  1738. tosize:=s16inttype;
  1739. fromcgsize:=def_cgsize(fromsize);
  1740. tocgsize:=def_cgsize(tosize);
  1741. if fromcgsize in [OS_S64,OS_64] then
  1742. begin
  1743. if not(tocgsize in [OS_S64,OS_64]) then
  1744. begin
  1745. { truncate }
  1746. list.concat(taicpu.op_none(a_i32_wrap_i64));
  1747. case tocgsize of
  1748. OS_8:
  1749. a_op_const_stack(list,OP_AND,s32inttype,255);
  1750. OS_S8:
  1751. list.concat(taicpu.op_none(a_i32_extend8_s));
  1752. OS_16:
  1753. a_op_const_stack(list,OP_AND,s32inttype,65535);
  1754. OS_S16:
  1755. list.concat(taicpu.op_none(a_i32_extend16_s));
  1756. OS_32,OS_S32:
  1757. ;
  1758. else
  1759. internalerror(2021012201);
  1760. end;
  1761. end;
  1762. end
  1763. else if tocgsize in [OS_S64,OS_64] then
  1764. begin
  1765. { extend }
  1766. case fromcgsize of
  1767. OS_8:
  1768. begin
  1769. a_op_const_stack(list,OP_AND,s32inttype,255);
  1770. list.concat(taicpu.op_none(a_i64_extend_i32_u));
  1771. end;
  1772. OS_S8:
  1773. begin
  1774. list.concat(taicpu.op_none(a_i64_extend_i32_u));
  1775. list.concat(taicpu.op_none(a_i64_extend8_s));
  1776. end;
  1777. OS_16:
  1778. begin
  1779. a_op_const_stack(list,OP_AND,s32inttype,65535);
  1780. list.concat(taicpu.op_none(a_i64_extend_i32_u));
  1781. end;
  1782. OS_S16:
  1783. begin
  1784. list.concat(taicpu.op_none(a_i64_extend_i32_u));
  1785. list.concat(taicpu.op_none(a_i64_extend16_s));
  1786. end;
  1787. OS_32:
  1788. list.concat(taicpu.op_none(a_i64_extend_i32_u));
  1789. OS_S32:
  1790. list.concat(taicpu.op_none(a_i64_extend_i32_s));
  1791. OS_64,OS_S64:
  1792. ;
  1793. else
  1794. internalerror(2021010301);
  1795. end;
  1796. end
  1797. else
  1798. begin
  1799. if tcgsize2size[fromcgsize]<tcgsize2size[tocgsize] then
  1800. begin
  1801. { extend }
  1802. case fromcgsize of
  1803. OS_8:
  1804. a_op_const_stack(list,OP_AND,s32inttype,255);
  1805. OS_S8:
  1806. list.concat(taicpu.op_none(a_i32_extend8_s));
  1807. OS_16:
  1808. a_op_const_stack(list,OP_AND,s32inttype,65535);
  1809. OS_S16:
  1810. list.concat(taicpu.op_none(a_i32_extend16_s));
  1811. OS_32,OS_S32:
  1812. ;
  1813. else
  1814. internalerror(2021010302);
  1815. end;
  1816. end
  1817. else if tcgsize2size[fromcgsize]>=tcgsize2size[tocgsize] then
  1818. begin
  1819. { truncate }
  1820. case tocgsize of
  1821. OS_8:
  1822. a_op_const_stack(list,OP_AND,s32inttype,255);
  1823. OS_S8:
  1824. list.concat(taicpu.op_none(a_i32_extend8_s));
  1825. OS_16:
  1826. a_op_const_stack(list,OP_AND,s32inttype,65535);
  1827. OS_S16:
  1828. list.concat(taicpu.op_none(a_i32_extend16_s));
  1829. OS_32,OS_S32:
  1830. ;
  1831. else
  1832. internalerror(2021010302);
  1833. end;
  1834. end;
  1835. end;
  1836. end;
  1837. procedure thlcgwasm.maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean);
  1838. var
  1839. convsize: tdef;
  1840. begin
  1841. if (retdef.typ=orddef) then
  1842. begin
  1843. if (torddef(retdef).ordtype in [u8bit,u16bit,uchar]) and
  1844. (torddef(retdef).high>=(1 shl (retdef.size*8-1))) then
  1845. begin
  1846. convsize:=nil;
  1847. if callside then
  1848. if torddef(retdef).ordtype in [u8bit,uchar] then
  1849. convsize:=s8inttype
  1850. else
  1851. convsize:=s16inttype
  1852. else if torddef(retdef).ordtype in [u8bit,uchar] then
  1853. convsize:=u8inttype
  1854. else
  1855. convsize:=u16inttype;
  1856. if assigned(convsize) then
  1857. resize_stack_int_val(list,s32inttype,convsize,false);
  1858. end;
  1859. end;
  1860. end;
  1861. procedure thlcgwasm.g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef);
  1862. var
  1863. totalremovesize: longint;
  1864. realresdef: tdef;
  1865. ft: TWasmFuncType;
  1866. begin
  1867. if pd.typ=procvardef then
  1868. ft:=tcpuprocvardef(pd).create_functype
  1869. else
  1870. ft:=tcpuprocdef(pd).create_functype;
  1871. totalremovesize:=Length(ft.params)-Length(ft.results);
  1872. if Length(ft.results)=0 then
  1873. dec(totalremovesize);
  1874. { remove parameters from internal evaluation stack counter (in case of
  1875. e.g. no parameters and a result, it can also increase) }
  1876. if totalremovesize>0 then
  1877. decstack(list,totalremovesize)
  1878. else if totalremovesize<0 then
  1879. incstack(list,-totalremovesize);
  1880. ft.free;
  1881. end;
  1882. procedure thlcgwasm.g_fingerprint(list: TAsmList);
  1883. begin
  1884. list.concat(taicpu.op_const(a_i64_const,Random(high(int64))));
  1885. list.concat(taicpu.op_const(a_i64_const,Random(high(int64))));
  1886. list.concat(taicpu.op_const(a_i64_const,Random(high(int64))));
  1887. list.concat(taicpu.op_const(a_i64_const,Random(high(int64))));
  1888. list.concat(taicpu.op_none(a_drop));
  1889. list.concat(taicpu.op_none(a_drop));
  1890. list.concat(taicpu.op_none(a_drop));
  1891. list.concat(taicpu.op_none(a_drop));
  1892. end;
  1893. procedure thlcgwasm.resizestackfpuval(list: TAsmList; fromsize, tosize: tcgsize);
  1894. begin
  1895. if (fromsize=OS_F32) and
  1896. (tosize=OS_F64) then
  1897. begin
  1898. list.concat(taicpu.op_none(a_f64_promote_f32));
  1899. end
  1900. else if (fromsize=OS_F64) and
  1901. (tosize=OS_F32) then
  1902. begin
  1903. list.concat(taicpu.op_none(a_f32_demote_f64));
  1904. end;
  1905. end;
  1906. procedure create_hlcodegen_cpu;
  1907. begin
  1908. hlcg:=thlcgwasm.create;
  1909. create_codegen;
  1910. end;
  1911. initialization
  1912. chlcgobj:=thlcgwasm;
  1913. create_hlcodegen:=@create_hlcodegen_cpu;
  1914. end.