hlcgcpu.pas 100 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550
  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. fntypelookup : TWasmProcTypeLookup;
  39. constructor create;
  40. destructor Destroy; override;
  41. procedure incblock;
  42. procedure decblock;
  43. procedure incstack(list : TAsmList;slots: longint);
  44. procedure decstack(list : TAsmList;slots: longint);
  45. class function def2regtyp(def: tdef): tregistertype; override;
  46. procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : tcgint;const cgpara : TCGPara);override;
  47. function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
  48. function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; override;
  49. { move instructions - a_load_FROM_TO }
  50. procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override;
  51. procedure a_load_const_ref(list : TAsmList;tosize : tdef;a : tcgint;const ref : treference);override;
  52. procedure a_load_reg_ref(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);override;
  53. procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tdef;reg1,reg2 : tregister);override;
  54. procedure a_load_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);override;
  55. procedure a_load_ref_ref(list : TAsmList;fromsize, tosize : tdef;const sref : treference;const dref : treference);override;
  56. procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
  57. { basic arithmetic operations }
  58. procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister); override;
  59. procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister); override;
  60. procedure a_op_const_ref(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; const ref: TReference); override;
  61. procedure a_op_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister); override;
  62. procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); override;
  63. procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); override;
  64. procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
  65. procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
  66. procedure a_cmp_const_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference; l: tasmlabel); override;
  67. procedure a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); override;
  68. procedure a_cmp_ref_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; l: tasmlabel); override;
  69. procedure a_cmp_reg_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; l: tasmlabel); override;
  70. procedure a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); override;
  71. procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
  72. procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);override;
  73. procedure g_copyshortstring(list : TAsmList;const source,dest : treference;strdef:tstringdef);override;
  74. procedure a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference); override;
  75. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override;
  76. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); override;
  77. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); 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 gen_load_return_value(list:TAsmList);override;
  81. procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); override;
  82. procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);override;
  83. procedure g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; const name: string); override;
  84. procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);override;
  85. procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);override;
  86. procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
  87. procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override;
  88. procedure location_get_data_ref(list:TAsmList;def: tdef; const l:tlocation;var ref:treference;loadref:boolean; alignment: longint);override;
  89. procedure maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean); override;
  90. procedure g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister); override;
  91. procedure g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation); override;
  92. procedure gen_initialize_code(list: TAsmList); override;
  93. procedure gen_entry_code(list: TAsmList); override;
  94. procedure gen_exit_code(list: TAsmList); override;
  95. { unimplemented/unnecessary routines }
  96. procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister); override;
  97. procedure a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle: pmmshuffle); override;
  98. procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle); override;
  99. procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); override;
  100. procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); override;
  101. procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle); override;
  102. procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); override;
  103. procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle); override;
  104. procedure g_stackpointer_alloc(list: TAsmList; size: longint); override;
  105. procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); override;
  106. procedure g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint); override;
  107. procedure g_local_unwind(list: TAsmList; l: TAsmLabel); override;
  108. { Wasm-specific routines }
  109. procedure g_procdef(list:TAsmList;pd: tprocdef);
  110. procedure a_load_stack_reg(list : TAsmList;size: tdef;reg: tregister);
  111. { extra_slots are the slots that are used by the reference, and that
  112. will be removed by the store operation }
  113. procedure a_load_stack_ref(list : TAsmList;size: tdef;const ref: treference;extra_slots: longint);
  114. procedure a_load_reg_stack(list : TAsmList;size: tdef;reg: tregister);
  115. { extra_slots are the slots that are used by the reference, and that
  116. will be removed by the load operation }
  117. procedure a_load_ref_stack(list : TAsmList;size: tdef;const ref: treference;extra_slots: longint);
  118. procedure a_load_const_stack(list : TAsmList;size: tdef;a :tcgint; typ: TRegisterType);
  119. procedure a_load_stack_loc(list : TAsmList;size: tdef;const loc: tlocation);
  120. procedure a_load_loc_stack(list : TAsmList;size: tdef;const loc: tlocation);
  121. procedure a_loadfpu_const_stack(list : TAsmList;size: tdef;a :double);
  122. procedure a_op_stack(list : TAsmList;op: topcg; size: tdef; trunc32: boolean);
  123. procedure a_op_const_stack(list : TAsmList;op: topcg; size: tdef;a : tcgint);
  124. procedure a_op_reg_stack(list : TAsmList;op: topcg; size: tdef;reg: tregister);
  125. procedure a_op_ref_stack(list : TAsmList;op: topcg; size: tdef;const ref: treference);
  126. procedure a_op_loc_stack(list : TAsmList;op: topcg; size: tdef;const loc: tlocation);
  127. procedure g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation); override;
  128. { assumes that initdim dimensions have already been pushed on the
  129. evaluation stack, and creates a new array of type arrdef with these
  130. dimensions }
  131. procedure g_newarray(list : TAsmList; arrdef: tdef; initdim: longint);
  132. { gets the length of the array whose reference is stored in arrloc,
  133. and puts it on the evaluation stack }
  134. procedure g_getarraylen(list : TAsmList; const arrloc: tlocation);
  135. { this routine expects that all values are already massaged into the
  136. required form (sign bits xor'ed for gt/lt comparisons for OS_32/OS_64,
  137. see http://stackoverflow.com/questions/4068973/c-performing-signed-comparison-in-unsigned-variables-without-casting ) }
  138. procedure a_cmp_stack_label(list : TAsmlist; size: tdef; cmp_op: topcmp; lab: tasmlabel);
  139. { these 2 routines perform the massaging expected by the previous one }
  140. procedure maybe_adjust_cmp_stackval(list : TAsmlist; size: tdef; cmp_op: topcmp);
  141. function maybe_adjust_cmp_constval(size: tdef; cmp_op: topcmp; a: tcgint): tcgint;
  142. { truncate/sign extend after performing operations on values < 32 bit
  143. that may have overflowed outside the range }
  144. procedure maybe_adjust_op_result(list: TAsmList; op: TOpCg; size: tdef);
  145. { performs sign/zero extension as required }
  146. procedure resize_stack_int_val(list: TAsmList;fromsize,tosize: tdef; formemstore: boolean);
  147. { 8/16 bit unsigned parameters and return values must be sign-extended on
  148. the producer side, because the JVM does not support unsigned variants;
  149. then they have to be zero-extended again on the consumer side }
  150. procedure maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean);
  151. { adjust the stack height after a call based on the specified number of
  152. slots used for parameters and the provided resultdef }
  153. procedure g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef; paraheight: longint; forceresdef: tdef);
  154. property maxevalstackheight: longint read fmaxevalstackheight;
  155. procedure gen_initialize_fields_code(list:TAsmList);
  156. procedure gen_typecheck(list: TAsmList; checkop: tasmop; checkdef: tdef);
  157. protected
  158. function get_enum_init_val_ref(def: tdef; out ref: treference): boolean;
  159. procedure allocate_implicit_structs_for_st_with_base_ref(list: TAsmList; st: tsymtable; const ref: treference; allocvartyp: tsymtyp);
  160. procedure allocate_enum_with_base_ref(list: TAsmList; vs: tabstractvarsym; const initref: treference; destbaseref: treference);
  161. procedure allocate_implicit_struct_with_base_ref(list: TAsmList; vs: tabstractvarsym; ref: treference);
  162. procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
  163. //procedure g_copyvalueparas(p: TObject; arg: pointer); override;
  164. procedure inittempvariables(list:TAsmList);override;
  165. function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; override;
  166. { in case of an array, the array base address and index have to be
  167. put on the evaluation stack before the stored value; similarly, for
  168. fields the self pointer has to be loaded first. Also checks whether
  169. the reference is valid. If dup is true, the necessary values are stored
  170. twice. Returns how many stack slots have been consumed, disregarding
  171. the "dup". }
  172. function prepare_stack_for_ref(list: TAsmList; var ref: treference; dup: boolean): longint;
  173. { return the load/store opcode to load/store from/to ref; if the result
  174. has to be and'ed after a load to get the final value, that constant
  175. is returned in finishandval (otherwise that value is set to -1) }
  176. function loadstoreopcref(def: tdef; isload: boolean; const ref: treference; out finishandval: tcgint): tasmop;
  177. { return the load/store opcode to load/store from/to reg; if the result
  178. has to be and'ed after a load to get the final value, that constant
  179. is returned in finishandval (otherwise that value is set to -1) }
  180. function loadstoreopc(def: tdef; isload, isarray: boolean; out finishandval: tcgint): tasmop;
  181. procedure resizestackfpuval(list: TAsmList; fromsize, tosize: tcgsize);
  182. { in case of an OS_32 OP_DIV, we have to use an OS_S64 OP_IDIV because the
  183. JVM does not support unsigned divisions }
  184. procedure maybepreparedivu32(list: TAsmList; var op: topcg; size: tdef; out isdivu32: boolean);
  185. { concatcopy helpers }
  186. procedure concatcopy_normal_array(list: TAsmList; size: tdef; const source, dest: treference);
  187. procedure concatcopy_record(list: TAsmList; size: tdef; const source, dest: treference);
  188. procedure concatcopy_set(list: TAsmList; size: tdef; const source, dest: treference);
  189. procedure concatcopy_shortstring(list: TAsmList; size: tdef; const source, dest: treference);
  190. end;
  191. implementation
  192. uses
  193. verbose,cutils,globals,fmodule,constexp,
  194. defutil,
  195. aasmtai,aasmcpu,
  196. symtable,symcpu,
  197. procinfo,cpuinfo,cgcpu,tgobj,tgcpu;
  198. const
  199. TOpCG2IAsmOp : array[topcg] of TAsmOp=(
  200. A_None, {OP_NONE}
  201. A_None, {OP_MOVE, replaced operation with direct load }
  202. a_i32_add, {OP_ADD, simple addition }
  203. a_i32_and, {OP_AND, simple logical and }
  204. a_i32_div_u, {OP_DIV, simple unsigned division }
  205. a_i32_div_s, {OP_IDIV, simple signed division }
  206. a_i32_mul, {OP_IMUL, simple signed multiply }
  207. a_i32_mul, {OP_MUL, simple unsigned multiply }
  208. A_None, {OP_NEG, simple negate } // neg = xor + 1
  209. A_None, {OP_NOT, simple logical not } // not = xor - 1
  210. a_i32_or, {OP_OR, simple logical or }
  211. a_i32_shr_s, {OP_SAR, arithmetic shift-right }
  212. a_i32_shl, {OP_SHL, logical shift left }
  213. a_i32_shr_u, {OP_SHR, logical shift right }
  214. a_i32_sub, {OP_SUB, simple subtraction }
  215. a_i32_xor, {OP_XOR, simple exclusive or }
  216. a_i32_rotl, {OP_ROL, rotate left }
  217. a_i32_rotr {OP_ROR rotate right }
  218. );
  219. TOpCG2LAsmOp : array[topcg] of TAsmOp=(
  220. A_None, {OP_NONE}
  221. a_i64_load, {OP_MOVE, replaced operation with direct load }
  222. a_i64_add, {OP_ADD, simple addition }
  223. a_i64_and, {OP_AND, simple logical and }
  224. a_i64_div_u, {OP_DIV, simple unsigned division }
  225. a_i64_div_s, {OP_IDIV, simple signed division }
  226. a_i64_mul, {OP_IMUL, simple signed multiply }
  227. a_i64_mul, {OP_MUL, simple unsigned multiply }
  228. A_None, {OP_NEG, simple negate } // neg = xor + 1
  229. A_None, {OP_NOT, simple logical not } // not = xor - 1
  230. a_i64_or, {OP_OR, simple logical or }
  231. a_i64_shr_s, {OP_SAR, arithmetic shift-right }
  232. a_i64_shl, {OP_SHL, logical shift left }
  233. a_i64_shr_u, {OP_SHR, logical shift right }
  234. a_i64_sub, {OP_SUB, simple subtraction }
  235. a_i64_xor, {OP_XOR, simple exclusive or }
  236. a_i64_rotl, {OP_ROL, rotate left }
  237. a_i64_rotr {OP_ROR rotate right }
  238. );
  239. constructor thlcgwasm.create;
  240. begin
  241. fevalstackheight:=0;
  242. fmaxevalstackheight:=0;
  243. fntypelookup:=TWasmProcTypeLookup.Create;
  244. end;
  245. destructor thlcgwasm.Destroy;
  246. begin
  247. fntypelookup.Free;
  248. inherited Destroy;
  249. end;
  250. procedure thlcgwasm.incblock;
  251. begin
  252. inc(br_blocks);
  253. end;
  254. procedure thlcgwasm.decblock;
  255. begin
  256. dec(br_blocks);
  257. if br_blocks<0 then Internalerror(2019091807); // out of block
  258. end;
  259. procedure thlcgwasm.incstack(list: TAsmList; slots: longint);
  260. begin
  261. if slots=0 then
  262. exit;
  263. inc(fevalstackheight,slots);
  264. if (fevalstackheight>fmaxevalstackheight) then
  265. fmaxevalstackheight:=fevalstackheight;
  266. if cs_asm_regalloc in current_settings.globalswitches then
  267. list.concat(tai_comment.Create(strpnew(' allocated '+tostr(slots)+', stack height = '+tostr(fevalstackheight))));
  268. end;
  269. procedure thlcgwasm.decstack(list: TAsmList;slots: longint);
  270. begin
  271. if slots=0 then
  272. exit;
  273. dec(fevalstackheight,slots);
  274. if (fevalstackheight<0) and
  275. not(cs_no_regalloc in current_settings.globalswitches) then
  276. internalerror(2010120501);
  277. if cs_asm_regalloc in current_settings.globalswitches then
  278. list.concat(tai_comment.Create(strpnew(' freed '+tostr(slots)+', stack height = '+tostr(fevalstackheight))));
  279. end;
  280. class function thlcgwasm.def2regtyp(def: tdef): tregistertype;
  281. begin
  282. case def.typ of
  283. { records (including files) and enums are implemented via classes }
  284. recorddef,
  285. filedef,
  286. enumdef,
  287. setdef:
  288. result:=R_ADDRESSREGISTER;
  289. { shortstrings are implemented via classes }
  290. else if is_shortstring(def) or
  291. { voiddef can only be typecasted into (implicit) pointers }
  292. is_void(def) then
  293. result:=R_ADDRESSREGISTER
  294. else
  295. result:=inherited;
  296. end;
  297. end;
  298. procedure thlcgwasm.a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; const cgpara: TCGPara);
  299. begin
  300. tosize:=get_para_push_size(tosize);
  301. if tosize=s8inttype then
  302. a:=shortint(a)
  303. else if tosize=s16inttype then
  304. a:=smallint(a);
  305. inherited a_load_const_cgpara(list, tosize, a, cgpara);
  306. end;
  307. function thlcgwasm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
  308. begin
  309. list.concat(taicpu.op_sym(a_call,current_asmdata.RefAsmSymbol(s,AT_FUNCTION)));
  310. result:=get_call_result_cgpara(pd,forceresdef);
  311. end;
  312. function thlcgwasm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
  313. begin
  314. a_load_reg_stack(list, ptrsinttype, reg);
  315. current_asmdata.CurrAsmList.Concat(taicpu.op_functype(a_call_indirect,tcpuprocdef(pd).create_functype));
  316. result:=hlcg.get_call_result_cgpara(pd, nil);
  317. end;
  318. procedure thlcgwasm.a_load_const_stack(list : TAsmList;size : tdef;a : tcgint; typ: TRegisterType);
  319. begin
  320. case typ of
  321. R_INTREGISTER:
  322. begin
  323. case def_cgsize(size) of
  324. OS_8,OS_16,OS_32,
  325. OS_S8,OS_S16,OS_S32:
  326. begin
  327. { convert cardinals to longints }
  328. list.concat(taicpu.op_const(a_i32_const, a));
  329. end;
  330. OS_64,OS_S64:
  331. begin
  332. list.concat(taicpu.op_const(a_i64_const, a));
  333. end;
  334. else
  335. internalerror(2010110702);
  336. end;
  337. end;
  338. R_ADDRESSREGISTER:
  339. begin
  340. if a<>0 then
  341. internalerror(2010110701);
  342. list.concat(taicpu.op_none(a_none));
  343. end;
  344. else
  345. internalerror(2010110703);
  346. end;
  347. incstack(list,1);
  348. end;
  349. procedure thlcgwasm.a_load_stack_loc(list: TAsmList; size: tdef; const loc: tlocation);
  350. var
  351. tmpref: treference;
  352. begin
  353. case loc.loc of
  354. LOC_REGISTER,LOC_CREGISTER,
  355. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  356. a_load_stack_reg(list,size,loc.register);
  357. LOC_REFERENCE:
  358. begin
  359. tmpref:=loc.reference;
  360. a_load_stack_ref(list,size,loc.reference,prepare_stack_for_ref(list,tmpref,false));
  361. end;
  362. else
  363. internalerror(2011020501);
  364. end;
  365. end;
  366. procedure thlcgwasm.a_load_loc_stack(list: TAsmList;size: tdef;const loc: tlocation);
  367. var
  368. tmpref: treference;
  369. extra_slots: LongInt;
  370. begin
  371. case loc.loc of
  372. LOC_REGISTER,LOC_CREGISTER,
  373. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  374. a_load_reg_stack(list,size,loc.register);
  375. LOC_REFERENCE,LOC_CREFERENCE:
  376. begin
  377. tmpref:=loc.reference;
  378. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  379. a_load_ref_stack(list,size,tmpref,extra_slots);
  380. end;
  381. LOC_CONSTANT:
  382. a_load_const_stack(list,size,loc.value,def2regtyp(size));
  383. else
  384. internalerror(2011010401);
  385. end;
  386. end;
  387. procedure thlcgwasm.a_loadfpu_const_stack(list: TAsmList; size: tdef; a: double);
  388. begin
  389. case tfloatdef(size).floattype of
  390. s32real:
  391. begin
  392. list.concat(taicpu.op_single(a_f32_const, a));
  393. incstack(list,1);
  394. end;
  395. s64real:
  396. begin
  397. list.concat(taicpu.op_double(a_f64_const,a));
  398. incstack(list,2);
  399. end
  400. else
  401. internalerror(2011010501);
  402. end;
  403. end;
  404. procedure thlcgwasm.a_op_stack(list: TAsmList; op: topcg; size: tdef; trunc32: boolean);
  405. var
  406. cgsize: tcgsize;
  407. begin
  408. if not trunc32 then
  409. cgsize:=def_cgsize(size)
  410. else
  411. begin
  412. resize_stack_int_val(list,u32inttype,s64inttype,false);
  413. cgsize:=OS_S64;
  414. end;
  415. case cgsize of
  416. OS_8,OS_S8,
  417. OS_16,OS_S16,
  418. OS_32,OS_S32:
  419. begin
  420. { not = xor 1 for boolean, xor -1 for the rest}
  421. if op=OP_NOT then
  422. begin
  423. if not is_pasbool(size) then
  424. a_load_const_stack(list,s32inttype,high(cardinal),R_INTREGISTER)
  425. else
  426. a_load_const_stack(list,size,1,R_INTREGISTER);
  427. op:=OP_XOR;
  428. end;
  429. if TOpCG2IAsmOp[op]=A_None then
  430. internalerror(2010120532);
  431. list.concat(taicpu.op_none(TOpCG2IAsmOp[op]));
  432. maybe_adjust_op_result(list,op,size);
  433. if op<>OP_NEG then
  434. decstack(list,1);
  435. end;
  436. OS_64,OS_S64:
  437. begin
  438. { unsigned 64 bit division must be done via a helper }
  439. if op=OP_DIV then
  440. internalerror(2010120530);
  441. { not = xor 1 for boolean, xor -1 for the rest}
  442. if op=OP_NOT then
  443. begin
  444. if not is_pasbool(size) then
  445. a_load_const_stack(list,s64inttype,-1,R_INTREGISTER)
  446. else
  447. a_load_const_stack(list,s64inttype,1,R_INTREGISTER);
  448. op:=OP_XOR;
  449. end;
  450. if TOpCG2LAsmOp[op]=A_None then
  451. internalerror(2010120533);
  452. list.concat(taicpu.op_none(TOpCG2LAsmOp[op]));
  453. case op of
  454. OP_NOT,
  455. OP_NEG:
  456. ;
  457. { the second argument here is an int rather than a long }
  458. OP_SHL,OP_SHR,OP_SAR:
  459. decstack(list,1);
  460. else
  461. decstack(list,2);
  462. end;
  463. end;
  464. else
  465. internalerror(2010120531);
  466. end;
  467. if trunc32 then
  468. begin
  469. list.concat(taicpu.op_none(a_i32_trunc_s_f32)); // todo: there are several truncs
  470. decstack(list,1);
  471. end;
  472. end;
  473. procedure thlcgwasm.a_op_const_stack(list: TAsmList;op: topcg;size: tdef;a: tcgint);
  474. var
  475. trunc32: boolean;
  476. begin
  477. maybepreparedivu32(list,op,size,trunc32);
  478. case op of
  479. OP_NEG,OP_NOT:
  480. internalerror(2011010801);
  481. OP_SHL,OP_SHR,OP_SAR:
  482. { the second argument here is an int rather than a long }
  483. a_load_const_stack(list,s32inttype,a,R_INTREGISTER);
  484. else
  485. a_load_const_stack(list,size,a,R_INTREGISTER);
  486. end;
  487. a_op_stack(list,op,size,trunc32);
  488. end;
  489. procedure thlcgwasm.a_op_reg_stack(list: TAsmList; op: topcg; size: tdef; reg: tregister);
  490. var
  491. trunc32: boolean;
  492. begin
  493. maybepreparedivu32(list,op,size,trunc32);
  494. case op of
  495. OP_SHL,OP_SHR,OP_SAR:
  496. if not is_64bitint(size) then
  497. a_load_reg_stack(list,size,reg)
  498. else
  499. begin
  500. { the second argument here is an int rather than a long }
  501. if getsubreg(reg)=R_SUBQ then
  502. internalerror(2011010802);
  503. a_load_reg_stack(list,s32inttype,reg)
  504. end
  505. else
  506. a_load_reg_stack(list,size,reg);
  507. end;
  508. a_op_stack(list,op,size,trunc32);
  509. end;
  510. procedure thlcgwasm.a_op_ref_stack(list: TAsmList; op: topcg; size: tdef; const ref: treference);
  511. var
  512. trunc32: boolean;
  513. tmpref: treference;
  514. begin
  515. { ref must not be the stack top, because that may indicate an error
  516. (it means that we will perform an operation of the stack top onto
  517. itself, so that means the two values have been loaded manually prior
  518. to calling this routine, instead of letting this routine load one of
  519. them; if something like that is needed, call a_op_stack() directly) }
  520. if ref.base=NR_EVAL_STACK_BASE then
  521. internalerror(2010121102);
  522. tmpref:=ref;
  523. maybepreparedivu32(list,op,size,trunc32);
  524. case op of
  525. OP_SHL,OP_SHR,OP_SAR:
  526. begin
  527. if not is_64bitint(size) then
  528. a_load_ref_stack(list,size,ref,prepare_stack_for_ref(list,tmpref,false))
  529. else
  530. a_load_ref_stack(list,s32inttype,ref,prepare_stack_for_ref(list,tmpref,false));
  531. end;
  532. else
  533. a_load_ref_stack(list,size,ref,prepare_stack_for_ref(list,tmpref,false));
  534. end;
  535. a_op_stack(list,op,size,trunc32);
  536. end;
  537. procedure thlcgwasm.a_op_loc_stack(list: TAsmList; op: topcg; size: tdef; const loc: tlocation);
  538. begin
  539. case loc.loc of
  540. LOC_REGISTER,LOC_CREGISTER:
  541. a_op_reg_stack(list,op,size,loc.register);
  542. LOC_REFERENCE,LOC_CREFERENCE:
  543. a_op_ref_stack(list,op,size,loc.reference);
  544. LOC_CONSTANT:
  545. a_op_const_stack(list,op,size,loc.value);
  546. else
  547. internalerror(2011011415)
  548. end;
  549. end;
  550. procedure thlcgwasm.g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation);
  551. begin
  552. case fromloc.loc of
  553. LOC_CREFERENCE,
  554. LOC_REFERENCE:
  555. begin
  556. toloc:=fromloc;
  557. if (fromloc.reference.base<>NR_NO) and
  558. (fromloc.reference.base<>current_procinfo.framepointer) and
  559. (fromloc.reference.base<>NR_STACK_POINTER_REG) then
  560. g_allocload_reg_reg(list,voidpointertype,fromloc.reference.base,toloc.reference.base,R_ADDRESSREGISTER);
  561. end;
  562. else
  563. inherited;
  564. end;
  565. end;
  566. procedure thlcgwasm.g_newarray(list: TAsmList; arrdef: tdef; initdim: longint);
  567. var
  568. recref,
  569. enuminitref: treference;
  570. elemdef: tdef;
  571. i: longint;
  572. mangledname: string;
  573. opc: tasmop;
  574. primitivetype: boolean;
  575. begin
  576. internalerror(2019083001); // arrays are note yet supported
  577. (*
  578. elemdef:=arrdef;
  579. if initdim>1 then
  580. begin
  581. { multianewarray typedesc ndim }
  582. { todo: WASM
  583. list.concat(taicpu.op_sym_const(a_multianewarray,
  584. current_asmdata.RefAsmSymbol(jvmarrtype(elemdef,primitivetype),AT_METADATA),initdim));
  585. }
  586. { has to be a multi-dimensional array type }
  587. if primitivetype then
  588. internalerror(2011012207);
  589. end
  590. else
  591. begin
  592. { for primitive types:
  593. newarray typedesc
  594. for reference types:
  595. anewarray typedesc
  596. }
  597. { get the type of the elements of the array we are creating }
  598. elemdef:=tarraydef(arrdef).elementdef;
  599. { todo: WASM. Todo: array data structures needs to be stored in Memory
  600. mangledname:=jvmarrtype(elemdef,primitivetype);
  601. if primitivetype then
  602. opc:=a_newarray
  603. else
  604. opc:=a_anewarray;
  605. list.concat(taicpu.op_sym(opc,current_asmdata.RefAsmSymbol(mangledname,AT_METADATA)));
  606. }
  607. end;
  608. { all dimensions are removed from the stack, an array reference is
  609. added }
  610. decstack(list,initdim-1);
  611. { in case of an array of records, sets or shortstrings, initialise }
  612. elemdef:=tarraydef(arrdef).elementdef;
  613. for i:=1 to pred(initdim) do
  614. elemdef:=tarraydef(elemdef).elementdef;
  615. if (elemdef.typ in [recorddef,setdef]) or
  616. ((elemdef.typ=enumdef) and
  617. get_enum_init_val_ref(elemdef,enuminitref)) or
  618. is_shortstring(elemdef) or
  619. ((elemdef.typ=procvardef) and
  620. not tprocvardef(elemdef).is_addressonly) or
  621. is_ansistring(elemdef) or
  622. is_wide_or_unicode_string(elemdef) or
  623. is_dynamic_array(elemdef) then
  624. begin
  625. { duplicate array instance }
  626. list.concat(taicpu.op_none(a_dup));
  627. incstack(list,1);
  628. a_load_const_stack(list,s32inttype,initdim-1,R_INTREGISTER);
  629. case elemdef.typ of
  630. arraydef:
  631. g_call_system_proc(list,'fpc_initialize_array_dynarr',[],nil);
  632. recorddef,setdef,procvardef:
  633. begin
  634. tg.gethltemp(list,elemdef,elemdef.size,tt_persistent,recref);
  635. a_load_ref_stack(list,elemdef,recref,prepare_stack_for_ref(list,recref,false));
  636. case elemdef.typ of
  637. recorddef:
  638. g_call_system_proc(list,'fpc_initialize_array_record',[],nil);
  639. setdef:
  640. begin
  641. if tsetdef(elemdef).elementdef.typ=enumdef then
  642. g_call_system_proc(list,'fpc_initialize_array_enumset',[],nil)
  643. else
  644. g_call_system_proc(list,'fpc_initialize_array_bitset',[],nil)
  645. end;
  646. procvardef:
  647. g_call_system_proc(list,'fpc_initialize_array_procvar',[],nil);
  648. else
  649. internalerror(2019051025);
  650. end;
  651. tg.ungettemp(list,recref);
  652. end;
  653. enumdef:
  654. begin
  655. a_load_ref_stack(list,java_jlobject,enuminitref,prepare_stack_for_ref(list,enuminitref,false));
  656. g_call_system_proc(list,'fpc_initialize_array_object',[],nil);
  657. end;
  658. stringdef:
  659. begin
  660. case tstringdef(elemdef).stringtype of
  661. st_shortstring:
  662. begin
  663. a_load_const_stack_intern(list,u8inttype,tstringdef(elemdef).len,R_INTREGISTER,true);
  664. g_call_system_proc(list,'fpc_initialize_array_shortstring',[],nil);
  665. end;
  666. st_ansistring:
  667. g_call_system_proc(list,'fpc_initialize_array_ansistring',[],nil);
  668. st_unicodestring,
  669. st_widestring:
  670. g_call_system_proc(list,'fpc_initialize_array_unicodestring',[],nil);
  671. else
  672. internalerror(2011081801);
  673. end;
  674. end;
  675. else
  676. internalerror(2011081801);
  677. end;
  678. end;
  679. *)
  680. end;
  681. procedure thlcgwasm.g_getarraylen(list: TAsmList; const arrloc: tlocation);
  682. var
  683. nillab,endlab: tasmlabel;
  684. begin
  685. internalerror(2019083001); // arrays are note yet supported
  686. (*
  687. { inline because we have to use the arraylength opcode, which
  688. cannot be represented directly in Pascal. Even though the JVM
  689. supports allocated arrays with length=0, we still also have to
  690. check for nil pointers because even if FPC always generates
  691. allocated empty arrays under all circumstances, external Java
  692. code could pass in nil pointers.
  693. Note that this means that assigned(arr) can be different from
  694. length(arr)<>0 for dynamic arrays when targeting the JVM.
  695. }
  696. current_asmdata.getjumplabel(nillab);
  697. current_asmdata.getjumplabel(endlab);
  698. { if assigned(arr) ... }
  699. a_load_loc_stack(list,java_jlobject,arrloc);
  700. list.concat(taicpu.op_none(a_dup));
  701. incstack(list,1);
  702. list.concat(taicpu.op_sym(a_ifnull,nillab));
  703. decstack(list,1);
  704. { ... then result:=arraylength(arr) ... }
  705. list.concat(taicpu.op_none(a_arraylength));
  706. a_jmp_always(list,endlab);
  707. { ... else result:=0 }
  708. a_label(list,nillab);
  709. list.concat(taicpu.op_none(a_pop));
  710. decstack(list,1);
  711. list.concat(taicpu.op_none(a_iconst_0));
  712. incstack(list,1);
  713. a_label(list,endlab);
  714. *)
  715. end;
  716. procedure thlcgwasm.a_cmp_stack_label(list: TAsmlist; size: tdef; cmp_op: topcmp; lab: tasmlabel);
  717. const
  718. opcmp32: array[topcmp] of tasmop = (
  719. A_None, { OC_NONE, }
  720. a_i32_eq, { OC_EQ, equality comparison }
  721. a_i32_gt_s, { OC_GT, greater than (signed) }
  722. a_i32_lt_s, { OC_LT, less than (signed) }
  723. a_i32_ge_s, { OC_GTE, greater or equal than (signed) }
  724. a_i32_le_s, { OC_LTE, less or equal than (signed) }
  725. a_i32_ne, { OC_NE, not equal }
  726. a_i32_le_u, { OC_BE, less or equal than (unsigned) }
  727. a_i32_lt_u, { OC_B, less than (unsigned) }
  728. a_i32_ge_u, { OC_AE, greater or equal than (unsigned) }
  729. a_i32_gt_u { OC_A greater than (unsigned) }
  730. );
  731. const
  732. opcmp64: array[TOpCmp] of TAsmOp = (A_None,
  733. a_i64_eq, // OC_EQ
  734. a_i64_gt_s, a_i64_lt_s, // OC_GT, OC_LT
  735. a_i64_ge_s, a_i64_le_s, // OC_GTE, OC_LTE
  736. a_i64_ne, // OC_NE
  737. a_i64_le_u, a_i64_lt_u, // OC_BE, OC_B
  738. a_i64_ge_u, a_i64_gt_u // OC_AE, OC_A
  739. );
  740. var
  741. cgsize: tcgsize;
  742. begin
  743. // WASM doesn't have compare+jump (to label) operation
  744. // thus even though this is a_cmp_stack_label()
  745. // label operrand is ommited
  746. //
  747. // todo: it should NOT be ommitted when we're leaving a block
  748. // (i.e. Exit or break or continue operators)
  749. case def2regtyp(size) of
  750. R_INTREGISTER:
  751. begin
  752. cgsize:=def_cgsize(size);
  753. case cgsize of
  754. OS_S8,OS_8,
  755. OS_16,OS_S16,
  756. OS_S32,OS_32:
  757. begin
  758. //list.concat(taicpu.op_sym(opcmp32[cmp_op],lab));
  759. list.concat(taicpu.op_none(opcmp32[cmp_op]));
  760. decstack(list,2);
  761. end;
  762. OS_64,OS_S64:
  763. begin
  764. //list.concat(taicpu.op_none(a_lcmp));
  765. //decstack(list,3);
  766. //list.concat(taicpu.op_sym(opcmp64[cmp_op],lab));
  767. list.concat(taicpu.op_none(opcmp64[cmp_op]));
  768. decstack(list,2);
  769. end;
  770. else
  771. internalerror(2010120538);
  772. end;
  773. end;
  774. R_ADDRESSREGISTER:
  775. begin
  776. case cmp_op of
  777. OC_EQ:
  778. //list.concat(taicpu.op_sym(a_i64_eq,lab));
  779. list.concat(taicpu.op_none(a_i32_eq));
  780. OC_NE:
  781. //list.concat(taicpu.op_sym(a_i64_ne,lab));
  782. list.concat(taicpu.op_none(a_i32_ne));
  783. else
  784. internalerror(2010120537);
  785. end;
  786. decstack(list,2);
  787. end;
  788. else
  789. internalerror(2010120538);
  790. end;
  791. end;
  792. procedure thlcgwasm.maybe_adjust_cmp_stackval(list: TAsmlist; size: tdef; cmp_op: topcmp);
  793. begin
  794. { use cmp_op because eventually that's what indicates the
  795. signed/unsigned character of the operation, not the size... }
  796. if (cmp_op in [OC_EQ,OC_NE,OC_LT,OC_LTE,OC_GT,OC_GTE]) or
  797. (def2regtyp(size)<>R_INTREGISTER) then
  798. exit;
  799. { http://stackoverflow.com/questions/4068973/c-performing-signed-comparison-in-unsigned-variables-without-casting }
  800. case def_cgsize(size) of
  801. OS_32,OS_S32:
  802. a_op_const_stack(list,OP_XOR,size,cardinal($80000000));
  803. OS_64,OS_S64:
  804. a_op_const_stack(list,OP_XOR,size,tcgint($8000000000000000));
  805. else
  806. ;
  807. end;
  808. end;
  809. function thlcgwasm.maybe_adjust_cmp_constval(size: tdef; cmp_op: topcmp; a: tcgint): tcgint;
  810. begin
  811. result:=a;
  812. { use cmp_op because eventually that's what indicates the
  813. signed/unsigned character of the operation, not the size... }
  814. if (cmp_op in [OC_EQ,OC_NE,OC_LT,OC_LTE,OC_GT,OC_GTE]) or
  815. (def2regtyp(size)<>R_INTREGISTER) then
  816. exit;
  817. case def_cgsize(size) of
  818. OS_32,OS_S32:
  819. result:=a xor cardinal($80000000);
  820. OS_64,OS_S64:
  821. {$push}{$r-}
  822. result:=a xor tcgint($8000000000000000);
  823. {$pop}
  824. else
  825. ;
  826. end;
  827. end;
  828. procedure thlcgwasm.maybe_adjust_op_result(list: TAsmList; op: TOpCg; size: tdef);
  829. const
  830. overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG];
  831. begin
  832. if (op in overflowops) and
  833. (def_cgsize(size) in [OS_8,OS_S8,OS_16,OS_S16]) then
  834. resize_stack_int_val(list,s32inttype,size,false);
  835. end;
  836. procedure thlcgwasm.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
  837. begin
  838. { constructors don't return anything in Java }
  839. if pd.proctypeoption=potype_constructor then
  840. exit;
  841. { must return a value of the correct type on the evaluation stack }
  842. case def2regtyp(resdef) of
  843. R_INTREGISTER,
  844. R_ADDRESSREGISTER:
  845. a_load_const_cgpara(list,resdef,0,resloc);
  846. R_FPUREGISTER:
  847. case tfloatdef(resdef).floattype of
  848. s32real:
  849. begin
  850. list.concat(taicpu.op_single(a_f32_const, 0));
  851. incstack(list,1);
  852. end;
  853. s64real:
  854. begin
  855. list.concat(taicpu.op_double(a_f64_const, 0));
  856. incstack(list,2);
  857. end;
  858. else
  859. internalerror(2011010302);
  860. end
  861. else
  862. internalerror(2011010301);
  863. end;
  864. end;
  865. //procedure thlcgwasm.g_copyvalueparas(p: TObject; arg: pointer);
  866. // var
  867. // list: tasmlist;
  868. // tmpref: treference;
  869. // begin
  870. // { zero-extend < 32 bit primitive types (FPC can zero-extend when calling,
  871. // but that doesn't help when we're called from Java code or indirectly
  872. // as a procvar -- exceptions: widechar (Java-specific type) and ordinal
  873. // types whose upper bound does not set the sign bit }
  874. // if (tsym(p).typ=paravarsym) and
  875. // (tparavarsym(p).varspez in [vs_value,vs_const]) and
  876. // (tparavarsym(p).vardef.typ=orddef) and
  877. // not is_pasbool(tparavarsym(p).vardef) and
  878. // not is_widechar(tparavarsym(p).vardef) and
  879. // (tparavarsym(p).vardef.size<4) and
  880. // not is_signed(tparavarsym(p).vardef) and
  881. // (torddef(tparavarsym(p).vardef).high>=(1 shl (tparavarsym(p).vardef.size*8-1))) then
  882. // begin
  883. // list:=TAsmList(arg);
  884. // { store value in new location to keep Android verifier happy }
  885. // tg.gethltemp(list,tparavarsym(p).vardef,tparavarsym(p).vardef.size,tt_persistent,tmpref);
  886. // a_load_loc_stack(list,tparavarsym(p).vardef,tparavarsym(p).initialloc);
  887. // a_op_const_stack(list,OP_AND,tparavarsym(p).vardef,(1 shl (tparavarsym(p).vardef.size*8))-1);
  888. // a_load_stack_ref(list,tparavarsym(p).vardef,tmpref,prepare_stack_for_ref(list,tmpref,false));
  889. // location_reset_ref(tparavarsym(p).localloc,LOC_REFERENCE,def_cgsize(tparavarsym(p).vardef),4,tmpref.volatility);
  890. // tparavarsym(p).localloc.reference:=tmpref;
  891. // end;
  892. //
  893. // inherited g_copyvalueparas(p, arg);
  894. // end;
  895. procedure thlcgwasm.inittempvariables(list: TAsmList);
  896. begin
  897. { these are automatically initialised when allocated if necessary }
  898. end;
  899. function thlcgwasm.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
  900. begin
  901. result:=inherited;
  902. pd.init_paraloc_info(callerside);
  903. g_adjust_stack_after_call(list,pd,pd.callerargareasize,forceresdef);
  904. end;
  905. function thlcgwasm.prepare_stack_for_ref(list: TAsmList; var ref: treference; dup: boolean): longint;
  906. begin
  907. result:=0;
  908. { fake location that indicates the value is already on the stack? }
  909. if (ref.base=NR_EVAL_STACK_BASE) or (ref.base=NR_LOCAL_STACK_POINTER_REG) then
  910. exit;
  911. // setting up memory offset
  912. if assigned(ref.symbol) and (ref.base=NR_NO) and (ref.index=NR_NO) then
  913. begin
  914. list.Concat(taicpu.op_const(a_i32_const,0));
  915. incstack(list,1);
  916. if dup then
  917. begin
  918. list.Concat(taicpu.op_const(a_i32_const,0));
  919. incstack(list,1);
  920. end;
  921. result:=1;
  922. end
  923. else if ref.index <> NR_NO then // array access
  924. begin
  925. // it's just faster to sum two of those together
  926. list.Concat(taicpu.op_reg(a_get_local, ref.base));
  927. list.Concat(taicpu.op_reg(a_get_local, ref.index));
  928. list.Concat(taicpu.op_none(a_i32_add));
  929. incstack(list,1);
  930. if dup then
  931. begin
  932. list.Concat(taicpu.op_reg(a_get_local, ref.base));
  933. list.Concat(taicpu.op_reg(a_get_local, ref.index));
  934. list.Concat(taicpu.op_none(a_i32_add));
  935. incstack(list,1);
  936. end;
  937. ref.base:=NR_NO;
  938. ref.index:=NR_NO;
  939. result:=1;
  940. end
  941. else if (ref.base<>NR_NO) then
  942. begin
  943. if (ref.base<>NR_STACK_POINTER_REG) then
  944. begin
  945. { regular field -> load self on the stack }
  946. a_load_reg_stack(list,voidpointertype,ref.base);
  947. if dup then
  948. a_load_reg_stack(list,voidpointertype,ref.base);
  949. { field name/type encoded in symbol, no index/offset }
  950. result:=1;
  951. ref.base:=NR_NO;
  952. end
  953. else // if (ref.base = NR_FRAME_POINTER_REG) then
  954. begin
  955. list.Concat(taicpu.op_sym(a_get_local, current_asmdata.RefAsmSymbol(FRAME_POINTER_SYM,AT_ADDR) ));
  956. end;
  957. end
  958. else
  959. begin
  960. { static field -> nothing to do here, except for validity check }
  961. {if not assigned(ref.symbol) or
  962. (ref.offset<>0) then
  963. begin
  964. internalerror(2010120525);
  965. end;}
  966. end;
  967. end;
  968. procedure thlcgwasm.a_load_const_reg(list: TAsmList; tosize: tdef; a: tcgint; register: tregister);
  969. begin
  970. a_load_const_stack(list,tosize,a,def2regtyp(tosize));
  971. a_load_stack_reg(list,tosize,register);
  972. end;
  973. procedure thlcgwasm.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);
  974. var
  975. extra_slots: longint;
  976. tmpref: treference;
  977. begin
  978. tmpref:=ref;
  979. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  980. a_load_const_stack(list,tosize,a,def2regtyp(tosize));
  981. a_load_stack_ref(list,tosize,tmpref,extra_slots);
  982. end;
  983. procedure thlcgwasm.a_load_reg_ref(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference);
  984. var
  985. extra_slots: longint;
  986. tmpref: treference;
  987. begin
  988. tmpref:=ref;
  989. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  990. a_load_reg_stack(list,fromsize,register);
  991. if def2regtyp(fromsize)=R_INTREGISTER then
  992. resize_stack_int_val(list,fromsize,tosize,assigned(tmpref.symbol));
  993. a_load_stack_ref(list,tosize,tmpref,extra_slots);
  994. end;
  995. procedure thlcgwasm.a_load_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  996. begin
  997. a_load_reg_stack(list,fromsize,reg1);
  998. if def2regtyp(fromsize)=R_INTREGISTER then
  999. resize_stack_int_val(list,fromsize,tosize,false);
  1000. a_load_stack_reg(list,tosize,reg2);
  1001. end;
  1002. procedure thlcgwasm.a_load_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister);
  1003. var
  1004. extra_slots: longint;
  1005. tmpref: treference;
  1006. begin
  1007. tmpref:=ref;
  1008. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  1009. a_load_ref_stack(list,fromsize,tmpref,extra_slots);
  1010. if def2regtyp(fromsize)=R_INTREGISTER then
  1011. resize_stack_int_val(list,fromsize,tosize,false);
  1012. a_load_stack_reg(list,tosize,register);
  1013. end;
  1014. procedure thlcgwasm.a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference);
  1015. var
  1016. extra_sslots,
  1017. extra_dslots: longint;
  1018. tmpsref, tmpdref: treference;
  1019. begin
  1020. if sref.base<>NR_EVAL_STACK_BASE then
  1021. begin
  1022. tmpsref:=sref;
  1023. tmpdref:=dref;
  1024. { make sure the destination reference is on top, since in the end the
  1025. order has to be "destref, value" -> first create "destref, sourceref" }
  1026. extra_dslots:=prepare_stack_for_ref(list,tmpdref,false);
  1027. extra_sslots:=prepare_stack_for_ref(list,tmpsref,false);
  1028. a_load_ref_stack(list,fromsize,tmpsref,extra_sslots);
  1029. if def2regtyp(fromsize)=R_INTREGISTER then
  1030. resize_stack_int_val(list,fromsize,tosize,assigned(tmpdref.symbol));
  1031. a_load_stack_ref(list,tosize,tmpdref,extra_dslots);
  1032. end
  1033. else
  1034. inherited;
  1035. end;
  1036. procedure thlcgwasm.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister);
  1037. var
  1038. tmpref: treference;
  1039. begin
  1040. { you can't take the address of references, that are on the local stack }
  1041. if (ref.base=NR_EVAL_STACK_BASE) or (ref.index=NR_EVAL_STACK_BASE) or
  1042. (ref.base=NR_LOCAL_STACK_POINTER_REG) or (ref.index=NR_LOCAL_STACK_POINTER_REG) then
  1043. internalerror(2021010101);
  1044. tmpref:=ref;
  1045. tmpref.base:=NR_NO;
  1046. tmpref.index:=NR_NO;
  1047. list.Concat(taicpu.op_ref(a_i32_const, tmpref));
  1048. if ref.base<>NR_NO then
  1049. begin
  1050. list.Concat(taicpu.op_reg(a_get_local,ref.base));
  1051. list.Concat(taicpu.op_none(a_i32_add));
  1052. end;
  1053. if ref.index<>NR_NO then
  1054. begin
  1055. list.Concat(taicpu.op_reg(a_get_local,ref.index));
  1056. if ref.scalefactor>1 then
  1057. begin
  1058. list.Concat(taicpu.op_const(a_i32_const,ref.scalefactor));
  1059. list.Concat(taicpu.op_none(a_i32_mul));
  1060. end;
  1061. list.Concat(taicpu.op_none(a_i32_add));
  1062. end;
  1063. incstack(list, 1);
  1064. a_load_stack_reg(list, tosize, r);
  1065. end;
  1066. procedure thlcgwasm.a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister);
  1067. begin
  1068. a_op_const_reg_reg(list,op,size,a,reg,reg);
  1069. end;
  1070. procedure thlcgwasm.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister);
  1071. begin
  1072. a_load_reg_stack(list,size,src);
  1073. a_op_const_stack(list,op,size,a);
  1074. a_load_stack_reg(list,size,dst);
  1075. end;
  1076. procedure thlcgwasm.a_op_const_ref(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; const ref: TReference);
  1077. var
  1078. extra_slots: longint;
  1079. tmpref: treference;
  1080. begin
  1081. tmpref:=ref;
  1082. extra_slots:=prepare_stack_for_ref(list,tmpref,true);
  1083. { TODO, here or in peepholeopt: use iinc when possible }
  1084. a_load_ref_stack(list,size,tmpref,extra_slots);
  1085. a_op_const_stack(list,op,size,a);
  1086. { for android verifier }
  1087. if (def2regtyp(size)=R_INTREGISTER) and
  1088. (assigned(tmpref.symbol)) then
  1089. resize_stack_int_val(list,size,size,true);
  1090. a_load_stack_ref(list,size,tmpref,extra_slots);
  1091. end;
  1092. procedure thlcgwasm.a_op_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister);
  1093. begin
  1094. if not(op in [OP_NOT,OP_NEG]) then
  1095. a_load_reg_stack(list,size,reg);
  1096. a_op_ref_stack(list,op,size,ref);
  1097. a_load_stack_reg(list,size,reg);
  1098. end;
  1099. procedure thlcgwasm.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister);
  1100. begin
  1101. if not(op in [OP_NOT,OP_NEG]) then
  1102. a_load_reg_stack(list,size,src2);
  1103. a_op_reg_stack(list,op,size,src1);
  1104. a_load_stack_reg(list,size,dst);
  1105. end;
  1106. procedure thlcgwasm.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister);
  1107. begin
  1108. a_op_reg_reg_reg(list,op,size,reg1,reg2,reg2);
  1109. end;
  1110. procedure thlcgwasm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
  1111. var
  1112. tmpreg: tregister;
  1113. begin
  1114. if not setflags then
  1115. begin
  1116. inherited;
  1117. exit;
  1118. end;
  1119. tmpreg:=getintregister(list,size);
  1120. a_load_const_reg(list,size,a,tmpreg);
  1121. a_op_reg_reg_reg_checkoverflow(list,op,size,tmpreg,src,dst,true,ovloc);
  1122. end;
  1123. procedure thlcgwasm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
  1124. var
  1125. orgsrc1, orgsrc2: tregister;
  1126. docheck: boolean;
  1127. lab: tasmlabel;
  1128. begin
  1129. if not setflags then
  1130. begin
  1131. inherited;
  1132. exit;
  1133. end;
  1134. { anything else cannot overflow }
  1135. docheck:=size.size in [4,8];
  1136. if docheck then
  1137. begin
  1138. orgsrc1:=src1;
  1139. orgsrc2:=src2;
  1140. if src1=dst then
  1141. begin
  1142. orgsrc1:=getintregister(list,size);
  1143. a_load_reg_reg(list,size,size,src1,orgsrc1);
  1144. end;
  1145. if src2=dst then
  1146. begin
  1147. orgsrc2:=getintregister(list,size);
  1148. a_load_reg_reg(list,size,size,src2,orgsrc2);
  1149. end;
  1150. end;
  1151. a_op_reg_reg_reg(list,op,size,src1,src2,dst);
  1152. if docheck then
  1153. begin
  1154. { * signed overflow for addition iff
  1155. - src1 and src2 are negative and result is positive (excep in case of
  1156. subtraction, then sign of src1 has to be inverted)
  1157. - src1 and src2 are positive and result is negative
  1158. -> Simplified boolean equivalent (in terms of sign bits):
  1159. not(src1 xor src2) and (src1 xor dst)
  1160. for subtraction, multiplication: invert src1 sign bit
  1161. for division: handle separately (div by zero, low(inttype) div -1),
  1162. not supported by this code
  1163. * unsigned overflow iff carry out, aka dst < src1 or dst < src2
  1164. }
  1165. location_reset(ovloc,LOC_REGISTER,OS_S32);
  1166. { not pasbool8, because then we'd still have to convert the integer to
  1167. a boolean via branches for Dalvik}
  1168. ovloc.register:=getintregister(list,s32inttype);
  1169. if not ((size.typ=pointerdef) or
  1170. ((size.typ=orddef) and
  1171. (torddef(size).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
  1172. pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
  1173. begin
  1174. a_load_reg_stack(list,size,src1);
  1175. if op in [OP_SUB,OP_IMUL] then
  1176. a_op_stack(list,OP_NOT,size,false);
  1177. a_op_reg_stack(list,OP_XOR,size,src2);
  1178. a_op_stack(list,OP_NOT,size,false);
  1179. a_load_reg_stack(list,size,src1);
  1180. a_op_reg_stack(list,OP_XOR,size,dst);
  1181. a_op_stack(list,OP_AND,size,false);
  1182. a_op_const_stack(list,OP_SHR,size,(size.size*8)-1);
  1183. if size.size=8 then
  1184. begin
  1185. //todo: any operands needed?
  1186. list.concat(taicpu.op_none(a_i32_wrap_i64));
  1187. decstack(list,1);
  1188. end;
  1189. end
  1190. else
  1191. begin
  1192. a_load_const_stack(list,s32inttype,0,R_INTREGISTER);
  1193. current_asmdata.getjumplabel(lab);
  1194. { can be optimized by removing duplicate xor'ing to convert dst from
  1195. signed to unsigned quadrant }
  1196. a_cmp_reg_reg_label(list,size,OC_B,dst,src1,lab);
  1197. a_cmp_reg_reg_label(list,size,OC_B,dst,src2,lab);
  1198. a_op_const_stack(list,OP_XOR,s32inttype,1);
  1199. a_label(list,lab);
  1200. end;
  1201. a_load_stack_reg(list,s32inttype,ovloc.register);
  1202. end
  1203. else
  1204. ovloc.loc:=LOC_VOID;
  1205. end;
  1206. procedure thlcgwasm.a_cmp_const_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference; l: tasmlabel);
  1207. var
  1208. tmpref: treference;
  1209. begin
  1210. tmpref:=ref;
  1211. if tmpref.base<>NR_EVAL_STACK_BASE then
  1212. a_load_ref_stack(list,size,tmpref,prepare_stack_for_ref(list,tmpref,false));
  1213. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1214. a_load_const_stack(list,size,maybe_adjust_cmp_constval(size,cmp_op,a),def2regtyp(size));
  1215. a_cmp_stack_label(list,size,cmp_op,l);
  1216. end;
  1217. procedure thlcgwasm.a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel);
  1218. begin
  1219. a_load_reg_stack(list,size,reg);
  1220. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1221. a_load_const_stack(list,size,maybe_adjust_cmp_constval(size,cmp_op,a),def2regtyp(size));
  1222. a_cmp_stack_label(list,size,cmp_op,l);
  1223. end;
  1224. procedure thlcgwasm.a_cmp_ref_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; l: tasmlabel);
  1225. var
  1226. tmpref: treference;
  1227. begin
  1228. tmpref:=ref;
  1229. a_load_reg_stack(list,size,reg);
  1230. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1231. if tmpref.base<>NR_EVAL_STACK_BASE then
  1232. a_load_ref_stack(list,size,tmpref,prepare_stack_for_ref(list,tmpref,false))
  1233. else begin
  1234. // todo: need a swap operation?
  1235. //list.concat(taicpu.op_none(a_swap));
  1236. Internalerror(2019083003);
  1237. end;
  1238. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1239. a_cmp_stack_label(list,size,cmp_op,l);
  1240. end;
  1241. procedure thlcgwasm.a_cmp_reg_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; l: tasmlabel);
  1242. var
  1243. tmpref: treference;
  1244. begin
  1245. tmpref:=ref;
  1246. if tmpref.base<>NR_EVAL_STACK_BASE then
  1247. a_load_ref_stack(list,size,ref,prepare_stack_for_ref(list,tmpref,false));
  1248. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1249. a_load_reg_stack(list,size,reg);
  1250. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1251. a_cmp_stack_label(list,size,cmp_op,l);
  1252. end;
  1253. procedure thlcgwasm.a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);
  1254. begin
  1255. a_load_reg_stack(list,size,reg2);
  1256. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1257. a_load_reg_stack(list,size,reg1);
  1258. maybe_adjust_cmp_stackval(list,size,cmp_op);
  1259. a_cmp_stack_label(list,size,cmp_op,l);
  1260. end;
  1261. procedure thlcgwasm.a_jmp_always(list: TAsmList; l: tasmlabel);
  1262. begin
  1263. //todo: for proper jumping it's necessary to check
  1264. // all active br_blocks (if, block, loops)
  1265. // and jump to the proper one.
  1266. //list.concat(taicpu.op_const(a_i32_const, 0));
  1267. if l = current_procinfo.CurrBreakLabel then begin
  1268. // todo: this should be moved to node generator pass2
  1269. list.concat(taicpu.op_const(a_i32_const, 0));
  1270. list.concat(taicpu.op_const(a_br,2+br_blocks))
  1271. end else if l = current_procinfo.CurrContinueLabel then begin
  1272. list.concat(taicpu.op_const(a_i32_const, 0));
  1273. list.concat(taicpu.op_const(a_br,loopContBr+br_blocks))
  1274. end else begin
  1275. Internalerror(2019091806); // unexpected jump
  1276. end;
  1277. end;
  1278. procedure thlcgwasm.concatcopy_normal_array(list: TAsmList; size: tdef; const source, dest: treference);
  1279. var
  1280. procname: string;
  1281. eledef: tdef;
  1282. ndim: longint;
  1283. adddefaultlenparas: boolean;
  1284. tmpsource, tmpdest: treference;
  1285. begin
  1286. tmpsource:=source;
  1287. tmpdest:=dest;
  1288. { load copy helper parameters on the stack }
  1289. a_load_ref_stack(list,ptruinttype,source,prepare_stack_for_ref(list,tmpsource,false));
  1290. a_load_ref_stack(list,ptruinttype,dest,prepare_stack_for_ref(list,tmpdest,false));
  1291. { call copy helper }
  1292. eledef:=tarraydef(size).elementdef;
  1293. ndim:=1;
  1294. adddefaultlenparas:=true;
  1295. case eledef.typ of
  1296. orddef:
  1297. begin
  1298. case torddef(eledef).ordtype of
  1299. pasbool1,pasbool8,s8bit,u8bit,bool8bit,uchar,
  1300. s16bit,u16bit,bool16bit,pasbool16,
  1301. uwidechar,
  1302. s32bit,u32bit,bool32bit,pasbool32,
  1303. s64bit,u64bit,bool64bit,pasbool64,scurrency:
  1304. procname:='FPC_COPY_SHALLOW_ARRAY'
  1305. else
  1306. internalerror(2011020504);
  1307. end;
  1308. end;
  1309. arraydef:
  1310. begin
  1311. { call fpc_setlength_dynarr_multidim with deepcopy=true, and extra
  1312. parameters }
  1313. while (eledef.typ=arraydef) and
  1314. not is_dynamic_array(eledef) do
  1315. begin
  1316. eledef:=tarraydef(eledef).elementdef;
  1317. inc(ndim)
  1318. end;
  1319. if (ndim=1) then
  1320. procname:='FPC_COPY_SHALLOW_ARRAY'
  1321. else
  1322. begin
  1323. { deepcopy=true }
  1324. a_load_const_stack(list,pasbool1type,1,R_INTREGISTER);
  1325. { ndim }
  1326. a_load_const_stack(list,s32inttype,ndim,R_INTREGISTER);
  1327. { eletype }
  1328. { todo: WASM
  1329. a_load_const_stack(list,cwidechartype,ord(jvmarrtype_setlength(eledef)),R_INTREGISTER);
  1330. }
  1331. adddefaultlenparas:=false;
  1332. procname:='FPC_SETLENGTH_DYNARR_MULTIDIM';
  1333. end;
  1334. end;
  1335. recorddef:
  1336. procname:='FPC_COPY_JRECORD_ARRAY';
  1337. procvardef:
  1338. if tprocvardef(eledef).is_addressonly then
  1339. procname:='FPC_COPY_SHALLOW_ARRAY'
  1340. else
  1341. procname:='FPC_COPY_JPROCVAR_ARRAY';
  1342. setdef:
  1343. if tsetdef(eledef).elementdef.typ=enumdef then
  1344. procname:='FPC_COPY_JENUMSET_ARRAY'
  1345. else
  1346. procname:='FPC_COPY_JBITSET_ARRAY';
  1347. floatdef:
  1348. procname:='FPC_COPY_SHALLOW_ARRAY';
  1349. stringdef:
  1350. if is_shortstring(eledef) then
  1351. procname:='FPC_COPY_JSHORTSTRING_ARRAY'
  1352. else
  1353. procname:='FPC_COPY_SHALLOW_ARRAY';
  1354. variantdef:
  1355. begin
  1356. {$ifndef nounsupported}
  1357. procname:='FPC_COPY_SHALLOW_ARRAY';
  1358. {$else}
  1359. { todo: make a deep copy via clone... }
  1360. internalerror(2011020505);
  1361. {$endif}
  1362. end;
  1363. else
  1364. procname:='FPC_COPY_SHALLOW_ARRAY';
  1365. end;
  1366. if adddefaultlenparas then
  1367. begin
  1368. { -1, -1 means "copy entire array" }
  1369. a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
  1370. a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
  1371. end;
  1372. g_call_system_proc(list,procname,[],nil);
  1373. if ndim<>1 then
  1374. begin
  1375. { pop return value, must be the same as dest }
  1376. //list.concat(taicpu.op_none(a_pop));
  1377. Internalerror(2019083001); // no support for arrays
  1378. decstack(list,1);
  1379. end;
  1380. end;
  1381. procedure thlcgwasm.concatcopy_record(list: TAsmList; size: tdef; const source, dest: treference);
  1382. var
  1383. srsym: tsym;
  1384. pd: tprocdef;
  1385. tmpsource, tmpdest: treference;
  1386. begin
  1387. tmpsource:=source;
  1388. tmpdest:=dest;
  1389. { self }
  1390. a_load_ref_stack(list,size,tmpsource,prepare_stack_for_ref(list,tmpsource,false));
  1391. { result }
  1392. a_load_ref_stack(list,size,tmpdest,prepare_stack_for_ref(list,tmpdest,false));
  1393. { call fpcDeepCopy helper }
  1394. srsym:=search_struct_member(tabstractrecorddef(size),'FPCDEEPCOPY');
  1395. if not assigned(srsym) or
  1396. (srsym.typ<>procsym) then
  1397. Message1(cg_f_unknown_compilerproc,size.typename+'.fpcDeepCopy');
  1398. pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
  1399. a_call_name(list,pd,pd.mangledname,[],nil,false);
  1400. { both parameters are removed, no function result }
  1401. decstack(list,2);
  1402. end;
  1403. procedure thlcgwasm.concatcopy_set(list: TAsmList; size: tdef; const source, dest: treference);
  1404. var
  1405. tmpsource, tmpdest: treference;
  1406. begin
  1407. tmpsource:=source;
  1408. tmpdest:=dest;
  1409. a_load_ref_stack(list,size,tmpsource,prepare_stack_for_ref(list,tmpsource,false));
  1410. a_load_ref_stack(list,size,tmpdest,prepare_stack_for_ref(list,tmpdest,false));
  1411. { call set copy helper }
  1412. if tsetdef(size).elementdef.typ=enumdef then
  1413. g_call_system_proc(list,'fpc_enumset_copy',[],nil)
  1414. else
  1415. g_call_system_proc(list,'fpc_bitset_copy',[],nil);
  1416. end;
  1417. procedure thlcgwasm.concatcopy_shortstring(list: TAsmList; size: tdef; const source, dest: treference);
  1418. var
  1419. srsym: tsym;
  1420. pd: tprocdef;
  1421. tmpsource, tmpdest: treference;
  1422. begin
  1423. tmpsource:=source;
  1424. tmpdest:=dest;
  1425. { self }
  1426. a_load_ref_stack(list,size,tmpsource,prepare_stack_for_ref(list,tmpsource,false));
  1427. { result }
  1428. a_load_ref_stack(list,size,tmpdest,prepare_stack_for_ref(list,tmpdest,false));
  1429. { call fpcDeepCopy helper }
  1430. srsym:=search_struct_member(java_shortstring,'FPCDEEPCOPY');
  1431. if not assigned(srsym) or
  1432. (srsym.typ<>procsym) then
  1433. Message1(cg_f_unknown_compilerproc,'ShortstringClass.FpcDeepCopy');
  1434. pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
  1435. a_call_name(list,pd,pd.mangledname,[],nil,false);
  1436. { both parameters are removed, no function result }
  1437. decstack(list,2);
  1438. end;
  1439. procedure thlcgwasm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
  1440. var
  1441. handled: boolean;
  1442. begin
  1443. handled:=false;
  1444. case size.typ of
  1445. arraydef:
  1446. begin
  1447. if not is_dynamic_array(size) then
  1448. begin
  1449. concatcopy_normal_array(list,size,source,dest);
  1450. handled:=true;
  1451. end;
  1452. end;
  1453. recorddef:
  1454. begin
  1455. concatcopy_record(list,size,source,dest);
  1456. handled:=true;
  1457. end;
  1458. setdef:
  1459. begin
  1460. concatcopy_set(list,size,source,dest);
  1461. handled:=true;
  1462. end;
  1463. stringdef:
  1464. begin
  1465. if is_shortstring(size) then
  1466. begin
  1467. concatcopy_shortstring(list,size,source,dest);
  1468. handled:=true;
  1469. end;
  1470. end;
  1471. else
  1472. ;
  1473. end;
  1474. if not handled then
  1475. inherited;
  1476. end;
  1477. procedure thlcgwasm.g_copyshortstring(list: TAsmList; const source, dest: treference; strdef: tstringdef);
  1478. begin
  1479. concatcopy_shortstring(list,strdef,source,dest);
  1480. end;
  1481. procedure thlcgwasm.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference);
  1482. var
  1483. dstack_slots: longint;
  1484. tmpref1, tmpref2: treference;
  1485. begin
  1486. tmpref1:=ref1;
  1487. tmpref2:=ref2;
  1488. dstack_slots:=prepare_stack_for_ref(list,tmpref2,false);
  1489. a_load_ref_stack(list,fromsize,tmpref1,prepare_stack_for_ref(list,tmpref1,false));
  1490. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1491. a_load_stack_ref(list,tosize,tmpref2,dstack_slots);
  1492. end;
  1493. procedure thlcgwasm.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister);
  1494. var
  1495. tmpref: treference;
  1496. begin
  1497. tmpref:=ref;
  1498. a_load_ref_stack(list,fromsize,tmpref,prepare_stack_for_ref(list,tmpref,false));
  1499. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1500. a_load_stack_reg(list,tosize,reg);
  1501. end;
  1502. procedure thlcgwasm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference);
  1503. var
  1504. dstack_slots: longint;
  1505. tmpref: treference;
  1506. begin
  1507. tmpref:=ref;
  1508. dstack_slots:=prepare_stack_for_ref(list,tmpref,false);
  1509. a_load_reg_stack(list,fromsize,reg);
  1510. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1511. a_load_stack_ref(list,tosize,tmpref,dstack_slots);
  1512. end;
  1513. procedure thlcgwasm.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  1514. begin
  1515. a_load_reg_stack(list,fromsize,reg1);
  1516. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1517. a_load_stack_reg(list,tosize,reg2);
  1518. end;
  1519. procedure thlcgwasm.g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean);
  1520. var
  1521. pd: tcpuprocdef;
  1522. begin
  1523. pd:=tcpuprocdef(current_procinfo.procdef);
  1524. g_procdef(list,pd);
  1525. ttgwasm(tg).allocframepointer(list,pd.frame_pointer_ref);
  1526. ttgwasm(tg).allocbasepointer(list,pd.base_pointer_ref);
  1527. { the localsize is based on tg.lasttemp -> already in terms of stack
  1528. slots rather than bytes }
  1529. //list.concat(tai_directive.Create(asd_jlimit,'locals '+tostr(localsize)));
  1530. { we insert the unit initialisation code afterwards in the proginit code,
  1531. and it uses one stack slot }
  1532. //if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1533. //fmaxevalstackheight:=max(1,fmaxevalstackheight);
  1534. list.Concat(tai_local.create(wbt_i32,FRAME_POINTER_SYM)); //TWasmBasicType
  1535. list.Concat(tai_local.create(wbt_i32,BASE_POINTER_SYM)); //TWasmBasicType
  1536. list.Concat(taicpu.op_sym(a_get_global,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_LABEL)));
  1537. list.Concat(taicpu.op_ref(a_set_local,pd.base_pointer_ref));
  1538. if (localsize>0) then begin
  1539. list.Concat(taicpu.op_ref(a_get_local,pd.base_pointer_ref));
  1540. list.concat(taicpu.op_const(a_i32_const, localsize ));
  1541. list.concat(taicpu.op_none(a_i32_sub));
  1542. list.Concat(taicpu.op_ref(a_set_local,pd.frame_pointer_ref));
  1543. list.Concat(taicpu.op_ref(a_get_local,pd.frame_pointer_ref));
  1544. list.Concat(taicpu.op_sym(a_set_global,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_LABEL)));
  1545. end;
  1546. //list.concat(tai_directive.Create(asd_jlimit,'stack '+tostr(fmaxevalstackheight)));
  1547. end;
  1548. procedure thlcgwasm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
  1549. var
  1550. pd: tcpuprocdef;
  1551. begin
  1552. pd:=tcpuprocdef(current_procinfo.procdef);
  1553. list.Concat(taicpu.op_ref(a_get_local,pd.base_pointer_ref));
  1554. list.Concat(taicpu.op_sym(a_set_global,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_LABEL)));
  1555. list.concat(taicpu.op_none(a_return));
  1556. list.concat(taicpu.op_none(a_end_function));
  1557. end;
  1558. procedure thlcgwasm.gen_load_return_value(list: TAsmList);
  1559. begin
  1560. { constructors don't return anything in the jvm }
  1561. if current_procinfo.procdef.proctypeoption in [potype_constructor,potype_class_constructor] then
  1562. exit;
  1563. inherited gen_load_return_value(list);
  1564. end;
  1565. procedure thlcgwasm.record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList);
  1566. begin
  1567. { add something to the al_procedures list as well, because if all al_*
  1568. lists are empty, the assembler writer isn't called }
  1569. if not code.empty and
  1570. current_asmdata.asmlists[al_procedures].empty then
  1571. current_asmdata.asmlists[al_procedures].concat(tai_align.Create(4));
  1572. tcpuprocdef(pd).exprasmlist:=TAsmList.create;
  1573. new_section(tcpuprocdef(pd).exprasmlist,sec_code,lower(pd.mangledname),current_settings.alignment.procalign);
  1574. tcpuprocdef(pd).exprasmlist.concatlist(code);
  1575. if assigned(data) and
  1576. not data.empty then
  1577. internalerror(2010122801);
  1578. end;
  1579. procedure thlcgwasm.g_incrrefcount(list: TAsmList; t: tdef; const ref: treference);
  1580. begin
  1581. // do nothing
  1582. end;
  1583. procedure thlcgwasm.g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; const name: string);
  1584. var
  1585. normaldim: longint;
  1586. eleref, tmpref: treference;
  1587. begin
  1588. { only in case of initialisation, we have to set all elements to "empty" }
  1589. if name<>'fpc_initialize_array' then
  1590. exit;
  1591. { put array on the stack }
  1592. tmpref:=ref;
  1593. a_load_ref_stack(list,ptruinttype,tmpref,prepare_stack_for_ref(list,tmpref,false));
  1594. { in case it's an open array whose elements are regular arrays, put the
  1595. dimension of the regular arrays on the stack (otherwise pass 0) }
  1596. normaldim:=0;
  1597. while (t.typ=arraydef) and
  1598. not is_dynamic_array(t) do
  1599. begin
  1600. inc(normaldim);
  1601. t:=tarraydef(t).elementdef;
  1602. end;
  1603. a_load_const_stack(list,s32inttype,normaldim,R_INTREGISTER);
  1604. { highloc is invalid, the length is part of the array in Java }
  1605. if is_wide_or_unicode_string(t) then
  1606. g_call_system_proc(list,'fpc_initialize_array_unicodestring',[],nil)
  1607. else if is_ansistring(t) then
  1608. g_call_system_proc(list,'fpc_initialize_array_ansistring',[],nil)
  1609. else if is_dynamic_array(t) then
  1610. g_call_system_proc(list,'fpc_initialize_array_dynarr',[],nil)
  1611. else if is_record(t) or
  1612. (t.typ=setdef) then
  1613. begin
  1614. tg.gethltemp(list,t,t.size,tt_persistent,eleref);
  1615. a_load_ref_stack(list,t,eleref,prepare_stack_for_ref(list,eleref,false));
  1616. if is_record(t) then
  1617. g_call_system_proc(list,'fpc_initialize_array_record',[],nil)
  1618. else if tsetdef(t).elementdef.typ=enumdef then
  1619. g_call_system_proc(list,'fpc_initialize_array_enumset',[],nil)
  1620. else
  1621. g_call_system_proc(list,'fpc_initialize_array_bitset',[],nil);
  1622. tg.ungettemp(list,eleref);
  1623. end
  1624. else if (t.typ=enumdef) then
  1625. begin
  1626. if get_enum_init_val_ref(t,eleref) then
  1627. begin
  1628. a_load_ref_stack(list,ptruinttype,eleref,prepare_stack_for_ref(list,eleref,false));
  1629. g_call_system_proc(list,'fpc_initialize_array_object',[],nil);
  1630. end;
  1631. end
  1632. else
  1633. internalerror(2011031901);
  1634. end;
  1635. procedure thlcgwasm.g_initialize(list: TAsmList; t: tdef; const ref: treference);
  1636. var
  1637. dummyloc: tlocation;
  1638. sym: tsym;
  1639. pd: tprocdef;
  1640. tmpref: treference;
  1641. begin
  1642. if (t.typ=arraydef) and
  1643. not is_dynamic_array(t) then
  1644. begin
  1645. dummyloc.loc:=LOC_INVALID;
  1646. g_array_rtti_helper(list,tarraydef(t).elementdef,ref,dummyloc,'fpc_initialize_array')
  1647. end
  1648. else if is_record(t) then
  1649. begin
  1650. { call the fpcInitializeRec method }
  1651. sym:=tsym(trecorddef(t).symtable.find('FPCINITIALIZEREC'));
  1652. if assigned(sym) and
  1653. (sym.typ=procsym) then
  1654. begin
  1655. if tprocsym(sym).procdeflist.Count<>1 then
  1656. internalerror(2011071713);
  1657. pd:=tprocdef(tprocsym(sym).procdeflist[0]);
  1658. end
  1659. else
  1660. internalerror(2013113008);
  1661. tmpref:=ref;
  1662. a_load_ref_stack(list,ptruinttype,ref,prepare_stack_for_ref(list,tmpref,false));
  1663. a_call_name(list,pd,pd.mangledname,[],nil,false);
  1664. { parameter removed, no result }
  1665. decstack(list,1);
  1666. end
  1667. else
  1668. a_load_const_ref(list,t,0,ref);
  1669. end;
  1670. procedure thlcgwasm.g_finalize(list: TAsmList; t: tdef; const ref: treference);
  1671. begin
  1672. // do nothing
  1673. end;
  1674. procedure thlcgwasm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
  1675. begin
  1676. { not possible, need the original operands }
  1677. internalerror(2012102101);
  1678. end;
  1679. procedure thlcgwasm.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation);
  1680. var
  1681. hl : tasmlabel;
  1682. begin
  1683. if not(cs_check_overflow in current_settings.localswitches) then
  1684. exit;
  1685. current_asmdata.getjumplabel(hl);
  1686. a_cmp_const_loc_label(list,s32inttype,OC_EQ,0,ovloc,hl);
  1687. g_call_system_proc(list,'fpc_overflow',[],nil);
  1688. a_label(list,hl);
  1689. end;
  1690. procedure thlcgwasm.location_get_data_ref(list: TAsmList; def: tdef; const l: tlocation; var ref: treference; loadref: boolean; alignment: longint);
  1691. var
  1692. tmploc: tlocation;
  1693. begin
  1694. { This routine is a combination of a generalised a_loadaddr_ref_reg()
  1695. that also works for addresses in registers (in case loadref is false)
  1696. and of a_load_ref_reg (in case loadref is true). It is used for
  1697. a) getting the address of managed var/out parameters
  1698. b) getting to the actual data of value types that are passed by
  1699. reference by the compiler (and then get a local copy at the caller
  1700. side). Normally, depending on whether this reference is passed in a
  1701. register or reference, we either need a reference with that register
  1702. as base or load the address in that reference and use that as a new
  1703. base.
  1704. Since the JVM cannot take the address of anything, all
  1705. "pass-by-reference" value parameters (which are always aggregate types)
  1706. are already simply the implicit pointer to the data (since arrays,
  1707. records, etc are already internally implicit pointers). This means
  1708. that if "loadref" is true, we must simply return this implicit pointer.
  1709. If it is false, we are supposed the take the address of this implicit
  1710. pointer, which is not possible.
  1711. However, managed types are also implicit pointers in Pascal, so in that
  1712. case "taking the address" again consists of simply returning the
  1713. implicit pointer/current value (in case of a var/out parameter, this
  1714. value is stored inside an array).
  1715. }
  1716. if not loadref then
  1717. begin
  1718. if not is_managed_type(def) then
  1719. internalerror(2011020601);
  1720. tmploc:=l;
  1721. end
  1722. else
  1723. begin
  1724. if not wasmAlwayInMem(def) then
  1725. begin
  1726. { passed by reference in array of single element; l contains the
  1727. base address of the array }
  1728. location_reset_ref(tmploc,LOC_REFERENCE,OS_ADDR,4,ref.volatility);
  1729. cgutils.reference_reset_base(tmploc.reference,getaddressregister(list,ptruinttype),0,tmploc.reference.temppos,4,ref.volatility);
  1730. a_load_loc_reg(list,ptruinttype,ptruinttype,l,tmploc.reference.base);
  1731. end
  1732. else
  1733. tmploc:=l;
  1734. end;
  1735. case tmploc.loc of
  1736. LOC_REGISTER,
  1737. LOC_CREGISTER :
  1738. begin
  1739. { the implicit pointer is in a register and has to be in a
  1740. reference -> create a reference and put it there }
  1741. location_force_mem(list,tmploc,ptruinttype);
  1742. ref:=tmploc.reference;
  1743. end;
  1744. LOC_REFERENCE,
  1745. LOC_CREFERENCE :
  1746. begin
  1747. ref:=tmploc.reference;
  1748. end;
  1749. else
  1750. internalerror(2011020603);
  1751. end;
  1752. end;
  1753. procedure thlcgwasm.maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean);
  1754. begin
  1755. { don't do anything, all registers become stack locations anyway }
  1756. end;
  1757. procedure thlcgwasm.g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister);
  1758. var
  1759. localref: treference;
  1760. arrloc: tlocation;
  1761. stackslots: longint;
  1762. begin
  1763. { temporary reference for passing to concatcopy }
  1764. tg.gethltemp(list,ptruinttype,ptruinttype.size,tt_persistent,localref);
  1765. stackslots:=prepare_stack_for_ref(list,localref,false);
  1766. { create the local copy of the array (lenloc is invalid, get length
  1767. directly from the array) }
  1768. location_reset_ref(arrloc,LOC_REFERENCE,OS_ADDR,sizeof(pint),ref.volatility);
  1769. arrloc.reference:=ref;
  1770. g_getarraylen(list,arrloc);
  1771. g_newarray(list,arrdef,1);
  1772. a_load_stack_ref(list,ptruinttype,localref,stackslots);
  1773. { copy the source array to the destination }
  1774. g_concatcopy(list,arrdef,ref,localref);
  1775. { and put the array pointer in the register as expected by the caller }
  1776. a_load_ref_reg(list,ptruinttype,ptruinttype,localref,destreg);
  1777. end;
  1778. procedure thlcgwasm.g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation);
  1779. begin
  1780. // do nothing, long live garbage collection!
  1781. end;
  1782. procedure thlcgwasm.gen_initialize_code(list: TAsmList);
  1783. var
  1784. ref: treference;
  1785. begin
  1786. { create globals with wrapped types such as arrays/records }
  1787. case current_procinfo.procdef.proctypeoption of
  1788. potype_unitinit:
  1789. begin
  1790. cgutils.reference_reset_base(ref,NR_NO,0,ctempposinvalid,1,[]);
  1791. if assigned(current_module.globalsymtable) then
  1792. allocate_implicit_structs_for_st_with_base_ref(list,current_module.globalsymtable,ref,staticvarsym);
  1793. allocate_implicit_structs_for_st_with_base_ref(list,current_module.localsymtable,ref,staticvarsym);
  1794. end;
  1795. potype_class_constructor:
  1796. begin
  1797. { also initialise local variables, if any }
  1798. inherited;
  1799. { initialise class fields }
  1800. cgutils.reference_reset_base(ref,NR_NO,0,ctempposinvalid,1,[]);
  1801. allocate_implicit_structs_for_st_with_base_ref(list,tabstractrecorddef(current_procinfo.procdef.owner.defowner).symtable,ref,staticvarsym);
  1802. end
  1803. else
  1804. inherited
  1805. end;
  1806. end;
  1807. procedure thlcgwasm.gen_entry_code(list: TAsmList);
  1808. begin
  1809. list.concat(Tai_force_line.Create);
  1810. end;
  1811. procedure thlcgwasm.gen_exit_code(list: TAsmList);
  1812. begin
  1813. { nothing }
  1814. end;
  1815. procedure thlcgwasm.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister);
  1816. begin
  1817. internalerror(2012090201);
  1818. end;
  1819. procedure thlcgwasm.a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle: pmmshuffle);
  1820. begin
  1821. internalerror(2012090202);
  1822. end;
  1823. procedure thlcgwasm.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle);
  1824. begin
  1825. internalerror(2012060130);
  1826. end;
  1827. procedure thlcgwasm.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle);
  1828. begin
  1829. internalerror(2012060131);
  1830. end;
  1831. procedure thlcgwasm.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle);
  1832. begin
  1833. internalerror(2012060132);
  1834. end;
  1835. procedure thlcgwasm.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle);
  1836. begin
  1837. internalerror(2012060133);
  1838. end;
  1839. procedure thlcgwasm.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle);
  1840. begin
  1841. internalerror(2012060134);
  1842. end;
  1843. procedure thlcgwasm.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle);
  1844. begin
  1845. internalerror(2012060135);
  1846. end;
  1847. procedure thlcgwasm.g_stackpointer_alloc(list: TAsmList; size: longint);
  1848. begin
  1849. internalerror(2012090203);
  1850. end;
  1851. procedure thlcgwasm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  1852. begin
  1853. internalerror(2012090204);
  1854. end;
  1855. procedure thlcgwasm.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint);
  1856. begin
  1857. internalerror(2012090205);
  1858. end;
  1859. procedure thlcgwasm.g_local_unwind(list: TAsmList; l: TAsmLabel);
  1860. begin
  1861. internalerror(2012090206);
  1862. end;
  1863. procedure thlcgwasm.g_procdef(list: TAsmList; pd: tprocdef);
  1864. begin
  1865. list.Concat(tai_functype.create(pd.mangledname,tcpuprocdef(pd).create_functype));
  1866. end;
  1867. procedure thlcgwasm.a_load_stack_reg(list: TAsmList; size: tdef; reg: tregister);
  1868. var
  1869. opc: tasmop;
  1870. finishandval: tcgint;
  1871. begin
  1872. opc:=loadstoreopc(size,false,false,finishandval);
  1873. list.concat(taicpu.op_reg(opc,reg));
  1874. { avoid problems with getting the size of an open array etc }
  1875. if wasmAlwayInMem(size) then
  1876. size:=ptruinttype;
  1877. decstack(list,1);
  1878. end;
  1879. procedure thlcgwasm.a_load_stack_ref(list: TAsmList; size: tdef; const ref: treference; extra_slots: longint);
  1880. var
  1881. opc: tasmop;
  1882. finishandval: tcgint;
  1883. begin
  1884. { fake location that indicates the value has to remain on the stack }
  1885. if ref.base=NR_EVAL_STACK_BASE then
  1886. exit;
  1887. opc:=loadstoreopcref(size,false,ref,finishandval);
  1888. list.concat(taicpu.op_ref(opc,ref));
  1889. { avoid problems with getting the size of an open array etc }
  1890. if wasmAlwayInMem(size) then
  1891. size:=ptruinttype;
  1892. decstack(list,1+extra_slots);
  1893. end;
  1894. procedure thlcgwasm.a_load_reg_stack(list: TAsmList; size: tdef; reg: tregister);
  1895. var
  1896. opc: tasmop;
  1897. finishandval: tcgint;
  1898. begin
  1899. opc:=loadstoreopc(size,true,false,finishandval);
  1900. list.concat(taicpu.op_reg(opc,reg));
  1901. { avoid problems with getting the size of an open array etc }
  1902. if wasmAlwayInMem(size) then
  1903. size:=ptruinttype;
  1904. incstack(list,1);
  1905. if finishandval<>-1 then
  1906. a_op_const_stack(list,OP_AND,size,finishandval);
  1907. end;
  1908. procedure thlcgwasm.a_load_ref_stack(list: TAsmList; size: tdef; const ref: treference; extra_slots: longint);
  1909. var
  1910. opc: tasmop;
  1911. finishandval: tcgint;
  1912. begin
  1913. { fake location that indicates the value is already on the stack? }
  1914. if (ref.base=NR_EVAL_STACK_BASE) then
  1915. exit;
  1916. opc:=loadstoreopcref(size,true,ref,finishandval);
  1917. list.concat(taicpu.op_ref(opc,ref));
  1918. { avoid problems with getting the size of an open array etc }
  1919. if wasmAlwayInMem(size) then
  1920. size:=ptruinttype;
  1921. incstack(list,1-extra_slots);
  1922. if finishandval<>-1 then
  1923. a_op_const_stack(list,OP_AND,size,finishandval);
  1924. // there's no cast check in Wasm
  1925. //if ref.checkcast then
  1926. // gen_typecheck(list,a_checkcast,size);
  1927. end;
  1928. function thlcgwasm.loadstoreopcref(def: tdef; isload: boolean; const ref: treference; out finishandval: tcgint): tasmop;
  1929. const
  1930. {iisload} {issigned}
  1931. getputmem8 : array [boolean, boolean] of TAsmOp = ((a_i32_store8, a_i32_store8), (a_i32_load8_u, a_i32_load8_s));
  1932. getputmem16 : array [boolean, boolean] of TAsmOp = ((a_i32_store16, a_i32_store16), (a_i32_load16_u ,a_i32_load16_s));
  1933. getputmem32 : array [boolean, boolean] of TAsmOp = ((a_i32_store, a_i32_store), (a_i32_load, a_i32_load));
  1934. getputmem64 : array [boolean, boolean] of TAsmOp = ((a_i64_store, a_i64_store), (a_i64_load, a_i64_load));
  1935. getputmemf32 : array [boolean] of TAsmOp = (a_f32_store, a_f32_load);
  1936. getputmemf64 : array [boolean] of TAsmOp = (a_f64_store, a_f64_load);
  1937. begin
  1938. if (ref.base<>NR_LOCAL_STACK_POINTER_REG) or assigned(ref.symbol) then
  1939. begin
  1940. { -> either a global (static) field, or a regular field. If a regular
  1941. field, then ref.base contains the self pointer, otherwise
  1942. ref.base=NR_NO. In both cases, the symbol contains all other
  1943. information (combined field name and type descriptor) }
  1944. case def.size of
  1945. 1: result := getputmem8[isload, is_signed(def)];
  1946. 2: result := getputmem16[isload, is_signed(def)];
  1947. 4:
  1948. if is_single(def) then
  1949. result := getputmemf32[isload]
  1950. else
  1951. result := getputmem32[isload, is_signed(def)];
  1952. 8: if is_double(def) then
  1953. result := getputmemf64[isload]
  1954. else
  1955. result := getputmem64[isload, is_signed(def)];
  1956. else
  1957. Internalerror(2019091501);
  1958. end;
  1959. //result:=getputopc[isload,ref.base=NR_NO];
  1960. finishandval:=-1;
  1961. { erase sign extension for byte/smallint loads }
  1962. if (def2regtyp(def)=R_INTREGISTER) and
  1963. not is_signed(def) and
  1964. (def.typ=orddef) and
  1965. not is_widechar(def) then
  1966. case def.size of
  1967. 1: if (torddef(def).high>127) then
  1968. finishandval:=255;
  1969. 2: if (torddef(def).high>32767) then
  1970. finishandval:=65535;
  1971. end;
  1972. end
  1973. else
  1974. result:=loadstoreopc(def,isload,false,finishandval);
  1975. end;
  1976. function thlcgwasm.loadstoreopc(def: tdef; isload, isarray: boolean; out finishandval: tcgint): tasmop;
  1977. var
  1978. size: longint;
  1979. begin
  1980. finishandval:=-1;
  1981. if isload then result := a_get_local
  1982. else result := a_set_local;
  1983. {case def2regtyp(def) of
  1984. R_INTREGISTER:
  1985. begin
  1986. size:=def.size;
  1987. case size of
  1988. 1,2,3,4:
  1989. if isload then
  1990. result:=a_i32_load
  1991. else
  1992. result:=a_i32_store;
  1993. 8:
  1994. if isload then
  1995. result:=a_i64_load
  1996. else
  1997. result:=a_i64_store;
  1998. else
  1999. internalerror(2011032814);
  2000. end;
  2001. end;
  2002. R_ADDRESSREGISTER:
  2003. if isload then
  2004. result:=a_i32_load
  2005. else
  2006. result:=a_i32_store;
  2007. R_FPUREGISTER:
  2008. begin
  2009. case tfloatdef(def).floattype of
  2010. s32real:
  2011. if isload then
  2012. result:=a_f32_load
  2013. else
  2014. result:=a_f32_store;
  2015. s64real:
  2016. if isload then
  2017. result:=a_f32_load
  2018. else
  2019. result:=a_f32_store
  2020. else
  2021. internalerror(2010120504);
  2022. end
  2023. end
  2024. else
  2025. internalerror(2010120502);
  2026. end;}
  2027. end;
  2028. procedure thlcgwasm.resize_stack_int_val(list: TAsmList; fromsize, tosize: tdef; formemstore: boolean);
  2029. var
  2030. fromcgsize, tocgsize: tcgsize;
  2031. begin
  2032. { When storing to an array, field or global variable, make sure the
  2033. static type verification can determine that the stored value fits
  2034. within the boundaries of the declared type (to appease the Dalvik VM).
  2035. Local variables either get their type upgraded in the debug info,
  2036. or have no type information at all }
  2037. if formemstore and
  2038. (tosize.typ=orddef) then
  2039. if (torddef(tosize).ordtype in [u8bit,uchar]) then
  2040. tosize:=s8inttype
  2041. else if torddef(tosize).ordtype=u16bit then
  2042. tosize:=s16inttype;
  2043. fromcgsize:=def_cgsize(fromsize);
  2044. tocgsize:=def_cgsize(tosize);
  2045. if fromcgsize in [OS_S64,OS_64] then
  2046. begin
  2047. if not(tocgsize in [OS_S64,OS_64]) then
  2048. begin
  2049. { truncate }
  2050. list.concat(taicpu.op_none(a_i32_wrap_i64));
  2051. end;
  2052. end
  2053. else if tocgsize in [OS_S64,OS_64] then
  2054. begin
  2055. { extend }
  2056. case fromcgsize of
  2057. OS_8:
  2058. begin
  2059. a_op_const_stack(list,OP_AND,s32inttype,255);
  2060. list.concat(taicpu.op_none(a_i64_extend_u_i32));
  2061. end;
  2062. OS_S8:
  2063. list.concat(taicpu.op_none(a_i64_extend_s_8));
  2064. OS_16:
  2065. begin
  2066. a_op_const_stack(list,OP_AND,s32inttype,65535);
  2067. list.concat(taicpu.op_none(a_i64_extend_u_i32));
  2068. end;
  2069. OS_S16:
  2070. list.concat(taicpu.op_none(a_i64_extend_s_16));
  2071. OS_32:
  2072. list.concat(taicpu.op_none(a_i64_extend_u_i32));
  2073. OS_S32:
  2074. list.concat(taicpu.op_none(a_i64_extend_s_i32));
  2075. OS_64,OS_S64:
  2076. ;
  2077. else
  2078. internalerror(2021010301);
  2079. end;
  2080. end;
  2081. { Conversions between 32 and 64 bit types have been completely handled
  2082. above. We still may have to truncate or sign extend in case the
  2083. destination type is smaller that the source type, or has a different
  2084. sign. In case the destination is a widechar and the source is not, we
  2085. also have to insert a conversion to widechar.
  2086. }
  2087. case fromcgsize of
  2088. OS_8:
  2089. a_op_const_stack(list,OP_AND,s32inttype,255);
  2090. OS_S8:
  2091. list.concat(taicpu.op_none(a_i32_extend_s_8));
  2092. OS_16:
  2093. a_op_const_stack(list,OP_AND,s32inttype,65535);
  2094. OS_S16:
  2095. list.concat(taicpu.op_none(a_i32_extend_s_16));
  2096. OS_32,OS_S32,OS_64,OS_S64:
  2097. ;
  2098. else
  2099. internalerror(2021010302);
  2100. end;
  2101. end;
  2102. procedure thlcgwasm.maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean);
  2103. var
  2104. convsize: tdef;
  2105. begin
  2106. if (retdef.typ=orddef) then
  2107. begin
  2108. if (torddef(retdef).ordtype in [u8bit,u16bit,uchar]) and
  2109. (torddef(retdef).high>=(1 shl (retdef.size*8-1))) then
  2110. begin
  2111. convsize:=nil;
  2112. if callside then
  2113. if torddef(retdef).ordtype in [u8bit,uchar] then
  2114. convsize:=s8inttype
  2115. else
  2116. convsize:=s16inttype
  2117. else if torddef(retdef).ordtype in [u8bit,uchar] then
  2118. convsize:=u8inttype
  2119. else
  2120. convsize:=u16inttype;
  2121. if assigned(convsize) then
  2122. resize_stack_int_val(list,s32inttype,convsize,false);
  2123. end;
  2124. end;
  2125. end;
  2126. procedure thlcgwasm.g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef; paraheight: longint; forceresdef: tdef);
  2127. var
  2128. totalremovesize: longint;
  2129. realresdef: tdef;
  2130. begin
  2131. if not assigned(forceresdef) then
  2132. realresdef:=pd.returndef
  2133. else
  2134. realresdef:=forceresdef;
  2135. { a constructor doesn't actually return a value in the jvm }
  2136. if (tabstractprocdef(pd).proctypeoption=potype_constructor) then
  2137. totalremovesize:=paraheight
  2138. else
  2139. { even a byte takes up a full stackslot -> align size to multiple of 4 }
  2140. totalremovesize:=paraheight-(align(realresdef.size,4) shr 2);
  2141. { remove parameters from internal evaluation stack counter (in case of
  2142. e.g. no parameters and a result, it can also increase) }
  2143. if totalremovesize>0 then
  2144. decstack(list,totalremovesize)
  2145. else if totalremovesize<0 then
  2146. incstack(list,-totalremovesize);
  2147. end;
  2148. procedure thlcgwasm.allocate_implicit_struct_with_base_ref(list: TAsmList; vs: tabstractvarsym; ref: treference);
  2149. var
  2150. tmpref: treference;
  2151. begin
  2152. ref.symbol:=current_asmdata.RefAsmSymbol(vs.mangledname,AT_DATA);
  2153. tg.gethltemp(list,vs.vardef,vs.vardef.size,tt_persistent,tmpref);
  2154. { only copy the reference, not the actual data }
  2155. a_load_ref_ref(list,ptruinttype,ptruinttype,tmpref,ref);
  2156. { remains live since there's still a reference to the created
  2157. entity }
  2158. tg.ungettemp(list,tmpref);
  2159. end;
  2160. procedure thlcgwasm.allocate_enum_with_base_ref(list: TAsmList; vs: tabstractvarsym; const initref: treference; destbaseref: treference);
  2161. begin
  2162. destbaseref.symbol:=current_asmdata.RefAsmSymbol(vs.mangledname,AT_DATA);
  2163. { only copy the reference, not the actual data }
  2164. a_load_ref_ref(list,ptruinttype,ptruinttype,initref,destbaseref);
  2165. end;
  2166. function thlcgwasm.get_enum_init_val_ref(def: tdef; out ref: treference): boolean;
  2167. var
  2168. sym: tstaticvarsym;
  2169. begin
  2170. result:=false;
  2171. sym:=tstaticvarsym(tcpuenumdef(tenumdef(def).getbasedef).classdef.symtable.Find('__FPC_ZERO_INITIALIZER'));
  2172. { no enum with ordinal value 0 -> exit }
  2173. if not assigned(sym) then
  2174. exit;
  2175. reference_reset_symbol(ref,current_asmdata.RefAsmSymbol(sym.mangledname,AT_DATA),0,4,[]);
  2176. result:=true;
  2177. end;
  2178. procedure thlcgwasm.allocate_implicit_structs_for_st_with_base_ref(list: TAsmList; st: tsymtable; const ref: treference; allocvartyp: tsymtyp);
  2179. var
  2180. vs: tabstractvarsym;
  2181. def: tdef;
  2182. i: longint;
  2183. initref: treference;
  2184. begin
  2185. for i:=0 to st.symlist.count-1 do
  2186. begin
  2187. if (tsym(st.symlist[i]).typ<>allocvartyp) then
  2188. continue;
  2189. vs:=tabstractvarsym(st.symlist[i]);
  2190. if sp_static in vs.symoptions then
  2191. continue;
  2192. { vo_is_external and vo_has_local_copy means a staticvarsym that is
  2193. alias for a constsym, whose sole purpose is for allocating and
  2194. intialising the constant }
  2195. if [vo_is_external,vo_has_local_copy]*vs.varoptions=[vo_is_external] then
  2196. continue;
  2197. { threadvar innitializations are handled at the node tree level }
  2198. if vo_is_thread_var in vs.varoptions then
  2199. begin
  2200. { nothing }
  2201. end
  2202. else if wasmAlwayInMem(vs.vardef) then
  2203. allocate_implicit_struct_with_base_ref(list,vs,ref)
  2204. { enums are class instances in Java, while they are ordinals in
  2205. Pascal. When they are initialized with enum(0), such as in
  2206. constructors or global variables, initialize them with the
  2207. enum instance for 0 if it exists (if not, it remains nil since
  2208. there is no valid enum value in it) }
  2209. else if (vs.vardef.typ=enumdef) and
  2210. ((vs.typ<>fieldvarsym) or
  2211. (tdef(vs.owner.defowner).typ<>objectdef) or
  2212. (ts_jvm_enum_field_init in current_settings.targetswitches)) and
  2213. get_enum_init_val_ref(vs.vardef,initref) then
  2214. allocate_enum_with_base_ref(list,vs,initref,ref);
  2215. end;
  2216. { process symtables of routines part of this symtable (for local typed
  2217. constants) }
  2218. if allocvartyp=staticvarsym then
  2219. begin
  2220. for i:=0 to st.deflist.count-1 do
  2221. begin
  2222. def:=tdef(st.deflist[i]);
  2223. { the unit symtable also contains the methods of classes defined
  2224. in that unit -> skip them when processing the unit itself.
  2225. Localst is not assigned for the main program code.
  2226. Localst can be the same as st in case of unit init code. }
  2227. if (def.typ<>procdef) or
  2228. (def.owner<>st) or
  2229. not assigned(tprocdef(def).localst) or
  2230. (tprocdef(def).localst=st) then
  2231. continue;
  2232. allocate_implicit_structs_for_st_with_base_ref(list,tprocdef(def).localst,ref,allocvartyp);
  2233. end;
  2234. end;
  2235. end;
  2236. procedure thlcgwasm.gen_initialize_fields_code(list: TAsmList);
  2237. var
  2238. sym: tsym;
  2239. selfpara: tparavarsym;
  2240. selfreg: tregister;
  2241. ref: treference;
  2242. obj: tabstractrecorddef;
  2243. i: longint;
  2244. needinit: boolean;
  2245. begin
  2246. obj:=tabstractrecorddef(current_procinfo.procdef.owner.defowner);
  2247. { check whether there are any fields that need initialisation }
  2248. needinit:=false;
  2249. for i:=0 to obj.symtable.symlist.count-1 do
  2250. begin
  2251. sym:=tsym(obj.symtable.symlist[i]);
  2252. if (sym.typ=fieldvarsym) and
  2253. not(sp_static in sym.symoptions) and
  2254. (wasmAlwayInMem(tfieldvarsym(sym).vardef) or
  2255. ((tfieldvarsym(sym).vardef.typ=enumdef) and
  2256. get_enum_init_val_ref(tfieldvarsym(sym).vardef,ref))) then
  2257. begin
  2258. needinit:=true;
  2259. break;
  2260. end;
  2261. end;
  2262. if not needinit then
  2263. exit;
  2264. selfpara:=tparavarsym(current_procinfo.procdef.parast.find('self'));
  2265. if not assigned(selfpara) then
  2266. internalerror(2011033001);
  2267. selfreg:=getaddressregister(list,selfpara.vardef);
  2268. a_load_loc_reg(list,obj,obj,selfpara.localloc,selfreg);
  2269. cgutils.reference_reset_base(ref,selfreg,0,ctempposinvalid,1,[]);
  2270. allocate_implicit_structs_for_st_with_base_ref(list,obj.symtable,ref,fieldvarsym);
  2271. end;
  2272. procedure thlcgwasm.gen_typecheck(list: TAsmList; checkop: tasmop; checkdef: tdef);
  2273. begin
  2274. { replace special types with their equivalent class type }
  2275. if (checkdef.typ=pointerdef) and
  2276. wasmAlwayInMem(tpointerdef(checkdef).pointeddef) then
  2277. checkdef:=tpointerdef(checkdef).pointeddef;
  2278. if (checkdef=voidpointertype) or
  2279. (checkdef.typ=formaldef) then
  2280. checkdef:=ptruinttype
  2281. else if checkdef.typ=enumdef then
  2282. checkdef:=tcpuenumdef(checkdef).classdef
  2283. else if checkdef.typ=setdef then
  2284. begin
  2285. if tsetdef(checkdef).elementdef.typ=enumdef then
  2286. checkdef:=java_juenumset
  2287. else
  2288. checkdef:=java_jubitset;
  2289. end
  2290. else if is_wide_or_unicode_string(checkdef) then
  2291. checkdef:=java_jlstring
  2292. else if is_ansistring(checkdef) then
  2293. checkdef:=java_ansistring
  2294. else if is_shortstring(checkdef) then
  2295. checkdef:=java_shortstring;
  2296. if checkdef.typ in [objectdef,recorddef] then
  2297. list.concat(taicpu.op_sym(checkop,current_asmdata.RefAsmSymbol(tabstractrecorddef(checkdef).jvm_full_typename(true),AT_METADATA)))
  2298. else if checkdef.typ=classrefdef then
  2299. list.concat(taicpu.op_sym(checkop,current_asmdata.RefAsmSymbol('java/lang/Class',AT_METADATA)))
  2300. { todo: WASM
  2301. else
  2302. list.concat(taicpu.op_sym(checkop,current_asmdata.RefAsmSymbol(jvmencodetype(checkdef,false),AT_METADATA)));
  2303. }
  2304. end;
  2305. procedure thlcgwasm.resizestackfpuval(list: TAsmList; fromsize, tosize: tcgsize);
  2306. begin
  2307. if (fromsize=OS_F32) and
  2308. (tosize=OS_F64) then
  2309. begin
  2310. list.concat(taicpu.op_none(a_f64_promote_f32));
  2311. incstack(list,1);
  2312. end
  2313. else if (fromsize=OS_F64) and
  2314. (tosize=OS_F32) then
  2315. begin
  2316. list.concat(taicpu.op_none(a_f32_demote_f64));
  2317. decstack(list,1);
  2318. end;
  2319. end;
  2320. procedure thlcgwasm.maybepreparedivu32(list: TAsmList; var op: topcg; size: tdef; out isdivu32: boolean);
  2321. begin
  2322. if (op=OP_DIV) and
  2323. (def_cgsize(size)=OS_32) then
  2324. begin
  2325. { needs zero-extension to 64 bit, because the JVM only supports
  2326. signed divisions }
  2327. resize_stack_int_val(list,u32inttype,s64inttype,false);
  2328. op:=OP_IDIV;
  2329. isdivu32:=true;
  2330. end
  2331. else
  2332. isdivu32:=false;
  2333. end;
  2334. procedure create_hlcodegen_cpu;
  2335. begin
  2336. hlcg:=thlcgwasm.create;
  2337. create_codegen;
  2338. end;
  2339. initialization
  2340. chlcgobj:=thlcgwasm;
  2341. create_hlcodegen:=@create_hlcodegen_cpu;
  2342. end.