hlcgcpu.pas 100 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556
  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. 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(blocks);
  253. end;
  254. procedure thlcgwasm.decblock;
  255. begin
  256. dec(blocks);
  257. if 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_callindirect(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 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+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+blocks))
  1274. end else begin
  1275. //Internalerror(2019091806); // unexpected jump
  1276. Internalerror(2019091806); // unexpected jump
  1277. end;
  1278. end;
  1279. procedure thlcgwasm.concatcopy_normal_array(list: TAsmList; size: tdef; const source, dest: treference);
  1280. var
  1281. procname: string;
  1282. eledef: tdef;
  1283. ndim: longint;
  1284. adddefaultlenparas: boolean;
  1285. tmpsource, tmpdest: treference;
  1286. begin
  1287. tmpsource:=source;
  1288. tmpdest:=dest;
  1289. { load copy helper parameters on the stack }
  1290. a_load_ref_stack(list,ptruinttype,source,prepare_stack_for_ref(list,tmpsource,false));
  1291. a_load_ref_stack(list,ptruinttype,dest,prepare_stack_for_ref(list,tmpdest,false));
  1292. { call copy helper }
  1293. eledef:=tarraydef(size).elementdef;
  1294. ndim:=1;
  1295. adddefaultlenparas:=true;
  1296. case eledef.typ of
  1297. orddef:
  1298. begin
  1299. case torddef(eledef).ordtype of
  1300. pasbool1,pasbool8,s8bit,u8bit,bool8bit,uchar,
  1301. s16bit,u16bit,bool16bit,pasbool16,
  1302. uwidechar,
  1303. s32bit,u32bit,bool32bit,pasbool32,
  1304. s64bit,u64bit,bool64bit,pasbool64,scurrency:
  1305. procname:='FPC_COPY_SHALLOW_ARRAY'
  1306. else
  1307. internalerror(2011020504);
  1308. end;
  1309. end;
  1310. arraydef:
  1311. begin
  1312. { call fpc_setlength_dynarr_multidim with deepcopy=true, and extra
  1313. parameters }
  1314. while (eledef.typ=arraydef) and
  1315. not is_dynamic_array(eledef) do
  1316. begin
  1317. eledef:=tarraydef(eledef).elementdef;
  1318. inc(ndim)
  1319. end;
  1320. if (ndim=1) then
  1321. procname:='FPC_COPY_SHALLOW_ARRAY'
  1322. else
  1323. begin
  1324. { deepcopy=true }
  1325. a_load_const_stack(list,pasbool1type,1,R_INTREGISTER);
  1326. { ndim }
  1327. a_load_const_stack(list,s32inttype,ndim,R_INTREGISTER);
  1328. { eletype }
  1329. { todo: WASM
  1330. a_load_const_stack(list,cwidechartype,ord(jvmarrtype_setlength(eledef)),R_INTREGISTER);
  1331. }
  1332. adddefaultlenparas:=false;
  1333. procname:='FPC_SETLENGTH_DYNARR_MULTIDIM';
  1334. end;
  1335. end;
  1336. recorddef:
  1337. procname:='FPC_COPY_JRECORD_ARRAY';
  1338. procvardef:
  1339. if tprocvardef(eledef).is_addressonly then
  1340. procname:='FPC_COPY_SHALLOW_ARRAY'
  1341. else
  1342. procname:='FPC_COPY_JPROCVAR_ARRAY';
  1343. setdef:
  1344. if tsetdef(eledef).elementdef.typ=enumdef then
  1345. procname:='FPC_COPY_JENUMSET_ARRAY'
  1346. else
  1347. procname:='FPC_COPY_JBITSET_ARRAY';
  1348. floatdef:
  1349. procname:='FPC_COPY_SHALLOW_ARRAY';
  1350. stringdef:
  1351. if is_shortstring(eledef) then
  1352. procname:='FPC_COPY_JSHORTSTRING_ARRAY'
  1353. else
  1354. procname:='FPC_COPY_SHALLOW_ARRAY';
  1355. variantdef:
  1356. begin
  1357. {$ifndef nounsupported}
  1358. procname:='FPC_COPY_SHALLOW_ARRAY';
  1359. {$else}
  1360. { todo: make a deep copy via clone... }
  1361. internalerror(2011020505);
  1362. {$endif}
  1363. end;
  1364. else
  1365. procname:='FPC_COPY_SHALLOW_ARRAY';
  1366. end;
  1367. if adddefaultlenparas then
  1368. begin
  1369. { -1, -1 means "copy entire array" }
  1370. a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
  1371. a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
  1372. end;
  1373. g_call_system_proc(list,procname,[],nil);
  1374. if ndim<>1 then
  1375. begin
  1376. { pop return value, must be the same as dest }
  1377. //list.concat(taicpu.op_none(a_pop));
  1378. Internalerror(2019083001); // no support for arrays
  1379. decstack(list,1);
  1380. end;
  1381. end;
  1382. procedure thlcgwasm.concatcopy_record(list: TAsmList; size: tdef; const source, dest: treference);
  1383. var
  1384. srsym: tsym;
  1385. pd: tprocdef;
  1386. tmpsource, tmpdest: treference;
  1387. begin
  1388. tmpsource:=source;
  1389. tmpdest:=dest;
  1390. { self }
  1391. a_load_ref_stack(list,size,tmpsource,prepare_stack_for_ref(list,tmpsource,false));
  1392. { result }
  1393. a_load_ref_stack(list,size,tmpdest,prepare_stack_for_ref(list,tmpdest,false));
  1394. { call fpcDeepCopy helper }
  1395. srsym:=search_struct_member(tabstractrecorddef(size),'FPCDEEPCOPY');
  1396. if not assigned(srsym) or
  1397. (srsym.typ<>procsym) then
  1398. Message1(cg_f_unknown_compilerproc,size.typename+'.fpcDeepCopy');
  1399. pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
  1400. a_call_name(list,pd,pd.mangledname,[],nil,false);
  1401. { both parameters are removed, no function result }
  1402. decstack(list,2);
  1403. end;
  1404. procedure thlcgwasm.concatcopy_set(list: TAsmList; size: tdef; const source, dest: treference);
  1405. var
  1406. tmpsource, tmpdest: treference;
  1407. begin
  1408. tmpsource:=source;
  1409. tmpdest:=dest;
  1410. a_load_ref_stack(list,size,tmpsource,prepare_stack_for_ref(list,tmpsource,false));
  1411. a_load_ref_stack(list,size,tmpdest,prepare_stack_for_ref(list,tmpdest,false));
  1412. { call set copy helper }
  1413. if tsetdef(size).elementdef.typ=enumdef then
  1414. g_call_system_proc(list,'fpc_enumset_copy',[],nil)
  1415. else
  1416. g_call_system_proc(list,'fpc_bitset_copy',[],nil);
  1417. end;
  1418. procedure thlcgwasm.concatcopy_shortstring(list: TAsmList; size: tdef; const source, dest: treference);
  1419. var
  1420. srsym: tsym;
  1421. pd: tprocdef;
  1422. tmpsource, tmpdest: treference;
  1423. begin
  1424. tmpsource:=source;
  1425. tmpdest:=dest;
  1426. { self }
  1427. a_load_ref_stack(list,size,tmpsource,prepare_stack_for_ref(list,tmpsource,false));
  1428. { result }
  1429. a_load_ref_stack(list,size,tmpdest,prepare_stack_for_ref(list,tmpdest,false));
  1430. { call fpcDeepCopy helper }
  1431. srsym:=search_struct_member(java_shortstring,'FPCDEEPCOPY');
  1432. if not assigned(srsym) or
  1433. (srsym.typ<>procsym) then
  1434. Message1(cg_f_unknown_compilerproc,'ShortstringClass.FpcDeepCopy');
  1435. pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
  1436. a_call_name(list,pd,pd.mangledname,[],nil,false);
  1437. { both parameters are removed, no function result }
  1438. decstack(list,2);
  1439. end;
  1440. procedure thlcgwasm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
  1441. var
  1442. handled: boolean;
  1443. begin
  1444. handled:=false;
  1445. case size.typ of
  1446. arraydef:
  1447. begin
  1448. if not is_dynamic_array(size) then
  1449. begin
  1450. concatcopy_normal_array(list,size,source,dest);
  1451. handled:=true;
  1452. end;
  1453. end;
  1454. recorddef:
  1455. begin
  1456. concatcopy_record(list,size,source,dest);
  1457. handled:=true;
  1458. end;
  1459. setdef:
  1460. begin
  1461. concatcopy_set(list,size,source,dest);
  1462. handled:=true;
  1463. end;
  1464. stringdef:
  1465. begin
  1466. if is_shortstring(size) then
  1467. begin
  1468. concatcopy_shortstring(list,size,source,dest);
  1469. handled:=true;
  1470. end;
  1471. end;
  1472. else
  1473. ;
  1474. end;
  1475. if not handled then
  1476. inherited;
  1477. end;
  1478. procedure thlcgwasm.g_copyshortstring(list: TAsmList; const source, dest: treference; strdef: tstringdef);
  1479. begin
  1480. concatcopy_shortstring(list,strdef,source,dest);
  1481. end;
  1482. procedure thlcgwasm.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference);
  1483. var
  1484. dstack_slots: longint;
  1485. tmpref1, tmpref2: treference;
  1486. begin
  1487. tmpref1:=ref1;
  1488. tmpref2:=ref2;
  1489. dstack_slots:=prepare_stack_for_ref(list,tmpref2,false);
  1490. a_load_ref_stack(list,fromsize,tmpref1,prepare_stack_for_ref(list,tmpref1,false));
  1491. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1492. a_load_stack_ref(list,tosize,tmpref2,dstack_slots);
  1493. end;
  1494. procedure thlcgwasm.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister);
  1495. var
  1496. tmpref: treference;
  1497. begin
  1498. tmpref:=ref;
  1499. a_load_ref_stack(list,fromsize,tmpref,prepare_stack_for_ref(list,tmpref,false));
  1500. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1501. a_load_stack_reg(list,tosize,reg);
  1502. end;
  1503. procedure thlcgwasm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference);
  1504. var
  1505. dstack_slots: longint;
  1506. tmpref: treference;
  1507. begin
  1508. tmpref:=ref;
  1509. dstack_slots:=prepare_stack_for_ref(list,tmpref,false);
  1510. a_load_reg_stack(list,fromsize,reg);
  1511. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1512. a_load_stack_ref(list,tosize,tmpref,dstack_slots);
  1513. end;
  1514. procedure thlcgwasm.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  1515. begin
  1516. a_load_reg_stack(list,fromsize,reg1);
  1517. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1518. a_load_stack_reg(list,tosize,reg2);
  1519. end;
  1520. procedure thlcgwasm.g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean);
  1521. var
  1522. pd: tcpuprocdef;
  1523. begin
  1524. pd:=tcpuprocdef(current_procinfo.procdef);
  1525. g_procdef(list,pd);
  1526. ttgwasm(tg).allocframepointer(list,pd.frame_pointer_ref);
  1527. ttgwasm(tg).allocbasepointer(list,pd.base_pointer_ref);
  1528. { the localsize is based on tg.lasttemp -> already in terms of stack
  1529. slots rather than bytes }
  1530. //list.concat(tai_directive.Create(asd_jlimit,'locals '+tostr(localsize)));
  1531. { we insert the unit initialisation code afterwards in the proginit code,
  1532. and it uses one stack slot }
  1533. //if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1534. //fmaxevalstackheight:=max(1,fmaxevalstackheight);
  1535. list.Concat(tai_local.create(wbt_i32,FRAME_POINTER_SYM)); //TWasmBasicType
  1536. list.Concat(tai_local.create(wbt_i32,BASE_POINTER_SYM)); //TWasmBasicType
  1537. list.Concat(taicpu.op_sym(a_get_global,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_LABEL)));
  1538. list.Concat(taicpu.op_ref(a_set_local,pd.base_pointer_ref));
  1539. if (localsize>0) then begin
  1540. list.Concat(taicpu.op_ref(a_get_local,pd.base_pointer_ref));
  1541. list.concat(taicpu.op_const(a_i32_const, localsize ));
  1542. list.concat(taicpu.op_none(a_i32_sub));
  1543. list.Concat(taicpu.op_ref(a_set_local,pd.frame_pointer_ref));
  1544. list.Concat(taicpu.op_ref(a_get_local,pd.frame_pointer_ref));
  1545. list.Concat(taicpu.op_sym(a_set_global,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_LABEL)));
  1546. end;
  1547. //list.concat(tai_directive.Create(asd_jlimit,'stack '+tostr(fmaxevalstackheight)));
  1548. end;
  1549. procedure thlcgwasm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
  1550. var
  1551. pd: tcpuprocdef;
  1552. begin
  1553. pd:=tcpuprocdef(current_procinfo.procdef);
  1554. list.Concat(taicpu.op_ref(a_get_local,pd.base_pointer_ref));
  1555. list.Concat(taicpu.op_sym(a_set_global,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_LABEL)));
  1556. list.concat(taicpu.op_none(a_return));
  1557. list.concat(taicpu.op_none(a_end_function));
  1558. end;
  1559. procedure thlcgwasm.gen_load_return_value(list: TAsmList);
  1560. begin
  1561. { constructors don't return anything in the jvm }
  1562. if current_procinfo.procdef.proctypeoption in [potype_constructor,potype_class_constructor] then
  1563. exit;
  1564. inherited gen_load_return_value(list);
  1565. end;
  1566. procedure thlcgwasm.record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList);
  1567. begin
  1568. { add something to the al_procedures list as well, because if all al_*
  1569. lists are empty, the assembler writer isn't called }
  1570. if not code.empty and
  1571. current_asmdata.asmlists[al_procedures].empty then
  1572. current_asmdata.asmlists[al_procedures].concat(tai_align.Create(4));
  1573. tcpuprocdef(pd).exprasmlist:=TAsmList.create;
  1574. new_section(tcpuprocdef(pd).exprasmlist,sec_code,lower(pd.mangledname),current_settings.alignment.procalign);
  1575. tcpuprocdef(pd).exprasmlist.concatlist(code);
  1576. if assigned(data) and
  1577. not data.empty then
  1578. internalerror(2010122801);
  1579. end;
  1580. procedure thlcgwasm.g_incrrefcount(list: TAsmList; t: tdef; const ref: treference);
  1581. begin
  1582. // do nothing
  1583. end;
  1584. procedure thlcgwasm.g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; const name: string);
  1585. var
  1586. normaldim: longint;
  1587. eleref, tmpref: treference;
  1588. begin
  1589. { only in case of initialisation, we have to set all elements to "empty" }
  1590. if name<>'fpc_initialize_array' then
  1591. exit;
  1592. { put array on the stack }
  1593. tmpref:=ref;
  1594. a_load_ref_stack(list,ptruinttype,tmpref,prepare_stack_for_ref(list,tmpref,false));
  1595. { in case it's an open array whose elements are regular arrays, put the
  1596. dimension of the regular arrays on the stack (otherwise pass 0) }
  1597. normaldim:=0;
  1598. while (t.typ=arraydef) and
  1599. not is_dynamic_array(t) do
  1600. begin
  1601. inc(normaldim);
  1602. t:=tarraydef(t).elementdef;
  1603. end;
  1604. a_load_const_stack(list,s32inttype,normaldim,R_INTREGISTER);
  1605. { highloc is invalid, the length is part of the array in Java }
  1606. if is_wide_or_unicode_string(t) then
  1607. g_call_system_proc(list,'fpc_initialize_array_unicodestring',[],nil)
  1608. else if is_ansistring(t) then
  1609. g_call_system_proc(list,'fpc_initialize_array_ansistring',[],nil)
  1610. else if is_dynamic_array(t) then
  1611. g_call_system_proc(list,'fpc_initialize_array_dynarr',[],nil)
  1612. else if is_record(t) or
  1613. (t.typ=setdef) then
  1614. begin
  1615. tg.gethltemp(list,t,t.size,tt_persistent,eleref);
  1616. a_load_ref_stack(list,t,eleref,prepare_stack_for_ref(list,eleref,false));
  1617. if is_record(t) then
  1618. g_call_system_proc(list,'fpc_initialize_array_record',[],nil)
  1619. else if tsetdef(t).elementdef.typ=enumdef then
  1620. g_call_system_proc(list,'fpc_initialize_array_enumset',[],nil)
  1621. else
  1622. g_call_system_proc(list,'fpc_initialize_array_bitset',[],nil);
  1623. tg.ungettemp(list,eleref);
  1624. end
  1625. else if (t.typ=enumdef) then
  1626. begin
  1627. if get_enum_init_val_ref(t,eleref) then
  1628. begin
  1629. a_load_ref_stack(list,ptruinttype,eleref,prepare_stack_for_ref(list,eleref,false));
  1630. g_call_system_proc(list,'fpc_initialize_array_object',[],nil);
  1631. end;
  1632. end
  1633. else
  1634. internalerror(2011031901);
  1635. end;
  1636. procedure thlcgwasm.g_initialize(list: TAsmList; t: tdef; const ref: treference);
  1637. var
  1638. dummyloc: tlocation;
  1639. sym: tsym;
  1640. pd: tprocdef;
  1641. tmpref: treference;
  1642. begin
  1643. if (t.typ=arraydef) and
  1644. not is_dynamic_array(t) then
  1645. begin
  1646. dummyloc.loc:=LOC_INVALID;
  1647. g_array_rtti_helper(list,tarraydef(t).elementdef,ref,dummyloc,'fpc_initialize_array')
  1648. end
  1649. else if is_record(t) then
  1650. begin
  1651. { call the fpcInitializeRec method }
  1652. sym:=tsym(trecorddef(t).symtable.find('FPCINITIALIZEREC'));
  1653. if assigned(sym) and
  1654. (sym.typ=procsym) then
  1655. begin
  1656. if tprocsym(sym).procdeflist.Count<>1 then
  1657. internalerror(2011071713);
  1658. pd:=tprocdef(tprocsym(sym).procdeflist[0]);
  1659. end
  1660. else
  1661. internalerror(2013113008);
  1662. tmpref:=ref;
  1663. a_load_ref_stack(list,ptruinttype,ref,prepare_stack_for_ref(list,tmpref,false));
  1664. a_call_name(list,pd,pd.mangledname,[],nil,false);
  1665. { parameter removed, no result }
  1666. decstack(list,1);
  1667. end
  1668. else
  1669. a_load_const_ref(list,t,0,ref);
  1670. end;
  1671. procedure thlcgwasm.g_finalize(list: TAsmList; t: tdef; const ref: treference);
  1672. begin
  1673. // do nothing
  1674. end;
  1675. procedure thlcgwasm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
  1676. begin
  1677. { not possible, need the original operands }
  1678. internalerror(2012102101);
  1679. end;
  1680. procedure thlcgwasm.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation);
  1681. var
  1682. hl : tasmlabel;
  1683. begin
  1684. if not(cs_check_overflow in current_settings.localswitches) then
  1685. exit;
  1686. current_asmdata.getjumplabel(hl);
  1687. a_cmp_const_loc_label(list,s32inttype,OC_EQ,0,ovloc,hl);
  1688. g_call_system_proc(list,'fpc_overflow',[],nil);
  1689. a_label(list,hl);
  1690. end;
  1691. procedure thlcgwasm.location_get_data_ref(list: TAsmList; def: tdef; const l: tlocation; var ref: treference; loadref: boolean; alignment: longint);
  1692. var
  1693. tmploc: tlocation;
  1694. begin
  1695. { This routine is a combination of a generalised a_loadaddr_ref_reg()
  1696. that also works for addresses in registers (in case loadref is false)
  1697. and of a_load_ref_reg (in case loadref is true). It is used for
  1698. a) getting the address of managed var/out parameters
  1699. b) getting to the actual data of value types that are passed by
  1700. reference by the compiler (and then get a local copy at the caller
  1701. side). Normally, depending on whether this reference is passed in a
  1702. register or reference, we either need a reference with that register
  1703. as base or load the address in that reference and use that as a new
  1704. base.
  1705. Since the JVM cannot take the address of anything, all
  1706. "pass-by-reference" value parameters (which are always aggregate types)
  1707. are already simply the implicit pointer to the data (since arrays,
  1708. records, etc are already internally implicit pointers). This means
  1709. that if "loadref" is true, we must simply return this implicit pointer.
  1710. If it is false, we are supposed the take the address of this implicit
  1711. pointer, which is not possible.
  1712. However, managed types are also implicit pointers in Pascal, so in that
  1713. case "taking the address" again consists of simply returning the
  1714. implicit pointer/current value (in case of a var/out parameter, this
  1715. value is stored inside an array).
  1716. }
  1717. if not loadref then
  1718. begin
  1719. if not is_managed_type(def) then
  1720. internalerror(2011020601);
  1721. tmploc:=l;
  1722. end
  1723. else
  1724. begin
  1725. if not wasmAlwayInMem(def) then
  1726. begin
  1727. { passed by reference in array of single element; l contains the
  1728. base address of the array }
  1729. location_reset_ref(tmploc,LOC_REFERENCE,OS_ADDR,4,ref.volatility);
  1730. cgutils.reference_reset_base(tmploc.reference,getaddressregister(list,ptruinttype),0,tmploc.reference.temppos,4,ref.volatility);
  1731. a_load_loc_reg(list,ptruinttype,ptruinttype,l,tmploc.reference.base);
  1732. end
  1733. else
  1734. tmploc:=l;
  1735. end;
  1736. case tmploc.loc of
  1737. LOC_REGISTER,
  1738. LOC_CREGISTER :
  1739. begin
  1740. { the implicit pointer is in a register and has to be in a
  1741. reference -> create a reference and put it there }
  1742. location_force_mem(list,tmploc,ptruinttype);
  1743. ref:=tmploc.reference;
  1744. end;
  1745. LOC_REFERENCE,
  1746. LOC_CREFERENCE :
  1747. begin
  1748. ref:=tmploc.reference;
  1749. end;
  1750. else
  1751. internalerror(2011020603);
  1752. end;
  1753. end;
  1754. procedure thlcgwasm.maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean);
  1755. begin
  1756. { don't do anything, all registers become stack locations anyway }
  1757. end;
  1758. procedure thlcgwasm.g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister);
  1759. var
  1760. localref: treference;
  1761. arrloc: tlocation;
  1762. stackslots: longint;
  1763. begin
  1764. { temporary reference for passing to concatcopy }
  1765. tg.gethltemp(list,ptruinttype,ptruinttype.size,tt_persistent,localref);
  1766. stackslots:=prepare_stack_for_ref(list,localref,false);
  1767. { create the local copy of the array (lenloc is invalid, get length
  1768. directly from the array) }
  1769. location_reset_ref(arrloc,LOC_REFERENCE,OS_ADDR,sizeof(pint),ref.volatility);
  1770. arrloc.reference:=ref;
  1771. g_getarraylen(list,arrloc);
  1772. g_newarray(list,arrdef,1);
  1773. a_load_stack_ref(list,ptruinttype,localref,stackslots);
  1774. { copy the source array to the destination }
  1775. g_concatcopy(list,arrdef,ref,localref);
  1776. { and put the array pointer in the register as expected by the caller }
  1777. a_load_ref_reg(list,ptruinttype,ptruinttype,localref,destreg);
  1778. end;
  1779. procedure thlcgwasm.g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation);
  1780. begin
  1781. // do nothing, long live garbage collection!
  1782. end;
  1783. procedure thlcgwasm.gen_initialize_code(list: TAsmList);
  1784. var
  1785. ref: treference;
  1786. begin
  1787. { create globals with wrapped types such as arrays/records }
  1788. case current_procinfo.procdef.proctypeoption of
  1789. potype_unitinit:
  1790. begin
  1791. cgutils.reference_reset_base(ref,NR_NO,0,ctempposinvalid,1,[]);
  1792. if assigned(current_module.globalsymtable) then
  1793. allocate_implicit_structs_for_st_with_base_ref(list,current_module.globalsymtable,ref,staticvarsym);
  1794. allocate_implicit_structs_for_st_with_base_ref(list,current_module.localsymtable,ref,staticvarsym);
  1795. end;
  1796. potype_class_constructor:
  1797. begin
  1798. { also initialise local variables, if any }
  1799. inherited;
  1800. { initialise class fields }
  1801. cgutils.reference_reset_base(ref,NR_NO,0,ctempposinvalid,1,[]);
  1802. allocate_implicit_structs_for_st_with_base_ref(list,tabstractrecorddef(current_procinfo.procdef.owner.defowner).symtable,ref,staticvarsym);
  1803. end
  1804. else
  1805. inherited
  1806. end;
  1807. end;
  1808. procedure thlcgwasm.gen_entry_code(list: TAsmList);
  1809. begin
  1810. list.concat(Tai_force_line.Create);
  1811. end;
  1812. procedure thlcgwasm.gen_exit_code(list: TAsmList);
  1813. begin
  1814. { nothing }
  1815. end;
  1816. procedure thlcgwasm.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister);
  1817. begin
  1818. internalerror(2012090201);
  1819. end;
  1820. procedure thlcgwasm.a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle: pmmshuffle);
  1821. begin
  1822. internalerror(2012090202);
  1823. end;
  1824. procedure thlcgwasm.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle);
  1825. begin
  1826. internalerror(2012060130);
  1827. end;
  1828. procedure thlcgwasm.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle);
  1829. begin
  1830. internalerror(2012060131);
  1831. end;
  1832. procedure thlcgwasm.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle);
  1833. begin
  1834. internalerror(2012060132);
  1835. end;
  1836. procedure thlcgwasm.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle);
  1837. begin
  1838. internalerror(2012060133);
  1839. end;
  1840. procedure thlcgwasm.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle);
  1841. begin
  1842. internalerror(2012060134);
  1843. end;
  1844. procedure thlcgwasm.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle);
  1845. begin
  1846. internalerror(2012060135);
  1847. end;
  1848. procedure thlcgwasm.g_stackpointer_alloc(list: TAsmList; size: longint);
  1849. begin
  1850. internalerror(2012090203);
  1851. end;
  1852. procedure thlcgwasm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  1853. begin
  1854. internalerror(2012090204);
  1855. end;
  1856. procedure thlcgwasm.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint);
  1857. begin
  1858. internalerror(2012090205);
  1859. end;
  1860. procedure thlcgwasm.g_local_unwind(list: TAsmList; l: TAsmLabel);
  1861. begin
  1862. internalerror(2012090206);
  1863. end;
  1864. procedure thlcgwasm.g_procdef(list: TAsmList; pd: tprocdef);
  1865. begin
  1866. list.Concat(tai_functype.create(pd.mangledname,tcpuprocdef(pd).create_functype));
  1867. end;
  1868. procedure thlcgwasm.a_load_stack_reg(list: TAsmList; size: tdef; reg: tregister);
  1869. var
  1870. opc: tasmop;
  1871. finishandval: tcgint;
  1872. begin
  1873. opc:=loadstoreopc(size,false,false,finishandval);
  1874. list.concat(taicpu.op_reg(opc,reg));
  1875. { avoid problems with getting the size of an open array etc }
  1876. if wasmAlwayInMem(size) then
  1877. size:=ptruinttype;
  1878. decstack(list,1);
  1879. end;
  1880. procedure thlcgwasm.a_load_stack_ref(list: TAsmList; size: tdef; const ref: treference; extra_slots: longint);
  1881. var
  1882. opc: tasmop;
  1883. finishandval: tcgint;
  1884. begin
  1885. { fake location that indicates the value has to remain on the stack }
  1886. if ref.base=NR_EVAL_STACK_BASE then
  1887. exit;
  1888. opc:=loadstoreopcref(size,false,ref,finishandval);
  1889. list.concat(taicpu.op_ref(opc,ref));
  1890. { avoid problems with getting the size of an open array etc }
  1891. if wasmAlwayInMem(size) then
  1892. size:=ptruinttype;
  1893. decstack(list,1+extra_slots);
  1894. end;
  1895. procedure thlcgwasm.a_load_reg_stack(list: TAsmList; size: tdef; reg: tregister);
  1896. var
  1897. opc: tasmop;
  1898. finishandval: tcgint;
  1899. begin
  1900. opc:=loadstoreopc(size,true,false,finishandval);
  1901. list.concat(taicpu.op_reg(opc,reg));
  1902. { avoid problems with getting the size of an open array etc }
  1903. if wasmAlwayInMem(size) then
  1904. size:=ptruinttype;
  1905. incstack(list,1);
  1906. if finishandval<>-1 then
  1907. a_op_const_stack(list,OP_AND,size,finishandval);
  1908. end;
  1909. procedure thlcgwasm.a_load_ref_stack(list: TAsmList; size: tdef; const ref: treference; extra_slots: longint);
  1910. var
  1911. opc: tasmop;
  1912. finishandval: tcgint;
  1913. begin
  1914. { fake location that indicates the value is already on the stack? }
  1915. if (ref.base=NR_EVAL_STACK_BASE) then
  1916. exit;
  1917. opc:=loadstoreopcref(size,true,ref,finishandval);
  1918. list.concat(taicpu.op_ref(opc,ref));
  1919. { avoid problems with getting the size of an open array etc }
  1920. if wasmAlwayInMem(size) then
  1921. size:=ptruinttype;
  1922. incstack(list,1-extra_slots);
  1923. if finishandval<>-1 then
  1924. a_op_const_stack(list,OP_AND,size,finishandval);
  1925. // there's no cast check in Wasm
  1926. //if ref.checkcast then
  1927. // gen_typecheck(list,a_checkcast,size);
  1928. end;
  1929. function thlcgwasm.loadstoreopcref(def: tdef; isload: boolean; const ref: treference; out finishandval: tcgint): tasmop;
  1930. const
  1931. {iisload} {issigned}
  1932. getputmem8 : array [boolean, boolean] of TAsmOp = ((a_i32_store8, a_i32_store8), (a_i32_load8_u, a_i32_load8_s));
  1933. getputmem16 : array [boolean, boolean] of TAsmOp = ((a_i32_store16, a_i32_store16), (a_i32_load16_u ,a_i32_load16_s));
  1934. getputmem32 : array [boolean, boolean] of TAsmOp = ((a_i32_store, a_i32_store), (a_i32_load, a_i32_load));
  1935. getputmem64 : array [boolean, boolean] of TAsmOp = ((a_i64_store, a_i64_store), (a_i64_load, a_i64_load));
  1936. getputmemf32 : array [boolean] of TAsmOp = (a_f32_store, a_f32_load);
  1937. getputmemf64 : array [boolean] of TAsmOp = (a_f64_store, a_f64_load);
  1938. begin
  1939. if (ref.base<>NR_LOCAL_STACK_POINTER_REG) or assigned(ref.symbol) then
  1940. begin
  1941. { -> either a global (static) field, or a regular field. If a regular
  1942. field, then ref.base contains the self pointer, otherwise
  1943. ref.base=NR_NO. In both cases, the symbol contains all other
  1944. information (combined field name and type descriptor) }
  1945. case def.size of
  1946. 1: result := getputmem8[isload, is_signed(def)];
  1947. 2: result := getputmem16[isload, is_signed(def)];
  1948. 4:
  1949. if is_single(def) then
  1950. result := getputmemf32[isload]
  1951. else
  1952. result := getputmem32[isload, is_signed(def)];
  1953. 8: if is_double(def) then
  1954. result := getputmemf64[isload]
  1955. else
  1956. result := getputmem64[isload, is_signed(def)];
  1957. else
  1958. Internalerror(2019091501);
  1959. end;
  1960. //result:=getputopc[isload,ref.base=NR_NO];
  1961. finishandval:=-1;
  1962. { erase sign extension for byte/smallint loads }
  1963. if (def2regtyp(def)=R_INTREGISTER) and
  1964. not is_signed(def) and
  1965. (def.typ=orddef) and
  1966. not is_widechar(def) then
  1967. case def.size of
  1968. 1: if (torddef(def).high>127) then
  1969. finishandval:=255;
  1970. 2: if (torddef(def).high>32767) then
  1971. finishandval:=65535;
  1972. end;
  1973. end
  1974. else
  1975. result:=loadstoreopc(def,isload,false,finishandval);
  1976. end;
  1977. function thlcgwasm.loadstoreopc(def: tdef; isload, isarray: boolean; out finishandval: tcgint): tasmop;
  1978. var
  1979. size: longint;
  1980. begin
  1981. finishandval:=-1;
  1982. if isload then result := a_get_local
  1983. else result := a_set_local;
  1984. {case def2regtyp(def) of
  1985. R_INTREGISTER:
  1986. begin
  1987. size:=def.size;
  1988. case size of
  1989. 1,2,3,4:
  1990. if isload then
  1991. result:=a_i32_load
  1992. else
  1993. result:=a_i32_store;
  1994. 8:
  1995. if isload then
  1996. result:=a_i64_load
  1997. else
  1998. result:=a_i64_store;
  1999. else
  2000. internalerror(2011032814);
  2001. end;
  2002. end;
  2003. R_ADDRESSREGISTER:
  2004. if isload then
  2005. result:=a_i32_load
  2006. else
  2007. result:=a_i32_store;
  2008. R_FPUREGISTER:
  2009. begin
  2010. case tfloatdef(def).floattype of
  2011. s32real:
  2012. if isload then
  2013. result:=a_f32_load
  2014. else
  2015. result:=a_f32_store;
  2016. s64real:
  2017. if isload then
  2018. result:=a_f32_load
  2019. else
  2020. result:=a_f32_store
  2021. else
  2022. internalerror(2010120504);
  2023. end
  2024. end
  2025. else
  2026. internalerror(2010120502);
  2027. end;}
  2028. end;
  2029. procedure thlcgwasm.resize_stack_int_val(list: TAsmList; fromsize, tosize: tdef; formemstore: boolean);
  2030. var
  2031. fromcgsize, tocgsize: tcgsize;
  2032. begin
  2033. { When storing to an array, field or global variable, make sure the
  2034. static type verification can determine that the stored value fits
  2035. within the boundaries of the declared type (to appease the Dalvik VM).
  2036. Local variables either get their type upgraded in the debug info,
  2037. or have no type information at all }
  2038. if formemstore and
  2039. (tosize.typ=orddef) then
  2040. if (torddef(tosize).ordtype in [u8bit,uchar]) then
  2041. tosize:=s8inttype
  2042. else if torddef(tosize).ordtype=u16bit then
  2043. tosize:=s16inttype;
  2044. fromcgsize:=def_cgsize(fromsize);
  2045. tocgsize:=def_cgsize(tosize);
  2046. if fromcgsize in [OS_S64,OS_64] then
  2047. begin
  2048. if not(tocgsize in [OS_S64,OS_64]) then
  2049. begin
  2050. { truncate }
  2051. list.concat(taicpu.op_none(a_i32_wrap_i64));
  2052. decstack(list,1);
  2053. end;
  2054. end
  2055. else if tocgsize in [OS_S64,OS_64] then
  2056. begin
  2057. { extend }
  2058. if tocgsize = OS_S64 then
  2059. list.concat(taicpu.op_none(a_i64_extend_s_i32))
  2060. else
  2061. list.concat(taicpu.op_none(a_i64_extend_u_i32));
  2062. incstack(list,1);
  2063. { if it was an unsigned 32 bit value, remove sign extension }
  2064. if fromcgsize=OS_32 then
  2065. a_op_const_stack(list,OP_AND,s64inttype,cardinal($ffffffff));
  2066. end;
  2067. { Conversions between 32 and 64 bit types have been completely handled
  2068. above. We still may have to truncate or sign extend in case the
  2069. destination type is smaller that the source type, or has a different
  2070. sign. In case the destination is a widechar and the source is not, we
  2071. also have to insert a conversion to widechar.
  2072. }
  2073. if (not(fromcgsize in [OS_S64,OS_64,OS_32,OS_S32]) or
  2074. not(tocgsize in [OS_S64,OS_64,OS_32,OS_S32])) and
  2075. ((tcgsize2size[fromcgsize]>tcgsize2size[tocgsize]) or
  2076. ((tcgsize2size[fromcgsize]=tcgsize2size[tocgsize]) and
  2077. (fromcgsize<>tocgsize)) or
  2078. { needs to mask out the sign in the top 16 bits }
  2079. ((fromcgsize=OS_S8) and
  2080. (tocgsize=OS_16)) or
  2081. ((tosize=cwidechartype) and
  2082. (fromsize<>cwidechartype))) then
  2083. case tocgsize of
  2084. OS_8:
  2085. //todo: conversion
  2086. //a_op_const_stack(list,OP_AND,s32inttype,255);
  2087. ;
  2088. OS_S8:
  2089. //todo: conversion
  2090. //list.concat(taicpu.op_none(a_i2b));
  2091. ;
  2092. OS_16:
  2093. //todo: conversion
  2094. //if (tosize.typ=orddef) and
  2095. // (torddef(tosize).ordtype=uwidechar) then
  2096. // list.concat(taicpu.op_none(a_i2c))
  2097. //else
  2098. // a_op_const_stack(list,OP_AND,s32inttype,65535);
  2099. ;
  2100. OS_S16:
  2101. //todo: conversion
  2102. //list.concat(taicpu.op_none(a_i2s));
  2103. ;
  2104. else
  2105. ;
  2106. end;
  2107. end;
  2108. procedure thlcgwasm.maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean);
  2109. var
  2110. convsize: tdef;
  2111. begin
  2112. if (retdef.typ=orddef) then
  2113. begin
  2114. if (torddef(retdef).ordtype in [u8bit,u16bit,uchar]) and
  2115. (torddef(retdef).high>=(1 shl (retdef.size*8-1))) then
  2116. begin
  2117. convsize:=nil;
  2118. if callside then
  2119. if torddef(retdef).ordtype in [u8bit,uchar] then
  2120. convsize:=s8inttype
  2121. else
  2122. convsize:=s16inttype
  2123. else if torddef(retdef).ordtype in [u8bit,uchar] then
  2124. convsize:=u8inttype
  2125. else
  2126. convsize:=u16inttype;
  2127. if assigned(convsize) then
  2128. resize_stack_int_val(list,s32inttype,convsize,false);
  2129. end;
  2130. end;
  2131. end;
  2132. procedure thlcgwasm.g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef; paraheight: longint; forceresdef: tdef);
  2133. var
  2134. totalremovesize: longint;
  2135. realresdef: tdef;
  2136. begin
  2137. if not assigned(forceresdef) then
  2138. realresdef:=pd.returndef
  2139. else
  2140. realresdef:=forceresdef;
  2141. { a constructor doesn't actually return a value in the jvm }
  2142. if (tabstractprocdef(pd).proctypeoption=potype_constructor) then
  2143. totalremovesize:=paraheight
  2144. else
  2145. { even a byte takes up a full stackslot -> align size to multiple of 4 }
  2146. totalremovesize:=paraheight-(align(realresdef.size,4) shr 2);
  2147. { remove parameters from internal evaluation stack counter (in case of
  2148. e.g. no parameters and a result, it can also increase) }
  2149. if totalremovesize>0 then
  2150. decstack(list,totalremovesize)
  2151. else if totalremovesize<0 then
  2152. incstack(list,-totalremovesize);
  2153. end;
  2154. procedure thlcgwasm.allocate_implicit_struct_with_base_ref(list: TAsmList; vs: tabstractvarsym; ref: treference);
  2155. var
  2156. tmpref: treference;
  2157. begin
  2158. ref.symbol:=current_asmdata.RefAsmSymbol(vs.mangledname,AT_DATA);
  2159. tg.gethltemp(list,vs.vardef,vs.vardef.size,tt_persistent,tmpref);
  2160. { only copy the reference, not the actual data }
  2161. a_load_ref_ref(list,ptruinttype,ptruinttype,tmpref,ref);
  2162. { remains live since there's still a reference to the created
  2163. entity }
  2164. tg.ungettemp(list,tmpref);
  2165. end;
  2166. procedure thlcgwasm.allocate_enum_with_base_ref(list: TAsmList; vs: tabstractvarsym; const initref: treference; destbaseref: treference);
  2167. begin
  2168. destbaseref.symbol:=current_asmdata.RefAsmSymbol(vs.mangledname,AT_DATA);
  2169. { only copy the reference, not the actual data }
  2170. a_load_ref_ref(list,ptruinttype,ptruinttype,initref,destbaseref);
  2171. end;
  2172. function thlcgwasm.get_enum_init_val_ref(def: tdef; out ref: treference): boolean;
  2173. var
  2174. sym: tstaticvarsym;
  2175. begin
  2176. result:=false;
  2177. sym:=tstaticvarsym(tcpuenumdef(tenumdef(def).getbasedef).classdef.symtable.Find('__FPC_ZERO_INITIALIZER'));
  2178. { no enum with ordinal value 0 -> exit }
  2179. if not assigned(sym) then
  2180. exit;
  2181. reference_reset_symbol(ref,current_asmdata.RefAsmSymbol(sym.mangledname,AT_DATA),0,4,[]);
  2182. result:=true;
  2183. end;
  2184. procedure thlcgwasm.allocate_implicit_structs_for_st_with_base_ref(list: TAsmList; st: tsymtable; const ref: treference; allocvartyp: tsymtyp);
  2185. var
  2186. vs: tabstractvarsym;
  2187. def: tdef;
  2188. i: longint;
  2189. initref: treference;
  2190. begin
  2191. for i:=0 to st.symlist.count-1 do
  2192. begin
  2193. if (tsym(st.symlist[i]).typ<>allocvartyp) then
  2194. continue;
  2195. vs:=tabstractvarsym(st.symlist[i]);
  2196. if sp_static in vs.symoptions then
  2197. continue;
  2198. { vo_is_external and vo_has_local_copy means a staticvarsym that is
  2199. alias for a constsym, whose sole purpose is for allocating and
  2200. intialising the constant }
  2201. if [vo_is_external,vo_has_local_copy]*vs.varoptions=[vo_is_external] then
  2202. continue;
  2203. { threadvar innitializations are handled at the node tree level }
  2204. if vo_is_thread_var in vs.varoptions then
  2205. begin
  2206. { nothing }
  2207. end
  2208. else if wasmAlwayInMem(vs.vardef) then
  2209. allocate_implicit_struct_with_base_ref(list,vs,ref)
  2210. { enums are class instances in Java, while they are ordinals in
  2211. Pascal. When they are initialized with enum(0), such as in
  2212. constructors or global variables, initialize them with the
  2213. enum instance for 0 if it exists (if not, it remains nil since
  2214. there is no valid enum value in it) }
  2215. else if (vs.vardef.typ=enumdef) and
  2216. ((vs.typ<>fieldvarsym) or
  2217. (tdef(vs.owner.defowner).typ<>objectdef) or
  2218. (ts_jvm_enum_field_init in current_settings.targetswitches)) and
  2219. get_enum_init_val_ref(vs.vardef,initref) then
  2220. allocate_enum_with_base_ref(list,vs,initref,ref);
  2221. end;
  2222. { process symtables of routines part of this symtable (for local typed
  2223. constants) }
  2224. if allocvartyp=staticvarsym then
  2225. begin
  2226. for i:=0 to st.deflist.count-1 do
  2227. begin
  2228. def:=tdef(st.deflist[i]);
  2229. { the unit symtable also contains the methods of classes defined
  2230. in that unit -> skip them when processing the unit itself.
  2231. Localst is not assigned for the main program code.
  2232. Localst can be the same as st in case of unit init code. }
  2233. if (def.typ<>procdef) or
  2234. (def.owner<>st) or
  2235. not assigned(tprocdef(def).localst) or
  2236. (tprocdef(def).localst=st) then
  2237. continue;
  2238. allocate_implicit_structs_for_st_with_base_ref(list,tprocdef(def).localst,ref,allocvartyp);
  2239. end;
  2240. end;
  2241. end;
  2242. procedure thlcgwasm.gen_initialize_fields_code(list: TAsmList);
  2243. var
  2244. sym: tsym;
  2245. selfpara: tparavarsym;
  2246. selfreg: tregister;
  2247. ref: treference;
  2248. obj: tabstractrecorddef;
  2249. i: longint;
  2250. needinit: boolean;
  2251. begin
  2252. obj:=tabstractrecorddef(current_procinfo.procdef.owner.defowner);
  2253. { check whether there are any fields that need initialisation }
  2254. needinit:=false;
  2255. for i:=0 to obj.symtable.symlist.count-1 do
  2256. begin
  2257. sym:=tsym(obj.symtable.symlist[i]);
  2258. if (sym.typ=fieldvarsym) and
  2259. not(sp_static in sym.symoptions) and
  2260. (wasmAlwayInMem(tfieldvarsym(sym).vardef) or
  2261. ((tfieldvarsym(sym).vardef.typ=enumdef) and
  2262. get_enum_init_val_ref(tfieldvarsym(sym).vardef,ref))) then
  2263. begin
  2264. needinit:=true;
  2265. break;
  2266. end;
  2267. end;
  2268. if not needinit then
  2269. exit;
  2270. selfpara:=tparavarsym(current_procinfo.procdef.parast.find('self'));
  2271. if not assigned(selfpara) then
  2272. internalerror(2011033001);
  2273. selfreg:=getaddressregister(list,selfpara.vardef);
  2274. a_load_loc_reg(list,obj,obj,selfpara.localloc,selfreg);
  2275. cgutils.reference_reset_base(ref,selfreg,0,ctempposinvalid,1,[]);
  2276. allocate_implicit_structs_for_st_with_base_ref(list,obj.symtable,ref,fieldvarsym);
  2277. end;
  2278. procedure thlcgwasm.gen_typecheck(list: TAsmList; checkop: tasmop; checkdef: tdef);
  2279. begin
  2280. { replace special types with their equivalent class type }
  2281. if (checkdef.typ=pointerdef) and
  2282. wasmAlwayInMem(tpointerdef(checkdef).pointeddef) then
  2283. checkdef:=tpointerdef(checkdef).pointeddef;
  2284. if (checkdef=voidpointertype) or
  2285. (checkdef.typ=formaldef) then
  2286. checkdef:=ptruinttype
  2287. else if checkdef.typ=enumdef then
  2288. checkdef:=tcpuenumdef(checkdef).classdef
  2289. else if checkdef.typ=setdef then
  2290. begin
  2291. if tsetdef(checkdef).elementdef.typ=enumdef then
  2292. checkdef:=java_juenumset
  2293. else
  2294. checkdef:=java_jubitset;
  2295. end
  2296. else if is_wide_or_unicode_string(checkdef) then
  2297. checkdef:=java_jlstring
  2298. else if is_ansistring(checkdef) then
  2299. checkdef:=java_ansistring
  2300. else if is_shortstring(checkdef) then
  2301. checkdef:=java_shortstring;
  2302. if checkdef.typ in [objectdef,recorddef] then
  2303. list.concat(taicpu.op_sym(checkop,current_asmdata.RefAsmSymbol(tabstractrecorddef(checkdef).jvm_full_typename(true),AT_METADATA)))
  2304. else if checkdef.typ=classrefdef then
  2305. list.concat(taicpu.op_sym(checkop,current_asmdata.RefAsmSymbol('java/lang/Class',AT_METADATA)))
  2306. { todo: WASM
  2307. else
  2308. list.concat(taicpu.op_sym(checkop,current_asmdata.RefAsmSymbol(jvmencodetype(checkdef,false),AT_METADATA)));
  2309. }
  2310. end;
  2311. procedure thlcgwasm.resizestackfpuval(list: TAsmList; fromsize, tosize: tcgsize);
  2312. begin
  2313. if (fromsize=OS_F32) and
  2314. (tosize=OS_F64) then
  2315. begin
  2316. list.concat(taicpu.op_none(a_f64_promote_f32));
  2317. incstack(list,1);
  2318. end
  2319. else if (fromsize=OS_F64) and
  2320. (tosize=OS_F32) then
  2321. begin
  2322. list.concat(taicpu.op_none(a_f32_demote_f64));
  2323. decstack(list,1);
  2324. end;
  2325. end;
  2326. procedure thlcgwasm.maybepreparedivu32(list: TAsmList; var op: topcg; size: tdef; out isdivu32: boolean);
  2327. begin
  2328. if (op=OP_DIV) and
  2329. (def_cgsize(size)=OS_32) then
  2330. begin
  2331. { needs zero-extension to 64 bit, because the JVM only supports
  2332. signed divisions }
  2333. resize_stack_int_val(list,u32inttype,s64inttype,false);
  2334. op:=OP_IDIV;
  2335. isdivu32:=true;
  2336. end
  2337. else
  2338. isdivu32:=false;
  2339. end;
  2340. procedure create_hlcodegen_cpu;
  2341. begin
  2342. hlcg:=thlcgwasm.create;
  2343. create_codegen;
  2344. end;
  2345. initialization
  2346. chlcgobj:=thlcgwasm;
  2347. create_hlcodegen:=@create_hlcodegen_cpu;
  2348. end.