hlcgcpu.pas 101 KB

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