hlcgcpu.pas 113 KB

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