hlcgcpu.pas 111 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763
  1. {
  2. Copyright (c) 1998-2010 by Florian Klaempfl and Jonas Maebe
  3. Member of the Free Pascal development team
  4. This unit implements the WebAssembly high level code generator
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit hlcgcpu;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. globtype,
  23. aasmbase,aasmdata,
  24. symbase,symconst,symtype,symdef,symsym,
  25. node,
  26. cpubase, hlcgobj, cgbase, cgutils, parabase, wasmdef;
  27. type
  28. { thlcgwasm }
  29. thlcgwasm = class(thlcgobj)
  30. private
  31. fevalstackheight,
  32. fmaxevalstackheight: longint;
  33. { checks whether the type needs special methodptr-like handling, when stored
  34. in a LOC_REGISTER location. This applies to the following types:
  35. - method pointers
  36. - 8-byte records
  37. - nested proc ptrs
  38. When stored in a LOC_REGISTER tlocation, these types use both register
  39. and registerhi with the following sizes:
  40. register - cgsize = int_cgsize(voidcodepointertype.size)
  41. registerhi - cgsize = int_cgsize(voidpointertype.size) or int_cgsize(parentfpvoidpointertype.size)
  42. (check d.size to determine which one of the two)
  43. }
  44. function is_methodptr_like_type(d:tdef): boolean;
  45. public
  46. fntypelookup : TWasmProcTypeLookup;
  47. constructor create;
  48. destructor Destroy; override;
  49. procedure incstack(list : TAsmList;slots: longint);
  50. procedure decstack(list : TAsmList;slots: longint);
  51. class function def2regtyp(def: tdef): tregistertype; override;
  52. function getintregister(list:TAsmList;size:tdef):Tregister;override;
  53. function getregisterfordef(list: TAsmList;size:tdef):Tregister;override;
  54. procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : tcgint;const cgpara : TCGPara);override;
  55. function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
  56. function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; override;
  57. { move instructions - a_load_FROM_TO }
  58. procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override;
  59. procedure a_load_const_ref(list : TAsmList;tosize : tdef;a : tcgint;const ref : treference);override;
  60. procedure a_load_reg_ref(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);override;
  61. procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tdef;reg1,reg2 : tregister);override;
  62. procedure a_load_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);override;
  63. procedure a_load_ref_ref(list : TAsmList;fromsize, tosize : tdef;const sref : treference;const dref : treference);override;
  64. procedure a_load_loc_ref(list : TAsmList;fromsize, tosize: tdef; const loc: tlocation; const ref : treference);override;
  65. procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
  66. procedure a_load_subsetref_regs_index(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg: tregister); override;
  67. procedure a_load_regconst_subsetref_intern(list : TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sref: tsubsetreference; slopt: tsubsetloadopt); override;
  68. { basic arithmetic operations }
  69. procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister); override;
  70. procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister); override;
  71. procedure a_op_const_ref(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; const ref: TReference); override;
  72. procedure a_op_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister); override;
  73. procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); override;
  74. procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); override;
  75. procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
  76. procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
  77. procedure a_cmp_const_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference; l: tasmlabel); override;
  78. procedure a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); override;
  79. procedure a_cmp_ref_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; l: tasmlabel); override;
  80. procedure a_cmp_reg_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; l: tasmlabel); override;
  81. procedure a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); override;
  82. procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
  83. procedure a_jmp_always_pascal_goto(list : TAsmList;l: tasmlabel); override;
  84. procedure a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference); override;
  85. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override;
  86. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); override;
  87. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); override;
  88. procedure g_unreachable(list: TAsmList); override;
  89. procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference); override;
  90. procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
  91. procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override;
  92. procedure g_rangecheck(list: TAsmList; const l:tlocation; fromdef,todef: tdef); override;
  93. procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
  94. procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override;
  95. procedure maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean); override;
  96. procedure gen_entry_code(list: TAsmList); override;
  97. procedure gen_exit_code(list: TAsmList); override;
  98. { unimplemented/unnecessary routines }
  99. procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister); override;
  100. procedure a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle: pmmshuffle); override;
  101. procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle); override;
  102. procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); override;
  103. procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); override;
  104. procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle); override;
  105. procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); override;
  106. procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle); override;
  107. procedure g_stackpointer_alloc(list: TAsmList; size: longint); override;
  108. procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); override;
  109. procedure g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint); override;
  110. procedure g_local_unwind(list: TAsmList; l: TAsmLabel); override;
  111. { Wasm-specific routines }
  112. procedure g_procdef(list:TAsmList;pd: tprocdef);
  113. procedure g_maybe_checkforexceptions(list:TasmList); override;
  114. procedure a_load_stack_reg(list : TAsmList;size: tdef;reg: tregister);
  115. { extra_slots are the slots that are used by the reference, and that
  116. will be removed by the store operation }
  117. procedure a_load_stack_ref(list : TAsmList;size: tdef;const ref: treference;extra_slots: longint);
  118. procedure a_load_reg_stack(list : TAsmList;size: tdef;reg: tregister);
  119. { extra_slots are the slots that are used by the reference, and that
  120. will be removed by the load operation }
  121. procedure a_load_ref_stack(list : TAsmList;size: tdef;const ref: treference;extra_slots: longint);
  122. procedure a_load_const_stack(list : TAsmList;size: tdef;a :tcgint; typ: TRegisterType);
  123. procedure a_load_subsetref_stack(list : TAsmList;size: tdef; const sref: tsubsetreference);
  124. procedure a_loadaddr_ref_stack(list : TAsmList;fromsize, tosize : tdef;const ref : treference);
  125. procedure a_load_stack_loc(list : TAsmList;size: tdef;const loc: tlocation);
  126. procedure a_load_loc_stack(list : TAsmList;size: tdef;const loc: tlocation);
  127. procedure a_loadfpu_const_stack(list : TAsmList;size: tdef;a :double);
  128. procedure a_op_stack(list : TAsmList;op: topcg; size: tdef);
  129. procedure a_op_const_stack(list : TAsmList;op: topcg; size: tdef;a : tcgint);
  130. procedure a_op_reg_stack(list : TAsmList;op: topcg; size: tdef;reg: tregister);
  131. procedure a_op_ref_stack(list : TAsmList;op: topcg; size: tdef;const ref: treference);
  132. procedure a_op_loc_stack(list : TAsmList;op: topcg; size: tdef;const loc: tlocation);
  133. procedure a_cmp_const_loc_stack(list: TAsmList; size: tdef;cmp_op: topcmp; a: tcgint; const loc: tlocation);
  134. procedure a_cmp_const_ref_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference);
  135. procedure a_cmp_const_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister);
  136. procedure a_cmp_ref_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister);
  137. procedure a_cmp_reg_ref_stack(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference);
  138. procedure a_cmp_reg_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister);
  139. procedure a_cmp_subsetreg_reg_stack(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister);
  140. procedure a_cmp_subsetref_reg_stack(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister);
  141. procedure a_cmp_loc_reg_stack(list : TAsmList;size : tdef;cmp_op : topcmp; const loc: tlocation; reg : tregister);
  142. procedure a_cmp_reg_loc_stack(list : TAsmList;size : tdef;cmp_op : topcmp; reg: tregister; const loc: tlocation);
  143. procedure a_cmp_ref_loc_stack(list: TAsmList; size: tdef;cmp_op: topcmp; const ref: treference; const loc: tlocation);
  144. procedure a_cmp_const_loc_br(list: TAsmList; size: tdef;cmp_op: topcmp; a: tcgint; const loc: tlocation; br: Integer);
  145. procedure a_cmp_const_ref_br(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference; br: Integer);
  146. procedure a_cmp_const_reg_br(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; br: Integer);
  147. procedure a_cmp_ref_reg_br(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; br: Integer);
  148. procedure a_cmp_reg_ref_br(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; br: Integer);
  149. procedure a_cmp_reg_reg_br(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; br: Integer);
  150. procedure a_cmp_subsetreg_reg_br(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister; br: Integer);
  151. procedure a_cmp_subsetref_reg_br(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister; br: Integer);
  152. procedure a_cmp_loc_reg_br(list : TAsmList;size : tdef;cmp_op : topcmp; const loc: tlocation; reg : tregister; br: Integer);
  153. procedure a_cmp_reg_loc_br(list : TAsmList;size : tdef;cmp_op : topcmp; reg: tregister; const loc: tlocation; br: Integer);
  154. procedure a_cmp_ref_loc_br(list: TAsmList; size: tdef;cmp_op: topcmp; const ref: treference; const loc: tlocation; br: Integer);
  155. procedure g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation); override;
  156. procedure a_cmp_stack_stack(list : TAsmlist; size: tdef; cmp_op: topcmp);
  157. { truncate/sign extend after performing operations on values < 32 bit
  158. that may have overflowed outside the range }
  159. procedure maybe_adjust_op_result(list: TAsmList; op: TOpCg; size: tdef);
  160. { performs sign/zero extension as required }
  161. procedure resize_stack_int_val(list: TAsmList;fromsize,tosize: tdef; formemstore: boolean);
  162. { 8/16 bit unsigned parameters and return values must be sign-extended on
  163. the producer side, because the JVM does not support unsigned variants;
  164. then they have to be zero-extended again on the consumer side }
  165. procedure maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean);
  166. { adjust the stack height after a call based on the specified number of
  167. slots used for parameters and the provided resultdef }
  168. procedure g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef);
  169. { because WebAssembly has no spec for any sort of debug info, and the
  170. only linker that we support (LLVM's wasm-ld) does not support creating
  171. map files in its stable version, and crashes when attempting to create
  172. a map file in its development version from git, we have no way to
  173. identify which procedure a crash occurred in. So, to identify the
  174. procedure, we call this procedure on proc entry, which generates a few
  175. useless loads of random numbers on the stack, that are immediately
  176. discarded, so they are essentially equivalent to a nop. This allows
  177. finding the procedure in the FPC output assembly, produced with -al by
  178. searching for these random numbers, as taken from the disassembly of the
  179. final binary. }
  180. procedure g_fingerprint(list: TAsmList);
  181. property maxevalstackheight: longint read fmaxevalstackheight;
  182. protected
  183. procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
  184. function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; override;
  185. public
  186. { in case of an array, the array base address and index have to be
  187. put on the evaluation stack before the stored value; similarly, for
  188. fields the self pointer has to be loaded first. Also checks whether
  189. the reference is valid. If dup is true, the necessary values are stored
  190. twice. Returns how many stack slots have been consumed, disregarding
  191. the "dup". }
  192. function prepare_stack_for_ref(list: TAsmList; var ref: treference; dup: boolean): longint;
  193. procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);override;
  194. protected
  195. { return the load/store opcode to load/store from/to ref; if the result
  196. has to be and'ed after a load to get the final value, that constant
  197. is returned in finishandval (otherwise that value is set to -1) }
  198. function loadstoreopcref(def: tdef; isload: boolean; const ref: treference; out finishandval: tcgint): tasmop;
  199. procedure resizestackfpuval(list: TAsmList; fromsize, tosize: tcgsize);
  200. end;
  201. implementation
  202. uses
  203. verbose,cutils,globals,fmodule,constexp,
  204. defutil,cpupi,
  205. aasmtai,aasmcpu,
  206. symtable,symcpu,
  207. procinfo,cpuinfo,cgobj,cgcpu,tgobj,tgcpu,paramgr;
  208. const
  209. TOpCG2IAsmOp : array[topcg] of TAsmOp=(
  210. A_None, {OP_NONE}
  211. A_None, {OP_MOVE, replaced operation with direct load }
  212. a_i32_add, {OP_ADD, simple addition }
  213. a_i32_and, {OP_AND, simple logical and }
  214. a_i32_div_u, {OP_DIV, simple unsigned division }
  215. a_i32_div_s, {OP_IDIV, simple signed division }
  216. a_i32_mul, {OP_IMUL, simple signed multiply }
  217. a_i32_mul, {OP_MUL, simple unsigned multiply }
  218. A_None, {OP_NEG, simple negate } // neg = xor + 1
  219. A_None, {OP_NOT, simple logical not } // not = xor - 1
  220. a_i32_or, {OP_OR, simple logical or }
  221. a_i32_shr_s, {OP_SAR, arithmetic shift-right }
  222. a_i32_shl, {OP_SHL, logical shift left }
  223. a_i32_shr_u, {OP_SHR, logical shift right }
  224. a_i32_sub, {OP_SUB, simple subtraction }
  225. a_i32_xor, {OP_XOR, simple exclusive or }
  226. a_i32_rotl, {OP_ROL, rotate left }
  227. a_i32_rotr {OP_ROR rotate right }
  228. );
  229. TOpCG2LAsmOp : array[topcg] of TAsmOp=(
  230. A_None, {OP_NONE}
  231. a_i64_load, {OP_MOVE, replaced operation with direct load }
  232. a_i64_add, {OP_ADD, simple addition }
  233. a_i64_and, {OP_AND, simple logical and }
  234. a_i64_div_u, {OP_DIV, simple unsigned division }
  235. a_i64_div_s, {OP_IDIV, simple signed division }
  236. a_i64_mul, {OP_IMUL, simple signed multiply }
  237. a_i64_mul, {OP_MUL, simple unsigned multiply }
  238. A_None, {OP_NEG, simple negate } // neg = xor + 1
  239. A_None, {OP_NOT, simple logical not } // not = xor - 1
  240. a_i64_or, {OP_OR, simple logical or }
  241. a_i64_shr_s, {OP_SAR, arithmetic shift-right }
  242. a_i64_shl, {OP_SHL, logical shift left }
  243. a_i64_shr_u, {OP_SHR, logical shift right }
  244. a_i64_sub, {OP_SUB, simple subtraction }
  245. a_i64_xor, {OP_XOR, simple exclusive or }
  246. a_i64_rotl, {OP_ROL, rotate left }
  247. a_i64_rotr {OP_ROR rotate right }
  248. );
  249. function thlcgwasm.is_methodptr_like_type(d:tdef): boolean;
  250. var
  251. is_8byterecord, is_methodptr, is_nestedprocptr: Boolean;
  252. begin
  253. is_8byterecord:=(d.typ=recorddef) and (d.size=8);
  254. is_methodptr:=(d.typ=procvardef)
  255. and (po_methodpointer in tprocvardef(d).procoptions)
  256. and not(po_addressonly in tprocvardef(d).procoptions);
  257. is_nestedprocptr:=(d.typ=procvardef)
  258. and is_nested_pd(tprocvardef(d))
  259. and not(po_addressonly in tprocvardef(d).procoptions);
  260. result:=is_8byterecord or is_methodptr or is_nestedprocptr;
  261. end;
  262. constructor thlcgwasm.create;
  263. begin
  264. fevalstackheight:=0;
  265. fmaxevalstackheight:=0;
  266. fntypelookup:=TWasmProcTypeLookup.Create;
  267. end;
  268. destructor thlcgwasm.Destroy;
  269. begin
  270. fntypelookup.Free;
  271. inherited Destroy;
  272. end;
  273. procedure thlcgwasm.incstack(list: TAsmList; slots: longint);
  274. begin
  275. if (fevalstackheight<0) and
  276. not(cs_no_regalloc in current_settings.globalswitches) then
  277. {$ifdef DEBUG_WASMSTACK}
  278. list.concat(tai_comment.Create(strpnew('!!! stack underflow')));
  279. {$else DEBUG_WASMSTACK}
  280. internalerror(2010120501);
  281. {$endif DEBUG_WASMSTACK}
  282. if slots=0 then
  283. exit;
  284. inc(fevalstackheight,slots);
  285. if (fevalstackheight>fmaxevalstackheight) then
  286. fmaxevalstackheight:=fevalstackheight;
  287. if cs_asm_regalloc in current_settings.globalswitches then
  288. list.concat(tai_comment.Create(strpnew(' allocated '+tostr(slots)+', stack height = '+tostr(fevalstackheight))));
  289. end;
  290. procedure thlcgwasm.decstack(list: TAsmList;slots: longint);
  291. begin
  292. if slots=0 then
  293. exit;
  294. dec(fevalstackheight,slots);
  295. if (fevalstackheight<0) and
  296. not(cs_no_regalloc in current_settings.globalswitches) then
  297. {$ifdef DEBUG_WASMSTACK}
  298. list.concat(tai_comment.Create(strpnew('!!! stack underflow')));
  299. {$else DEBUG_WASMSTACK}
  300. internalerror(2010120501);
  301. {$endif DEBUG_WASMSTACK}
  302. if cs_asm_regalloc in current_settings.globalswitches then
  303. list.concat(tai_comment.Create(strpnew(' freed '+tostr(slots)+', stack height = '+tostr(fevalstackheight))));
  304. end;
  305. class function thlcgwasm.def2regtyp(def: tdef): tregistertype;
  306. begin
  307. if is_wasm_externref(def) then
  308. result:=R_EXTERNREFREGISTER
  309. else if is_wasm_funcref(def) then
  310. result:=R_FUNCREFREGISTER
  311. else if (def.typ=recorddef) and (def.size in [4,8]) and (trecorddef(def).contains_float_field) then
  312. result:=R_FPUREGISTER
  313. else
  314. result:=inherited;
  315. end;
  316. function thlcgwasm.getintregister(list:TAsmList;size:tdef):Tregister;
  317. begin
  318. if is_wasm_reference_type(size) then
  319. internalerror(2023060702)
  320. else
  321. result:=inherited;
  322. end;
  323. function thlcgwasm.getregisterfordef(list: TAsmList;size:tdef):Tregister;
  324. begin
  325. case def2regtyp(size) of
  326. R_EXTERNREFREGISTER:
  327. result:=TCgWasm(cg).getexternrefregister(list);
  328. R_FUNCREFREGISTER:
  329. result:=TCgWasm(cg).getfuncrefregister(list);
  330. else
  331. result:=inherited;
  332. end;
  333. end;
  334. procedure thlcgwasm.a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; const cgpara: TCGPara);
  335. begin
  336. tosize:=get_para_push_size(tosize);
  337. if tosize=s8inttype then
  338. a:=shortint(a)
  339. else if tosize=s16inttype then
  340. a:=smallint(a);
  341. inherited a_load_const_cgpara(list, tosize, a, cgpara);
  342. end;
  343. function thlcgwasm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
  344. begin
  345. list.concat(taicpu.op_sym(a_call,current_asmdata.RefAsmSymbol(s,AT_FUNCTION)));
  346. result:=get_call_result_cgpara(pd,forceresdef);
  347. end;
  348. function thlcgwasm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
  349. begin
  350. a_load_reg_stack(list, ptrsinttype, reg);
  351. if pd.typ=procvardef then
  352. current_asmdata.CurrAsmList.Concat(taicpu.op_functype(a_call_indirect,tcpuprocvardef(pd).create_functype))
  353. else
  354. current_asmdata.CurrAsmList.Concat(taicpu.op_functype(a_call_indirect,tcpuprocdef(pd).create_functype));
  355. decstack(list,1);
  356. result:=hlcg.get_call_result_cgpara(pd, nil);
  357. end;
  358. procedure thlcgwasm.a_load_const_stack(list : TAsmList;size : tdef;a : tcgint; typ: TRegisterType);
  359. begin
  360. case typ of
  361. R_INTREGISTER,
  362. R_ADDRESSREGISTER:
  363. begin
  364. case def_cgsize(size) of
  365. OS_8,OS_16,OS_32,
  366. OS_S8,OS_S16,OS_S32:
  367. begin
  368. { convert cardinals to longints }
  369. list.concat(taicpu.op_const(a_i32_const, a));
  370. end;
  371. OS_64,OS_S64:
  372. begin
  373. list.concat(taicpu.op_const(a_i64_const, a));
  374. end;
  375. else
  376. internalerror(2010110702);
  377. end;
  378. end;
  379. R_EXTERNREFREGISTER:
  380. begin
  381. if a<>0 then
  382. internalerror(2023061101);
  383. list.Concat(taicpu.op_none(a_ref_null_externref));
  384. end;
  385. R_FUNCREFREGISTER:
  386. begin
  387. if a<>0 then
  388. internalerror(2023061102);
  389. list.Concat(taicpu.op_none(a_ref_null_funcref));
  390. end;
  391. else
  392. internalerror(2010110703);
  393. end;
  394. incstack(list,1);
  395. end;
  396. procedure thlcgwasm.a_loadaddr_ref_stack(list : TAsmList;fromsize, tosize : tdef;const ref : treference);
  397. var
  398. tmpref: treference;
  399. begin
  400. { you can't take the address of references, that are on the local stack }
  401. if (ref.base=NR_EVAL_STACK_BASE) or (ref.index=NR_EVAL_STACK_BASE) or
  402. (ref.base=NR_LOCAL_STACK_POINTER_REG) or (ref.index=NR_LOCAL_STACK_POINTER_REG) then
  403. internalerror(2021010101);
  404. tmpref:=ref;
  405. tmpref.base:=NR_NO;
  406. tmpref.index:=NR_NO;
  407. if tmpref.refaddr=addr_got_tls then
  408. begin
  409. tmpref.offset:=0;
  410. list.Concat(taicpu.op_ref(a_global_get, tmpref));
  411. incstack(list, 1);
  412. if ref.offset<>0 then
  413. begin
  414. list.Concat(taicpu.op_const(a_i32_const,ref.offset));
  415. incstack(list, 1);
  416. list.Concat(taicpu.op_none(a_i32_add));
  417. decstack(list, 1);
  418. end;
  419. end
  420. else
  421. begin
  422. list.Concat(taicpu.op_ref(a_i32_const, tmpref));
  423. incstack(list, 1);
  424. end;
  425. if ref.base<>NR_NO then
  426. begin
  427. list.Concat(taicpu.op_reg(a_local_get,ref.base));
  428. incstack(list, 1);
  429. list.Concat(taicpu.op_none(a_i32_add));
  430. decstack(list, 1);
  431. end;
  432. if ref.index<>NR_NO then
  433. begin
  434. list.Concat(taicpu.op_reg(a_local_get,ref.index));
  435. incstack(list, 1);
  436. if ref.scalefactor>1 then
  437. begin
  438. list.Concat(taicpu.op_const(a_i32_const,ref.scalefactor));
  439. incstack(list, 1);
  440. list.Concat(taicpu.op_none(a_i32_mul));
  441. decstack(list, 1);
  442. end;
  443. list.Concat(taicpu.op_none(a_i32_add));
  444. decstack(list, 1);
  445. end;
  446. end;
  447. procedure thlcgwasm.a_load_stack_loc(list: TAsmList; size: tdef; const loc: tlocation);
  448. var
  449. tmpref: treference;
  450. begin
  451. case loc.loc of
  452. LOC_REGISTER,LOC_CREGISTER,
  453. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  454. a_load_stack_reg(list,size,loc.register);
  455. LOC_REFERENCE:
  456. begin
  457. tmpref:=loc.reference;
  458. a_load_stack_ref(list,size,loc.reference,prepare_stack_for_ref(list,tmpref,false));
  459. end;
  460. else
  461. internalerror(2011020501);
  462. end;
  463. end;
  464. procedure thlcgwasm.a_load_loc_stack(list: TAsmList;size: tdef;const loc: tlocation);
  465. var
  466. tmpref: treference;
  467. extra_slots: LongInt;
  468. begin
  469. case loc.loc of
  470. LOC_REGISTER,LOC_CREGISTER,
  471. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  472. a_load_reg_stack(list,size,loc.register);
  473. LOC_REFERENCE,LOC_CREFERENCE:
  474. begin
  475. tmpref:=loc.reference;
  476. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  477. a_load_ref_stack(list,size,tmpref,extra_slots);
  478. end;
  479. LOC_CONSTANT:
  480. a_load_const_stack(list,size,loc.value,def2regtyp(size));
  481. LOC_SUBSETREF,LOC_CSUBSETREF:
  482. a_load_subsetref_stack(list,size,loc.sref);
  483. else
  484. internalerror(2011010401);
  485. end;
  486. end;
  487. procedure thlcgwasm.a_loadfpu_const_stack(list: TAsmList; size: tdef; a: double);
  488. begin
  489. case tfloatdef(size).floattype of
  490. s32real:
  491. begin
  492. list.concat(taicpu.op_single(a_f32_const, a));
  493. incstack(list,1);
  494. end;
  495. s64real:
  496. begin
  497. list.concat(taicpu.op_double(a_f64_const,a));
  498. incstack(list,1);
  499. end
  500. else
  501. internalerror(2011010501);
  502. end;
  503. end;
  504. procedure thlcgwasm.a_op_stack(list: TAsmList; op: topcg; size: tdef);
  505. begin
  506. case def_cgsize(size) of
  507. OS_8,OS_S8,
  508. OS_16,OS_S16,
  509. OS_32,OS_S32:
  510. begin
  511. { boolean not: =0? for boolean }
  512. if (op=OP_NOT) and is_pasbool(size) then
  513. list.concat(taicpu.op_none(a_i32_eqz))
  514. else if (op=OP_NOT) and is_cbool(size) then
  515. begin
  516. current_asmdata.CurrAsmList.Concat(taicpu.op_functype(a_if,TWasmFuncType.Create([],[wbt_i32])));
  517. decstack(current_asmdata.CurrAsmList,1);
  518. current_asmdata.CurrAsmList.Concat( taicpu.op_const(a_i32_const, 0) );
  519. incstack(current_asmdata.CurrAsmList,1);
  520. current_asmdata.CurrAsmList.Concat( taicpu.op_none(a_else) );
  521. decstack(current_asmdata.CurrAsmList,1);
  522. case def_cgsize(size) of
  523. OS_32,OS_S32:
  524. current_asmdata.CurrAsmList.Concat( taicpu.op_const(a_i32_const, -1) );
  525. OS_16,OS_S16:
  526. current_asmdata.CurrAsmList.Concat( taicpu.op_const(a_i32_const, 65535) );
  527. OS_8,OS_S8:
  528. current_asmdata.CurrAsmList.Concat( taicpu.op_const(a_i32_const, 255) );
  529. else
  530. internalerror(2021100102);
  531. end;
  532. incstack(current_asmdata.CurrAsmList,1);
  533. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
  534. end
  535. else
  536. begin
  537. if op=OP_NOT then
  538. begin
  539. { not = xor -1 for integer }
  540. a_load_const_stack(list,s32inttype,high(cardinal),R_INTREGISTER);
  541. op:=OP_XOR;
  542. end
  543. else if op=OP_NEG then
  544. begin
  545. { neg = *(-1) }
  546. a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
  547. op:=OP_MUL;
  548. end;
  549. if TOpCG2IAsmOp[op]=A_None then
  550. internalerror(2010120532);
  551. list.concat(taicpu.op_none(TOpCG2IAsmOp[op]));
  552. decstack(list,1);
  553. end;
  554. maybe_adjust_op_result(list,op,size);
  555. end;
  556. OS_64,OS_S64:
  557. begin
  558. { boolean not: =0? for boolean }
  559. if (op=OP_NOT) and is_pasbool(size) then
  560. begin
  561. list.concat(taicpu.op_none(a_i64_eqz));
  562. list.concat(taicpu.op_none(a_i64_extend_i32_u));
  563. end
  564. else if (op=OP_NOT) and is_cbool(size) then
  565. begin
  566. list.concat(taicpu.op_none(a_i64_eqz));
  567. current_asmdata.CurrAsmList.Concat(taicpu.op_functype(a_if,TWasmFuncType.Create([],[wbt_i64])));
  568. decstack(current_asmdata.CurrAsmList,1);
  569. current_asmdata.CurrAsmList.Concat( taicpu.op_const(a_i64_const, -1) );
  570. incstack(current_asmdata.CurrAsmList,1);
  571. current_asmdata.CurrAsmList.Concat( taicpu.op_none(a_else) );
  572. decstack(current_asmdata.CurrAsmList,1);
  573. current_asmdata.CurrAsmList.Concat( taicpu.op_const(a_i64_const, 0) );
  574. incstack(current_asmdata.CurrAsmList,1);
  575. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
  576. end
  577. else
  578. begin
  579. if op=OP_NOT then
  580. begin
  581. { not = xor -1 for integer }
  582. a_load_const_stack(list,s64inttype,-1,R_INTREGISTER);
  583. op:=OP_XOR;
  584. end
  585. else if op=OP_NEG then
  586. begin
  587. { neg = *(-1) }
  588. a_load_const_stack(list,s64inttype,-1,R_INTREGISTER);
  589. op:=OP_MUL;
  590. end;
  591. if TOpCG2LAsmOp[op]=A_None then
  592. internalerror(2010120533);
  593. list.concat(taicpu.op_none(TOpCG2LAsmOp[op]));
  594. decstack(list,1);
  595. end;
  596. end;
  597. else
  598. internalerror(2010120531);
  599. end;
  600. end;
  601. procedure thlcgwasm.a_op_const_stack(list: TAsmList;op: topcg;size: tdef;a: tcgint);
  602. begin
  603. case op of
  604. OP_NEG,OP_NOT:
  605. internalerror(2011010801);
  606. else
  607. a_load_const_stack(list,size,a,R_INTREGISTER);
  608. end;
  609. a_op_stack(list,op,size);
  610. end;
  611. procedure thlcgwasm.a_op_reg_stack(list: TAsmList; op: topcg; size: tdef; reg: tregister);
  612. begin
  613. a_load_reg_stack(list,size,reg);
  614. a_op_stack(list,op,size);
  615. end;
  616. procedure thlcgwasm.a_op_ref_stack(list: TAsmList; op: topcg; size: tdef; const ref: treference);
  617. var
  618. tmpref: treference;
  619. begin
  620. { ref must not be the stack top, because that may indicate an error
  621. (it means that we will perform an operation of the stack top onto
  622. itself, so that means the two values have been loaded manually prior
  623. to calling this routine, instead of letting this routine load one of
  624. them; if something like that is needed, call a_op_stack() directly) }
  625. if ref.base=NR_EVAL_STACK_BASE then
  626. internalerror(2010121102);
  627. tmpref:=ref;
  628. a_load_ref_stack(list,size,tmpref,prepare_stack_for_ref(list,tmpref,false));
  629. a_op_stack(list,op,size);
  630. end;
  631. procedure thlcgwasm.a_op_loc_stack(list: TAsmList; op: topcg; size: tdef; const loc: tlocation);
  632. begin
  633. case loc.loc of
  634. LOC_REGISTER,LOC_CREGISTER:
  635. a_op_reg_stack(list,op,size,loc.register);
  636. LOC_REFERENCE,LOC_CREFERENCE:
  637. a_op_ref_stack(list,op,size,loc.reference);
  638. LOC_CONSTANT:
  639. a_op_const_stack(list,op,size,loc.value);
  640. else
  641. internalerror(2011011415)
  642. end;
  643. end;
  644. procedure thlcgwasm.a_cmp_const_loc_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const loc: tlocation);
  645. var
  646. tmpreg: tregister;
  647. begin
  648. case loc.loc of
  649. LOC_REGISTER,LOC_CREGISTER:
  650. a_cmp_const_reg_stack(list,size,cmp_op,a,loc.register);
  651. LOC_REFERENCE,LOC_CREFERENCE:
  652. a_cmp_const_ref_stack(list,size,cmp_op,a,loc.reference);
  653. LOC_SUBSETREG, LOC_CSUBSETREG:
  654. begin
  655. tmpreg:=getintregister(list,size);
  656. a_load_subsetreg_reg(list,size,size,loc.sreg,tmpreg);
  657. a_cmp_const_reg_stack(list,size,cmp_op,a,tmpreg);
  658. end;
  659. LOC_SUBSETREF, LOC_CSUBSETREF:
  660. begin
  661. tmpreg:=getintregister(list,size);
  662. a_load_subsetref_reg(list,size,size,loc.sref,tmpreg);
  663. a_cmp_const_reg_stack(list,size,cmp_op,a,tmpreg);
  664. end;
  665. else
  666. internalerror(2010120430);
  667. end;
  668. end;
  669. procedure thlcgwasm.a_cmp_const_ref_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference);
  670. var
  671. tmpref: treference;
  672. regtyp: TRegisterType;
  673. begin
  674. tmpref:=ref;
  675. if tmpref.base<>NR_EVAL_STACK_BASE then
  676. a_load_ref_stack(list,size,tmpref,prepare_stack_for_ref(list,tmpref,false));
  677. regtyp:=def2regtyp(size);
  678. case regtyp of
  679. R_EXTERNREFREGISTER,
  680. R_FUNCREFREGISTER:
  681. begin
  682. if a<>0 then
  683. internalerror(2023061103);
  684. if not (cmp_op in [OC_EQ,OC_NE]) then
  685. internalerror(2023061104);
  686. list.Concat(taicpu.op_none(a_ref_is_null));
  687. if cmp_op=OC_NE then
  688. begin
  689. a_load_const_stack(list,s32inttype,0,R_INTREGISTER);
  690. a_cmp_stack_stack(list,s32inttype,OC_EQ);
  691. end;
  692. end;
  693. else
  694. begin
  695. a_load_const_stack(list,size,a,regtyp);
  696. a_cmp_stack_stack(list,size,cmp_op);
  697. end;
  698. end;
  699. end;
  700. procedure thlcgwasm.a_cmp_const_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister);
  701. var
  702. regtyp: TRegisterType;
  703. begin
  704. a_load_reg_stack(list,size,reg);
  705. regtyp:=def2regtyp(size);
  706. case regtyp of
  707. R_EXTERNREFREGISTER,
  708. R_FUNCREFREGISTER:
  709. begin
  710. if a<>0 then
  711. internalerror(2023061105);
  712. if not (cmp_op in [OC_EQ,OC_NE]) then
  713. internalerror(2023061106);
  714. list.Concat(taicpu.op_none(a_ref_is_null));
  715. if cmp_op=OC_NE then
  716. begin
  717. a_load_const_stack(list,s32inttype,0,R_INTREGISTER);
  718. a_cmp_stack_stack(list,s32inttype,OC_EQ);
  719. end;
  720. end;
  721. else
  722. begin
  723. a_load_const_stack(list,size,a,regtyp);
  724. a_cmp_stack_stack(list,size,cmp_op);
  725. end;
  726. end;
  727. end;
  728. procedure thlcgwasm.a_cmp_ref_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister);
  729. var
  730. tmpref: treference;
  731. begin
  732. tmpref:=ref;
  733. a_load_reg_stack(list,size,reg);
  734. if tmpref.base<>NR_EVAL_STACK_BASE then
  735. a_load_ref_stack(list,size,tmpref,prepare_stack_for_ref(list,tmpref,false))
  736. else
  737. cmp_op:=swap_opcmp(cmp_op);
  738. a_cmp_stack_stack(list,size,cmp_op);
  739. end;
  740. procedure thlcgwasm.a_cmp_reg_ref_stack(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference);
  741. var
  742. tmpref: treference;
  743. begin
  744. tmpref:=ref;
  745. if tmpref.base<>NR_EVAL_STACK_BASE then
  746. a_load_ref_stack(list,size,ref,prepare_stack_for_ref(list,tmpref,false));
  747. a_load_reg_stack(list,size,reg);
  748. a_cmp_stack_stack(list,size,cmp_op);
  749. end;
  750. procedure thlcgwasm.a_cmp_reg_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister);
  751. begin
  752. a_load_reg_stack(list,size,reg2);
  753. a_load_reg_stack(list,size,reg1);
  754. a_cmp_stack_stack(list,size,cmp_op);
  755. end;
  756. procedure thlcgwasm.a_cmp_subsetreg_reg_stack(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister);
  757. var
  758. tmpreg: tregister;
  759. begin
  760. tmpreg:=getintregister(list,cmpsize);
  761. a_load_subsetreg_reg(list,fromsubsetsize,cmpsize,sreg,tmpreg);
  762. a_cmp_reg_reg_stack(list,cmpsize,cmp_op,tmpreg,reg);
  763. end;
  764. procedure thlcgwasm.a_cmp_subsetref_reg_stack(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister);
  765. var
  766. tmpreg: tregister;
  767. begin
  768. tmpreg:=getintregister(list,cmpsize);
  769. a_load_subsetref_reg(list,fromsubsetsize,cmpsize,sref,tmpreg);
  770. a_cmp_reg_reg_stack(list,cmpsize,cmp_op,tmpreg,reg);
  771. end;
  772. procedure thlcgwasm.a_cmp_loc_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; const loc: tlocation; reg: tregister);
  773. begin
  774. case loc.loc of
  775. LOC_REGISTER,
  776. LOC_CREGISTER:
  777. a_cmp_reg_reg_stack(list,size,cmp_op,loc.register,reg);
  778. LOC_REFERENCE,
  779. LOC_CREFERENCE :
  780. a_cmp_ref_reg_stack(list,size,cmp_op,loc.reference,reg);
  781. LOC_CONSTANT:
  782. a_cmp_const_reg_stack(list,size,cmp_op,loc.value,reg);
  783. LOC_SUBSETREG,
  784. LOC_CSUBSETREG:
  785. a_cmp_subsetreg_reg_stack(list,size,size,cmp_op,loc.sreg,reg);
  786. LOC_SUBSETREF,
  787. LOC_CSUBSETREF:
  788. a_cmp_subsetref_reg_stack(list,size,size,cmp_op,loc.sref,reg);
  789. else
  790. internalerror(2010120431);
  791. end;
  792. end;
  793. procedure thlcgwasm.a_cmp_reg_loc_stack(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const loc: tlocation);
  794. begin
  795. a_cmp_loc_reg_stack(list,size,swap_opcmp(cmp_op),loc,reg);
  796. end;
  797. procedure thlcgwasm.a_cmp_ref_loc_stack(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; const loc: tlocation);
  798. var
  799. tmpreg: tregister;
  800. begin
  801. case loc.loc of
  802. LOC_REGISTER,LOC_CREGISTER:
  803. a_cmp_ref_reg_stack(list,size,cmp_op,ref,loc.register);
  804. LOC_REFERENCE,LOC_CREFERENCE:
  805. begin
  806. tmpreg:=getintregister(list,size);
  807. a_load_ref_reg(list,size,size,loc.reference,tmpreg);
  808. a_cmp_ref_reg_stack(list,size,cmp_op,ref,tmpreg);
  809. end;
  810. LOC_CONSTANT:
  811. begin
  812. a_cmp_const_ref_stack(list,size,swap_opcmp(cmp_op),loc.value,ref);
  813. end;
  814. LOC_SUBSETREG, LOC_CSUBSETREG:
  815. begin
  816. tmpreg:=getintregister(list,size);
  817. a_load_ref_reg(list,size,size,loc.reference,tmpreg);
  818. a_cmp_subsetreg_reg_stack(list,size,size,swap_opcmp(cmp_op),loc.sreg,tmpreg);
  819. end;
  820. LOC_SUBSETREF, LOC_CSUBSETREF:
  821. begin
  822. tmpreg:=getintregister(list,size);
  823. a_load_ref_reg(list,size,size,loc.reference,tmpreg);
  824. a_cmp_subsetref_reg_stack(list,size,size,swap_opcmp(cmp_op),loc.sref,tmpreg);
  825. end;
  826. else
  827. internalerror(2010120432);
  828. end;
  829. end;
  830. procedure thlcgwasm.a_cmp_const_loc_br(list: TAsmList; size: tdef;cmp_op: topcmp; a: tcgint; const loc: tlocation; br: Integer);
  831. begin
  832. a_cmp_const_loc_stack(list,size,cmp_op,a,loc);
  833. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  834. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  835. end;
  836. procedure thlcgwasm.a_cmp_const_ref_br(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference; br: Integer);
  837. begin
  838. a_cmp_const_ref_stack(list,size,cmp_op,a,ref);
  839. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  840. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  841. end;
  842. procedure thlcgwasm.a_cmp_const_reg_br(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; br: Integer);
  843. begin
  844. a_cmp_const_reg_stack(list,size,cmp_op,a,reg);
  845. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  846. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  847. end;
  848. procedure thlcgwasm.a_cmp_ref_reg_br(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; br: Integer);
  849. begin
  850. a_cmp_ref_reg_stack(list,size,cmp_op,ref,reg);
  851. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  852. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  853. end;
  854. procedure thlcgwasm.a_cmp_reg_ref_br(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; br: Integer);
  855. begin
  856. a_cmp_reg_ref_stack(list,size,cmp_op,reg,ref);
  857. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  858. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  859. end;
  860. procedure thlcgwasm.a_cmp_reg_reg_br(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; br: Integer);
  861. begin
  862. a_cmp_reg_reg_stack(list,size,cmp_op,reg1,reg2);
  863. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  864. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  865. end;
  866. procedure thlcgwasm.a_cmp_subsetreg_reg_br(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister; br: Integer);
  867. begin
  868. a_cmp_subsetreg_reg_stack(list,fromsubsetsize,cmpsize,cmp_op,sreg,reg);
  869. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  870. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  871. end;
  872. procedure thlcgwasm.a_cmp_subsetref_reg_br(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister; br: Integer);
  873. begin
  874. a_cmp_subsetref_reg_stack(list,fromsubsetsize,cmpsize,cmp_op,sref,reg);
  875. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  876. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  877. end;
  878. procedure thlcgwasm.a_cmp_loc_reg_br(list : TAsmList;size : tdef;cmp_op : topcmp; const loc: tlocation; reg : tregister; br: Integer);
  879. begin
  880. a_cmp_loc_reg_stack(list,size,cmp_op,loc,reg);
  881. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  882. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  883. end;
  884. procedure thlcgwasm.a_cmp_reg_loc_br(list : TAsmList;size : tdef;cmp_op : topcmp; reg: tregister; const loc: tlocation; br: Integer);
  885. begin
  886. a_cmp_reg_loc_stack(list,size,cmp_op,reg,loc);
  887. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  888. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  889. end;
  890. procedure thlcgwasm.a_cmp_ref_loc_br(list: TAsmList; size: tdef;cmp_op: topcmp; const ref: treference; const loc: tlocation; br: Integer);
  891. begin
  892. a_cmp_ref_loc_stack(list,size,cmp_op,ref,loc);
  893. current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br_if,br));
  894. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  895. end;
  896. procedure thlcgwasm.g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation);
  897. begin
  898. case fromloc.loc of
  899. LOC_CREFERENCE,
  900. LOC_REFERENCE:
  901. begin
  902. toloc:=fromloc;
  903. if (fromloc.reference.base<>NR_NO) and
  904. (fromloc.reference.base<>current_procinfo.framepointer) and
  905. (fromloc.reference.base<>NR_STACK_POINTER_REG) then
  906. g_allocload_reg_reg(list,voidpointertype,fromloc.reference.base,toloc.reference.base,R_ADDRESSREGISTER);
  907. end;
  908. else
  909. inherited;
  910. end;
  911. end;
  912. procedure thlcgwasm.a_cmp_stack_stack(list: TAsmlist; size: tdef; cmp_op: topcmp);
  913. const
  914. opcmp32: array[topcmp] of tasmop = (
  915. A_None, { OC_NONE, }
  916. a_i32_eq, { OC_EQ, equality comparison }
  917. a_i32_gt_s, { OC_GT, greater than (signed) }
  918. a_i32_lt_s, { OC_LT, less than (signed) }
  919. a_i32_ge_s, { OC_GTE, greater or equal than (signed) }
  920. a_i32_le_s, { OC_LTE, less or equal than (signed) }
  921. a_i32_ne, { OC_NE, not equal }
  922. a_i32_le_u, { OC_BE, less or equal than (unsigned) }
  923. a_i32_lt_u, { OC_B, less than (unsigned) }
  924. a_i32_ge_u, { OC_AE, greater or equal than (unsigned) }
  925. a_i32_gt_u { OC_A greater than (unsigned) }
  926. );
  927. const
  928. opcmp64: array[TOpCmp] of TAsmOp = (A_None,
  929. a_i64_eq, // OC_EQ
  930. a_i64_gt_s, a_i64_lt_s, // OC_GT, OC_LT
  931. a_i64_ge_s, a_i64_le_s, // OC_GTE, OC_LTE
  932. a_i64_ne, // OC_NE
  933. a_i64_le_u, a_i64_lt_u, // OC_BE, OC_B
  934. a_i64_ge_u, a_i64_gt_u // OC_AE, OC_A
  935. );
  936. var
  937. cgsize: tcgsize;
  938. begin
  939. case def2regtyp(size) of
  940. R_INTREGISTER,
  941. R_ADDRESSREGISTER:
  942. begin
  943. cgsize:=def_cgsize(size);
  944. case cgsize of
  945. OS_S8,OS_8,
  946. OS_16,OS_S16,
  947. OS_S32,OS_32:
  948. begin
  949. list.concat(taicpu.op_none(opcmp32[cmp_op]));
  950. decstack(list,1);
  951. end;
  952. OS_64,OS_S64:
  953. begin
  954. list.concat(taicpu.op_none(opcmp64[cmp_op]));
  955. decstack(list,1);
  956. end;
  957. else
  958. internalerror(2010120538);
  959. end;
  960. end;
  961. else
  962. internalerror(2010120538);
  963. end;
  964. end;
  965. procedure thlcgwasm.maybe_adjust_op_result(list: TAsmList; op: TOpCg; size: tdef);
  966. const
  967. overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG];
  968. begin
  969. if (op in overflowops) and
  970. (def_cgsize(size) in [OS_8,OS_S8,OS_16,OS_S16]) then
  971. resize_stack_int_val(list,s32inttype,size,false);
  972. end;
  973. procedure thlcgwasm.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
  974. begin
  975. { nothing to do for ret_in_param results }
  976. if paramanager.ret_in_param(pd.returndef,pd) then
  977. exit;
  978. { constructors don't return anything in Java }
  979. if pd.proctypeoption=potype_constructor then
  980. exit;
  981. { must return a value of the correct type on the evaluation stack }
  982. case def2regtyp(resdef) of
  983. R_INTREGISTER,
  984. R_ADDRESSREGISTER:
  985. a_load_const_cgpara(list,resdef,0,resloc);
  986. R_FPUREGISTER:
  987. case tfloatdef(resdef).floattype of
  988. s32real:
  989. begin
  990. list.concat(taicpu.op_single(a_f32_const, 0));
  991. incstack(list,1);
  992. end;
  993. s64real:
  994. begin
  995. list.concat(taicpu.op_double(a_f64_const, 0));
  996. incstack(list,1);
  997. end;
  998. else
  999. internalerror(2011010302);
  1000. end;
  1001. R_FUNCREFREGISTER:
  1002. begin
  1003. list.concat(taicpu.op_none(a_ref_null_funcref));
  1004. incstack(list,1);
  1005. end;
  1006. R_EXTERNREFREGISTER:
  1007. begin
  1008. list.concat(taicpu.op_none(a_ref_null_externref));
  1009. incstack(list,1);
  1010. end;
  1011. else
  1012. internalerror(2011010301);
  1013. end;
  1014. end;
  1015. function thlcgwasm.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
  1016. begin
  1017. result:=inherited;
  1018. pd.init_paraloc_info(callerside);
  1019. g_adjust_stack_after_call(list,pd);
  1020. end;
  1021. function thlcgwasm.prepare_stack_for_ref(list: TAsmList; var ref: treference; dup: boolean): longint;
  1022. var
  1023. tmpref: treference;
  1024. begin
  1025. result:=0;
  1026. { fake location that indicates the value is already on the stack? }
  1027. if (ref.base=NR_EVAL_STACK_BASE) or (ref.base=NR_LOCAL_STACK_POINTER_REG) then
  1028. exit;
  1029. if (ref.base=NR_NO) and (ref.index<>NR_NO) and (ref.scalefactor<=1) then
  1030. begin
  1031. ref.base:=ref.index;
  1032. ref.index:=NR_NO;
  1033. end;
  1034. if assigned(ref.symbol) and (ref.symbol.typ=AT_WASM_GLOBAL) then
  1035. begin
  1036. if ref.base<>NR_NO then
  1037. internalerror(2022072601);
  1038. if ref.index<>NR_NO then
  1039. internalerror(2022072602);
  1040. if ref.offset<>0 then
  1041. internalerror(2022072603);
  1042. end
  1043. else if ref.refaddr=addr_got_tls then
  1044. begin
  1045. if not assigned(ref.symbol) then
  1046. internalerror(2022071405);
  1047. if ref.base<>NR_NO then
  1048. internalerror(2022071406);
  1049. if ref.index<>NR_NO then
  1050. internalerror(2022071407);
  1051. tmpref:=ref;
  1052. tmpref.offset:=0;
  1053. list.Concat(taicpu.op_ref(a_global_get,tmpref));
  1054. incstack(list,1);
  1055. if dup then
  1056. begin
  1057. list.Concat(taicpu.op_ref(a_global_get,tmpref));
  1058. incstack(list,1);
  1059. end;
  1060. result:=1;
  1061. end
  1062. else if assigned(ref.symbol) and (ref.base=NR_NO) and (ref.index=NR_NO) then
  1063. begin
  1064. list.Concat(taicpu.op_const(a_i32_const,ref.offset));
  1065. incstack(list,1);
  1066. if dup then
  1067. begin
  1068. list.Concat(taicpu.op_const(a_i32_const,ref.offset));
  1069. incstack(list,1);
  1070. end;
  1071. ref.offset:=0;
  1072. result:=1;
  1073. end
  1074. else if ref.index <> NR_NO then // array access
  1075. begin
  1076. // it's just faster to sum two of those together
  1077. list.Concat(taicpu.op_reg(a_local_get, ref.base));
  1078. incstack(list,1);
  1079. list.Concat(taicpu.op_reg(a_local_get, ref.index));
  1080. incstack(list,1);
  1081. list.Concat(taicpu.op_none(a_i32_add));
  1082. decstack(list,1);
  1083. if assigned(ref.symbol) then
  1084. begin
  1085. list.Concat(taicpu.op_sym(a_i32_const,ref.symbol));
  1086. incstack(list,1);
  1087. list.Concat(taicpu.op_none(a_i32_add));
  1088. decstack(list,1);
  1089. end;
  1090. if ref.offset<0 then
  1091. begin
  1092. list.Concat(taicpu.op_const(a_i32_const,-ref.offset));
  1093. incstack(list,1);
  1094. list.Concat(taicpu.op_none(a_i32_sub));
  1095. decstack(list,1);
  1096. end
  1097. else if ref.offset>0 then
  1098. begin
  1099. list.Concat(taicpu.op_const(a_i32_const,ref.offset));
  1100. incstack(list,1);
  1101. list.Concat(taicpu.op_none(a_i32_add));
  1102. decstack(list,1);
  1103. end;
  1104. if dup then
  1105. begin
  1106. list.Concat(taicpu.op_reg(a_local_get, ref.base));
  1107. incstack(list,1);
  1108. list.Concat(taicpu.op_reg(a_local_get, ref.index));
  1109. incstack(list,1);
  1110. list.Concat(taicpu.op_none(a_i32_add));
  1111. decstack(list,1);
  1112. if assigned(ref.symbol) then
  1113. begin
  1114. list.Concat(taicpu.op_sym(a_i32_const,ref.symbol));
  1115. incstack(list,1);
  1116. list.Concat(taicpu.op_none(a_i32_add));
  1117. decstack(list,1);
  1118. end;
  1119. if ref.offset<0 then
  1120. begin
  1121. list.Concat(taicpu.op_const(a_i32_const,-ref.offset));
  1122. incstack(list,1);
  1123. list.Concat(taicpu.op_none(a_i32_sub));
  1124. decstack(list,1);
  1125. end
  1126. else if ref.offset>0 then
  1127. begin
  1128. list.Concat(taicpu.op_const(a_i32_const,ref.offset));
  1129. incstack(list,1);
  1130. list.Concat(taicpu.op_none(a_i32_add));
  1131. decstack(list,1);
  1132. end;
  1133. end;
  1134. ref.base:=NR_NO;
  1135. ref.index:=NR_NO;
  1136. ref.offset:=0;
  1137. ref.symbol:=nil;
  1138. result:=1;
  1139. end
  1140. else if (ref.base<>NR_NO) then
  1141. begin
  1142. if (ref.base<>NR_STACK_POINTER_REG) then
  1143. begin
  1144. { regular field -> load self on the stack }
  1145. a_load_reg_stack(list,voidpointertype,ref.base);
  1146. if assigned(ref.symbol) then
  1147. begin
  1148. list.Concat(taicpu.op_sym(a_i32_const,ref.symbol));
  1149. incstack(list,1);
  1150. list.Concat(taicpu.op_none(a_i32_add));
  1151. decstack(list,1);
  1152. end;
  1153. if ref.offset<0 then
  1154. begin
  1155. list.Concat(taicpu.op_const(a_i32_const,-ref.offset));
  1156. incstack(list,1);
  1157. list.Concat(taicpu.op_none(a_i32_sub));
  1158. decstack(list,1);
  1159. end
  1160. else if ref.offset>0 then
  1161. begin
  1162. list.Concat(taicpu.op_const(a_i32_const,ref.offset));
  1163. incstack(list,1);
  1164. list.Concat(taicpu.op_none(a_i32_add));
  1165. decstack(list,1);
  1166. end;
  1167. if dup then
  1168. begin
  1169. a_load_reg_stack(list,voidpointertype,ref.base);
  1170. if assigned(ref.symbol) then
  1171. begin
  1172. list.Concat(taicpu.op_sym(a_i32_const,ref.symbol));
  1173. incstack(list,1);
  1174. list.Concat(taicpu.op_none(a_i32_add));
  1175. decstack(list,1);
  1176. end;
  1177. if ref.offset<0 then
  1178. begin
  1179. list.Concat(taicpu.op_const(a_i32_const,-ref.offset));
  1180. incstack(list,1);
  1181. list.Concat(taicpu.op_none(a_i32_sub));
  1182. decstack(list,1);
  1183. end
  1184. else if ref.offset>0 then
  1185. begin
  1186. list.Concat(taicpu.op_const(a_i32_const,ref.offset));
  1187. incstack(list,1);
  1188. list.Concat(taicpu.op_none(a_i32_add));
  1189. decstack(list,1);
  1190. end;
  1191. end;
  1192. ref.offset:=0;
  1193. ref.symbol:=nil;
  1194. ref.base:=NR_NO;
  1195. result:=1;
  1196. end
  1197. else // if (ref.base = NR_FRAME_POINTER_REG) then
  1198. begin
  1199. internalerror(2021012202);
  1200. //list.Concat(taicpu.op_sym(a_local_get, current_asmdata.RefAsmSymbol(FRAME_POINTER_SYM,AT_ADDR) ));
  1201. //incstack(list,1);
  1202. end;
  1203. end
  1204. else
  1205. begin
  1206. { static field -> nothing to do here, except for validity check }
  1207. {if not assigned(ref.symbol) or
  1208. (ref.offset<>0) then
  1209. begin
  1210. internalerror(2010120525);
  1211. end;}
  1212. end;
  1213. end;
  1214. procedure thlcgwasm.gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
  1215. begin
  1216. { support loading a function result (from the evaluation stack), to a register }
  1217. if assigned(para.location) and (not assigned(para.location^.next)) and
  1218. (para.location^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
  1219. (para.location^.reference.index=NR_EVAL_STACK_BASE) and
  1220. (para.location^.reference.offset=0) and
  1221. (def_cgsize(para.location^.Def)=destloc.size) and
  1222. (destloc.loc=LOC_REGISTER) then
  1223. a_load_stack_loc(list,para.location^.Def,destloc)
  1224. else
  1225. inherited;
  1226. end;
  1227. procedure thlcgwasm.a_load_const_reg(list: TAsmList; tosize: tdef; a: tcgint; register: tregister);
  1228. begin
  1229. a_load_const_stack(list,tosize,a,def2regtyp(tosize));
  1230. a_load_stack_reg(list,tosize,register);
  1231. end;
  1232. procedure thlcgwasm.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);
  1233. var
  1234. extra_slots: longint;
  1235. tmpref: treference;
  1236. begin
  1237. tmpref:=ref;
  1238. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  1239. a_load_const_stack(list,tosize,a,def2regtyp(tosize));
  1240. a_load_stack_ref(list,tosize,tmpref,extra_slots);
  1241. end;
  1242. procedure thlcgwasm.a_load_reg_ref(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference);
  1243. var
  1244. extra_slots: longint;
  1245. tmpref: treference;
  1246. begin
  1247. tmpref:=ref;
  1248. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  1249. a_load_reg_stack(list,fromsize,register);
  1250. if def2regtyp(fromsize)=R_INTREGISTER then
  1251. resize_stack_int_val(list,fromsize,tosize,assigned(tmpref.symbol));
  1252. a_load_stack_ref(list,tosize,tmpref,extra_slots);
  1253. end;
  1254. procedure thlcgwasm.a_load_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  1255. begin
  1256. a_load_reg_stack(list,fromsize,reg1);
  1257. if def2regtyp(fromsize)=R_INTREGISTER then
  1258. resize_stack_int_val(list,fromsize,tosize,false);
  1259. a_load_stack_reg(list,tosize,reg2);
  1260. end;
  1261. procedure thlcgwasm.a_load_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister);
  1262. var
  1263. extra_slots: longint;
  1264. tmpref: treference;
  1265. begin
  1266. tmpref:=ref;
  1267. extra_slots:=prepare_stack_for_ref(list,tmpref,false);
  1268. a_load_ref_stack(list,fromsize,tmpref,extra_slots);
  1269. if def2regtyp(fromsize)=R_INTREGISTER then
  1270. resize_stack_int_val(list,fromsize,tosize,false);
  1271. a_load_stack_reg(list,tosize,register);
  1272. end;
  1273. procedure thlcgwasm.a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference);
  1274. var
  1275. extra_sslots,
  1276. extra_dslots: longint;
  1277. tmpsref, tmpdref: treference;
  1278. tmpreg: tregister;
  1279. begin
  1280. if sref.base<>NR_EVAL_STACK_BASE then
  1281. begin
  1282. tmpsref:=sref;
  1283. tmpdref:=dref;
  1284. { make sure the destination reference is on top, since in the end the
  1285. order has to be "destref, value" -> first create "destref, sourceref" }
  1286. extra_dslots:=prepare_stack_for_ref(list,tmpdref,false);
  1287. extra_sslots:=prepare_stack_for_ref(list,tmpsref,false);
  1288. a_load_ref_stack(list,fromsize,tmpsref,extra_sslots);
  1289. if def2regtyp(fromsize)=R_INTREGISTER then
  1290. resize_stack_int_val(list,fromsize,tosize,assigned(tmpdref.symbol));
  1291. a_load_stack_ref(list,tosize,tmpdref,extra_dslots);
  1292. end
  1293. else
  1294. begin
  1295. { verify if we have the same reference }
  1296. if references_equal(sref,dref) then
  1297. exit;
  1298. tmpreg:=getregisterfordef(list,tosize);
  1299. a_load_ref_reg(list,fromsize,tosize,sref,tmpreg);
  1300. a_load_reg_ref(list,tosize,tosize,tmpreg,dref);
  1301. end;
  1302. end;
  1303. procedure thlcgwasm.a_load_loc_ref(list : TAsmList;fromsize, tosize: tdef; const loc: tlocation; const ref : treference);
  1304. var
  1305. tmpref: treference;
  1306. begin
  1307. if is_methodptr_like_type(tosize) and (loc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  1308. begin
  1309. tmpref:=ref;
  1310. a_load_reg_ref(list,voidcodepointertype,voidcodepointertype,loc.register,tmpref);
  1311. inc(tmpref.offset,voidcodepointertype.size);
  1312. { the second part could be either self or parentfp }
  1313. if tosize.size=(voidcodepointertype.size+voidpointertype.size) then
  1314. a_load_reg_ref(list,voidpointertype,voidpointertype,loc.registerhi,tmpref)
  1315. else if tosize.size=(voidcodepointertype.size+parentfpvoidpointertype.size) then
  1316. a_load_reg_ref(list,parentfpvoidpointertype,parentfpvoidpointertype,loc.registerhi,tmpref)
  1317. else
  1318. internalerror(2021100301);
  1319. end
  1320. else
  1321. inherited;
  1322. end;
  1323. procedure thlcgwasm.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister);
  1324. begin
  1325. a_loadaddr_ref_stack(list,fromsize,tosize,ref);
  1326. a_load_stack_reg(list, tosize, r);
  1327. end;
  1328. procedure thlcgwasm.a_load_subsetref_regs_index(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg: tregister);
  1329. var
  1330. tmpref: treference;
  1331. extra_value_reg,
  1332. tmpreg: tregister;
  1333. begin
  1334. tmpreg:=getintregister(list,osuinttype);
  1335. tmpref:=sref.ref;
  1336. inc(tmpref.offset,loadbitsize div 8);
  1337. extra_value_reg:=getintregister(list,osuinttype);
  1338. a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,valuereg);
  1339. { ensure we don't load anything past the end of the array }
  1340. a_cmp_const_reg_stack(list,osuinttype,OC_A,loadbitsize-sref.bitlen,sref.bitindexreg);
  1341. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
  1342. decstack(current_asmdata.CurrAsmList,1);
  1343. { Y-x = -(Y-x) }
  1344. a_op_const_reg_reg(list,OP_SUB,osuinttype,loadbitsize,sref.bitindexreg,tmpreg);
  1345. a_op_reg_reg(list,OP_NEG,osuinttype,tmpreg,tmpreg);
  1346. { load next "loadbitsize" bits of the array }
  1347. a_load_ref_reg(list,cgsize_orddef(int_cgsize(loadbitsize div 8)),osuinttype,tmpref,extra_value_reg);
  1348. { tmpreg is in the range 1..<cpu_bitsize>-1 -> always ok }
  1349. a_op_reg_reg(list,OP_SHL,osuinttype,tmpreg,extra_value_reg);
  1350. { merge }
  1351. a_op_reg_reg(list,OP_OR,osuinttype,extra_value_reg,valuereg);
  1352. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
  1353. { sign extend or mask other bits }
  1354. if is_signed(subsetsize) then
  1355. begin
  1356. a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-sref.bitlen,valuereg);
  1357. a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,valuereg);
  1358. end
  1359. else
  1360. a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
  1361. end;
  1362. procedure thlcgwasm.a_load_regconst_subsetref_intern(list : TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sref: tsubsetreference; slopt: tsubsetloadopt);
  1363. var
  1364. tmpreg, tmpindexreg, valuereg, extra_value_reg, maskreg: tregister;
  1365. tosreg, fromsreg: tsubsetregister;
  1366. tmpref: treference;
  1367. bitmask: aword;
  1368. loadsize: torddef;
  1369. loadbitsize: byte;
  1370. extra_load: boolean;
  1371. begin
  1372. { the register must be able to contain the requested value }
  1373. if (fromsize.size*8<sref.bitlen) then
  1374. internalerror(2006081613);
  1375. get_subsetref_load_info(sref,loadsize,extra_load);
  1376. loadbitsize:=loadsize.size*8;
  1377. { load the (first part) of the bit sequence }
  1378. valuereg:=getintregister(list,osuinttype);
  1379. a_load_ref_reg(list,loadsize,osuinttype,sref.ref,valuereg);
  1380. { constant offset of bit sequence? }
  1381. if not extra_load then
  1382. begin
  1383. if (sref.bitindexreg=NR_NO) then
  1384. begin
  1385. { use subsetreg routine, it may have been overridden with an optimized version }
  1386. tosreg.subsetreg:=valuereg;
  1387. tosreg.subsetregsize:=def_cgsize(osuinttype);
  1388. { subsetregs always count bits from right to left }
  1389. tosreg.startbit:=sref.startbit;
  1390. tosreg.bitlen:=sref.bitlen;
  1391. a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,tosreg,slopt);
  1392. end
  1393. else
  1394. begin
  1395. if (sref.startbit<>0) then
  1396. internalerror(2006081710);
  1397. { should be handled by normal code and will give wrong result }
  1398. { on x86 for the '1 shl bitlen' below }
  1399. if (sref.bitlen=AIntBits) then
  1400. internalerror(2006081711);
  1401. { zero the bits we have to insert }
  1402. if (slopt<>SL_SETMAX) then
  1403. begin
  1404. maskreg:=getintregister(list,osuinttype);
  1405. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
  1406. a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,maskreg);
  1407. a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
  1408. a_op_reg_reg(list,OP_AND,osuinttype,maskreg,valuereg);
  1409. end;
  1410. { insert the value }
  1411. if (slopt<>SL_SETZERO) then
  1412. begin
  1413. tmpreg:=getintregister(list,osuinttype);
  1414. if (slopt<>SL_SETMAX) then
  1415. a_load_reg_reg(list,fromsize,osuinttype,fromreg,tmpreg)
  1416. else if (sref.bitlen<>AIntBits) then
  1417. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1), tmpreg)
  1418. else
  1419. a_load_const_reg(list,osuinttype,-1,tmpreg);
  1420. if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
  1421. a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
  1422. a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,tmpreg);
  1423. a_op_reg_reg(list,OP_OR,osuinttype,tmpreg,valuereg);
  1424. end;
  1425. end;
  1426. { store back to memory }
  1427. tmpreg:=getintregister(list,loadsize);
  1428. a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
  1429. a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
  1430. exit;
  1431. end
  1432. else
  1433. begin
  1434. { load next value }
  1435. extra_value_reg:=getintregister(list,osuinttype);
  1436. tmpref:=sref.ref;
  1437. inc(tmpref.offset,loadbitsize div 8);
  1438. { should maybe be taken out too, can be done more efficiently }
  1439. { on e.g. i386 with shld/shrd }
  1440. if (sref.bitindexreg = NR_NO) then
  1441. begin
  1442. a_load_ref_reg(list,loadsize,osuinttype,tmpref,extra_value_reg);
  1443. fromsreg.subsetreg:=fromreg;
  1444. fromsreg.subsetregsize:=def_cgsize(fromsize);
  1445. tosreg.subsetreg:=valuereg;
  1446. tosreg.subsetregsize:=def_cgsize(osuinttype);
  1447. { transfer first part }
  1448. fromsreg.bitlen:=loadbitsize-sref.startbit;
  1449. tosreg.bitlen:=fromsreg.bitlen;
  1450. { valuereg must contain the lower bits of the value at bits [startbit..loadbitsize] }
  1451. { lower bits of the value ... }
  1452. fromsreg.startbit:=0;
  1453. { ... to startbit }
  1454. tosreg.startbit:=sref.startbit;
  1455. case slopt of
  1456. SL_SETZERO,
  1457. SL_SETMAX:
  1458. a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,tosreg,slopt);
  1459. else
  1460. a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg);
  1461. end;
  1462. {$ifndef cpuhighleveltarget}
  1463. valuereg:=cg.makeregsize(list,valuereg,def_cgsize(loadsize));
  1464. a_load_reg_ref(list,loadsize,loadsize,valuereg,sref.ref);
  1465. {$else}
  1466. tmpreg:=getintregister(list,loadsize);
  1467. a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
  1468. a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
  1469. {$endif}
  1470. { transfer second part }
  1471. { extra_value_reg must contain the upper bits of the value at bits [0..bitlen-(loadbitsize-startbit)] }
  1472. fromsreg.startbit:=fromsreg.bitlen;
  1473. tosreg.startbit:=0;
  1474. tosreg.subsetreg:=extra_value_reg;
  1475. fromsreg.bitlen:=sref.bitlen-fromsreg.bitlen;
  1476. tosreg.bitlen:=fromsreg.bitlen;
  1477. case slopt of
  1478. SL_SETZERO,
  1479. SL_SETMAX:
  1480. a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,tosreg,slopt);
  1481. else
  1482. a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg);
  1483. end;
  1484. tmpreg:=getintregister(list,loadsize);
  1485. a_load_reg_reg(list,osuinttype,loadsize,extra_value_reg,tmpreg);
  1486. a_load_reg_ref(list,loadsize,loadsize,tmpreg,tmpref);
  1487. exit;
  1488. end
  1489. else
  1490. begin
  1491. if (sref.startbit <> 0) then
  1492. internalerror(2006081812);
  1493. { should be handled by normal code and will give wrong result }
  1494. { on x86 for the '1 shl bitlen' below }
  1495. if (sref.bitlen = AIntBits) then
  1496. internalerror(2006081713);
  1497. { generate mask to zero the bits we have to insert }
  1498. if (slopt <> SL_SETMAX) then
  1499. begin
  1500. maskreg := getintregister(list,osuinttype);
  1501. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
  1502. a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,maskreg);
  1503. a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
  1504. a_op_reg_reg(list,OP_AND,osuinttype,maskreg,valuereg);
  1505. end;
  1506. { insert the value }
  1507. if (slopt <> SL_SETZERO) then
  1508. begin
  1509. tmpreg := getintregister(list,osuinttype);
  1510. if (slopt <> SL_SETMAX) then
  1511. a_load_reg_reg(list,fromsize,osuinttype,fromreg,tmpreg)
  1512. else if (sref.bitlen <> AIntBits) then
  1513. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg)
  1514. else
  1515. a_load_const_reg(list,osuinttype,-1,tmpreg);
  1516. if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
  1517. { mask left over bits }
  1518. a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
  1519. a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,tmpreg);
  1520. a_op_reg_reg(list,OP_OR,osuinttype,tmpreg,valuereg);
  1521. end;
  1522. tmpreg:=getintregister(list,loadsize);
  1523. a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
  1524. a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
  1525. { make sure we do not read/write past the end of the array }
  1526. a_cmp_const_reg_stack(list,osuinttype,OC_A,loadbitsize-sref.bitlen,sref.bitindexreg);
  1527. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
  1528. decstack(current_asmdata.CurrAsmList,1);
  1529. a_load_ref_reg(list,loadsize,osuinttype,tmpref,extra_value_reg);
  1530. tmpindexreg:=getintregister(list,osuinttype);
  1531. { load current array value }
  1532. if (slopt<>SL_SETZERO) then
  1533. begin
  1534. tmpreg:=getintregister(list,osuinttype);
  1535. if (slopt<>SL_SETMAX) then
  1536. a_load_reg_reg(list,fromsize,osuinttype,fromreg,tmpreg)
  1537. else if (sref.bitlen<>AIntBits) then
  1538. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg)
  1539. else
  1540. a_load_const_reg(list,osuinttype,-1,tmpreg);
  1541. end;
  1542. { generate mask to zero the bits we have to insert }
  1543. if (slopt<>SL_SETMAX) then
  1544. begin
  1545. maskreg:=getintregister(list,osuinttype);
  1546. { Y-x = -(x-Y) }
  1547. a_op_const_reg_reg(list,OP_SUB,osuinttype,loadbitsize,sref.bitindexreg,tmpindexreg);
  1548. a_op_reg_reg(list,OP_NEG,osuinttype,tmpindexreg,tmpindexreg);
  1549. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
  1550. a_op_reg_reg(list,OP_SHR,osuinttype,tmpindexreg,maskreg);
  1551. a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
  1552. a_op_reg_reg(list,OP_AND,osuinttype,maskreg,extra_value_reg);
  1553. end;
  1554. if (slopt<>SL_SETZERO) then
  1555. begin
  1556. if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
  1557. a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
  1558. a_op_reg_reg(list,OP_SHR,osuinttype,tmpindexreg,tmpreg);
  1559. a_op_reg_reg(list,OP_OR,osuinttype,tmpreg,extra_value_reg);
  1560. end;
  1561. {$ifndef cpuhighleveltarget}
  1562. extra_value_reg:=cg.makeregsize(list,extra_value_reg,def_cgsize(loadsize));
  1563. a_load_reg_ref(list,loadsize,loadsize,extra_value_reg,tmpref);
  1564. {$else}
  1565. tmpreg:=getintregister(list,loadsize);
  1566. a_load_reg_reg(list,osuinttype,loadsize,extra_value_reg,tmpreg);
  1567. a_load_reg_ref(list,loadsize,loadsize,tmpreg,tmpref);
  1568. {$endif}
  1569. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
  1570. end;
  1571. end;
  1572. end;
  1573. procedure thlcgwasm.a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister);
  1574. begin
  1575. a_op_const_reg_reg(list,op,size,a,reg,reg);
  1576. end;
  1577. procedure thlcgwasm.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister);
  1578. begin
  1579. a_load_reg_stack(list,size,src);
  1580. a_op_const_stack(list,op,size,a);
  1581. a_load_stack_reg(list,size,dst);
  1582. end;
  1583. procedure thlcgwasm.a_op_const_ref(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; const ref: TReference);
  1584. var
  1585. extra_slots: longint;
  1586. tmpref: treference;
  1587. begin
  1588. tmpref:=ref;
  1589. extra_slots:=prepare_stack_for_ref(list,tmpref,true);
  1590. { TODO, here or in peepholeopt: use iinc when possible }
  1591. a_load_ref_stack(list,size,tmpref,extra_slots);
  1592. a_op_const_stack(list,op,size,a);
  1593. { for android verifier }
  1594. if (def2regtyp(size)=R_INTREGISTER) and
  1595. (assigned(tmpref.symbol)) then
  1596. resize_stack_int_val(list,size,size,true);
  1597. a_load_stack_ref(list,size,tmpref,extra_slots);
  1598. end;
  1599. procedure thlcgwasm.a_op_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister);
  1600. begin
  1601. if not(op in [OP_NOT,OP_NEG]) then
  1602. a_load_reg_stack(list,size,reg);
  1603. a_op_ref_stack(list,op,size,ref);
  1604. a_load_stack_reg(list,size,reg);
  1605. end;
  1606. procedure thlcgwasm.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister);
  1607. begin
  1608. if not(op in [OP_NOT,OP_NEG]) then
  1609. a_load_reg_stack(list,size,src2);
  1610. a_op_reg_stack(list,op,size,src1);
  1611. a_load_stack_reg(list,size,dst);
  1612. end;
  1613. procedure thlcgwasm.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister);
  1614. begin
  1615. a_op_reg_reg_reg(list,op,size,reg1,reg2,reg2);
  1616. end;
  1617. procedure thlcgwasm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
  1618. var
  1619. tmpreg: tregister;
  1620. begin
  1621. if not setflags then
  1622. begin
  1623. inherited;
  1624. exit;
  1625. end;
  1626. tmpreg:=getintregister(list,size);
  1627. a_load_const_reg(list,size,a,tmpreg);
  1628. a_op_reg_reg_reg_checkoverflow(list,op,size,tmpreg,src,dst,true,ovloc);
  1629. end;
  1630. procedure thlcgwasm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
  1631. var
  1632. orgsrc1, orgsrc2: tregister;
  1633. docheck: boolean;
  1634. lab: tasmlabel;
  1635. begin
  1636. if not setflags then
  1637. begin
  1638. inherited;
  1639. exit;
  1640. end;
  1641. { anything else cannot overflow }
  1642. docheck:=size.size in [4,8];
  1643. if docheck then
  1644. begin
  1645. orgsrc1:=src1;
  1646. orgsrc2:=src2;
  1647. if src1=dst then
  1648. begin
  1649. orgsrc1:=getintregister(list,size);
  1650. a_load_reg_reg(list,size,size,src1,orgsrc1);
  1651. end;
  1652. if src2=dst then
  1653. begin
  1654. orgsrc2:=getintregister(list,size);
  1655. a_load_reg_reg(list,size,size,src2,orgsrc2);
  1656. end;
  1657. end;
  1658. a_op_reg_reg_reg(list,op,size,src1,src2,dst);
  1659. if docheck then
  1660. begin
  1661. { * signed overflow for addition iff
  1662. - src1 and src2 are negative and result is positive (excep in case of
  1663. subtraction, then sign of src1 has to be inverted)
  1664. - src1 and src2 are positive and result is negative
  1665. -> Simplified boolean equivalent (in terms of sign bits):
  1666. not(src1 xor src2) and (src1 xor dst)
  1667. for subtraction, multiplication: invert src1 sign bit
  1668. for division: handle separately (div by zero, low(inttype) div -1),
  1669. not supported by this code
  1670. * unsigned overflow iff carry out, aka dst < src1 or dst < src2
  1671. }
  1672. location_reset(ovloc,LOC_REGISTER,OS_S32);
  1673. { not pasbool8, because then we'd still have to convert the integer to
  1674. a boolean via branches for Dalvik}
  1675. ovloc.register:=getintregister(list,s32inttype);
  1676. if not ((size.typ=pointerdef) or
  1677. ((size.typ=orddef) and
  1678. (torddef(size).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
  1679. pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
  1680. begin
  1681. a_load_reg_stack(list,size,src1);
  1682. if op in [OP_SUB,OP_IMUL] then
  1683. a_op_stack(list,OP_NOT,size);
  1684. a_op_reg_stack(list,OP_XOR,size,src2);
  1685. a_op_stack(list,OP_NOT,size);
  1686. a_load_reg_stack(list,size,src1);
  1687. a_op_reg_stack(list,OP_XOR,size,dst);
  1688. a_op_stack(list,OP_AND,size);
  1689. a_op_const_stack(list,OP_SHR,size,(size.size*8)-1);
  1690. if size.size=8 then
  1691. begin
  1692. //todo: any operands needed?
  1693. list.concat(taicpu.op_none(a_i32_wrap_i64));
  1694. end;
  1695. end
  1696. else
  1697. begin
  1698. a_load_const_stack(list,s32inttype,0,R_INTREGISTER);
  1699. current_asmdata.getjumplabel(lab);
  1700. { can be optimized by removing duplicate xor'ing to convert dst from
  1701. signed to unsigned quadrant }
  1702. list.concat(taicpu.op_none(a_block));
  1703. a_cmp_reg_reg_label(list,size,OC_B,dst,src1,lab);
  1704. a_cmp_reg_reg_label(list,size,OC_B,dst,src2,lab);
  1705. a_op_const_stack(list,OP_XOR,s32inttype,1);
  1706. list.concat(taicpu.op_none(a_end_block));
  1707. a_label(list,lab);
  1708. end;
  1709. a_load_stack_reg(list,s32inttype,ovloc.register);
  1710. end
  1711. else
  1712. ovloc.loc:=LOC_VOID;
  1713. end;
  1714. procedure thlcgwasm.a_cmp_const_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference; l: tasmlabel);
  1715. begin
  1716. a_cmp_const_ref_stack(list,size,cmp_op,a,ref);
  1717. current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_br_if,l));
  1718. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  1719. end;
  1720. procedure thlcgwasm.a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel);
  1721. begin
  1722. a_cmp_const_reg_stack(list,size,cmp_op,a,reg);
  1723. current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_br_if,l));
  1724. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  1725. end;
  1726. procedure thlcgwasm.a_cmp_ref_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; l: tasmlabel);
  1727. begin
  1728. a_cmp_ref_reg_stack(list,size,cmp_op,ref,reg);
  1729. current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_br_if,l));
  1730. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  1731. end;
  1732. procedure thlcgwasm.a_cmp_reg_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; l: tasmlabel);
  1733. begin
  1734. a_cmp_reg_ref_stack(list,size,cmp_op,reg,ref);
  1735. current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_br_if,l));
  1736. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  1737. end;
  1738. procedure thlcgwasm.a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);
  1739. begin
  1740. a_cmp_reg_reg_stack(list,size,cmp_op,reg1,reg2);
  1741. current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_br_if,l));
  1742. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  1743. end;
  1744. procedure thlcgwasm.a_jmp_always(list: TAsmList; l: tasmlabel);
  1745. begin
  1746. if (l=current_procinfo.CurrBreakLabel) or
  1747. (l=current_procinfo.CurrContinueLabel) or
  1748. (l=current_procinfo.CurrExitLabel) then
  1749. list.concat(taicpu.op_sym(a_br,l))
  1750. else
  1751. begin
  1752. {$ifndef EXTDEBUG}
  1753. Internalerror(2019091806); // unexpected jump
  1754. {$endif EXTDEBUG}
  1755. list.concat(tai_comment.create(strpnew('Unable to find destination of label '+l.name)));
  1756. end;
  1757. end;
  1758. procedure thlcgwasm.a_jmp_always_pascal_goto(list: TAsmList; l: tasmlabel);
  1759. var
  1760. br_ins: taicpu;
  1761. begin
  1762. br_ins:=taicpu.op_sym(a_br,l);
  1763. br_ins.is_br_generated_by_goto:=true;
  1764. list.concat(br_ins);
  1765. end;
  1766. procedure thlcgwasm.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference);
  1767. var
  1768. dstack_slots: longint;
  1769. tmpref1, tmpref2: treference;
  1770. begin
  1771. tmpref1:=ref1;
  1772. tmpref2:=ref2;
  1773. dstack_slots:=prepare_stack_for_ref(list,tmpref2,false);
  1774. a_load_ref_stack(list,fromsize,tmpref1,prepare_stack_for_ref(list,tmpref1,false));
  1775. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1776. a_load_stack_ref(list,tosize,tmpref2,dstack_slots);
  1777. end;
  1778. procedure thlcgwasm.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister);
  1779. var
  1780. tmpref: treference;
  1781. begin
  1782. tmpref:=ref;
  1783. a_load_ref_stack(list,fromsize,tmpref,prepare_stack_for_ref(list,tmpref,false));
  1784. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1785. a_load_stack_reg(list,tosize,reg);
  1786. end;
  1787. procedure thlcgwasm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference);
  1788. var
  1789. dstack_slots: longint;
  1790. tmpref: treference;
  1791. begin
  1792. tmpref:=ref;
  1793. dstack_slots:=prepare_stack_for_ref(list,tmpref,false);
  1794. a_load_reg_stack(list,fromsize,reg);
  1795. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1796. a_load_stack_ref(list,tosize,tmpref,dstack_slots);
  1797. end;
  1798. procedure thlcgwasm.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  1799. begin
  1800. a_load_reg_stack(list,fromsize,reg1);
  1801. resizestackfpuval(list,def_cgsize(fromsize),def_cgsize(tosize));
  1802. a_load_stack_reg(list,tosize,reg2);
  1803. end;
  1804. procedure thlcgwasm.g_unreachable(list: TAsmList);
  1805. begin
  1806. list.Concat(taicpu.op_none(a_unreachable));
  1807. end;
  1808. procedure thlcgwasm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
  1809. var
  1810. pd: tprocdef;
  1811. cgpara1,cgpara2,cgpara3 : TCGPara;
  1812. begin
  1813. if (source.base=NR_EVAL_STACK_BASE) or (source.base=NR_LOCAL_STACK_POINTER_REG) or
  1814. (source.index=NR_EVAL_STACK_BASE) or (source.index=NR_LOCAL_STACK_POINTER_REG) or
  1815. (dest.base=NR_EVAL_STACK_BASE) or (dest.base=NR_LOCAL_STACK_POINTER_REG) or
  1816. (dest.index=NR_EVAL_STACK_BASE) or (dest.index=NR_LOCAL_STACK_POINTER_REG) or
  1817. (size.size in [1,2,4,8]) then
  1818. inherited
  1819. else
  1820. begin
  1821. pd:=search_system_proc('MOVE');
  1822. cgpara1.init;
  1823. cgpara2.init;
  1824. cgpara3.init;
  1825. paramanager.getcgtempparaloc(list,pd,1,cgpara1);
  1826. paramanager.getcgtempparaloc(list,pd,2,cgpara2);
  1827. paramanager.getcgtempparaloc(list,pd,3,cgpara3);
  1828. if pd.is_pushleftright then
  1829. begin
  1830. { load source }
  1831. a_loadaddr_ref_cgpara(list,voidtype,source,cgpara1);
  1832. { load destination }
  1833. a_loadaddr_ref_cgpara(list,voidtype,dest,cgpara2);
  1834. { load size }
  1835. a_load_const_cgpara(list,sizesinttype,size.size,cgpara3);
  1836. end
  1837. else
  1838. begin
  1839. { load size }
  1840. a_load_const_cgpara(list,sizesinttype,size.size,cgpara3);
  1841. { load destination }
  1842. a_loadaddr_ref_cgpara(list,voidtype,dest,cgpara2);
  1843. { load source }
  1844. a_loadaddr_ref_cgpara(list,voidtype,source,cgpara1);
  1845. end;
  1846. paramanager.freecgpara(list,cgpara3);
  1847. paramanager.freecgpara(list,cgpara2);
  1848. paramanager.freecgpara(list,cgpara1);
  1849. g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil).resetiftemp;
  1850. cgpara3.done;
  1851. cgpara2.done;
  1852. cgpara1.done;
  1853. end;
  1854. end;
  1855. procedure thlcgwasm.g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean);
  1856. var
  1857. pd: tcpuprocdef;
  1858. begin
  1859. pd:=tcpuprocdef(current_procinfo.procdef);
  1860. g_procdef(list,pd);
  1861. ttgwasm(tg).allocframepointer(list,pd.frame_pointer_ref);
  1862. ttgwasm(tg).allocbasepointer(list,pd.base_pointer_ref);
  1863. g_fingerprint(list);
  1864. list.Concat(taicpu.op_sym(a_global_get,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_WASM_GLOBAL)));
  1865. incstack(list,1);
  1866. list.Concat(taicpu.op_ref(a_local_set,pd.base_pointer_ref));
  1867. decstack(list,1);
  1868. if (localsize>0) then begin
  1869. list.Concat(taicpu.op_ref(a_local_get,pd.base_pointer_ref));
  1870. incstack(list,1);
  1871. list.concat(taicpu.op_const(a_i32_const, localsize ));
  1872. incstack(list,1);
  1873. list.concat(taicpu.op_none(a_i32_sub));
  1874. decstack(list,1);
  1875. list.Concat(taicpu.op_ref(a_local_set,pd.frame_pointer_ref));
  1876. decstack(list,1);
  1877. list.Concat(taicpu.op_ref(a_local_get,pd.frame_pointer_ref));
  1878. incstack(list,1);
  1879. list.Concat(taicpu.op_sym(a_global_set,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_WASM_GLOBAL)));
  1880. decstack(list,1);
  1881. end;
  1882. end;
  1883. procedure thlcgwasm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
  1884. var
  1885. pd: tcpuprocdef;
  1886. begin
  1887. pd:=tcpuprocdef(current_procinfo.procdef);
  1888. list.Concat(taicpu.op_ref(a_local_get,pd.base_pointer_ref));
  1889. incstack(list,1);
  1890. list.Concat(taicpu.op_sym(a_global_set,current_asmdata.RefAsmSymbol(STACK_POINTER_SYM,AT_WASM_GLOBAL)));
  1891. decstack(list,1);
  1892. list.concat(taicpu.op_none(a_return));
  1893. list.concat(taicpu.op_none(a_end_function));
  1894. end;
  1895. procedure thlcgwasm.g_rangecheck(list: TAsmList; const l: tlocation; fromdef, todef: tdef);
  1896. var
  1897. {$if defined(cpuhighleveltarget)}
  1898. aintmax: tcgint;
  1899. {$elseif defined(cpu64bitalu) or defined(cpu32bitalu)}
  1900. aintmax: aint;
  1901. {$else}
  1902. aintmax: longint;
  1903. {$endif}
  1904. //neglabel : tasmlabel;
  1905. //hreg : tregister;
  1906. lto,hto,
  1907. lfrom,hfrom : TConstExprInt;
  1908. fromsize, tosize: cardinal;
  1909. maxdef: tdef;
  1910. from_signed, to_signed: boolean;
  1911. begin
  1912. { range checking on and range checkable value? }
  1913. if not(cs_check_range in current_settings.localswitches) or
  1914. not(fromdef.typ in [orddef,enumdef]) or
  1915. { C-style booleans can't really fail range checks, }
  1916. { all values are always valid }
  1917. is_cbool(todef) then
  1918. exit;
  1919. {$if not defined(cpuhighleveltarget) and not defined(cpu64bitalu)}
  1920. { handle 64bit rangechecks separate for 32bit processors }
  1921. if is_64bit(fromdef) or is_64bit(todef) then
  1922. begin
  1923. cg64.g_rangecheck64(list,l,fromdef,todef);
  1924. exit;
  1925. end;
  1926. {$endif ndef cpuhighleveltarget and ndef cpu64bitalu}
  1927. { only check when assigning to scalar, subranges are different, }
  1928. { when todef=fromdef then the check is always generated }
  1929. getrange(fromdef,lfrom,hfrom);
  1930. getrange(todef,lto,hto);
  1931. from_signed := is_signed(fromdef);
  1932. to_signed := is_signed(todef);
  1933. { check the rangedef of the array, not the array itself }
  1934. { (only change now, since getrange needs the arraydef) }
  1935. if (todef.typ = arraydef) then
  1936. todef := tarraydef(todef).rangedef;
  1937. { no range check if from and to are equal and are both longint/dword }
  1938. { (if we have a 32bit processor) or int64/qword, since such }
  1939. { operations can at most cause overflows (JM) }
  1940. { Note that these checks are mostly processor independent, they only }
  1941. { have to be changed once we introduce 64bit subrange types }
  1942. {$if defined(cpuhighleveltarget) or defined(cpu64bitalu)}
  1943. if (fromdef=todef) and
  1944. (fromdef.typ=orddef) and
  1945. (((((torddef(fromdef).ordtype=s64bit) and
  1946. (lfrom = low(int64)) and
  1947. (hfrom = high(int64))) or
  1948. ((torddef(fromdef).ordtype=u64bit) and
  1949. (lfrom = low(qword)) and
  1950. (hfrom = high(qword))) or
  1951. ((torddef(fromdef).ordtype=scurrency) and
  1952. (lfrom = low(int64)) and
  1953. (hfrom = high(int64)))))) then
  1954. exit;
  1955. {$endif cpuhighleveltarget or cpu64bitalu}
  1956. { 32 bit operations are automatically widened to 64 bit on 64 bit addr
  1957. targets }
  1958. {$ifdef cpu32bitaddr}
  1959. if (fromdef = todef) and
  1960. (fromdef.typ=orddef) and
  1961. (((((torddef(fromdef).ordtype = s32bit) and
  1962. (lfrom = int64(low(longint))) and
  1963. (hfrom = int64(high(longint)))) or
  1964. ((torddef(fromdef).ordtype = u32bit) and
  1965. (lfrom = low(cardinal)) and
  1966. (hfrom = high(cardinal)))))) then
  1967. exit;
  1968. {$endif cpu32bitaddr}
  1969. { optimize some range checks away in safe cases }
  1970. fromsize := fromdef.size;
  1971. tosize := todef.size;
  1972. if ((from_signed = to_signed) or
  1973. (not from_signed)) and
  1974. (lto<=lfrom) and (hto>=hfrom) and
  1975. (fromsize <= tosize) then
  1976. begin
  1977. { if fromsize < tosize, and both have the same signed-ness or }
  1978. { fromdef is unsigned, then all bit patterns from fromdef are }
  1979. { valid for todef as well }
  1980. if (fromsize < tosize) then
  1981. exit;
  1982. if (fromsize = tosize) and
  1983. (from_signed = to_signed) then
  1984. { only optimize away if all bit patterns which fit in fromsize }
  1985. { are valid for the todef }
  1986. begin
  1987. {$ifopt Q+}
  1988. {$define overflowon}
  1989. {$Q-}
  1990. {$endif}
  1991. {$ifopt R+}
  1992. {$define rangeon}
  1993. {$R-}
  1994. {$endif}
  1995. if to_signed then
  1996. begin
  1997. { calculation of the low/high ranges must not overflow 64 bit
  1998. otherwise we end up comparing with zero for 64 bit data types on
  1999. 64 bit processors }
  2000. if (lto = (int64(-1) << (tosize * 8 - 1))) and
  2001. (hto = (-((int64(-1) << (tosize * 8 - 1))+1))) then
  2002. exit
  2003. end
  2004. else
  2005. begin
  2006. { calculation of the low/high ranges must not overflow 64 bit
  2007. otherwise we end up having all zeros for 64 bit data types on
  2008. 64 bit processors }
  2009. if (lto = 0) and
  2010. (qword(hto) = (qword(-1) >> (64-(tosize * 8))) ) then
  2011. exit
  2012. end;
  2013. {$ifdef overflowon}
  2014. {$Q+}
  2015. {$undef overflowon}
  2016. {$endif}
  2017. {$ifdef rangeon}
  2018. {$R+}
  2019. {$undef rangeon}
  2020. {$endif}
  2021. end
  2022. end;
  2023. { depending on the types involved, we perform the range check for 64 or
  2024. for 32 bit }
  2025. if fromsize=8 then
  2026. maxdef:=fromdef
  2027. else
  2028. maxdef:=todef;
  2029. {$if sizeof(aintmax) = 8}
  2030. if maxdef.size=8 then
  2031. aintmax:=high(int64)
  2032. else
  2033. {$endif}
  2034. begin
  2035. aintmax:=high(longint);
  2036. maxdef:=u32inttype;
  2037. end;
  2038. { generate the rangecheck code for the def where we are going to }
  2039. { store the result }
  2040. { use the trick that }
  2041. { a <= x <= b <=> 0 <= x-a <= b-a <=> unsigned(x-a) <= unsigned(b-a) }
  2042. { To be able to do that, we have to make sure however that either }
  2043. { fromdef and todef are both signed or unsigned, or that we leave }
  2044. { the parts < 0 and > maxlongint out }
  2045. if from_signed xor to_signed then
  2046. begin
  2047. if from_signed then
  2048. { from is signed, to is unsigned }
  2049. begin
  2050. { if high(from) < 0 -> always range error }
  2051. if (hfrom < 0) or
  2052. { if low(to) > maxlongint also range error }
  2053. (lto > aintmax) then
  2054. begin
  2055. g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
  2056. exit
  2057. end;
  2058. { from is signed and to is unsigned -> when looking at to }
  2059. { as an signed value, it must be < maxaint (otherwise }
  2060. { it will become negative, which is invalid since "to" is unsigned) }
  2061. if hto > aintmax then
  2062. hto := aintmax;
  2063. end
  2064. else
  2065. { from is unsigned, to is signed }
  2066. begin
  2067. if (lfrom > aintmax) or
  2068. (hto < 0) then
  2069. begin
  2070. g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
  2071. exit
  2072. end;
  2073. { from is unsigned and to is signed -> when looking at to }
  2074. { as an unsigned value, it must be >= 0 (since negative }
  2075. { values are the same as values > maxlongint) }
  2076. if lto < 0 then
  2077. lto := 0;
  2078. end;
  2079. end;
  2080. a_load_loc_stack(list,fromdef,l);
  2081. resize_stack_int_val(list,fromdef,maxdef,false);
  2082. a_load_const_stack(list,maxdef,tcgint(int64(lto)),R_INTREGISTER);
  2083. a_op_stack(list,OP_SUB,maxdef);
  2084. {
  2085. if from_signed then
  2086. a_cmp_const_reg_label(list,OS_INT,OC_GTE,aint(hto-lto),hreg,neglabel)
  2087. else
  2088. }
  2089. if qword(hto-lto)>qword(aintmax) then
  2090. a_load_const_stack(list,maxdef,aintmax,R_INTREGISTER)
  2091. else
  2092. a_load_const_stack(list,maxdef,tcgint(int64(hto-lto)),R_INTREGISTER);
  2093. a_cmp_stack_stack(list,maxdef,OC_A);
  2094. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
  2095. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  2096. g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
  2097. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
  2098. end;
  2099. procedure thlcgwasm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
  2100. begin
  2101. { not possible, need the original operands }
  2102. internalerror(2012102101);
  2103. end;
  2104. procedure thlcgwasm.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation);
  2105. var
  2106. hl : tasmlabel;
  2107. begin
  2108. if not(cs_check_overflow in current_settings.localswitches) then
  2109. exit;
  2110. current_asmdata.getjumplabel(hl);
  2111. list.concat(taicpu.op_none(a_block));
  2112. a_cmp_const_loc_label(list,s32inttype,OC_EQ,0,ovloc,hl);
  2113. g_call_system_proc(list,'fpc_overflow',[],nil);
  2114. hlcg.g_maybe_checkforexceptions(current_asmdata.CurrAsmList);
  2115. list.concat(taicpu.op_none(a_end_block));
  2116. a_label(list,hl);
  2117. end;
  2118. procedure thlcgwasm.maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean);
  2119. begin
  2120. { don't do anything, all registers become stack locations anyway }
  2121. end;
  2122. procedure thlcgwasm.gen_entry_code(list: TAsmList);
  2123. begin
  2124. inherited;
  2125. list.concat(taicpu.op_none(a_block));
  2126. list.concat(taicpu.op_none(a_block));
  2127. end;
  2128. procedure thlcgwasm.gen_exit_code(list: TAsmList);
  2129. begin
  2130. list.concat(taicpu.op_none(a_end_block));
  2131. if ts_wasm_bf_exceptions in current_settings.targetswitches then
  2132. a_label(list,tcpuprocinfo(current_procinfo).CurrRaiseLabel);
  2133. if fevalstackheight<>0 then
  2134. {$ifdef DEBUG_WASMSTACK}
  2135. list.concat(tai_comment.Create(strpnew('!!! values remaining on stack at end of block !!!')));
  2136. {$else DEBUG_WASMSTACK}
  2137. internalerror(2021091801);
  2138. {$endif DEBUG_WASMSTACK}
  2139. inherited;
  2140. end;
  2141. procedure thlcgwasm.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister);
  2142. begin
  2143. internalerror(2012090201);
  2144. end;
  2145. procedure thlcgwasm.a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle: pmmshuffle);
  2146. begin
  2147. internalerror(2012090202);
  2148. end;
  2149. procedure thlcgwasm.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle);
  2150. begin
  2151. internalerror(2012060130);
  2152. end;
  2153. procedure thlcgwasm.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle);
  2154. begin
  2155. internalerror(2012060131);
  2156. end;
  2157. procedure thlcgwasm.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle);
  2158. begin
  2159. internalerror(2012060132);
  2160. end;
  2161. procedure thlcgwasm.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle);
  2162. begin
  2163. internalerror(2012060133);
  2164. end;
  2165. procedure thlcgwasm.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle);
  2166. begin
  2167. internalerror(2012060134);
  2168. end;
  2169. procedure thlcgwasm.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle);
  2170. begin
  2171. internalerror(2012060135);
  2172. end;
  2173. procedure thlcgwasm.g_stackpointer_alloc(list: TAsmList; size: longint);
  2174. begin
  2175. internalerror(2012090203);
  2176. end;
  2177. procedure thlcgwasm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  2178. begin
  2179. internalerror(2012090204);
  2180. end;
  2181. procedure thlcgwasm.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint);
  2182. begin
  2183. internalerror(2012090205);
  2184. end;
  2185. procedure thlcgwasm.g_local_unwind(list: TAsmList; l: TAsmLabel);
  2186. begin
  2187. internalerror(2012090206);
  2188. end;
  2189. procedure thlcgwasm.g_procdef(list: TAsmList; pd: tprocdef);
  2190. begin
  2191. list.Concat(tai_functype.create(pd.mangledname,tcpuprocdef(pd).create_functype));
  2192. end;
  2193. procedure thlcgwasm.g_maybe_checkforexceptions(list: TasmList);
  2194. var
  2195. pd: tprocdef;
  2196. begin
  2197. if ts_wasm_bf_exceptions in current_settings.targetswitches then
  2198. begin
  2199. pd:=search_system_proc('fpc_raised_exception_flag');
  2200. g_call_system_proc(list,pd,[],nil).resetiftemp;
  2201. decstack(current_asmdata.CurrAsmList,1);
  2202. list.concat(taicpu.op_sym(a_br_if,tcpuprocinfo(current_procinfo).CurrRaiseLabel));
  2203. end;
  2204. end;
  2205. procedure thlcgwasm.a_load_stack_reg(list: TAsmList; size: tdef; reg: tregister);
  2206. begin
  2207. list.concat(taicpu.op_reg(a_local_set,reg));
  2208. decstack(list,1);
  2209. end;
  2210. procedure thlcgwasm.a_load_stack_ref(list: TAsmList; size: tdef; const ref: treference; extra_slots: longint);
  2211. var
  2212. opc: tasmop;
  2213. finishandval: tcgint;
  2214. begin
  2215. { fake location that indicates the value has to remain on the stack }
  2216. if ref.base=NR_EVAL_STACK_BASE then
  2217. exit;
  2218. opc:=loadstoreopcref(size,false,ref,finishandval);
  2219. if ref.refaddr=addr_got_tls then
  2220. list.concat(taicpu.op_const(opc,ref.offset))
  2221. else
  2222. list.concat(taicpu.op_ref(opc,ref));
  2223. { avoid problems with getting the size of an open array etc }
  2224. if wasmAlwayInMem(size) then
  2225. size:=ptruinttype;
  2226. decstack(list,1+extra_slots);
  2227. end;
  2228. procedure thlcgwasm.a_load_reg_stack(list: TAsmList; size: tdef; reg: tregister);
  2229. begin
  2230. list.concat(taicpu.op_reg(a_local_get,reg));
  2231. incstack(list,1);
  2232. end;
  2233. procedure thlcgwasm.a_load_ref_stack(list: TAsmList; size: tdef; const ref: treference; extra_slots: longint);
  2234. var
  2235. opc: tasmop;
  2236. finishandval: tcgint;
  2237. begin
  2238. { fake location that indicates the value is already on the stack? }
  2239. if (ref.base=NR_EVAL_STACK_BASE) then
  2240. exit;
  2241. opc:=loadstoreopcref(size,true,ref,finishandval);
  2242. if ref.refaddr=addr_got_tls then
  2243. list.concat(taicpu.op_const(opc,ref.offset))
  2244. else
  2245. list.concat(taicpu.op_ref(opc,ref));
  2246. { avoid problems with getting the size of an open array etc }
  2247. if wasmAlwayInMem(size) then
  2248. size:=ptruinttype;
  2249. incstack(list,1-extra_slots);
  2250. if finishandval<>-1 then
  2251. a_op_const_stack(list,OP_AND,size,finishandval);
  2252. // there's no cast check in Wasm
  2253. //if ref.checkcast then
  2254. // gen_typecheck(list,a_checkcast,size);
  2255. end;
  2256. procedure thlcgwasm.a_load_subsetref_stack(list : TAsmList;size: tdef; const sref: tsubsetreference);
  2257. var
  2258. tmpreg: TRegister;
  2259. begin
  2260. tmpreg:=getintregister(list,size);
  2261. a_load_subsetref_reg(list,size,size,sref,tmpreg);
  2262. a_load_reg_stack(list,size,tmpreg);
  2263. end;
  2264. function thlcgwasm.loadstoreopcref(def: tdef; isload: boolean; const ref: treference; out finishandval: tcgint): tasmop;
  2265. const
  2266. {iisload} {issigned}
  2267. getputmem8 : array [boolean, boolean] of TAsmOp = ((a_i32_store8, a_i32_store8), (a_i32_load8_u, a_i32_load8_s));
  2268. getputmem16 : array [boolean, boolean] of TAsmOp = ((a_i32_store16, a_i32_store16), (a_i32_load16_u ,a_i32_load16_s));
  2269. getputmem32 : array [boolean, boolean] of TAsmOp = ((a_i32_store, a_i32_store), (a_i32_load, a_i32_load));
  2270. getputmem64 : array [boolean, boolean] of TAsmOp = ((a_i64_store, a_i64_store), (a_i64_load, a_i64_load));
  2271. getputmemf32 : array [boolean] of TAsmOp = (a_f32_store, a_f32_load);
  2272. getputmemf64 : array [boolean] of TAsmOp = (a_f64_store, a_f64_load);
  2273. begin
  2274. if assigned(ref.symbol) and (ref.symbol.typ=AT_WASM_GLOBAL) then
  2275. begin
  2276. if isload then
  2277. result:=a_global_get
  2278. else
  2279. result:=a_global_set;
  2280. finishandval:=-1;
  2281. end
  2282. else if (ref.base<>NR_LOCAL_STACK_POINTER_REG) or assigned(ref.symbol) then
  2283. begin
  2284. { -> either a global (static) field, or a regular field. If a regular
  2285. field, then ref.base contains the self pointer, otherwise
  2286. ref.base=NR_NO. In both cases, the symbol contains all other
  2287. information (combined field name and type descriptor) }
  2288. case def.size of
  2289. 1: result := getputmem8[isload, is_signed(def)];
  2290. 2: result := getputmem16[isload, is_signed(def)];
  2291. 4:
  2292. if is_single(def) or ((def.typ=recorddef) and (trecorddef(def).contains_float_field)) then
  2293. result := getputmemf32[isload]
  2294. else
  2295. result := getputmem32[isload, is_signed(def)];
  2296. 8: if is_double(def) or ((def.typ=recorddef) and (trecorddef(def).contains_float_field)) then
  2297. result := getputmemf64[isload]
  2298. else
  2299. result := getputmem64[isload, is_signed(def)];
  2300. else
  2301. Internalerror(2019091501);
  2302. end;
  2303. //result:=getputopc[isload,ref.base=NR_NO];
  2304. finishandval:=-1;
  2305. { erase sign extension for byte/smallint loads }
  2306. if (def2regtyp(def)=R_INTREGISTER) and
  2307. not is_signed(def) and
  2308. (def.typ=orddef) and
  2309. not is_widechar(def) then
  2310. case def.size of
  2311. 1: if (torddef(def).high>127) then
  2312. finishandval:=255;
  2313. 2: if (torddef(def).high>32767) then
  2314. finishandval:=65535;
  2315. end;
  2316. end
  2317. else
  2318. begin
  2319. finishandval:=-1;
  2320. if isload then
  2321. result := a_local_get
  2322. else
  2323. result := a_local_set;
  2324. end;
  2325. end;
  2326. procedure thlcgwasm.resize_stack_int_val(list: TAsmList; fromsize, tosize: tdef; formemstore: boolean);
  2327. var
  2328. fromcgsize, tocgsize: tcgsize;
  2329. begin
  2330. { When storing to an array, field or global variable, make sure the
  2331. static type verification can determine that the stored value fits
  2332. within the boundaries of the declared type (to appease the Dalvik VM).
  2333. Local variables either get their type upgraded in the debug info,
  2334. or have no type information at all }
  2335. if formemstore and
  2336. (tosize.typ=orddef) then
  2337. if (torddef(tosize).ordtype in [u8bit,uchar]) then
  2338. tosize:=s8inttype
  2339. else if torddef(tosize).ordtype=u16bit then
  2340. tosize:=s16inttype;
  2341. fromcgsize:=def_cgsize(fromsize);
  2342. tocgsize:=def_cgsize(tosize);
  2343. if fromcgsize in [OS_S64,OS_64] then
  2344. begin
  2345. if not(tocgsize in [OS_S64,OS_64]) then
  2346. begin
  2347. { truncate }
  2348. list.concat(taicpu.op_none(a_i32_wrap_i64));
  2349. case tocgsize of
  2350. OS_8:
  2351. a_op_const_stack(list,OP_AND,s32inttype,255);
  2352. OS_S8:
  2353. list.concat(taicpu.op_none(a_i32_extend8_s));
  2354. OS_16:
  2355. a_op_const_stack(list,OP_AND,s32inttype,65535);
  2356. OS_S16:
  2357. list.concat(taicpu.op_none(a_i32_extend16_s));
  2358. OS_32,OS_S32:
  2359. ;
  2360. else
  2361. internalerror(2021012201);
  2362. end;
  2363. end;
  2364. end
  2365. else if tocgsize in [OS_S64,OS_64] then
  2366. begin
  2367. { extend }
  2368. case fromcgsize of
  2369. OS_8:
  2370. begin
  2371. a_op_const_stack(list,OP_AND,s32inttype,255);
  2372. list.concat(taicpu.op_none(a_i64_extend_i32_u));
  2373. end;
  2374. OS_S8:
  2375. begin
  2376. list.concat(taicpu.op_none(a_i64_extend_i32_u));
  2377. list.concat(taicpu.op_none(a_i64_extend8_s));
  2378. end;
  2379. OS_16:
  2380. begin
  2381. a_op_const_stack(list,OP_AND,s32inttype,65535);
  2382. list.concat(taicpu.op_none(a_i64_extend_i32_u));
  2383. end;
  2384. OS_S16:
  2385. begin
  2386. list.concat(taicpu.op_none(a_i64_extend_i32_u));
  2387. list.concat(taicpu.op_none(a_i64_extend16_s));
  2388. end;
  2389. OS_32:
  2390. list.concat(taicpu.op_none(a_i64_extend_i32_u));
  2391. OS_S32:
  2392. list.concat(taicpu.op_none(a_i64_extend_i32_s));
  2393. OS_64,OS_S64:
  2394. ;
  2395. else
  2396. internalerror(2021010301);
  2397. end;
  2398. end
  2399. else
  2400. begin
  2401. if tcgsize2size[fromcgsize]<tcgsize2size[tocgsize] then
  2402. begin
  2403. { extend }
  2404. case fromcgsize of
  2405. OS_8:
  2406. a_op_const_stack(list,OP_AND,s32inttype,255);
  2407. OS_S8:
  2408. begin
  2409. list.concat(taicpu.op_none(a_i32_extend8_s));
  2410. if tocgsize=OS_16 then
  2411. a_op_const_stack(list,OP_AND,s32inttype,65535);
  2412. end;
  2413. OS_16:
  2414. a_op_const_stack(list,OP_AND,s32inttype,65535);
  2415. OS_S16:
  2416. list.concat(taicpu.op_none(a_i32_extend16_s));
  2417. OS_32,OS_S32:
  2418. ;
  2419. else
  2420. internalerror(2021010302);
  2421. end;
  2422. end
  2423. else if tcgsize2size[fromcgsize]>=tcgsize2size[tocgsize] then
  2424. begin
  2425. { truncate }
  2426. case tocgsize of
  2427. OS_8:
  2428. a_op_const_stack(list,OP_AND,s32inttype,255);
  2429. OS_S8:
  2430. list.concat(taicpu.op_none(a_i32_extend8_s));
  2431. OS_16:
  2432. a_op_const_stack(list,OP_AND,s32inttype,65535);
  2433. OS_S16:
  2434. list.concat(taicpu.op_none(a_i32_extend16_s));
  2435. OS_32,OS_S32:
  2436. ;
  2437. else
  2438. internalerror(2021010302);
  2439. end;
  2440. end;
  2441. end;
  2442. end;
  2443. procedure thlcgwasm.maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean);
  2444. var
  2445. convsize: tdef;
  2446. begin
  2447. if (retdef.typ=orddef) then
  2448. begin
  2449. if (torddef(retdef).ordtype in [u8bit,u16bit,uchar]) and
  2450. (torddef(retdef).high>=(1 shl (retdef.size*8-1))) then
  2451. begin
  2452. convsize:=nil;
  2453. if callside then
  2454. if torddef(retdef).ordtype in [u8bit,uchar] then
  2455. convsize:=s8inttype
  2456. else
  2457. convsize:=s16inttype
  2458. else if torddef(retdef).ordtype in [u8bit,uchar] then
  2459. convsize:=u8inttype
  2460. else
  2461. convsize:=u16inttype;
  2462. if assigned(convsize) then
  2463. resize_stack_int_val(list,s32inttype,convsize,false);
  2464. end;
  2465. end;
  2466. end;
  2467. procedure thlcgwasm.g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef);
  2468. var
  2469. totalremovesize: longint;
  2470. realresdef: tdef;
  2471. ft: TWasmFuncType;
  2472. begin
  2473. if pd.typ=procvardef then
  2474. ft:=tcpuprocvardef(pd).create_functype
  2475. else
  2476. ft:=tcpuprocdef(pd).create_functype;
  2477. totalremovesize:=Length(ft.params)-Length(ft.results);
  2478. { remove parameters from internal evaluation stack counter (in case of
  2479. e.g. no parameters and a result, it can also increase) }
  2480. if totalremovesize>0 then
  2481. decstack(list,totalremovesize)
  2482. else if totalremovesize<0 then
  2483. incstack(list,-totalremovesize);
  2484. ft.free;
  2485. end;
  2486. procedure thlcgwasm.g_fingerprint(list: TAsmList);
  2487. begin
  2488. list.concat(taicpu.op_const(a_i64_const,Random(high(int64))));
  2489. list.concat(taicpu.op_const(a_i64_const,Random(high(int64))));
  2490. list.concat(taicpu.op_const(a_i64_const,Random(high(int64))));
  2491. list.concat(taicpu.op_const(a_i64_const,Random(high(int64))));
  2492. list.concat(taicpu.op_none(a_drop));
  2493. list.concat(taicpu.op_none(a_drop));
  2494. list.concat(taicpu.op_none(a_drop));
  2495. list.concat(taicpu.op_none(a_drop));
  2496. end;
  2497. procedure thlcgwasm.resizestackfpuval(list: TAsmList; fromsize, tosize: tcgsize);
  2498. begin
  2499. if (fromsize=OS_F32) and
  2500. (tosize=OS_F64) then
  2501. begin
  2502. list.concat(taicpu.op_none(a_f64_promote_f32));
  2503. end
  2504. else if (fromsize=OS_F64) and
  2505. (tosize=OS_F32) then
  2506. begin
  2507. list.concat(taicpu.op_none(a_f32_demote_f64));
  2508. end;
  2509. end;
  2510. procedure create_hlcodegen_cpu;
  2511. begin
  2512. hlcg:=thlcgwasm.create;
  2513. create_codegen;
  2514. end;
  2515. initialization
  2516. chlcgobj:=thlcgwasm;
  2517. create_hlcodegen:=@create_hlcodegen_cpu;
  2518. end.