hlcgcpu.pas 106 KB

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