2
0

cpupi.pas 53 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239
  1. {
  2. Copyright (c) 2002-2010 by Florian Klaempfl and Jonas Maebe
  3. This unit contains the CPU specific part of tprocinfo
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit cpupi;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cutils,globtype,aasmdata,aasmcpu,aasmtai,
  22. procinfo,cpubase,cpuinfo, symtype,aasmbase,cgbase,
  23. psub, cclasses;
  24. type
  25. { tcpuprocinfo }
  26. tcpuprocinfo=class(tcgprocinfo)
  27. private
  28. FFuncType: TWasmFuncType;
  29. FLocals: array of TWasmBasicType;
  30. FParametersCount: Integer;
  31. FFirstFreeLocal: Integer;
  32. FAllocatedLocals: array of TWasmBasicType;
  33. FGotoTargets: TFPHashObjectList;
  34. function ConvertBranchTargetNumbersToLabels(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
  35. function ConvertIfToBrIf(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
  36. function ConvertLoopToBr(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
  37. function StripBlockInstructions(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
  38. { used for allocating locals during the postprocess_code stage (i.e. after register allocation) }
  39. function AllocWasmLocal(wbt: TWasmBasicType): Integer;
  40. function GetLocalType(localidx: Integer): TWasmBasicType;
  41. public
  42. { label to the nearest local exception handler }
  43. CurrRaiseLabel : tasmlabel;
  44. constructor create(aparent: tprocinfo); override;
  45. destructor destroy; override;
  46. function calc_stackframe_size : longint;override;
  47. procedure setup_eh; override;
  48. procedure generate_exit_label(list: tasmlist); override;
  49. procedure postprocess_code; override;
  50. procedure set_first_temp_offset;override;
  51. procedure add_goto_target(l : tasmlabel);
  52. function is_goto_target(l : tasmsymbol): Boolean;
  53. end;
  54. implementation
  55. uses
  56. systems,verbose,globals,tgcpu,cgexcept,
  57. tgobj,paramgr,symconst,symdef,symtable,symcpu,cgutils,pass_2,parabase,
  58. fmodule,hlcgobj,hlcgcpu,defutil,itcpugas;
  59. {*****************************************************************************
  60. twasmexceptionstatehandler_noexceptions
  61. *****************************************************************************}
  62. type
  63. { twasmexceptionstatehandler_noexceptions }
  64. twasmexceptionstatehandler_noexceptions = class(tcgexceptionstatehandler)
  65. class procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); override;
  66. class procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps); override;
  67. class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
  68. class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
  69. class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); override;
  70. end;
  71. class procedure twasmexceptionstatehandler_noexceptions.get_exception_temps(list:TAsmList;var t:texceptiontemps);
  72. begin
  73. if not assigned(exceptionreasontype) then
  74. exceptionreasontype:=search_system_proc('fpc_setjmp').returndef;
  75. reference_reset(t.envbuf,0,[]);
  76. reference_reset(t.jmpbuf,0,[]);
  77. tg.gethltemp(list,exceptionreasontype,exceptionreasontype.size,tt_persistent,t.reasonbuf);
  78. end;
  79. class procedure twasmexceptionstatehandler_noexceptions.unget_exception_temps(list:TAsmList;const t:texceptiontemps);
  80. begin
  81. tg.ungettemp(list,t.reasonbuf);
  82. end;
  83. class procedure twasmexceptionstatehandler_noexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
  84. begin
  85. exceptstate.exceptionlabel:=nil;
  86. exceptstate.oldflowcontrol:=flowcontrol;
  87. exceptstate.finallycodelabel:=nil;
  88. flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
  89. end;
  90. class procedure twasmexceptionstatehandler_noexceptions.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean);
  91. begin
  92. end;
  93. class procedure twasmexceptionstatehandler_noexceptions.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
  94. begin
  95. list.Concat(tai_comment.Create(strpnew('TODO: handle_nested_exception')));
  96. end;
  97. {*****************************************************************************
  98. twasmexceptionstatehandler_nativeexnrefexceptions
  99. *****************************************************************************}
  100. type
  101. { twasmexceptionstatehandler_nativeexnrefexceptions }
  102. twasmexceptionstatehandler_nativeexnrefexceptions = class(tcgexceptionstatehandler)
  103. class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
  104. class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
  105. class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); override;
  106. { start of an "on" (catch) block }
  107. class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); override;
  108. { end of an "on" (catch) block }
  109. class procedure end_catch(list: TAsmList); override;
  110. end;
  111. class procedure twasmexceptionstatehandler_nativeexnrefexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
  112. begin
  113. exceptstate.exceptionlabel:=nil;
  114. exceptstate.oldflowcontrol:=flowcontrol;
  115. exceptstate.finallycodelabel:=nil;
  116. flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
  117. end;
  118. class procedure twasmexceptionstatehandler_nativeexnrefexceptions.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean);
  119. begin
  120. end;
  121. class procedure twasmexceptionstatehandler_nativeexnrefexceptions.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
  122. begin
  123. Message1(parser_f_unsupported_feature,'nested exception');
  124. end;
  125. class procedure twasmexceptionstatehandler_nativeexnrefexceptions.begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister);
  126. var
  127. pd: tprocdef;
  128. href2: treference;
  129. fpc_catches_res,
  130. paraloc1: tcgpara;
  131. exceptloc: tlocation;
  132. indirect: boolean;
  133. otherunit: boolean;
  134. begin
  135. paraloc1.init;
  136. otherunit:=findunitsymtable(excepttype.owner).moduleid<>findunitsymtable(current_procinfo.procdef.owner).moduleid;
  137. indirect:=(tf_supports_packages in target_info.flags) and
  138. (target_info.system in systems_indirect_var_imports) and
  139. (cs_imported_data in current_settings.localswitches) and
  140. otherunit;
  141. { send the vmt parameter }
  142. pd:=search_system_proc('fpc_catches');
  143. reference_reset_symbol(href2, current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname, AT_DATA, indirect), 0, sizeof(pint), []);
  144. if otherunit then
  145. current_module.add_extern_asmsym(excepttype.vmt_mangledname, AB_EXTERNAL, AT_DATA);
  146. paramanager.getcgtempparaloc(list, pd, 1, paraloc1);
  147. hlcg.a_loadaddr_ref_cgpara(list, excepttype.vmt_def, href2, paraloc1);
  148. paramanager.freecgpara(list, paraloc1);
  149. fpc_catches_res:=hlcg.g_call_system_proc(list, pd, [@paraloc1], nil);
  150. location_reset(exceptloc, LOC_REGISTER, def_cgsize(fpc_catches_res.def));
  151. exceptloc.register:=hlcg.getaddressregister(list, fpc_catches_res.def);
  152. hlcg.gen_load_cgpara_loc(list, fpc_catches_res.def, fpc_catches_res, exceptloc, true);
  153. { is it this catch? }
  154. thlcgwasm(hlcg).a_cmp_const_reg_stack(list, fpc_catches_res.def, OC_NE, 0, exceptloc.register);
  155. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
  156. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  157. paraloc1.done;
  158. exceptlocdef:=fpc_catches_res.def;
  159. exceptlocreg:=exceptloc.register;
  160. end;
  161. class procedure twasmexceptionstatehandler_nativeexnrefexceptions.end_catch(list: TAsmList);
  162. begin
  163. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
  164. end;
  165. {*****************************************************************************
  166. twasmexceptionstatehandler_nativelegacyexceptions
  167. *****************************************************************************}
  168. type
  169. { twasmexceptionstatehandler_nativelegacyexceptions }
  170. twasmexceptionstatehandler_nativelegacyexceptions = class(tcgexceptionstatehandler)
  171. class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
  172. class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
  173. class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); override;
  174. { start of an "on" (catch) block }
  175. class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); override;
  176. { end of an "on" (catch) block }
  177. class procedure end_catch(list: TAsmList); override;
  178. end;
  179. class procedure twasmexceptionstatehandler_nativelegacyexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
  180. begin
  181. exceptstate.exceptionlabel:=nil;
  182. exceptstate.oldflowcontrol:=flowcontrol;
  183. exceptstate.finallycodelabel:=nil;
  184. flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
  185. end;
  186. class procedure twasmexceptionstatehandler_nativelegacyexceptions.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean);
  187. begin
  188. end;
  189. class procedure twasmexceptionstatehandler_nativelegacyexceptions.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
  190. begin
  191. Message1(parser_f_unsupported_feature,'nested exception');
  192. end;
  193. class procedure twasmexceptionstatehandler_nativelegacyexceptions.begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister);
  194. var
  195. pd: tprocdef;
  196. href2: treference;
  197. fpc_catches_res,
  198. paraloc1: tcgpara;
  199. exceptloc: tlocation;
  200. indirect: boolean;
  201. otherunit: boolean;
  202. begin
  203. paraloc1.init;
  204. otherunit:=findunitsymtable(excepttype.owner).moduleid<>findunitsymtable(current_procinfo.procdef.owner).moduleid;
  205. indirect:=(tf_supports_packages in target_info.flags) and
  206. (target_info.system in systems_indirect_var_imports) and
  207. (cs_imported_data in current_settings.localswitches) and
  208. otherunit;
  209. { send the vmt parameter }
  210. pd:=search_system_proc('fpc_catches');
  211. reference_reset_symbol(href2, current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname, AT_DATA, indirect), 0, sizeof(pint), []);
  212. if otherunit then
  213. current_module.add_extern_asmsym(excepttype.vmt_mangledname, AB_EXTERNAL, AT_DATA);
  214. paramanager.getcgtempparaloc(list, pd, 1, paraloc1);
  215. hlcg.a_loadaddr_ref_cgpara(list, excepttype.vmt_def, href2, paraloc1);
  216. paramanager.freecgpara(list, paraloc1);
  217. fpc_catches_res:=hlcg.g_call_system_proc(list, pd, [@paraloc1], nil);
  218. location_reset(exceptloc, LOC_REGISTER, def_cgsize(fpc_catches_res.def));
  219. exceptloc.register:=hlcg.getaddressregister(list, fpc_catches_res.def);
  220. hlcg.gen_load_cgpara_loc(list, fpc_catches_res.def, fpc_catches_res, exceptloc, true);
  221. { is it this catch? }
  222. thlcgwasm(hlcg).a_cmp_const_reg_stack(list, fpc_catches_res.def, OC_NE, 0, exceptloc.register);
  223. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
  224. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  225. paraloc1.done;
  226. exceptlocdef:=fpc_catches_res.def;
  227. exceptlocreg:=exceptloc.register;
  228. end;
  229. class procedure twasmexceptionstatehandler_nativelegacyexceptions.end_catch(list: TAsmList);
  230. begin
  231. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
  232. end;
  233. {*****************************************************************************
  234. twasmexceptionstatehandler_bfexceptions
  235. *****************************************************************************}
  236. type
  237. { twasmexceptionstatehandler_bfexceptions }
  238. twasmexceptionstatehandler_bfexceptions = class(tcgexceptionstatehandler)
  239. class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
  240. class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
  241. class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); override;
  242. { start of an "on" (catch) block }
  243. class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); override;
  244. { end of an "on" (catch) block }
  245. class procedure end_catch(list: TAsmList); override;
  246. end;
  247. class procedure twasmexceptionstatehandler_bfexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
  248. begin
  249. exceptstate.exceptionlabel:=nil;
  250. exceptstate.oldflowcontrol:=flowcontrol;
  251. exceptstate.finallycodelabel:=nil;
  252. flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
  253. end;
  254. class procedure twasmexceptionstatehandler_bfexceptions.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean);
  255. begin
  256. end;
  257. class procedure twasmexceptionstatehandler_bfexceptions.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
  258. begin
  259. Message1(parser_f_unsupported_feature,'nested exception');
  260. end;
  261. class procedure twasmexceptionstatehandler_bfexceptions.begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister);
  262. var
  263. pd: tprocdef;
  264. href2: treference;
  265. fpc_catches_res,
  266. paraloc1: tcgpara;
  267. exceptloc: tlocation;
  268. indirect: boolean;
  269. otherunit: boolean;
  270. begin
  271. paraloc1.init;
  272. otherunit:=findunitsymtable(excepttype.owner).moduleid<>findunitsymtable(current_procinfo.procdef.owner).moduleid;
  273. indirect:=(tf_supports_packages in target_info.flags) and
  274. (target_info.system in systems_indirect_var_imports) and
  275. (cs_imported_data in current_settings.localswitches) and
  276. otherunit;
  277. { send the vmt parameter }
  278. pd:=search_system_proc('fpc_catches');
  279. reference_reset_symbol(href2, current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname, AT_DATA, indirect), 0, sizeof(pint), []);
  280. if otherunit then
  281. current_module.add_extern_asmsym(excepttype.vmt_mangledname, AB_EXTERNAL, AT_DATA);
  282. paramanager.getcgtempparaloc(list, pd, 1, paraloc1);
  283. hlcg.a_loadaddr_ref_cgpara(list, excepttype.vmt_def, href2, paraloc1);
  284. paramanager.freecgpara(list, paraloc1);
  285. fpc_catches_res:=hlcg.g_call_system_proc(list, pd, [@paraloc1], nil);
  286. location_reset(exceptloc, LOC_REGISTER, def_cgsize(fpc_catches_res.def));
  287. exceptloc.register:=hlcg.getaddressregister(list, fpc_catches_res.def);
  288. hlcg.gen_load_cgpara_loc(list, fpc_catches_res.def, fpc_catches_res, exceptloc, true);
  289. { is it this catch? }
  290. thlcgwasm(hlcg).a_cmp_const_reg_stack(list, fpc_catches_res.def, OC_NE, 0, exceptloc.register);
  291. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
  292. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  293. paraloc1.done;
  294. exceptlocdef:=fpc_catches_res.def;
  295. exceptlocreg:=exceptloc.register;
  296. end;
  297. class procedure twasmexceptionstatehandler_bfexceptions.end_catch(list: TAsmList);
  298. begin
  299. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
  300. end;
  301. {*****************************************************************************
  302. twasmblockitem
  303. *****************************************************************************}
  304. type
  305. { twasmblockitem }
  306. twasmblockitem = class(TLinkedListItem)
  307. blockstart: taicpu;
  308. elseinstr: taicpu;
  309. constructor Create(ablockstart: taicpu);
  310. end;
  311. constructor twasmblockitem.Create(ablockstart: taicpu);
  312. begin
  313. blockstart:=ablockstart;
  314. end;
  315. {*****************************************************************************
  316. twasmblockstack
  317. *****************************************************************************}
  318. type
  319. { twasmblockstack }
  320. twasmblockstack = class(tlinkedlist)
  321. end;
  322. {*****************************************************************************
  323. tcpuprocinfo
  324. *****************************************************************************}
  325. function tcpuprocinfo.ConvertBranchTargetNumbersToLabels(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
  326. var
  327. instr: taicpu;
  328. bl: taicpu_wasm_structured_instruction;
  329. l: TAsmLabel;
  330. lblopidx: Integer;
  331. begin
  332. result.typ:=amfrtNoChange;
  333. if ai.typ<>ait_instruction then
  334. exit;
  335. instr:=taicpu(ai);
  336. case instr.opcode of
  337. a_br,a_br_if,a_catch_all,a_catch_all_ref:
  338. begin
  339. if instr.ops<>1 then
  340. internalerror(2023101601);
  341. lblopidx:=0;
  342. end;
  343. a_catch,a_catch_ref:
  344. begin
  345. if instr.ops<>2 then
  346. internalerror(2023101601);
  347. lblopidx:=1;
  348. end;
  349. else
  350. exit;
  351. end;
  352. if instr.oper[lblopidx]^.typ<>top_const then
  353. exit;
  354. bl:=blockstack[instr.oper[lblopidx]^.val];
  355. l:=bl.getlabel;
  356. instr.loadsymbol(lblopidx,l,0);
  357. end;
  358. function tcpuprocinfo.ConvertIfToBrIf(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
  359. begin
  360. result.typ:=amfrtNoChange;
  361. if (ai.typ=ait_wasm_structured_instruction) and (taicpu_wasm_structured_instruction(ai).wstyp=aitws_if) then
  362. begin
  363. result.typ:=amfrtNewList;
  364. result.newlist:=TAsmList.Create;
  365. tai_wasmstruc_if(ai).ConvertToBrIf(result.newlist,@AllocWasmLocal);
  366. end;
  367. end;
  368. function tcpuprocinfo.ConvertLoopToBr(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
  369. begin
  370. result.typ:=amfrtNoChange;
  371. if (ai.typ=ait_wasm_structured_instruction) and (taicpu_wasm_structured_instruction(ai).wstyp=aitws_loop) then
  372. begin
  373. result.typ:=amfrtNewList;
  374. result.newlist:=TAsmList.Create;
  375. tai_wasmstruc_loop(ai).ConvertToBr(result.newlist);
  376. end;
  377. end;
  378. function tcpuprocinfo.StripBlockInstructions(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
  379. var
  380. instr: taicpu;
  381. begin
  382. result.typ:=amfrtNoChange;
  383. if ai.typ<>ait_instruction then
  384. exit;
  385. instr:=taicpu(ai);
  386. if instr.opcode in [a_block,a_end_block] then
  387. result.typ:=amfrtDeleteAi;
  388. end;
  389. function tcpuprocinfo.AllocWasmLocal(wbt: TWasmBasicType): Integer;
  390. begin
  391. SetLength(FAllocatedLocals,Length(FAllocatedLocals)+1);
  392. FAllocatedLocals[High(FAllocatedLocals)]:=wbt;
  393. result:=High(FAllocatedLocals)+FFirstFreeLocal;
  394. SetLength(FLocals,Length(FLocals)+1);
  395. FLocals[High(FLocals)]:=wbt;
  396. end;
  397. function tcpuprocinfo.GetLocalType(localidx: Integer): TWasmBasicType;
  398. begin
  399. if (localidx<Low(FLocals)) or (localidx>High(FLocals)) then
  400. internalerror(2024022601);
  401. result:=FLocals[localidx];
  402. end;
  403. constructor tcpuprocinfo.create(aparent: tprocinfo);
  404. begin
  405. inherited create(aparent);
  406. FGotoTargets:=TFPHashObjectList.Create(false);
  407. if ts_wasm_bf_exceptions in current_settings.targetswitches then
  408. current_asmdata.getjumplabel(CurrRaiseLabel);
  409. end;
  410. destructor tcpuprocinfo.destroy;
  411. begin
  412. FGotoTargets.Free;
  413. inherited destroy;
  414. end;
  415. function tcpuprocinfo.calc_stackframe_size: longint;
  416. begin
  417. { the stack frame in WebAssembly should always have a 16-byte alignment }
  418. Result:=Align(inherited calc_stackframe_size,16);
  419. end;
  420. procedure tcpuprocinfo.setup_eh;
  421. begin
  422. if ts_wasm_native_exnref_exceptions in current_settings.targetswitches then
  423. cexceptionstatehandler:=twasmexceptionstatehandler_nativeexnrefexceptions
  424. else if ts_wasm_native_legacy_exceptions in current_settings.targetswitches then
  425. cexceptionstatehandler:=twasmexceptionstatehandler_nativelegacyexceptions
  426. else if ts_wasm_no_exceptions in current_settings.targetswitches then
  427. cexceptionstatehandler:=twasmexceptionstatehandler_noexceptions
  428. else if ts_wasm_bf_exceptions in current_settings.targetswitches then
  429. cexceptionstatehandler:=twasmexceptionstatehandler_bfexceptions
  430. else
  431. internalerror(2021091701);
  432. end;
  433. procedure tcpuprocinfo.generate_exit_label(list: tasmlist);
  434. begin
  435. if not (po_assembler in current_procinfo.procdef.procoptions) then
  436. list.concat(taicpu.op_none(a_end_block));
  437. inherited generate_exit_label(list);
  438. end;
  439. procedure tcpuprocinfo.postprocess_code;
  440. function findfirst_tai_functype(asmlist: TAsmList): tai_functype;
  441. var
  442. hp: tai;
  443. begin
  444. result:=nil;
  445. if not assigned(asmlist) then
  446. exit;
  447. hp:=tai(asmlist.first);
  448. while assigned(hp) do
  449. begin
  450. if hp.typ=ait_functype then
  451. begin
  452. result:=tai_functype(hp);
  453. exit;
  454. end;
  455. hp:=tai(hp.Next);
  456. end;
  457. end;
  458. procedure replace_local_frame_pointer(asmlist: TAsmList);
  459. var
  460. hp: tai;
  461. instr: taicpu;
  462. l: Integer;
  463. begin
  464. if not assigned(asmlist) then
  465. exit;
  466. hp:=tai(asmlist.first);
  467. while assigned(hp) do
  468. begin
  469. if hp.typ=ait_instruction then
  470. begin
  471. instr:=taicpu(hp);
  472. for l:=0 to instr.ops-1 do
  473. if (instr.oper[l]^.typ=top_reg) and (instr.oper[l]^.reg=NR_LOCAL_FRAME_POINTER_REG) then
  474. instr.loadref(l,tcpuprocdef(current_procinfo.procdef).frame_pointer_ref);
  475. end;
  476. hp:=tai(hp.Next);
  477. end;
  478. end;
  479. function FindNextInstruction(hp: tai): taicpu;
  480. begin
  481. result:=nil;
  482. if not assigned(hp) then
  483. exit;
  484. repeat
  485. hp:=tai(hp.next);
  486. until not assigned(hp) or (hp.typ=ait_instruction);
  487. if assigned(hp) then
  488. result:=taicpu(hp);
  489. end;
  490. procedure resolve_labels_pass1(asmlist: TAsmList);
  491. var
  492. hp: tai;
  493. lastinstr, nextinstr: taicpu;
  494. cur_nesting_depth: longint;
  495. lbl: tai_label;
  496. blockstack: twasmblockstack;
  497. cblock: twasmblockitem;
  498. begin
  499. blockstack:=twasmblockstack.create;
  500. cur_nesting_depth:=0;
  501. lastinstr:=nil;
  502. hp:=tai(asmlist.first);
  503. while assigned(hp) do
  504. begin
  505. case hp.typ of
  506. ait_instruction:
  507. begin
  508. lastinstr:=taicpu(hp);
  509. case lastinstr.opcode of
  510. a_block,
  511. a_loop,
  512. a_if,
  513. a_try_table,
  514. a_legacy_try:
  515. begin
  516. blockstack.Concat(twasmblockitem.create(lastinstr));
  517. inc(cur_nesting_depth);
  518. end;
  519. a_else:
  520. begin
  521. cblock:=twasmblockitem(blockstack.Last);
  522. if (cblock=nil) or
  523. (cblock.blockstart.opcode<>a_if) or
  524. assigned(cblock.elseinstr) then
  525. Message1(parser_f_unsupported_feature,'misplaced a_else');
  526. cblock.elseinstr:=lastinstr;
  527. end;
  528. a_end_block,
  529. a_end_loop,
  530. a_end_if,
  531. a_end_try_table,
  532. a_end_legacy_try:
  533. begin
  534. dec(cur_nesting_depth);
  535. if cur_nesting_depth<0 then
  536. Message1(parser_f_unsupported_feature,'negative nesting level');
  537. cblock:=twasmblockitem(blockstack.GetLast);
  538. if (cblock=nil) or
  539. ((cblock.blockstart.opcode=a_block) and (lastinstr.opcode<>a_end_block)) or
  540. ((cblock.blockstart.opcode=a_loop) and (lastinstr.opcode<>a_end_loop)) or
  541. ((cblock.blockstart.opcode=a_if) and (lastinstr.opcode<>a_end_if)) or
  542. ((cblock.blockstart.opcode=a_try_table) and (lastinstr.opcode<>a_end_try_table)) or
  543. ((cblock.blockstart.opcode=a_legacy_try) and (lastinstr.opcode<>a_end_legacy_try)) then
  544. Message1(parser_f_unsupported_feature,'incompatible nesting level');
  545. cblock.free;
  546. end;
  547. else
  548. ;
  549. end;
  550. end;
  551. ait_label:
  552. begin
  553. lbl:=tai_label(hp);
  554. lbl.labsym.nestingdepth:=-1;
  555. nextinstr:=FindNextInstruction(hp);
  556. if assigned(nextinstr) and (nextinstr.opcode in [a_end_block,a_end_legacy_try,a_end_try_table,a_end_if]) then
  557. lbl.labsym.nestingdepth:=cur_nesting_depth
  558. else if assigned(lastinstr) and (lastinstr.opcode=a_loop) then
  559. lbl.labsym.nestingdepth:=cur_nesting_depth
  560. else if assigned(lastinstr) and (lastinstr.opcode in [a_end_block,a_end_legacy_try,a_end_try_table,a_end_if]) then
  561. lbl.labsym.nestingdepth:=cur_nesting_depth+1
  562. else if assigned(nextinstr) and (nextinstr.opcode=a_loop) then
  563. lbl.labsym.nestingdepth:=cur_nesting_depth+1;
  564. end;
  565. else
  566. ;
  567. end;
  568. hp:=tai(hp.Next);
  569. end;
  570. if cur_nesting_depth<>0 then
  571. Message1(parser_f_unsupported_feature,'unbalanced nesting level');
  572. blockstack.free;
  573. end;
  574. function resolve_labels_pass2(asmlist: TAsmList): Boolean;
  575. var
  576. hp: tai;
  577. instr, catchinstr: taicpu;
  578. hlabel: tasmsymbol;
  579. cur_nesting_depth: longint;
  580. begin
  581. Result:=true;
  582. cur_nesting_depth:=0;
  583. hp:=tai(asmlist.first);
  584. while assigned(hp) do
  585. begin
  586. if hp.typ=ait_instruction then
  587. begin
  588. instr:=taicpu(hp);
  589. case instr.opcode of
  590. a_block,
  591. a_loop,
  592. a_if,
  593. a_legacy_try:
  594. inc(cur_nesting_depth);
  595. a_try_table:
  596. begin
  597. catchinstr:=taicpu(instr.try_table_catch_clauses.First);
  598. while assigned(catchinstr) do
  599. begin
  600. case catchinstr.opcode of
  601. a_catch,
  602. a_catch_ref:
  603. begin
  604. if catchinstr.ops<>2 then
  605. Message1(parser_f_unsupported_feature,'a_catch or a_catch_ref with wrong operand count');
  606. if catchinstr.oper[1]^.typ=top_ref then
  607. begin
  608. if not assigned(catchinstr.oper[1]^.ref^.symbol) then
  609. Message1(parser_f_unsupported_feature,'a_catch or a_catch_ref with wrong ref operand');
  610. if (catchinstr.oper[1]^.ref^.base<>NR_NO) or
  611. (catchinstr.oper[1]^.ref^.index<>NR_NO) or
  612. (catchinstr.oper[1]^.ref^.offset<>0) then
  613. Message1(parser_f_unsupported_feature,'a_catch or a_catch_ref with wrong ref type');
  614. if (catchinstr.oper[1]^.ref^.symbol.nestingdepth<>-1) and
  615. (cur_nesting_depth>=catchinstr.oper[1]^.ref^.symbol.nestingdepth) then
  616. catchinstr.loadconst(0,cur_nesting_depth-catchinstr.oper[1]^.ref^.symbol.nestingdepth)
  617. else
  618. begin
  619. result:=false;
  620. hlabel:=tasmsymbol(catchinstr.oper[1]^.ref^.symbol);
  621. asmlist.insertafter(tai_comment.create(strpnew('Unable to find destination of label '+hlabel.name)),hp);
  622. end;
  623. end;
  624. end;
  625. a_catch_all,
  626. a_catch_all_ref:
  627. begin
  628. if catchinstr.ops<>1 then
  629. Message1(parser_f_unsupported_feature,'a_catch_all or a_catch_all_ref with wrong operand count');
  630. if catchinstr.oper[0]^.typ=top_ref then
  631. begin
  632. if not assigned(catchinstr.oper[0]^.ref^.symbol) then
  633. Message1(parser_f_unsupported_feature,'a_catch_all or a_catch_all_ref with wrong ref operand');
  634. if (catchinstr.oper[0]^.ref^.base<>NR_NO) or
  635. (catchinstr.oper[0]^.ref^.index<>NR_NO) or
  636. (catchinstr.oper[0]^.ref^.offset<>0) then
  637. Message1(parser_f_unsupported_feature,'a_catch_all or a_catch_all_ref with wrong ref type');
  638. if (catchinstr.oper[0]^.ref^.symbol.nestingdepth<>-1) and
  639. (cur_nesting_depth>=catchinstr.oper[0]^.ref^.symbol.nestingdepth) then
  640. catchinstr.loadconst(0,cur_nesting_depth-catchinstr.oper[0]^.ref^.symbol.nestingdepth)
  641. else
  642. begin
  643. result:=false;
  644. hlabel:=tasmsymbol(catchinstr.oper[0]^.ref^.symbol);
  645. asmlist.insertafter(tai_comment.create(strpnew('Unable to find destination of label '+hlabel.name)),hp);
  646. end;
  647. end;
  648. end;
  649. else
  650. internalerror(2025100515);
  651. end;
  652. catchinstr:=taicpu(catchinstr.Next);
  653. end;
  654. inc(cur_nesting_depth);
  655. end;
  656. a_end_block,
  657. a_end_loop,
  658. a_end_if,
  659. a_end_legacy_try,
  660. a_end_try_table:
  661. begin
  662. dec(cur_nesting_depth);
  663. if cur_nesting_depth<0 then
  664. Message1(parser_f_unsupported_feature,'negative nesting level');
  665. end;
  666. a_br,
  667. a_br_if:
  668. begin
  669. if instr.ops<>1 then
  670. Message1(parser_f_unsupported_feature,'a_br or a_br_if with wrong operand count');
  671. if instr.oper[0]^.typ=top_ref then
  672. begin
  673. if not assigned(instr.oper[0]^.ref^.symbol) then
  674. Message1(parser_f_unsupported_feature,'a_br or a_br_if with wrong ref operand');
  675. if (instr.oper[0]^.ref^.base<>NR_NO) or
  676. (instr.oper[0]^.ref^.index<>NR_NO) or
  677. (instr.oper[0]^.ref^.offset<>0) then
  678. Message1(parser_f_unsupported_feature,'a_br or a_br_if with wrong ref type');
  679. if (instr.oper[0]^.ref^.symbol.nestingdepth<>-1) and
  680. (cur_nesting_depth>=instr.oper[0]^.ref^.symbol.nestingdepth) then
  681. instr.loadconst(0,cur_nesting_depth-instr.oper[0]^.ref^.symbol.nestingdepth)
  682. else
  683. begin
  684. result:=false;
  685. hlabel:=tasmsymbol(instr.oper[0]^.ref^.symbol);
  686. asmlist.insertafter(tai_comment.create(strpnew('Unable to find destination of label '+hlabel.name)),hp);
  687. end;
  688. end;
  689. end;
  690. else
  691. ;
  692. end;
  693. end;
  694. hp:=tai(hp.Next);
  695. end;
  696. if cur_nesting_depth<>0 then
  697. Message1(parser_f_unsupported_feature,'unbalanced nesting level');
  698. end;
  699. function resolve_labels_simple(asmlist: TAsmList): Boolean;
  700. begin
  701. if not assigned(asmlist) then
  702. exit(true);
  703. resolve_labels_pass1(asmlist);
  704. result:=resolve_labels_pass2(asmlist);
  705. end;
  706. procedure resolve_labels_via_state_machine(asmlist: TAsmList);
  707. var
  708. blocks: TFPHashObjectList;
  709. curr_block, tmplist: TAsmList;
  710. hp, hpnext: tai;
  711. block_nr, machine_state, target_block_index, catch_nr: Integer;
  712. state_machine_loop_start_label, state_machine_exit: TAsmLabel;
  713. catchinstr: taicpu;
  714. begin
  715. blocks:=TFPHashObjectList.Create;
  716. curr_block:=TAsmList.Create;
  717. blocks.Add('.start',curr_block);
  718. repeat
  719. hp:=tai(asmlist.First);
  720. if assigned(hp) then
  721. begin
  722. asmlist.Remove(hp);
  723. if hp.typ=ait_label then
  724. begin
  725. if (tai_label(hp).labsym.is_used) then
  726. begin
  727. curr_block:=TAsmList.Create;
  728. blocks.Add(tai_label(hp).labsym.Name,curr_block);
  729. end;
  730. end
  731. else
  732. curr_block.Concat(hp);
  733. end;
  734. until not assigned(hp);
  735. { asmlist is now empty }
  736. asmlist.Concat(tai_comment.Create(strpnew('labels resolved via state machine')));
  737. machine_state:=AllocWasmLocal(wbt_i32);
  738. asmlist.Concat(tai_comment.Create(strpnew('machine state is in local '+tostr(machine_state))));
  739. asmlist.Concat(taicpu.op_const(a_i32_const,0));
  740. asmlist.Concat(taicpu.op_const(a_local_set,machine_state));
  741. asmlist.Concat(taicpu.op_none(a_block));
  742. asmlist.Concat(taicpu.op_none(a_loop));
  743. current_asmdata.getjumplabel(state_machine_loop_start_label);
  744. asmlist.concat(tai_label.create(state_machine_loop_start_label));
  745. current_asmdata.getjumplabel(state_machine_exit);
  746. for block_nr:=0 to blocks.Count-1 do
  747. asmlist.Concat(taicpu.op_none(a_block));
  748. for block_nr:=0 to blocks.Count-1 do
  749. begin
  750. { TODO: this sequence can be replaced with a single br_table instruction }
  751. asmlist.Concat(taicpu.op_const(a_local_get,machine_state));
  752. asmlist.Concat(taicpu.op_const(a_i32_const,block_nr));
  753. asmlist.Concat(taicpu.op_none(a_i32_eq));
  754. asmlist.Concat(taicpu.op_const(a_br_if,block_nr));
  755. end;
  756. asmlist.Concat(taicpu.op_none(a_unreachable));
  757. tmplist:=TAsmList.Create;
  758. for block_nr:=0 to blocks.Count-1 do
  759. begin
  760. asmlist.Concat(taicpu.op_none(a_end_block));
  761. asmlist.Concat(tai_comment.Create(strpnew('block '+tostr(block_nr)+' for label '+blocks.NameOfIndex(block_nr))));
  762. curr_block:=TAsmList(blocks[block_nr]);
  763. hp:=tai(curr_block.First);
  764. while assigned(hp) do
  765. begin
  766. hpnext:=tai(hp.next);
  767. if (hp.typ=ait_instruction) and (taicpu(hp).opcode in [a_br,a_br_if]) and
  768. (taicpu(hp).ops=1) and
  769. (taicpu(hp).oper[0]^.typ=top_ref) and
  770. assigned(taicpu(hp).oper[0]^.ref^.symbol) then
  771. begin
  772. target_block_index:=blocks.FindIndexOf(taicpu(hp).oper[0]^.ref^.symbol.Name);
  773. curr_block.InsertBefore(tai_comment.Create(strpnew(
  774. 'branch '+gas_op2str[taicpu(hp).opcode]+
  775. ' '+taicpu(hp).oper[0]^.ref^.symbol.Name+
  776. ' target_block_index='+tostr(target_block_index))),hp);
  777. if target_block_index<>-1 then
  778. begin
  779. tmplist.Clear;
  780. if taicpu(hp).opcode=a_br_if then
  781. tmplist.Concat(taicpu.op_none(a_if));
  782. tmplist.Concat(taicpu.op_const(a_i32_const,target_block_index));
  783. tmplist.Concat(taicpu.op_const(a_local_set,machine_state));
  784. tmplist.Concat(taicpu.op_sym(a_br,state_machine_loop_start_label));
  785. if taicpu(hp).opcode=a_br_if then
  786. tmplist.Concat(taicpu.op_none(a_end_if));
  787. curr_block.insertListAfter(hp,tmplist);
  788. curr_block.Remove(hp);
  789. end;
  790. end
  791. else if (hp.typ=ait_wasm_structured_instruction) and
  792. (taicpu_wasm_structured_instruction(hp).wstyp=aitws_try_table) and
  793. (tai_wasmstruc_try_table(hp).try_table_instr.try_table_catch_clauses.Count>0) then
  794. begin
  795. {
  796. block ;; Count
  797. block ;; Count-1
  798. ...
  799. block ;; 1
  800. block ;; 0
  801. try_table (catch 0) (catch 1) (catch 2) ... (catch Count-1)
  802. ;; code inside try
  803. end_try_table
  804. br Count
  805. end_block ;; 0
  806. br catch_0_label
  807. end_block
  808. br catch_1_label
  809. ...
  810. end_block ;; Count-1
  811. br catch_Count-1_label
  812. end_block ;; Count
  813. }
  814. for catch_nr:=0 to tai_wasmstruc_try_table(hp).try_table_instr.try_table_catch_clauses.Count do
  815. curr_block.InsertBefore(taicpu.op_none(a_block),hp);
  816. tmplist.Clear;
  817. tmplist.Concat(taicpu.op_const(a_br,tai_wasmstruc_try_table(hp).try_table_instr.try_table_catch_clauses.Count));
  818. catchinstr:=taicpu(tai_wasmstruc_try_table(hp).try_table_instr.try_table_catch_clauses.Last);
  819. for catch_nr:=tai_wasmstruc_try_table(hp).try_table_instr.try_table_catch_clauses.Count-1 downto 0 do
  820. begin
  821. case catchinstr.opcode of
  822. a_catch,a_catch_ref:
  823. begin
  824. if (catchinstr.ops<>2) or
  825. (catchinstr.oper[1]^.typ<>top_ref) or
  826. not assigned(catchinstr.oper[1]^.ref^.symbol) then
  827. internalerror(2025100517);
  828. target_block_index:=blocks.FindIndexOf(catchinstr.oper[1]^.ref^.symbol.Name);
  829. catchinstr.loadconst(1,catch_nr);
  830. end;
  831. a_catch_all,a_catch_all_ref:
  832. begin
  833. if (catchinstr.ops<>1) or
  834. (catchinstr.oper[0]^.typ<>top_ref) or
  835. not assigned(catchinstr.oper[0]^.ref^.symbol) then
  836. internalerror(2025100518);
  837. target_block_index:=blocks.FindIndexOf(catchinstr.oper[0]^.ref^.symbol.Name);
  838. catchinstr.loadconst(0,catch_nr);
  839. end;
  840. else
  841. internalerror(2025100516);
  842. end;
  843. tmplist.Concat(taicpu.op_none(a_end_block));
  844. tmplist.Concat(taicpu.op_const(a_i32_const,target_block_index));
  845. tmplist.Concat(taicpu.op_const(a_local_set,machine_state));
  846. tmplist.Concat(taicpu.op_sym(a_br,state_machine_loop_start_label));
  847. catchinstr:=taicpu(catchinstr.Previous);
  848. end;
  849. tmplist.Concat(taicpu.op_none(a_end_block));
  850. curr_block.insertListAfter(hp,tmplist);
  851. end;
  852. hp:=hpnext;
  853. end;
  854. if block_nr<(blocks.Count-1) then
  855. begin
  856. curr_block.Concat(taicpu.op_const(a_i32_const,block_nr+1));
  857. curr_block.Concat(taicpu.op_const(a_local_set,machine_state));
  858. curr_block.Concat(taicpu.op_sym(a_br,state_machine_loop_start_label));
  859. end
  860. else
  861. curr_block.Concat(taicpu.op_sym(a_br,state_machine_exit));
  862. asmlist.concatList(curr_block);
  863. end;
  864. tmplist.Free;
  865. asmlist.Concat(taicpu.op_none(a_end_loop));
  866. asmlist.Concat(taicpu.op_none(a_end_block));
  867. asmlist.concat(tai_label.create(state_machine_exit));
  868. end;
  869. procedure filter_start_exit_code(asmlist: TAsmList; out entry_code, proc_body, exit_code: TAsmList);
  870. var
  871. hp, hpnext, hpprev: tai;
  872. begin
  873. entry_code:=TAsmList.Create;
  874. proc_body:=TAsmList.Create;
  875. exit_code:=TAsmList.Create;
  876. repeat
  877. hp:=tai(asmlist.First);
  878. if assigned(hp) then
  879. begin
  880. hpnext:=tai(hp.next);
  881. if (hp.typ=ait_instruction) and (taicpu(hp).opcode=a_block) then
  882. break;
  883. asmlist.Remove(hp);
  884. entry_code.Concat(hp);
  885. hp:=hpnext;
  886. end;
  887. until not assigned(hp);
  888. repeat
  889. hp:=tai(asmlist.Last);
  890. if assigned(hp) then
  891. begin
  892. hpprev:=tai(hp.Previous);
  893. if (hp.typ=ait_instruction) and (taicpu(hp).opcode=a_end_block) then
  894. break;
  895. asmlist.Remove(hp);
  896. exit_code.Insert(hp);
  897. hp:=hpprev;
  898. end;
  899. until not assigned(hp);
  900. proc_body.insertList(asmlist);
  901. end;
  902. procedure resolve_labels_of_asmlist_with_try_blocks_recursive(asmlist: TAsmList);
  903. var
  904. hp: tai;
  905. i: Integer;
  906. begin
  907. if not assigned(asmlist) then
  908. exit;
  909. hp:=tai(asmlist.First);
  910. while assigned(hp) do
  911. begin
  912. if hp.typ=ait_wasm_structured_instruction then
  913. begin
  914. if taicpu_wasm_structured_instruction(hp).wstyp=aitws_try_table then
  915. begin
  916. resolve_labels_of_asmlist_with_try_blocks_recursive(tai_wasmstruc_try_table(hp).inner_asmlist);
  917. end
  918. else
  919. begin
  920. if not (taicpu_wasm_structured_instruction(hp).wstyp in [aitws_legacy_try_catch,aitws_legacy_try_delegate]) then
  921. internalerror(2023102201);
  922. resolve_labels_of_asmlist_with_try_blocks_recursive(tai_wasmstruc_legacy_try(hp).try_asmlist);
  923. if taicpu_wasm_structured_instruction(hp).wstyp=aitws_legacy_try_catch then
  924. with tai_wasmstruc_legacy_try_catch(hp) do
  925. begin
  926. for i:=low(catch_list) to high(catch_list) do
  927. resolve_labels_of_asmlist_with_try_blocks_recursive(catch_list[i].asmlist);
  928. resolve_labels_of_asmlist_with_try_blocks_recursive(catch_all_asmlist);
  929. end
  930. else if taicpu_wasm_structured_instruction(hp).wstyp=aitws_legacy_try_delegate then
  931. {nothing}
  932. else
  933. internalerror(2023102202);
  934. end;
  935. end;
  936. hp:=tai(hp.next);
  937. end;
  938. resolve_labels_via_state_machine(asmlist);
  939. end;
  940. procedure resolve_labels_complex(var asmlist: TAsmList);
  941. var
  942. entry_code, proc_body, exit_code: TAsmList;
  943. begin
  944. filter_start_exit_code(asmlist,entry_code,proc_body,exit_code);
  945. asmlist.Free;
  946. asmlist:=proc_body;
  947. proc_body:=nil;
  948. wasm_convert_to_structured_asmlist(asmlist);
  949. map_structured_asmlist(asmlist,@ConvertBranchTargetNumbersToLabels);
  950. map_structured_asmlist(asmlist,@ConvertIfToBrIf);
  951. map_structured_asmlist(asmlist,@ConvertLoopToBr);
  952. wasm_convert_to_flat_asmlist(asmlist);
  953. map_structured_asmlist(asmlist,@StripBlockInstructions);
  954. wasm_convert_to_structured_asmlist(asmlist);
  955. resolve_labels_of_asmlist_with_try_blocks_recursive(asmlist);
  956. wasm_convert_to_flat_asmlist(asmlist);
  957. asmlist.insertList(entry_code);
  958. entry_code.free;
  959. asmlist.concatList(exit_code);
  960. exit_code.free;
  961. if not resolve_labels_simple(asmlist) then
  962. internalerror(2023102101);
  963. end;
  964. function prepare_locals: TAsmList;
  965. var
  966. local: tai_local;
  967. l : TWasmLocal;
  968. begin
  969. result:=TAsmList.create;
  970. local:=tai_local.create([]);
  971. result.Concat(local);
  972. l:=ttgwasm(tg).localvars.first;
  973. FFuncType:=findfirst_tai_functype(aktproccode).functype;
  974. FLocals:=Copy(FFuncType.params);
  975. FParametersCount:=Length(FLocals);
  976. FFirstFreeLocal:=FParametersCount;
  977. while Assigned(l) do
  978. begin
  979. SetLength(FLocals,Length(FLocals)+1);
  980. FLocals[High(FLocals)]:=l.typ;
  981. local.AddLocal(l.typ);
  982. l:=l.nextseq;
  983. Inc(FFirstFreeLocal);
  984. end;
  985. end;
  986. procedure add_extra_allocated_locals(localslist: TAsmList);
  987. begin
  988. if tai(localslist.First).typ<>ait_local then
  989. internalerror(2024081501);
  990. tai_local(localslist.First).AddLocals(FAllocatedLocals);
  991. end;
  992. procedure insert_localslist(destlist,localslist: TAsmList);
  993. begin
  994. if assigned(localslist) then
  995. destlist.insertListAfter(findfirst_tai_functype(destlist),localslist);
  996. end;
  997. procedure check_goto_br_instructions(list: TAsmList; out HasGotoBrInstructions: boolean);
  998. var
  999. hp: tai;
  1000. begin
  1001. HasGotoBrInstructions:=False;
  1002. hp:=tai(list.first);
  1003. while assigned(hp) do
  1004. begin
  1005. if (hp.typ=ait_instruction) and (taicpu(hp).is_br_generated_by_goto) then
  1006. begin
  1007. HasGotoBrInstructions:=True;
  1008. if (taicpu(hp).opcode<>a_br) or
  1009. (taicpu(hp).ops<>1) or
  1010. (taicpu(hp).oper[0]^.typ<>top_ref) or
  1011. (taicpu(hp).oper[0]^.ref^.offset<>0) or
  1012. (taicpu(hp).oper[0]^.ref^.base<>NR_NO) or
  1013. (taicpu(hp).oper[0]^.ref^.index<>NR_NO) or
  1014. (taicpu(hp).oper[0]^.ref^.symbol=nil) then
  1015. internalerror(2023102203);
  1016. if not is_goto_target(taicpu(hp).oper[0]^.ref^.symbol) then
  1017. internalerror(2023102204);
  1018. end;
  1019. hp:=tai(hp.next);
  1020. end;
  1021. end;
  1022. procedure validate_code;
  1023. var
  1024. vs: TWasmValidationStacks;
  1025. hp: tai;
  1026. begin
  1027. vs:=TWasmValidationStacks.Create(@GetLocalType,FFuncType);
  1028. hp:=tai(aktproccode.first);
  1029. while assigned(hp) do
  1030. begin
  1031. if hp.typ=ait_instruction then
  1032. vs.Validate(taicpu(hp));
  1033. hp:=tai(hp.next);
  1034. end;
  1035. vs.Free;
  1036. end;
  1037. procedure postprocess_code_assembler;
  1038. begin
  1039. aktproccode.InsertAfter(tai_local.create([]),findfirst_tai_functype(aktproccode));
  1040. end;
  1041. var
  1042. localslist: TAsmList;
  1043. labels_resolved, has_goto: Boolean;
  1044. begin
  1045. if po_assembler in procdef.procoptions then
  1046. begin
  1047. postprocess_code_assembler;
  1048. exit;
  1049. end;
  1050. check_goto_br_instructions(aktproccode,has_goto);
  1051. localslist:=prepare_locals;
  1052. replace_local_frame_pointer(aktproccode);
  1053. labels_resolved:=false;
  1054. if not has_goto then
  1055. { TODO: make resolve_labels_simple handle goto labels correctly }
  1056. labels_resolved:=resolve_labels_simple(aktproccode);
  1057. {$ifndef DEBUG_WASM_GOTO}
  1058. if not labels_resolved then
  1059. {$endif DEBUG_WASM_GOTO}
  1060. resolve_labels_complex(aktproccode);
  1061. add_extra_allocated_locals(localslist);
  1062. insert_localslist(aktproccode,localslist);
  1063. localslist.Free;
  1064. {$ifdef DEBUG_WASM_VALIDATION}
  1065. validate_code;
  1066. {$endif DEBUG_WASM_VALIDATION}
  1067. inherited postprocess_code;
  1068. end;
  1069. procedure tcpuprocinfo.set_first_temp_offset;
  1070. var
  1071. sz : integer;
  1072. i : integer;
  1073. sym: tsym;
  1074. begin
  1075. {
  1076. Stackframe layout:
  1077. sp:
  1078. <incoming parameters>
  1079. sp+first_temp_offset:
  1080. <locals>
  1081. <temp>
  1082. }
  1083. procdef.init_paraloc_info(calleeside);
  1084. sz := procdef.calleeargareasize;
  1085. tg.setfirsttemp(sz);
  1086. end;
  1087. procedure tcpuprocinfo.add_goto_target(l: tasmlabel);
  1088. begin
  1089. FGotoTargets.Add(l.Name,l);
  1090. end;
  1091. function tcpuprocinfo.is_goto_target(l: tasmsymbol): Boolean;
  1092. begin
  1093. result:=FGotoTargets.FindIndexOf(l.Name)<>-1;
  1094. end;
  1095. initialization
  1096. cprocinfo:=tcpuprocinfo;
  1097. end.