cpupi.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714
  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. FFirstFreeLocal: Integer;
  29. FAllocatedLocals: array of TWasmBasicType;
  30. function ConvertBranchTargetNumbersToLabels(ai: tai; blockstack: twasmstruc_stack): tai;
  31. { used for allocating locals during the postprocess_code stage (i.e. after register allocation) }
  32. function AllocWasmLocal(wbt: TWasmBasicType): Integer;
  33. public
  34. { label to the nearest local exception handler }
  35. CurrRaiseLabel : tasmlabel;
  36. constructor create(aparent: tprocinfo); override;
  37. function calc_stackframe_size : longint;override;
  38. procedure setup_eh; override;
  39. procedure generate_exit_label(list: tasmlist); override;
  40. procedure postprocess_code; override;
  41. procedure set_first_temp_offset;override;
  42. end;
  43. implementation
  44. uses
  45. systems,verbose,globals,tgcpu,cgexcept,
  46. tgobj,paramgr,symconst,symdef,symtable,symcpu,cgutils,pass_2,parabase,
  47. fmodule,hlcgobj,hlcgcpu,defutil;
  48. {*****************************************************************************
  49. twasmexceptionstatehandler_noexceptions
  50. *****************************************************************************}
  51. type
  52. { twasmexceptionstatehandler_noexceptions }
  53. twasmexceptionstatehandler_noexceptions = class(tcgexceptionstatehandler)
  54. class procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); override;
  55. class procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps); override;
  56. class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
  57. class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
  58. class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); override;
  59. end;
  60. class procedure twasmexceptionstatehandler_noexceptions.get_exception_temps(list:TAsmList;var t:texceptiontemps);
  61. begin
  62. if not assigned(exceptionreasontype) then
  63. exceptionreasontype:=search_system_proc('fpc_setjmp').returndef;
  64. reference_reset(t.envbuf,0,[]);
  65. reference_reset(t.jmpbuf,0,[]);
  66. tg.gethltemp(list,exceptionreasontype,exceptionreasontype.size,tt_persistent,t.reasonbuf);
  67. end;
  68. class procedure twasmexceptionstatehandler_noexceptions.unget_exception_temps(list:TAsmList;const t:texceptiontemps);
  69. begin
  70. tg.ungettemp(list,t.reasonbuf);
  71. end;
  72. class procedure twasmexceptionstatehandler_noexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
  73. begin
  74. exceptstate.exceptionlabel:=nil;
  75. exceptstate.oldflowcontrol:=flowcontrol;
  76. exceptstate.finallycodelabel:=nil;
  77. flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
  78. end;
  79. class procedure twasmexceptionstatehandler_noexceptions.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean);
  80. begin
  81. end;
  82. class procedure twasmexceptionstatehandler_noexceptions.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
  83. begin
  84. list.Concat(tai_comment.Create(strpnew('TODO: handle_nested_exception')));
  85. end;
  86. {*****************************************************************************
  87. twasmexceptionstatehandler_jsexceptions
  88. *****************************************************************************}
  89. type
  90. twasmexceptionstatehandler_jsexceptions = class(tcgexceptionstatehandler)
  91. class procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); override;
  92. class procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps); override;
  93. class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
  94. class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
  95. class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); override;
  96. end;
  97. class procedure twasmexceptionstatehandler_jsexceptions.get_exception_temps(list:TAsmList;var t:texceptiontemps);
  98. begin
  99. if not assigned(exceptionreasontype) then
  100. exceptionreasontype:=search_system_proc('fpc_setjmp').returndef;
  101. reference_reset(t.envbuf,0,[]);
  102. reference_reset(t.jmpbuf,0,[]);
  103. tg.gethltemp(list,exceptionreasontype,exceptionreasontype.size,tt_persistent,t.reasonbuf);
  104. end;
  105. class procedure twasmexceptionstatehandler_jsexceptions.unget_exception_temps(list:TAsmList;const t:texceptiontemps);
  106. begin
  107. tg.ungettemp(list,t.reasonbuf);
  108. end;
  109. class procedure twasmexceptionstatehandler_jsexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
  110. begin
  111. exceptstate.exceptionlabel:=nil;
  112. exceptstate.oldflowcontrol:=flowcontrol;
  113. exceptstate.finallycodelabel:=nil;
  114. flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
  115. end;
  116. class procedure twasmexceptionstatehandler_jsexceptions.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean);
  117. begin
  118. end;
  119. class procedure twasmexceptionstatehandler_jsexceptions.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
  120. begin
  121. list.Concat(tai_comment.Create(strpnew('TODO: handle_nested_exception')));
  122. end;
  123. {*****************************************************************************
  124. twasmexceptionstatehandler_nativeexceptions
  125. *****************************************************************************}
  126. type
  127. { twasmexceptionstatehandler_nativeexceptions }
  128. twasmexceptionstatehandler_nativeexceptions = class(tcgexceptionstatehandler)
  129. class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
  130. class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
  131. class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); override;
  132. { start of an "on" (catch) block }
  133. class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); override;
  134. { end of an "on" (catch) block }
  135. class procedure end_catch(list: TAsmList); override;
  136. end;
  137. class procedure twasmexceptionstatehandler_nativeexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
  138. begin
  139. exceptstate.exceptionlabel:=nil;
  140. exceptstate.oldflowcontrol:=flowcontrol;
  141. exceptstate.finallycodelabel:=nil;
  142. flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
  143. end;
  144. class procedure twasmexceptionstatehandler_nativeexceptions.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean);
  145. begin
  146. end;
  147. class procedure twasmexceptionstatehandler_nativeexceptions.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
  148. begin
  149. Message1(parser_f_unsupported_feature,'nested exception');
  150. end;
  151. class procedure twasmexceptionstatehandler_nativeexceptions.begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister);
  152. var
  153. pd: tprocdef;
  154. href2: treference;
  155. fpc_catches_res,
  156. paraloc1: tcgpara;
  157. exceptloc: tlocation;
  158. indirect: boolean;
  159. otherunit: boolean;
  160. begin
  161. paraloc1.init;
  162. otherunit:=findunitsymtable(excepttype.owner).moduleid<>findunitsymtable(current_procinfo.procdef.owner).moduleid;
  163. indirect:=(tf_supports_packages in target_info.flags) and
  164. (target_info.system in systems_indirect_var_imports) and
  165. (cs_imported_data in current_settings.localswitches) and
  166. otherunit;
  167. { send the vmt parameter }
  168. pd:=search_system_proc('fpc_catches');
  169. reference_reset_symbol(href2, current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname, AT_DATA, indirect), 0, sizeof(pint), []);
  170. if otherunit then
  171. current_module.add_extern_asmsym(excepttype.vmt_mangledname, AB_EXTERNAL, AT_DATA);
  172. paramanager.getcgtempparaloc(list, pd, 1, paraloc1);
  173. hlcg.a_loadaddr_ref_cgpara(list, excepttype.vmt_def, href2, paraloc1);
  174. paramanager.freecgpara(list, paraloc1);
  175. fpc_catches_res:=hlcg.g_call_system_proc(list, pd, [@paraloc1], nil);
  176. location_reset(exceptloc, LOC_REGISTER, def_cgsize(fpc_catches_res.def));
  177. exceptloc.register:=hlcg.getaddressregister(list, fpc_catches_res.def);
  178. hlcg.gen_load_cgpara_loc(list, fpc_catches_res.def, fpc_catches_res, exceptloc, true);
  179. { is it this catch? }
  180. thlcgwasm(hlcg).a_cmp_const_reg_stack(list, fpc_catches_res.def, OC_NE, 0, exceptloc.register);
  181. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
  182. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  183. paraloc1.done;
  184. exceptlocdef:=fpc_catches_res.def;
  185. exceptlocreg:=exceptloc.register;
  186. end;
  187. class procedure twasmexceptionstatehandler_nativeexceptions.end_catch(list: TAsmList);
  188. begin
  189. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
  190. end;
  191. {*****************************************************************************
  192. twasmexceptionstatehandler_bfexceptions
  193. *****************************************************************************}
  194. type
  195. { twasmexceptionstatehandler_bfexceptions }
  196. twasmexceptionstatehandler_bfexceptions = class(tcgexceptionstatehandler)
  197. class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
  198. class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
  199. class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); override;
  200. { start of an "on" (catch) block }
  201. class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); override;
  202. { end of an "on" (catch) block }
  203. class procedure end_catch(list: TAsmList); override;
  204. end;
  205. class procedure twasmexceptionstatehandler_bfexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
  206. begin
  207. exceptstate.exceptionlabel:=nil;
  208. exceptstate.oldflowcontrol:=flowcontrol;
  209. exceptstate.finallycodelabel:=nil;
  210. flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
  211. end;
  212. class procedure twasmexceptionstatehandler_bfexceptions.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean);
  213. begin
  214. end;
  215. class procedure twasmexceptionstatehandler_bfexceptions.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
  216. begin
  217. Message1(parser_f_unsupported_feature,'nested exception');
  218. end;
  219. class procedure twasmexceptionstatehandler_bfexceptions.begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister);
  220. var
  221. pd: tprocdef;
  222. href2: treference;
  223. fpc_catches_res,
  224. paraloc1: tcgpara;
  225. exceptloc: tlocation;
  226. indirect: boolean;
  227. otherunit: boolean;
  228. begin
  229. paraloc1.init;
  230. otherunit:=findunitsymtable(excepttype.owner).moduleid<>findunitsymtable(current_procinfo.procdef.owner).moduleid;
  231. indirect:=(tf_supports_packages in target_info.flags) and
  232. (target_info.system in systems_indirect_var_imports) and
  233. (cs_imported_data in current_settings.localswitches) and
  234. otherunit;
  235. { send the vmt parameter }
  236. pd:=search_system_proc('fpc_catches');
  237. reference_reset_symbol(href2, current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname, AT_DATA, indirect), 0, sizeof(pint), []);
  238. if otherunit then
  239. current_module.add_extern_asmsym(excepttype.vmt_mangledname, AB_EXTERNAL, AT_DATA);
  240. paramanager.getcgtempparaloc(list, pd, 1, paraloc1);
  241. hlcg.a_loadaddr_ref_cgpara(list, excepttype.vmt_def, href2, paraloc1);
  242. paramanager.freecgpara(list, paraloc1);
  243. fpc_catches_res:=hlcg.g_call_system_proc(list, pd, [@paraloc1], nil);
  244. location_reset(exceptloc, LOC_REGISTER, def_cgsize(fpc_catches_res.def));
  245. exceptloc.register:=hlcg.getaddressregister(list, fpc_catches_res.def);
  246. hlcg.gen_load_cgpara_loc(list, fpc_catches_res.def, fpc_catches_res, exceptloc, true);
  247. { is it this catch? }
  248. thlcgwasm(hlcg).a_cmp_const_reg_stack(list, fpc_catches_res.def, OC_NE, 0, exceptloc.register);
  249. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
  250. thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  251. paraloc1.done;
  252. exceptlocdef:=fpc_catches_res.def;
  253. exceptlocreg:=exceptloc.register;
  254. end;
  255. class procedure twasmexceptionstatehandler_bfexceptions.end_catch(list: TAsmList);
  256. begin
  257. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
  258. end;
  259. {*****************************************************************************
  260. twasmblockitem
  261. *****************************************************************************}
  262. type
  263. { twasmblockitem }
  264. twasmblockitem = class(TLinkedListItem)
  265. blockstart: taicpu;
  266. elseinstr: taicpu;
  267. constructor Create(ablockstart: taicpu);
  268. end;
  269. constructor twasmblockitem.Create(ablockstart: taicpu);
  270. begin
  271. blockstart:=ablockstart;
  272. end;
  273. {*****************************************************************************
  274. twasmblockstack
  275. *****************************************************************************}
  276. type
  277. { twasmblockstack }
  278. twasmblockstack = class(tlinkedlist)
  279. end;
  280. {*****************************************************************************
  281. tcpuprocinfo
  282. *****************************************************************************}
  283. function tcpuprocinfo.ConvertBranchTargetNumbersToLabels(ai: tai; blockstack: twasmstruc_stack): tai;
  284. var
  285. instr: taicpu;
  286. bl: taicpu_wasm_structured_instruction;
  287. l: TAsmLabel;
  288. begin
  289. result:=ai;
  290. if ai.typ<>ait_instruction then
  291. exit;
  292. instr:=taicpu(ai);
  293. if not (instr.opcode in [a_br,a_br_if]) then
  294. exit;
  295. if instr.ops<>1 then
  296. internalerror(2023101601);
  297. if instr.oper[0]^.typ<>top_const then
  298. exit;
  299. bl:=blockstack[instr.oper[0]^.val];
  300. l:=bl.getlabel;
  301. instr.loadsymbol(0,l,0);
  302. end;
  303. function tcpuprocinfo.AllocWasmLocal(wbt: TWasmBasicType): Integer;
  304. begin
  305. SetLength(FAllocatedLocals,Length(FAllocatedLocals)+1);
  306. FAllocatedLocals[High(FAllocatedLocals)]:=wbt;
  307. result:=High(FAllocatedLocals)+FFirstFreeLocal;
  308. end;
  309. constructor tcpuprocinfo.create(aparent: tprocinfo);
  310. begin
  311. inherited create(aparent);
  312. if ts_wasm_bf_exceptions in current_settings.targetswitches then
  313. current_asmdata.getjumplabel(CurrRaiseLabel);
  314. end;
  315. function tcpuprocinfo.calc_stackframe_size: longint;
  316. begin
  317. { the stack frame in WebAssembly should always have a 16-byte alignment }
  318. Result:=Align(inherited calc_stackframe_size,16);
  319. end;
  320. procedure tcpuprocinfo.setup_eh;
  321. begin
  322. if ts_wasm_native_exceptions in current_settings.targetswitches then
  323. cexceptionstatehandler:=twasmexceptionstatehandler_nativeexceptions
  324. else if ts_wasm_js_exceptions in current_settings.targetswitches then
  325. cexceptionstatehandler:=twasmexceptionstatehandler_jsexceptions
  326. else if ts_wasm_no_exceptions in current_settings.targetswitches then
  327. cexceptionstatehandler:=twasmexceptionstatehandler_noexceptions
  328. else if ts_wasm_bf_exceptions in current_settings.targetswitches then
  329. cexceptionstatehandler:=twasmexceptionstatehandler_bfexceptions
  330. else
  331. internalerror(2021091701);
  332. end;
  333. procedure tcpuprocinfo.generate_exit_label(list: tasmlist);
  334. begin
  335. list.concat(taicpu.op_none(a_end_block));
  336. inherited generate_exit_label(list);
  337. end;
  338. procedure tcpuprocinfo.postprocess_code;
  339. function findfirst_tai_functype(asmlist: TAsmList): tai_functype;
  340. var
  341. hp: tai;
  342. begin
  343. result:=nil;
  344. if not assigned(asmlist) then
  345. exit;
  346. hp:=tai(asmlist.first);
  347. while assigned(hp) do
  348. begin
  349. if hp.typ=ait_functype then
  350. begin
  351. result:=tai_functype(hp);
  352. exit;
  353. end;
  354. hp:=tai(hp.Next);
  355. end;
  356. end;
  357. procedure replace_local_frame_pointer(asmlist: TAsmList);
  358. var
  359. hp: tai;
  360. instr: taicpu;
  361. l: Integer;
  362. begin
  363. if not assigned(asmlist) then
  364. exit;
  365. hp:=tai(asmlist.first);
  366. while assigned(hp) do
  367. begin
  368. if hp.typ=ait_instruction then
  369. begin
  370. instr:=taicpu(hp);
  371. for l:=0 to instr.ops-1 do
  372. if (instr.oper[l]^.typ=top_reg) and (instr.oper[l]^.reg=NR_LOCAL_FRAME_POINTER_REG) then
  373. instr.loadref(l,tcpuprocdef(current_procinfo.procdef).frame_pointer_ref);
  374. end;
  375. hp:=tai(hp.Next);
  376. end;
  377. end;
  378. function FindNextInstruction(hp: tai): taicpu;
  379. begin
  380. result:=nil;
  381. if not assigned(hp) then
  382. exit;
  383. repeat
  384. hp:=tai(hp.next);
  385. until not assigned(hp) or (hp.typ=ait_instruction);
  386. if assigned(hp) then
  387. result:=taicpu(hp);
  388. end;
  389. procedure resolve_labels_pass1(asmlist: TAsmList);
  390. var
  391. hp: tai;
  392. lastinstr, nextinstr: taicpu;
  393. cur_nesting_depth: longint;
  394. lbl: tai_label;
  395. blockstack: twasmblockstack;
  396. cblock: twasmblockitem;
  397. begin
  398. blockstack:=twasmblockstack.create;
  399. cur_nesting_depth:=0;
  400. lastinstr:=nil;
  401. hp:=tai(asmlist.first);
  402. while assigned(hp) do
  403. begin
  404. case hp.typ of
  405. ait_instruction:
  406. begin
  407. lastinstr:=taicpu(hp);
  408. case lastinstr.opcode of
  409. a_block,
  410. a_loop,
  411. a_if,
  412. a_try:
  413. begin
  414. blockstack.Concat(twasmblockitem.create(lastinstr));
  415. inc(cur_nesting_depth);
  416. end;
  417. a_else:
  418. begin
  419. cblock:=twasmblockitem(blockstack.Last);
  420. if (cblock=nil) or
  421. (cblock.blockstart.opcode<>a_if) or
  422. assigned(cblock.elseinstr) then
  423. Message1(parser_f_unsupported_feature,'misplaced a_else');
  424. cblock.elseinstr:=lastinstr;
  425. end;
  426. a_end_block,
  427. a_end_loop,
  428. a_end_if,
  429. a_end_try:
  430. begin
  431. dec(cur_nesting_depth);
  432. if cur_nesting_depth<0 then
  433. Message1(parser_f_unsupported_feature,'negative nesting level');
  434. cblock:=twasmblockitem(blockstack.GetLast);
  435. if (cblock=nil) or
  436. ((cblock.blockstart.opcode=a_block) and (lastinstr.opcode<>a_end_block)) or
  437. ((cblock.blockstart.opcode=a_loop) and (lastinstr.opcode<>a_end_loop)) or
  438. ((cblock.blockstart.opcode=a_if) and (lastinstr.opcode<>a_end_if)) or
  439. ((cblock.blockstart.opcode=a_try) and (lastinstr.opcode<>a_end_try)) then
  440. Message1(parser_f_unsupported_feature,'incompatible nesting level');
  441. cblock.free;
  442. end;
  443. else
  444. ;
  445. end;
  446. end;
  447. ait_label:
  448. begin
  449. lbl:=tai_label(hp);
  450. lbl.labsym.nestingdepth:=-1;
  451. nextinstr:=FindNextInstruction(hp);
  452. if assigned(nextinstr) and (nextinstr.opcode in [a_end_block,a_end_try,a_end_if]) then
  453. lbl.labsym.nestingdepth:=cur_nesting_depth
  454. else if assigned(lastinstr) and (lastinstr.opcode=a_loop) then
  455. lbl.labsym.nestingdepth:=cur_nesting_depth
  456. else if assigned(lastinstr) and (lastinstr.opcode in [a_end_block,a_end_try,a_end_if]) then
  457. lbl.labsym.nestingdepth:=cur_nesting_depth+1
  458. else if assigned(nextinstr) and (nextinstr.opcode=a_loop) then
  459. lbl.labsym.nestingdepth:=cur_nesting_depth+1;
  460. end;
  461. else
  462. ;
  463. end;
  464. hp:=tai(hp.Next);
  465. end;
  466. if cur_nesting_depth<>0 then
  467. Message1(parser_f_unsupported_feature,'unbalanced nesting level');
  468. blockstack.free;
  469. end;
  470. function resolve_labels_pass2(asmlist: TAsmList): Boolean;
  471. var
  472. hp: tai;
  473. instr: taicpu;
  474. hlabel: tasmsymbol;
  475. cur_nesting_depth: longint;
  476. begin
  477. Result:=true;
  478. cur_nesting_depth:=0;
  479. hp:=tai(asmlist.first);
  480. while assigned(hp) do
  481. begin
  482. if hp.typ=ait_instruction then
  483. begin
  484. instr:=taicpu(hp);
  485. case instr.opcode of
  486. a_block,
  487. a_loop,
  488. a_if,
  489. a_try:
  490. inc(cur_nesting_depth);
  491. a_end_block,
  492. a_end_loop,
  493. a_end_if,
  494. a_end_try:
  495. begin
  496. dec(cur_nesting_depth);
  497. if cur_nesting_depth<0 then
  498. Message1(parser_f_unsupported_feature,'negative nesting level');
  499. end;
  500. a_br,
  501. a_br_if:
  502. begin
  503. if instr.ops<>1 then
  504. Message1(parser_f_unsupported_feature,'a_br or a_br_if with wrong operand count');
  505. if instr.oper[0]^.typ=top_ref then
  506. begin
  507. if not assigned(instr.oper[0]^.ref^.symbol) then
  508. Message1(parser_f_unsupported_feature,'a_br or a_br_if with wrong ref operand');
  509. if (instr.oper[0]^.ref^.base<>NR_NO) or
  510. (instr.oper[0]^.ref^.index<>NR_NO) or
  511. (instr.oper[0]^.ref^.offset<>0) then
  512. Message1(parser_f_unsupported_feature,'a_br or a_br_if with wrong ref type');
  513. if (instr.oper[0]^.ref^.symbol.nestingdepth<>-1) and
  514. (cur_nesting_depth>=instr.oper[0]^.ref^.symbol.nestingdepth) then
  515. instr.loadconst(0,cur_nesting_depth-instr.oper[0]^.ref^.symbol.nestingdepth)
  516. else
  517. begin
  518. result:=false;
  519. hlabel:=tasmsymbol(instr.oper[0]^.ref^.symbol);
  520. asmlist.insertafter(tai_comment.create(strpnew('Unable to find destination of label '+hlabel.name)),hp);
  521. end;
  522. end;
  523. end;
  524. else
  525. ;
  526. end;
  527. end;
  528. hp:=tai(hp.Next);
  529. end;
  530. if cur_nesting_depth<>0 then
  531. Message1(parser_f_unsupported_feature,'unbalanced nesting level');
  532. end;
  533. function resolve_labels_simple(asmlist: TAsmList): Boolean;
  534. begin
  535. if not assigned(asmlist) then
  536. exit(true);
  537. resolve_labels_pass1(asmlist);
  538. result:=resolve_labels_pass2(asmlist);
  539. end;
  540. procedure resolve_labels_complex(var asmlist: TAsmList);
  541. var
  542. l2: TAsmList;
  543. begin
  544. l2:=TAsmList.Create;
  545. wasm_convert_to_structured_asmlist(asmlist,l2);
  546. asmlist.Free;
  547. asmlist:=l2;
  548. map_structured_asmlist(asmlist,@ConvertBranchTargetNumbersToLabels);
  549. l2:=TAsmList.Create;
  550. wasm_convert_to_flat_asmlist(asmlist,l2);
  551. asmlist.Free;
  552. asmlist:=l2;
  553. end;
  554. var
  555. templist: TAsmList;
  556. l : TWasmLocal;
  557. first, labels_resolved: Boolean;
  558. local: tai_local;
  559. first_tai_functype: tai_functype;
  560. begin
  561. first_tai_functype:=findfirst_tai_functype(aktproccode);
  562. templist:=TAsmList.create;
  563. local:=nil;
  564. first:=true;
  565. l:=ttgwasm(tg).localvars.first;
  566. FFirstFreeLocal:=Length(first_tai_functype.functype.params);
  567. while Assigned(l) do
  568. begin
  569. local:=tai_local.create(l.typ);
  570. local.first:=first;
  571. first:=false;
  572. templist.Concat(local);
  573. l:=l.nextseq;
  574. Inc(FFirstFreeLocal);
  575. end;
  576. if assigned(local) then
  577. local.last:=true;
  578. aktproccode.insertListAfter(first_tai_functype,templist);
  579. templist.Free;
  580. replace_local_frame_pointer(aktproccode);
  581. labels_resolved:=resolve_labels_simple(aktproccode);
  582. {$ifndef DEBUG_WASM_GOTO}
  583. if not labels_resolved then
  584. {$endif DEBUG_WASM_GOTO}
  585. resolve_labels_complex(aktproccode);
  586. inherited postprocess_code;
  587. end;
  588. procedure tcpuprocinfo.set_first_temp_offset;
  589. var
  590. sz : integer;
  591. i : integer;
  592. sym: tsym;
  593. begin
  594. {
  595. Stackframe layout:
  596. sp:
  597. <incoming parameters>
  598. sp+first_temp_offset:
  599. <locals>
  600. <temp>
  601. }
  602. procdef.init_paraloc_info(calleeside);
  603. sz := procdef.calleeargareasize;
  604. tg.setfirsttemp(sz);
  605. end;
  606. initialization
  607. cprocinfo:=tcpuprocinfo;
  608. end.