cpupi.pas 28 KB

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