ncgcal.pas 69 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Generate i386 assembler for in call nodes
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published bymethodpointer
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit ncgcal;
  19. {$i fpcdefs.inc}
  20. interface
  21. { $define AnsiStrRef}
  22. uses
  23. cpubase,
  24. globtype,
  25. symdef,node,ncal;
  26. type
  27. tcgcallparanode = class(tcallparanode)
  28. procedure secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;
  29. para_alignment,para_offset : longint);override;
  30. end;
  31. tcgcallnode = class(tcallnode)
  32. private
  33. function push_self_and_vmt(needvmtreg:boolean):tregister;
  34. protected
  35. // funcretref : treference;
  36. refcountedtemp : treference;
  37. procedure handle_return_value(inlined:boolean);
  38. {# This routine is used to push the current frame pointer
  39. on the stack. This is used in nested routines where the
  40. value of the frame pointer is always pushed as an extra
  41. parameter.
  42. The default handling is the standard handling used on
  43. most stack based machines, where the frame pointer is
  44. the first invisible parameter.
  45. }
  46. function align_parasize(parasize,para_alignment:longint):longint;virtual;
  47. procedure pop_parasize(pop_size:longint);virtual;
  48. procedure push_framepointer;virtual;
  49. procedure extra_interrupt_code;virtual;
  50. public
  51. procedure pass_2;override;
  52. end;
  53. tcgprocinlinenode = class(tprocinlinenode)
  54. procedure pass_2;override;
  55. end;
  56. implementation
  57. uses
  58. systems,
  59. cutils,verbose,globals,
  60. symconst,symbase,symsym,symtable,defutil,paramgr,
  61. {$ifdef GDB}
  62. {$ifdef delphi}
  63. sysutils,
  64. {$else}
  65. strings,
  66. {$endif}
  67. gdb,
  68. {$endif GDB}
  69. cginfo,cgbase,pass_2,
  70. cpuinfo,cpupi,aasmbase,aasmtai,aasmcpu,
  71. nbas,nmem,nld,ncnv,
  72. {$ifdef x86}
  73. cga,
  74. {$endif x86}
  75. {$ifdef cpu64bit}
  76. cg64f64,
  77. {$else cpu64bit}
  78. cg64f32,
  79. {$endif cpu64bit}
  80. ncgutil,cgobj,tgobj,regvars,rgobj,rgcpu,cgcpu;
  81. var
  82. { Current callnode, this is needed for having a link
  83. between the callparanodes and the callnode they belong to }
  84. aktcallnode : tcallnode;
  85. {*****************************************************************************
  86. TCGCALLPARANODE
  87. *****************************************************************************}
  88. procedure tcgcallparanode.secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;para_alignment,para_offset : longint);
  89. var
  90. otlabel,
  91. oflabel : tasmlabel;
  92. tmpreg : tregister;
  93. href : treference;
  94. begin
  95. if not(assigned(paraitem.paratype.def) or
  96. assigned(paraitem.parasym)) then
  97. internalerror(200304242);
  98. { set default para_alignment to target_info.stackalignment }
  99. if para_alignment=0 then
  100. para_alignment:=aktalignment.paraalign;
  101. { push from left to right if specified }
  102. if push_from_left_to_right and assigned(right) then
  103. begin
  104. if (nf_varargs_para in flags) then
  105. tcallparanode(right).secondcallparan(push_from_left_to_right,
  106. calloption,para_alignment,para_offset)
  107. else
  108. tcallparanode(right).secondcallparan(push_from_left_to_right,
  109. calloption,para_alignment,para_offset);
  110. end;
  111. otlabel:=truelabel;
  112. oflabel:=falselabel;
  113. objectlibrary.getlabel(truelabel);
  114. objectlibrary.getlabel(falselabel);
  115. secondpass(left);
  116. { handle varargs first, because defcoll is not valid }
  117. if (nf_varargs_para in flags) then
  118. begin
  119. if paramanager.push_addr_param(left.resulttype.def,calloption) then
  120. begin
  121. inc(pushedparasize,POINTER_SIZE);
  122. cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
  123. location_release(exprasmlist,left.location);
  124. end
  125. else
  126. push_value_para(exprasmlist,left,calloption,para_offset,para_alignment,paraitem.paraloc);
  127. end
  128. { filter array of const c styled args }
  129. else if is_array_of_const(left.resulttype.def) and (nf_cargs in left.flags) then
  130. begin
  131. { nothing, everything is already pushed }
  132. end
  133. { in codegen.handleread.. paraitem.data is set to nil }
  134. else if assigned(paraitem.paratype.def) and
  135. (paraitem.paratype.def.deftype=formaldef) then
  136. begin
  137. { allow passing of a constant to a const formaldef }
  138. if (tvarsym(paraitem.parasym).varspez=vs_const) and
  139. (left.location.loc=LOC_CONSTANT) then
  140. location_force_mem(exprasmlist,left.location);
  141. { allow @var }
  142. inc(pushedparasize,POINTER_SIZE);
  143. if (left.nodetype=addrn) and
  144. (not(nf_procvarload in left.flags)) then
  145. begin
  146. if calloption=pocall_inline then
  147. begin
  148. reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
  149. cg.a_load_loc_ref(exprasmlist,left.location,href);
  150. end
  151. else
  152. cg.a_param_loc(exprasmlist,left.location,paraitem.paraloc);
  153. location_release(exprasmlist,left.location);
  154. end
  155. else
  156. begin
  157. if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  158. internalerror(200304235);
  159. if calloption=pocall_inline then
  160. begin
  161. {$ifdef newra}
  162. tmpreg:=rg.getaddressregister(exprasmlist);
  163. {$else}
  164. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  165. {$endif newra}
  166. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
  167. reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
  168. cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
  169. {$ifdef newra}
  170. rg.ungetregisterint(exprasmlist,tmpreg);
  171. {$else}
  172. cg.free_scratch_reg(exprasmlist,tmpreg);
  173. {$endif}
  174. end
  175. else
  176. cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
  177. location_release(exprasmlist,left.location);
  178. end;
  179. end
  180. { handle call by reference parameter }
  181. else if (paraitem.paratyp in [vs_var,vs_out]) then
  182. begin
  183. if (left.location.loc<>LOC_REFERENCE) then
  184. begin
  185. { passing self to a var parameter is allowed in
  186. TP and delphi }
  187. if not((left.location.loc=LOC_CREFERENCE) and
  188. (left.nodetype=selfn)) then
  189. internalerror(200106041);
  190. end;
  191. if (paraitem.paratyp=vs_out) and
  192. assigned(paraitem.paratype.def) and
  193. not is_class(paraitem.paratype.def) and
  194. paraitem.paratype.def.needs_inittable then
  195. cg.g_finalize(exprasmlist,paraitem.paratype.def,left.location.reference,false);
  196. inc(pushedparasize,POINTER_SIZE);
  197. if calloption=pocall_inline then
  198. begin
  199. {$ifdef newra}
  200. tmpreg:=rg.getaddressregister(exprasmlist);
  201. {$else}
  202. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  203. {$endif}
  204. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
  205. reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
  206. cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
  207. {$ifdef newra}
  208. rg.ungetregisterint(exprasmlist,tmpreg);
  209. {$else}
  210. cg.free_scratch_reg(exprasmlist,tmpreg);
  211. {$endif}
  212. end
  213. else
  214. cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
  215. location_release(exprasmlist,left.location);
  216. end
  217. else
  218. begin
  219. { open array must always push the address, this is needed to
  220. also push addr of small open arrays and with cdecl functions (PFV) }
  221. if (
  222. assigned(paraitem.paratype.def) and
  223. (is_open_array(paraitem.paratype.def) or
  224. is_array_of_const(paraitem.paratype.def))
  225. ) or
  226. (
  227. paramanager.push_addr_param(resulttype.def,calloption)
  228. ) then
  229. begin
  230. if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  231. begin
  232. { allow passing nil to a procvardef (methodpointer) }
  233. if (left.nodetype=typeconvn) and
  234. (left.resulttype.def.deftype=procvardef) and
  235. (ttypeconvnode(left).left.nodetype=niln) then
  236. begin
  237. tg.GetTemp(exprasmlist,tcgsize2size[left.location.size],tt_normal,href);
  238. if not (left.location.size in [OS_64,OS_S64]) then
  239. cg.a_load_loc_ref(exprasmlist,left.location,href)
  240. else
  241. cg64.a_load64_loc_ref(exprasmlist,left.location,href);
  242. location_reset(left.location,LOC_REFERENCE,left.location.size);
  243. left.location.reference:=href;
  244. end
  245. else
  246. internalerror(200204011);
  247. end;
  248. inc(pushedparasize,POINTER_SIZE);
  249. if calloption=pocall_inline then
  250. begin
  251. {$ifdef newra}
  252. tmpreg:=rg.getaddressregister(exprasmlist);
  253. {$else}
  254. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  255. {$endif}
  256. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
  257. reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
  258. cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
  259. {$ifdef newra}
  260. rg.ungetregisterint(exprasmlist,tmpreg);
  261. {$else}
  262. cg.free_scratch_reg(exprasmlist,tmpreg);
  263. {$endif}
  264. end
  265. else
  266. cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
  267. location_release(exprasmlist,left.location);
  268. end
  269. else
  270. begin
  271. push_value_para(exprasmlist,left,calloption,
  272. para_offset,para_alignment,paraitem.paraloc);
  273. end;
  274. end;
  275. truelabel:=otlabel;
  276. falselabel:=oflabel;
  277. { update return location in callnode when this is the function
  278. result }
  279. if (vo_is_funcret in tvarsym(paraitem.parasym).varoptions) then
  280. begin
  281. location_copy(aktcallnode.location,left.location);
  282. end;
  283. { push from right to left }
  284. if not push_from_left_to_right and assigned(right) then
  285. begin
  286. if (nf_varargs_para in flags) then
  287. tcallparanode(right).secondcallparan(push_from_left_to_right,
  288. calloption,para_alignment,para_offset)
  289. else
  290. tcallparanode(right).secondcallparan(push_from_left_to_right,
  291. calloption,para_alignment,para_offset);
  292. end;
  293. end;
  294. {*****************************************************************************
  295. TCGCALLNODE
  296. *****************************************************************************}
  297. procedure tcgcallnode.extra_interrupt_code;
  298. begin
  299. end;
  300. function tcgcallnode.align_parasize(parasize,para_alignment:longint):longint;
  301. begin
  302. result:=0;
  303. end;
  304. procedure tcgcallnode.pop_parasize(pop_size:longint);
  305. begin
  306. end;
  307. function tcgcallnode.push_self_and_vmt(needvmtreg:boolean):tregister;
  308. var
  309. href : treference;
  310. vmtloc,selfloc : tlocation;
  311. self_is_vmt,
  312. vmtrefaddr,
  313. selfrefaddr : boolean;
  314. procedure selfloc_to_register;
  315. var
  316. hregister : tregister;
  317. begin
  318. case selfloc.loc of
  319. LOC_REGISTER :
  320. hregister:=selfloc.register;
  321. LOC_CREFERENCE,
  322. LOC_REFERENCE :
  323. begin
  324. hregister:=rg.getaddressregister(exprasmlist);
  325. if selfrefaddr then
  326. begin
  327. cg.a_loadaddr_ref_reg(exprasmlist,selfloc.reference,hregister);
  328. selfrefaddr:=false;
  329. end
  330. else
  331. cg.a_load_ref_reg(exprasmlist,OS_ADDR,selfloc.reference,hregister);
  332. reference_release(exprasmlist,selfloc.reference);
  333. end;
  334. else
  335. internalerror(200303269);
  336. end;
  337. location_reset(selfloc,LOC_REGISTER,OS_ADDR);
  338. selfloc.register:=hregister;
  339. end;
  340. begin
  341. result.enum:=R_INTREGISTER;
  342. result.number:=NR_NO;
  343. location_reset(vmtloc,LOC_CONSTANT,OS_ADDR);
  344. location_reset(selfloc,LOC_CONSTANT,OS_ADDR);
  345. vmtrefaddr:=false;
  346. selfrefaddr:=false;
  347. self_is_vmt:=false;
  348. { generate fake methodpointer node for withsymtable }
  349. if (symtableproc.symtabletype=withsymtable) then
  350. begin
  351. methodpointer:=cnothingnode.create;
  352. methodpointer.resulttype:=twithnode(twithsymtable(symtableproc).withnode).left.resulttype;
  353. end;
  354. if assigned(methodpointer) then
  355. begin
  356. case methodpointer.nodetype of
  357. typen:
  358. begin
  359. if (sp_static in symtableprocentry.symoptions) then
  360. begin
  361. self_is_vmt:=true;
  362. if (oo_has_vmt in tobjectdef(methodpointer.resulttype.def).objectoptions) then
  363. begin
  364. location_reset(vmtloc,LOC_REFERENCE,OS_NO);
  365. reference_reset_symbol(vmtloc.reference,objectlibrary.newasmsymboldata(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  366. vmtrefaddr:=true;
  367. end;
  368. end
  369. else
  370. begin
  371. { normal member call, load self. Not for classes
  372. when we call the constructor }
  373. if not(
  374. is_class(methodpointer.resulttype.def) and
  375. (procdefinition.proctypeoption=potype_constructor) and
  376. (current_procdef.proctypeoption<>potype_constructor)
  377. ) then
  378. begin
  379. location_reset(selfloc,LOC_REGISTER,OS_ADDR);
  380. selfloc.register:=cg.g_load_self(exprasmlist);
  381. end;
  382. end;
  383. if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) then
  384. begin
  385. if is_object(methodpointer.resulttype.def) then
  386. begin
  387. { reset self when calling constructor from destructor }
  388. if (procdefinition.proctypeoption=potype_constructor) and
  389. assigned(current_procdef) and
  390. (current_procdef.proctypeoption=potype_destructor) then
  391. begin
  392. location_release(exprasmlist,selfloc);
  393. location_reset(selfloc,LOC_CONSTANT,OS_ADDR);
  394. end;
  395. end;
  396. end;
  397. end;
  398. hnewn:
  399. begin
  400. { constructor with extended syntax called from new }
  401. { vmt }
  402. location_reset(vmtloc,LOC_REFERENCE,OS_ADDR);
  403. reference_reset_symbol(vmtloc.reference,objectlibrary.newasmsymboldata(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  404. vmtrefaddr:=true;
  405. end;
  406. hdisposen:
  407. begin
  408. { destructor with extended syntax called from dispose }
  409. { hdisposen always deliver LOC_REFERENCE }
  410. secondpass(methodpointer);
  411. { vmt }
  412. location_reset(vmtloc,LOC_REFERENCE,OS_ADDR);
  413. reference_reset_symbol(vmtloc.reference,objectlibrary.newasmsymboldata(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  414. vmtrefaddr:=true;
  415. { self, load in register first when it requires a virtual call }
  416. location_reset(selfloc,LOC_REFERENCE,OS_ADDR);
  417. selfloc.reference:=methodpointer.location.reference;
  418. selfrefaddr:=true;
  419. end;
  420. else
  421. begin
  422. { call to an instance member }
  423. if (symtableproc.symtabletype<>withsymtable) then
  424. begin
  425. secondpass(methodpointer);
  426. case methodpointer.location.loc of
  427. LOC_CREGISTER,
  428. LOC_REGISTER:
  429. begin
  430. location_reset(selfloc,LOC_REGISTER,OS_ADDR);
  431. selfloc.register:=methodpointer.location.register;
  432. end;
  433. LOC_CREFERENCE,
  434. LOC_REFERENCE :
  435. begin
  436. location_reset(selfloc,LOC_REFERENCE,OS_ADDR);
  437. selfloc.reference:=methodpointer.location.reference;
  438. if (methodpointer.resulttype.def.deftype<>classrefdef) and
  439. not(is_class_or_interface(methodpointer.resulttype.def)) then
  440. selfrefaddr:=true;
  441. end;
  442. else
  443. internalerror(200303212);
  444. end;
  445. end
  446. else
  447. begin
  448. location_reset(selfloc,LOC_REFERENCE,OS_ADDR);
  449. selfloc.reference:=twithnode(twithsymtable(symtableproc).withnode).withreference;
  450. if (nf_islocal in twithnode(twithsymtable(symtableproc).withnode).flags) and
  451. (twithsymtable(symtableproc).direct_with) and
  452. not(is_class_or_interface(twithnode(twithsymtable(symtableproc).withnode).left.resulttype.def)) then
  453. selfrefaddr:=true;
  454. end;
  455. if (po_staticmethod in procdefinition.procoptions) or
  456. (po_classmethod in procdefinition.procoptions) then
  457. begin
  458. self_is_vmt:=true;
  459. { classref are already loaded with VMT }
  460. if (methodpointer.resulttype.def.deftype=classrefdef) then
  461. location_copy(vmtloc,selfloc)
  462. else
  463. begin
  464. if (oo_has_vmt in tprocdef(procdefinition)._class.objectoptions) then
  465. begin
  466. { load VMT from passed self }
  467. selfloc_to_register;
  468. cg.g_maybe_testself(exprasmlist,selfloc.register);
  469. location_copy(vmtloc,selfloc);
  470. reference_reset_base(href,vmtloc.register,tprocdef(procdefinition)._class.vmt_offset);
  471. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,vmtloc.register);
  472. end;
  473. end;
  474. { reset self }
  475. location_reset(selfloc,LOC_CONSTANT,OS_ADDR);
  476. end;
  477. if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) then
  478. begin
  479. { constructor call via classreference => allocate memory }
  480. if (methodpointer.resulttype.def.deftype=classrefdef) then
  481. begin
  482. if (procdefinition.proctypeoption=potype_constructor) and
  483. is_class(tclassrefdef(methodpointer.resulttype.def).pointertype.def) then
  484. begin
  485. self_is_vmt:=true;
  486. { vmt load from provided methodpointer that
  487. was already loaded in selfloc }
  488. location_copy(vmtloc,selfloc);
  489. { reset self }
  490. location_reset(selfloc,LOC_CONSTANT,OS_ADDR);
  491. end;
  492. end
  493. else
  494. { class }
  495. if is_class(methodpointer.resulttype.def) then
  496. begin
  497. { destructor: release instance, flag(vmt)=1
  498. constructor: direct call, do nothing, leave vmt=0 }
  499. if (procdefinition.proctypeoption=potype_destructor) then
  500. begin
  501. { flag 1 for destructor: remove data }
  502. location_reset(vmtloc,LOC_CONSTANT,OS_ADDR);
  503. vmtloc.value:=1;
  504. end;
  505. end
  506. else
  507. { object }
  508. begin
  509. { destructor: direct call, no dispose, vmt=0
  510. constructor: initialize object, load vmt }
  511. if (procdefinition.proctypeoption=potype_constructor) then
  512. begin
  513. { vmt }
  514. location_reset(vmtloc,LOC_REFERENCE,OS_ADDR);
  515. reference_reset_symbol(vmtloc.reference,objectlibrary.newasmsymboldata(
  516. tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  517. vmtrefaddr:=true;
  518. end;
  519. end;
  520. end;
  521. end;
  522. end;
  523. end
  524. else
  525. { No methodpointer }
  526. begin
  527. if (po_staticmethod in procdefinition.procoptions) or
  528. (po_classmethod in procdefinition.procoptions) then
  529. begin
  530. self_is_vmt:=true;
  531. { Load VMT from self? }
  532. if (
  533. (po_classmethod in procdefinition.procoptions) and
  534. not(assigned(current_procdef) and
  535. (po_classmethod in current_procdef.procoptions))
  536. ) or
  537. (
  538. (po_staticmethod in procdefinition.procoptions) and
  539. not(assigned(current_procdef) and
  540. (po_staticmethod in current_procdef.procoptions))
  541. ) then
  542. begin
  543. if (oo_has_vmt in tprocdef(procdefinition)._class.objectoptions) then
  544. begin
  545. { load vmt from self passed to the current method }
  546. location_reset(vmtloc,LOC_REGISTER,OS_ADDR);
  547. vmtloc.register:=cg.g_load_self(exprasmlist);
  548. cg.g_maybe_testself(exprasmlist,vmtloc.register);
  549. reference_reset_base(href,vmtloc.register,tprocdef(procdefinition)._class.vmt_offset);
  550. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,vmtloc.register);
  551. end;
  552. end
  553. else
  554. begin
  555. { self is already VMT }
  556. location_reset(vmtloc,LOC_REGISTER,OS_ADDR);
  557. vmtloc.register:=cg.g_load_self(exprasmlist);
  558. end;
  559. end
  560. else
  561. begin
  562. { member call, load self }
  563. location_reset(selfloc,LOC_REGISTER,OS_ADDR);
  564. selfloc.register:=cg.g_load_self(exprasmlist);
  565. end;
  566. end;
  567. { Do we need to push the VMT as self for
  568. class methods and static methods? }
  569. if self_is_vmt then
  570. begin
  571. location_release(exprasmlist,selfloc);
  572. location_copy(selfloc,vmtloc);
  573. selfrefaddr:=vmtrefaddr;
  574. end;
  575. { when we need the vmt in a register then we already
  576. load self in a register so it can generate optimized code }
  577. if needvmtreg then
  578. selfloc_to_register;
  579. { constructor/destructor need vmt }
  580. if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) then
  581. begin
  582. if vmtrefaddr then
  583. cg.a_paramaddr_ref(exprasmlist,vmtloc.reference,paramanager.getintparaloc(2))
  584. else
  585. cg.a_param_loc(exprasmlist,vmtloc,paramanager.getintparaloc(2));
  586. end;
  587. if not self_is_vmt then
  588. location_release(exprasmlist,vmtloc);
  589. { push self }
  590. if selfrefaddr then
  591. cg.a_paramaddr_ref(exprasmlist,selfloc.reference,paramanager.getintparaloc(1))
  592. else
  593. cg.a_param_loc(exprasmlist,selfloc,paramanager.getintparaloc(1));
  594. if needvmtreg then
  595. begin
  596. { self should already be loaded in a register }
  597. if selfloc.register.number=NR_NO then
  598. internalerror(2003032611);
  599. { load vmt from self, this is already done
  600. for static/class methods }
  601. if not self_is_vmt then
  602. begin
  603. cg.g_maybe_testself(exprasmlist,selfloc.register);
  604. { this is one point where we need vmt_offset (PM) }
  605. reference_reset_base(href,selfloc.register,tprocdef(procdefinition)._class.vmt_offset);
  606. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,selfloc.register);
  607. end;
  608. result:=selfloc.register;
  609. end
  610. else
  611. location_release(exprasmlist,selfloc);
  612. end;
  613. procedure tcgcallnode.push_framepointer;
  614. var
  615. href : treference;
  616. hregister : tregister;
  617. i : integer;
  618. begin
  619. { this routine is itself not nested }
  620. if current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
  621. begin
  622. reference_reset_base(href,current_procinfo.framepointer,current_procinfo.framepointer_offset);
  623. cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
  624. end
  625. { one nesting level }
  626. else if (current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
  627. begin
  628. cg.a_param_reg(exprasmlist,OS_ADDR,current_procinfo.framepointer,paramanager.getintparaloc(1));
  629. end
  630. { very complex nesting level ... }
  631. else if (current_procdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
  632. begin
  633. hregister:=rg.getaddressregister(exprasmlist);
  634. reference_reset_base(href,current_procinfo.framepointer,current_procinfo.framepointer_offset);
  635. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
  636. i:=current_procdef.parast.symtablelevel;
  637. while (i>tprocdef(procdefinition).parast.symtablelevel) do
  638. begin
  639. reference_reset_base(href,hregister,current_procinfo.framepointer_offset);
  640. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
  641. dec(i);
  642. end;
  643. cg.a_param_reg(exprasmlist,OS_ADDR,hregister,paramanager.getintparaloc(1));
  644. rg.ungetaddressregister(exprasmlist,hregister);
  645. end;
  646. end;
  647. procedure tcgcallnode.handle_return_value(inlined:boolean);
  648. var
  649. cgsize : tcgsize;
  650. r,hregister : tregister;
  651. nr:Tnewregister;
  652. begin
  653. { structured results are easy to handle.... }
  654. { needed also when result_no_used !! }
  655. if paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
  656. begin
  657. { Location should be setup by the funcret para }
  658. if location.loc<>LOC_REFERENCE then
  659. internalerror(200304241);
  660. end
  661. else
  662. { ansi/widestrings must be registered, so we can dispose them }
  663. if is_ansistring(resulttype.def) or
  664. is_widestring(resulttype.def) then
  665. begin
  666. location_reset(location,LOC_CREFERENCE,OS_ADDR);
  667. location.reference:=refcountedtemp;
  668. r.enum:=accumulator;
  669. cg.a_reg_alloc(exprasmlist,r);
  670. cg.a_load_reg_ref(exprasmlist,OS_ADDR,r,location.reference);
  671. cg.a_reg_dealloc(exprasmlist,r);
  672. end
  673. else
  674. { we have only to handle the result if it is used }
  675. if (nf_return_value_used in flags) then
  676. begin
  677. case resulttype.def.deftype of
  678. enumdef,
  679. orddef :
  680. begin
  681. cgsize:=def_cgsize(resulttype.def);
  682. { an object constructor is a function with pointer result }
  683. if (inlined or (right=nil)) and
  684. (procdefinition.proctypeoption=potype_constructor) then
  685. cgsize:=OS_ADDR;
  686. if cgsize<>OS_NO then
  687. begin
  688. location_reset(location,LOC_REGISTER,cgsize);
  689. {$ifndef cpu64bit}
  690. if cgsize in [OS_64,OS_S64] then
  691. begin
  692. {Move the function result to free registers, preferably the
  693. accumulator/accumulatorhigh, so no move is necessary.}
  694. r.enum:=R_INTREGISTER;
  695. r.number:=NR_ACCUMULATOR;
  696. hregister.enum:=R_INTREGISTER;
  697. hregister.number:=NR_ACCUMULATORHIGH;
  698. {$ifdef newra}
  699. rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR);
  700. rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATORHIGH);
  701. rg.ungetregisterint(exprasmlist,r);
  702. rg.ungetregisterint(exprasmlist,hregister);
  703. location.registerlow:=rg.getregisterint(exprasmlist,OS_INT);
  704. location.registerhigh:=rg.getregisterint(exprasmlist,OS_INT);
  705. {$else newra}
  706. cg.a_reg_alloc(exprasmlist,r);
  707. cg.a_reg_alloc(exprasmlist,hregister);
  708. if RS_ACCUMULATOR in rg.unusedregsint then
  709. location.registerlow:=rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR)
  710. else
  711. location.registerlow:=rg.getregisterint(exprasmlist,OS_INT);
  712. if RS_ACCUMULATORHIGH in rg.unusedregsint then
  713. location.registerhigh:=rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATORHIGH)
  714. else
  715. location.registerhigh:=rg.getregisterint(exprasmlist,OS_INT);
  716. {$endif newra}
  717. cg64.a_load64_reg_reg(exprasmlist,joinreg64(r,hregister),
  718. location.register64);
  719. end
  720. else
  721. {$endif cpu64bit}
  722. begin
  723. {Move the function result to a free register, preferably the
  724. accumulator, so no move is necessary.}
  725. nr:=RS_ACCUMULATOR shl 8 or cgsize2subreg(cgsize);
  726. r.enum:=R_INTREGISTER;
  727. r.number:=nr;
  728. {$ifdef newra}
  729. rg.getexplicitregisterint(exprasmlist,nr);
  730. rg.ungetregisterint(exprasmlist,r);
  731. location.register:=rg.getregisterint(exprasmlist,cgsize);
  732. {$else newra}
  733. cg.a_reg_alloc(exprasmlist,r);
  734. if RS_ACCUMULATOR in rg.unusedregsint then
  735. location.register:=rg.getexplicitregisterint(exprasmlist,nr)
  736. else
  737. location.register:=rg.getregisterint(exprasmlist,cgsize);
  738. {$endif newra}
  739. cg.a_load_reg_reg(exprasmlist,cgsize,cgsize,r,location.register);
  740. end;
  741. end;
  742. end;
  743. floatdef :
  744. begin
  745. location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
  746. {$ifdef cpufpemu}
  747. if cs_fp_emulation in aktmoduleswitches then
  748. location.register.enum := accumulator
  749. else
  750. {$endif cpufpemu}
  751. location.register.enum:=FPU_RESULT_REG;
  752. {$ifdef x86}
  753. inc(trgcpu(rg).fpuvaroffset);
  754. {$endif x86}
  755. end;
  756. {$ifdef TEST_WIN32_RECORDS}
  757. recorddef :
  758. begin
  759. if (target_info.system=system_i386_win32) then
  760. begin
  761. location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def));
  762. tg.GetTemp(exprasmlist,resulttype.size,tt_normal,location);
  763. {$ifndef cpu64bit}
  764. if cgsize in [OS_64,OS_S64] then
  765. cg64.a_load64_reg_loc(exprasmlist,joinreg64(accumulator,accumulatorhigh),location)
  766. else
  767. {$endif cpu64bit}
  768. cg.a_load_reg_loc(exprasmlist,accumulator,location);
  769. end
  770. else
  771. internalerror(200211141);
  772. end;
  773. {$endif TEST_WIN32_RECORDS}
  774. else
  775. begin
  776. location_reset(location,LOC_REGISTER,OS_INT);
  777. r.enum:=R_INTREGISTER;
  778. r.number:=NR_ACCUMULATOR;
  779. {$ifdef newra}
  780. rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR);
  781. rg.ungetregisterint(exprasmlist,r);
  782. location.register:=rg.getregisterint(exprasmlist,OS_INT);
  783. {$else newra}
  784. if RS_ACCUMULATOR in rg.unusedregsint then
  785. location.register:=rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR)
  786. else
  787. location.register:=rg.getregisterint(exprasmlist,OS_INT);
  788. {$endif newra}
  789. cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,r,location.register);
  790. end;
  791. end;
  792. end
  793. else
  794. location_reset(location,LOC_VOID,OS_NO);
  795. end;
  796. procedure tcgcallnode.pass_2;
  797. var
  798. regs_to_push_int : Tsupregset;
  799. regs_to_push_other : tregisterset;
  800. unusedstate: pointer;
  801. pushed : tpushedsaved;
  802. pushedint : tpushedsavedint;
  803. oldpushedparasize : longint;
  804. { adress returned from an I/O-error }
  805. iolabel : tasmlabel;
  806. { help reference pointer }
  807. href : treference;
  808. hp : tnode;
  809. pp : tcallparanode;
  810. virtual_vmt_call,
  811. inlined : boolean;
  812. inlinecode : tprocinlinenode;
  813. store_parast_fixup,
  814. para_alignment,
  815. para_offset : longint;
  816. pop_size : longint;
  817. returnref,
  818. pararef : treference;
  819. accreg,
  820. vmtreg : tregister;
  821. oldaktcallnode : tcallnode;
  822. begin
  823. iolabel:=nil;
  824. inlinecode:=nil;
  825. inlined:=false;
  826. rg.saveunusedstate(unusedstate);
  827. { if we allocate the temp. location for ansi- or widestrings }
  828. { already here, we avoid later a push/pop }
  829. if is_widestring(resulttype.def) then
  830. begin
  831. tg.GetTemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
  832. cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
  833. end
  834. else if is_ansistring(resulttype.def) then
  835. begin
  836. tg.GetTemp(exprasmlist,pointer_size,tt_ansistring,refcountedtemp);
  837. cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
  838. end;
  839. if (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_stdcall]) then
  840. para_alignment:=4
  841. else
  842. para_alignment:=aktalignment.paraalign;
  843. if not assigned(procdefinition) then
  844. exit;
  845. if (procdefinition.proccalloption=pocall_inline) then
  846. begin
  847. inlined:=true;
  848. inlinecode:=tprocinlinenode(right);
  849. right:=nil;
  850. { set it to the same lexical level as the local symtable, becuase
  851. the para's are stored there }
  852. tprocdef(procdefinition).parast.symtablelevel:=current_procdef.localst.symtablelevel;
  853. if assigned(left) then
  854. begin
  855. inlinecode.para_size:=tprocdef(procdefinition).para_size(para_alignment);
  856. tg.GetTemp(exprasmlist,inlinecode.para_size,tt_persistant,pararef);
  857. inlinecode.para_offset:=pararef.offset;
  858. end;
  859. store_parast_fixup:=tprocdef(procdefinition).parast.address_fixup;
  860. tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset;
  861. {$ifdef extdebug}
  862. Comment(V_debug,
  863. 'inlined parasymtable is at offset '
  864. +tostr(tprocdef(procdefinition).parast.address_fixup));
  865. exprasmList.concat(tai_comment.Create(
  866. strpnew('inlined parasymtable is at offset '
  867. +tostr(tprocdef(procdefinition).parast.address_fixup))));
  868. {$endif extdebug}
  869. end;
  870. { proc variables destroy all registers }
  871. if (inlined or
  872. (right=nil)) and
  873. { virtual methods too }
  874. not(po_virtualmethod in procdefinition.procoptions) then
  875. begin
  876. if (cs_check_io in aktlocalswitches) and
  877. (po_iocheck in procdefinition.procoptions) and
  878. not(po_iocheck in current_procdef.procoptions) then
  879. begin
  880. objectlibrary.getaddrlabel(iolabel);
  881. cg.a_label(exprasmlist,iolabel);
  882. end
  883. else
  884. iolabel:=nil;
  885. { save all used registers and possible registers
  886. used for the return value }
  887. regs_to_push_int := tprocdef(procdefinition).usedintregisters;
  888. regs_to_push_other := tprocdef(procdefinition).usedotherregisters;
  889. if (not is_void(resulttype.def)) and
  890. (not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption)) then
  891. begin
  892. include(regs_to_push_int,RS_ACCUMULATOR);
  893. {$ifndef cpu64bit}
  894. if resulttype.def.size>sizeof(aword) then
  895. include(regs_to_push_int,RS_ACCUMULATORHIGH);
  896. {$endif cpu64bit}
  897. end;
  898. rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
  899. rg.saveusedotherregisters(exprasmlist,pushed,regs_to_push_other);
  900. { give used registers through }
  901. rg.usedintinproc:=rg.usedintinproc + tprocdef(procdefinition).usedintregisters;
  902. rg.usedinproc:=rg.usedinproc + tprocdef(procdefinition).usedotherregisters;
  903. end
  904. else
  905. begin
  906. regs_to_push_int := all_intregisters;
  907. regs_to_push_other := all_registers;
  908. rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
  909. rg.saveusedotherregisters(exprasmlist,pushed,regs_to_push_other);
  910. rg.usedinproc:=all_registers;
  911. { no IO check for methods and procedure variables }
  912. iolabel:=nil;
  913. end;
  914. { Initialize for pushing the parameters }
  915. oldpushedparasize:=pushedparasize;
  916. pushedparasize:=0;
  917. pop_size:=0;
  918. { Align stack if required }
  919. if not inlined then
  920. pop_size:=align_parasize(oldpushedparasize,para_alignment);
  921. { Push parameters }
  922. oldaktcallnode:=aktcallnode;
  923. aktcallnode:=self;
  924. if assigned(left) then
  925. begin
  926. { be found elsewhere }
  927. if inlined then
  928. para_offset:=tprocdef(procdefinition).parast.address_fixup+
  929. tprocdef(procdefinition).parast.datasize
  930. else
  931. para_offset:=0;
  932. if not(inlined) and
  933. assigned(right) then
  934. tcallparanode(left).secondcallparan(
  935. (po_leftright in procdefinition.procoptions),procdefinition.proccalloption,
  936. para_alignment,para_offset)
  937. else
  938. tcallparanode(left).secondcallparan(
  939. (po_leftright in procdefinition.procoptions),procdefinition.proccalloption,
  940. para_alignment,para_offset);
  941. end;
  942. aktcallnode:=oldaktcallnode;
  943. { Allocate return value for inlined routines }
  944. if inlined and
  945. (resulttype.def.size>0) then
  946. begin
  947. tg.GetTemp(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign),tt_persistant,returnref);
  948. inlinecode.retoffset:=returnref.offset;
  949. end;
  950. { procedure variable or normal function call ? }
  951. if inlined or
  952. (right=nil) then
  953. begin
  954. { Virtual function call through VMT? }
  955. vmtreg.enum:=R_INTREGISTER;
  956. vmtreg.number:=NR_NO;
  957. virtual_vmt_call:=(po_virtualmethod in procdefinition.procoptions) and
  958. not(assigned(methodpointer) and
  959. (methodpointer.nodetype=typen));
  960. { push self/vmt for methods }
  961. if assigned(symtableproc) and
  962. (symtableproc.symtabletype in [withsymtable,objectsymtable]) then
  963. vmtreg:=push_self_and_vmt(virtual_vmt_call);
  964. { push base pointer ?}
  965. { never when inlining, since if necessary, the base pointer }
  966. { can/will be gottten from the current procedure's symtable }
  967. { (JM) }
  968. if not inlined then
  969. if (current_procdef.parast.symtablelevel>=normal_function_level) and
  970. assigned(tprocdef(procdefinition).parast) and
  971. ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
  972. push_framepointer;
  973. rg.saveintregvars(exprasmlist,regs_to_push_int);
  974. rg.saveotherregvars(exprasmlist,regs_to_push_other);
  975. if virtual_vmt_call then
  976. begin
  977. { virtual methods require an index }
  978. if tprocdef(procdefinition).extnumber=-1 then
  979. internalerror(200304021);
  980. { VMT should already be loaded in a register }
  981. if vmtreg.number=NR_NO then
  982. internalerror(200304022);
  983. { test validity of VMT }
  984. if not(is_interface(tprocdef(procdefinition)._class)) and
  985. not(is_cppclass(tprocdef(procdefinition)._class)) then
  986. cg.g_maybe_testvmt(exprasmlist,vmtreg,tprocdef(procdefinition)._class);
  987. { call method }
  988. reference_reset_base(href,vmtreg,
  989. tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber));
  990. cg.a_call_ref(exprasmlist,href);
  991. { release self }
  992. rg.ungetregisterint(exprasmlist,vmtreg);
  993. end
  994. else
  995. begin
  996. if not inlined then
  997. begin
  998. { Calling interrupt from the same code requires some
  999. extra code }
  1000. if (po_interrupt in procdefinition.procoptions) then
  1001. extra_interrupt_code;
  1002. cg.a_call_name(exprasmlist,tprocdef(procdefinition).mangledname);
  1003. end
  1004. else { inlined proc }
  1005. begin
  1006. { process the inlinecode }
  1007. secondpass(tnode(inlinecode));
  1008. { free the args }
  1009. if tprocdef(procdefinition).parast.datasize>0 then
  1010. tg.UnGetTemp(exprasmlist,pararef);
  1011. end;
  1012. end;
  1013. end
  1014. else
  1015. { now procedure variable case }
  1016. begin
  1017. secondpass(right);
  1018. { Calling interrupt from the same code requires some
  1019. extra code }
  1020. if (po_interrupt in procdefinition.procoptions) then
  1021. extra_interrupt_code;
  1022. if (po_methodpointer in procdefinition.procoptions) then
  1023. begin
  1024. { push self, but not if it's already explicitly pushed }
  1025. if not(po_containsself in procdefinition.procoptions) then
  1026. begin
  1027. { push self }
  1028. href:=right.location.reference;
  1029. inc(href.offset,POINTER_SIZE);
  1030. cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
  1031. end;
  1032. rg.saveintregvars(exprasmlist,ALL_INTREGISTERS);
  1033. rg.saveotherregvars(exprasmlist,ALL_REGISTERS);
  1034. cg.a_call_ref(exprasmlist,right.location.reference);
  1035. reference_release(exprasmlist,right.location.reference);
  1036. tg.Ungetiftemp(exprasmlist,right.location.reference);
  1037. end
  1038. else
  1039. begin
  1040. rg.saveintregvars(exprasmlist,ALL_INTREGISTERS);
  1041. rg.saveotherregvars(exprasmlist,ALL_REGISTERS);
  1042. cg.a_call_loc(exprasmlist,right.location);
  1043. location_release(exprasmlist,right.location);
  1044. location_freetemp(exprasmlist,right.location);
  1045. end;
  1046. end;
  1047. { Need to remove the parameters from the stack? }
  1048. if (not inlined) and (po_clearstack in procdefinition.procoptions) then
  1049. begin
  1050. { the old pop_size was already included in pushedparasize }
  1051. pop_size:=pushedparasize;
  1052. end;
  1053. { Remove parameters/alignment from the stack }
  1054. if pop_size>0 then
  1055. pop_parasize(pop_size);
  1056. {$ifdef powerpc}
  1057. { this calculation must be done in pass_1 anyway, so don't worry }
  1058. if tppcprocinfo(current_procinfo).maxpushedparasize<pushedparasize then
  1059. tppcprocinfo(current_procinfo).maxpushedparasize:=pushedparasize;
  1060. {$endif powerpc}
  1061. { Restore }
  1062. pushedparasize:=oldpushedparasize;
  1063. rg.restoreunusedstate(unusedstate);
  1064. {$ifdef TEMPREGDEBUG}
  1065. testregisters32;
  1066. {$endif TEMPREGDEBUG}
  1067. { Called an inherited constructor? Then
  1068. we need to check the result }
  1069. if (inlined or (right=nil)) and
  1070. (procdefinition.proctypeoption=potype_constructor) and
  1071. assigned(methodpointer) and
  1072. (methodpointer.nodetype=typen) and
  1073. (current_procdef.proctypeoption=potype_constructor) then
  1074. begin
  1075. accreg.enum:=R_INTREGISTER;
  1076. accreg.number:=NR_ACCUMULATOR;
  1077. cg.a_reg_alloc(exprasmlist,accreg);
  1078. cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,accreg,faillabel);
  1079. cg.a_reg_dealloc(exprasmlist,accreg);
  1080. end;
  1081. { handle function results }
  1082. if (not is_void(resulttype.def)) then
  1083. handle_return_value(inlined)
  1084. else
  1085. location_reset(location,LOC_VOID,OS_NO);
  1086. { perhaps i/o check ? }
  1087. if iolabel<>nil then
  1088. begin
  1089. reference_reset_symbol(href,iolabel,0);
  1090. cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
  1091. cg.a_call_name(exprasmlist,'FPC_IOCHECK');
  1092. end;
  1093. { restore registers }
  1094. rg.restoreusedotherregisters(exprasmlist,pushed);
  1095. rg.restoreusedintregisters(exprasmlist,pushedint);
  1096. { Release temps from parameters }
  1097. pp:=tcallparanode(left);
  1098. while assigned(pp) do
  1099. begin
  1100. if assigned(pp.left) then
  1101. begin
  1102. { don't release the funcret temp }
  1103. if not(vo_is_funcret in tvarsym(pp.paraitem.parasym).varoptions) then
  1104. location_freetemp(exprasmlist,pp.left.location);
  1105. { process also all nodes of an array of const }
  1106. if pp.left.nodetype=arrayconstructorn then
  1107. begin
  1108. if assigned(tarrayconstructornode(pp.left).left) then
  1109. begin
  1110. hp:=pp.left;
  1111. while assigned(hp) do
  1112. begin
  1113. location_freetemp(exprasmlist,tarrayconstructornode(hp).left.location);
  1114. hp:=tarrayconstructornode(hp).right;
  1115. end;
  1116. end;
  1117. end;
  1118. end;
  1119. pp:=tcallparanode(pp.right);
  1120. end;
  1121. if inlined then
  1122. begin
  1123. if (resulttype.def.size>0) then
  1124. tg.UnGetTemp(exprasmlist,returnref);
  1125. tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup;
  1126. right:=inlinecode;
  1127. { from now on the result can be freed normally }
  1128. if paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
  1129. tg.ChangeTempType(exprasmlist,funcretnode.location.reference,tt_normal);
  1130. end;
  1131. { if return value is not used }
  1132. if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then
  1133. begin
  1134. if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
  1135. begin
  1136. { data which must be finalized ? }
  1137. if (resulttype.def.needs_inittable) then
  1138. cg.g_finalize(exprasmlist,resulttype.def,location.reference,false);
  1139. { release unused temp }
  1140. tg.ungetiftemp(exprasmlist,location.reference)
  1141. end
  1142. else if location.loc=LOC_FPUREGISTER then
  1143. begin
  1144. {$ifdef x86}
  1145. { release FPU stack }
  1146. accreg.enum:=FPU_RESULT_REG;
  1147. emit_reg(A_FSTP,S_NO,accreg);
  1148. {
  1149. dec(trgcpu(rg).fpuvaroffset);
  1150. do NOT decrement as the increment before
  1151. is not called for unused results PM }
  1152. {$endif x86}
  1153. end;
  1154. end;
  1155. end;
  1156. {*****************************************************************************
  1157. TCGPROCINLINENODE
  1158. *****************************************************************************}
  1159. procedure tcgprocinlinenode.pass_2;
  1160. var st : tsymtable;
  1161. oldprocdef : tprocdef;
  1162. ps, i : longint;
  1163. oldprocinfo : tprocinfo;
  1164. oldinlining_procedure,
  1165. nostackframe,make_global : boolean;
  1166. inlineentrycode,inlineexitcode : TAAsmoutput;
  1167. oldexitlabel,oldexit2label,oldquickexitlabel:tasmlabel;
  1168. oldregstate: pointer;
  1169. localsref : treference;
  1170. {$ifdef GDB}
  1171. startlabel,endlabel : tasmlabel;
  1172. pp : pchar;
  1173. mangled_length : longint;
  1174. {$endif GDB}
  1175. begin
  1176. { deallocate the registers used for the current procedure's regvars }
  1177. if assigned(current_procdef.regvarinfo) then
  1178. begin
  1179. with pregvarinfo(current_procdef.regvarinfo)^ do
  1180. for i := 1 to maxvarregs do
  1181. if assigned(regvars[i]) then
  1182. store_regvar(exprasmlist,regvars[i].reg);
  1183. rg.saveStateForInline(oldregstate);
  1184. { make sure the register allocator knows what the regvars in the }
  1185. { inlined code block are (JM) }
  1186. rg.resetusableregisters;
  1187. rg.clearregistercount;
  1188. {$ifndef newra}
  1189. rg.cleartempgen;
  1190. {$endif}
  1191. if assigned(inlineprocdef.regvarinfo) then
  1192. with pregvarinfo(inlineprocdef.regvarinfo)^ do
  1193. for i := 1 to maxvarregs do
  1194. if assigned(regvars[i]) then
  1195. begin
  1196. {Fix me!!}
  1197. {tmpreg:=rg.makeregsize(regvars[i].reg,OS_INT);
  1198. rg.makeregvar(tmpreg);}
  1199. internalerror(200301232);
  1200. end;
  1201. end;
  1202. oldinlining_procedure:=inlining_procedure;
  1203. oldexitlabel:=aktexitlabel;
  1204. oldexit2label:=aktexit2label;
  1205. oldquickexitlabel:=quickexitlabel;
  1206. oldprocdef:=current_procdef;
  1207. oldprocinfo:=current_procinfo;
  1208. objectlibrary.getlabel(aktexitlabel);
  1209. objectlibrary.getlabel(aktexit2label);
  1210. { we're inlining a procedure }
  1211. inlining_procedure:=true;
  1212. current_procdef:=inlineprocdef;
  1213. { clone procinfo, but not the asmlists }
  1214. current_procinfo:=tprocinfo(cprocinfo.newinstance);
  1215. move(pointer(oldprocinfo)^,pointer(current_procinfo)^,cprocinfo.InstanceSize);
  1216. current_procinfo.aktentrycode:=nil;
  1217. current_procinfo.aktexitcode:=nil;
  1218. current_procinfo.aktproccode:=nil;
  1219. current_procinfo.aktlocaldata:=nil;
  1220. { set new procinfo }
  1221. current_procinfo.return_offset:=retoffset;
  1222. { arg space has been filled by the parent secondcall }
  1223. st:=current_procdef.localst;
  1224. { set it to the same lexical level }
  1225. st.symtablelevel:=oldprocdef.localst.symtablelevel;
  1226. if st.datasize>0 then
  1227. begin
  1228. tg.GetTemp(exprasmlist,st.datasize,tt_persistant,localsref);
  1229. st.address_fixup:=localsref.offset+st.datasize;
  1230. {$ifdef extdebug}
  1231. Comment(V_debug,'local symtable is at offset '+tostr(st.address_fixup));
  1232. exprasmList.concat(tai_comment.Create(strpnew(
  1233. 'local symtable is at offset '+tostr(st.address_fixup))));
  1234. {$endif extdebug}
  1235. end;
  1236. exprasmList.concat(Tai_Marker.Create(InlineStart));
  1237. {$ifdef extdebug}
  1238. exprasmList.concat(tai_comment.Create(strpnew('Start of inlined proc')));
  1239. {$endif extdebug}
  1240. {$ifdef GDB}
  1241. if (cs_debuginfo in aktmoduleswitches) then
  1242. begin
  1243. objectlibrary.getaddrlabel(startlabel);
  1244. objectlibrary.getaddrlabel(endlabel);
  1245. cg.a_label(exprasmlist,startlabel);
  1246. inlineprocdef.localst.symtabletype:=inlinelocalsymtable;
  1247. inlineprocdef.parast.symtabletype:=inlineparasymtable;
  1248. { Here we must include the para and local symtable info }
  1249. inlineprocdef.concatstabto(withdebuglist);
  1250. { set it back for safety }
  1251. inlineprocdef.localst.symtabletype:=localsymtable;
  1252. inlineprocdef.parast.symtabletype:=parasymtable;
  1253. mangled_length:=length(oldprocdef.mangledname);
  1254. getmem(pp,mangled_length+50);
  1255. strpcopy(pp,'192,0,0,'+startlabel.name);
  1256. if (target_info.use_function_relative_addresses) then
  1257. begin
  1258. strpcopy(strend(pp),'-');
  1259. strpcopy(strend(pp),oldprocdef.mangledname);
  1260. end;
  1261. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  1262. end;
  1263. {$endif GDB}
  1264. { takes care of local data initialization }
  1265. inlineentrycode:=TAAsmoutput.Create;
  1266. inlineexitcode:=TAAsmoutput.Create;
  1267. ps:=para_size;
  1268. make_global:=false; { to avoid warning }
  1269. genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
  1270. if po_assembler in current_procdef.procoptions then
  1271. inlineentrycode.insert(Tai_marker.Create(asmblockstart));
  1272. exprasmList.concatlist(inlineentrycode);
  1273. secondpass(inlinetree);
  1274. genexitcode(inlineexitcode,0,false,true);
  1275. if po_assembler in current_procdef.procoptions then
  1276. inlineexitcode.concat(Tai_marker.Create(asmblockend));
  1277. exprasmList.concatlist(inlineexitcode);
  1278. inlineentrycode.free;
  1279. inlineexitcode.free;
  1280. {$ifdef extdebug}
  1281. exprasmList.concat(tai_comment.Create(strpnew('End of inlined proc')));
  1282. {$endif extdebug}
  1283. exprasmList.concat(Tai_Marker.Create(InlineEnd));
  1284. {we can free the local data now, reset also the fixup address }
  1285. if st.datasize>0 then
  1286. begin
  1287. tg.UnGetTemp(exprasmlist,localsref);
  1288. st.address_fixup:=0;
  1289. end;
  1290. { restore procinfo }
  1291. current_procinfo.free;
  1292. current_procinfo:=oldprocinfo;
  1293. {$ifdef GDB}
  1294. if (cs_debuginfo in aktmoduleswitches) then
  1295. begin
  1296. cg.a_label(exprasmlist,endlabel);
  1297. strpcopy(pp,'224,0,0,'+endlabel.name);
  1298. if (target_info.use_function_relative_addresses) then
  1299. begin
  1300. strpcopy(strend(pp),'-');
  1301. strpcopy(strend(pp),oldprocdef.mangledname);
  1302. end;
  1303. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  1304. freemem(pp,mangled_length+50);
  1305. end;
  1306. {$endif GDB}
  1307. { restore }
  1308. current_procdef:=oldprocdef;
  1309. aktexitlabel:=oldexitlabel;
  1310. aktexit2label:=oldexit2label;
  1311. quickexitlabel:=oldquickexitlabel;
  1312. inlining_procedure:=oldinlining_procedure;
  1313. { reallocate the registers used for the current procedure's regvars, }
  1314. { since they may have been used and then deallocated in the inlined }
  1315. { procedure (JM) }
  1316. if assigned(current_procdef.regvarinfo) then
  1317. begin
  1318. rg.restoreStateAfterInline(oldregstate);
  1319. end;
  1320. end;
  1321. begin
  1322. ccallparanode:=tcgcallparanode;
  1323. ccallnode:=tcgcallnode;
  1324. cprocinlinenode:=tcgprocinlinenode;
  1325. end.
  1326. {
  1327. $Log$
  1328. Revision 1.58 2003-05-05 14:53:16 peter
  1329. * vs_hidden replaced by is_hidden boolean
  1330. Revision 1.57 2003/04/30 20:53:32 florian
  1331. * error when address of an abstract method is taken
  1332. * fixed some x86-64 problems
  1333. * merged some more x86-64 and i386 code
  1334. Revision 1.56 2003/04/29 07:28:52 michael
  1335. + Patch from peter to fix wrong pushing of ansistring function results in open array
  1336. Revision 1.55 2003/04/27 11:21:33 peter
  1337. * aktprocdef renamed to current_procdef
  1338. * procinfo renamed to current_procinfo
  1339. * procinfo will now be stored in current_module so it can be
  1340. cleaned up properly
  1341. * gen_main_procsym changed to create_main_proc and release_main_proc
  1342. to also generate a tprocinfo structure
  1343. * fixed unit implicit initfinal
  1344. Revision 1.54 2003/04/27 07:29:50 peter
  1345. * current_procdef cleanup, current_procdef is now always nil when parsing
  1346. a new procdef declaration
  1347. * aktprocsym removed
  1348. * lexlevel removed, use symtable.symtablelevel instead
  1349. * implicit init/final code uses the normal genentry/genexit
  1350. * funcret state checking updated for new funcret handling
  1351. Revision 1.53 2003/04/25 20:59:33 peter
  1352. * removed funcretn,funcretsym, function result is now in varsym
  1353. and aliases for result and function name are added using absolutesym
  1354. * vs_hidden parameter for funcret passed in parameter
  1355. * vs_hidden fixes
  1356. * writenode changed to printnode and released from extdebug
  1357. * -vp option added to generate a tree.log with the nodetree
  1358. * nicer printnode for statements, callnode
  1359. Revision 1.52 2003/04/25 08:25:26 daniel
  1360. * Ifdefs around a lot of calls to cleartempgen
  1361. * Fixed registers that are allocated but not freed in several nodes
  1362. * Tweak to register allocator to cause less spills
  1363. * 8-bit registers now interfere with esi,edi and ebp
  1364. Compiler can now compile rtl successfully when using new register
  1365. allocator
  1366. Revision 1.51 2003/04/22 23:50:22 peter
  1367. * firstpass uses expectloc
  1368. * checks if there are differences between the expectloc and
  1369. location.loc from secondpass in EXTDEBUG
  1370. Revision 1.50 2003/04/22 14:33:38 peter
  1371. * removed some notes/hints
  1372. Revision 1.49 2003/04/22 13:47:08 peter
  1373. * fixed C style array of const
  1374. * fixed C array passing
  1375. * fixed left to right with high parameters
  1376. Revision 1.48 2003/04/22 10:09:34 daniel
  1377. + Implemented the actual register allocator
  1378. + Scratch registers unavailable when new register allocator used
  1379. + maybe_save/maybe_restore unavailable when new register allocator used
  1380. Revision 1.47 2003/04/22 09:49:44 peter
  1381. * do not load self when calling a non-inherited class constructor
  1382. Revision 1.46 2003/04/21 20:03:32 peter
  1383. * forgot to copy vmtrefaddr to selfrefaddr when self=vmt
  1384. Revision 1.45 2003/04/21 13:53:16 jonas
  1385. - removed copying of all paras when secondpassing a callnode (this used
  1386. to be necessary for inlinign support, but currently the whole inlined
  1387. procedure is already copied in advance). Note that the compiler crashes
  1388. when compiling ucomplex with -dTEST_INLINE (also after fixing the
  1389. syntax errors), but that was also the case before this change.
  1390. Revision 1.44 2003/04/10 17:57:52 peter
  1391. * vs_hidden released
  1392. Revision 1.43 2003/04/06 21:11:23 olle
  1393. * changed newasmsymbol to newasmsymboldata for data symbols
  1394. Revision 1.42 2003/04/04 15:38:56 peter
  1395. * moved generic code from n386cal to ncgcal, i386 now also
  1396. uses the generic ncgcal
  1397. Revision 1.41 2003/03/28 19:16:56 peter
  1398. * generic constructor working for i386
  1399. * remove fixed self register
  1400. * esi added as address register for i386
  1401. Revision 1.40 2003/03/06 11:35:50 daniel
  1402. * Fixed internalerror 7843 issue
  1403. Revision 1.39 2003/02/19 22:00:14 daniel
  1404. * Code generator converted to new register notation
  1405. - Horribily outdated todo.txt removed
  1406. Revision 1.38 2003/02/15 22:17:38 carl
  1407. * bugfix of FPU emulation code
  1408. Revision 1.37 2003/02/12 22:10:07 carl
  1409. * load_frame_pointer is now generic
  1410. * change fpu emulation routine names
  1411. Revision 1.36 2003/01/30 21:46:57 peter
  1412. * self fixes for static methods (merged)
  1413. Revision 1.35 2003/01/22 20:45:15 mazen
  1414. * making math code in RTL compiling.
  1415. *NB : This does NOT mean necessary that it will generate correct code!
  1416. Revision 1.34 2003/01/17 12:03:45 daniel
  1417. * Optalign conditional code adapted to record Tregister
  1418. Revision 1.33 2003/01/08 18:43:56 daniel
  1419. * Tregister changed into a record
  1420. Revision 1.32 2002/12/15 22:50:00 florian
  1421. + some stuff for the new hidden parameter handling added
  1422. Revision 1.31 2002/12/15 21:30:12 florian
  1423. * tcallnode.paraitem introduced, all references to defcoll removed
  1424. Revision 1.30 2002/11/27 20:04:39 peter
  1425. * cdecl array of const fixes
  1426. Revision 1.29 2002/11/25 17:43:17 peter
  1427. * splitted defbase in defutil,symutil,defcmp
  1428. * merged isconvertable and is_equal into compare_defs(_ext)
  1429. * made operator search faster by walking the list only once
  1430. Revision 1.28 2002/11/18 17:31:54 peter
  1431. * pass proccalloption to ret_in_xxx and push_xxx functions
  1432. Revision 1.27 2002/11/16 15:34:30 florian
  1433. * generic location for float results
  1434. Revision 1.26 2002/11/15 01:58:51 peter
  1435. * merged changes from 1.0.7 up to 04-11
  1436. - -V option for generating bug report tracing
  1437. - more tracing for option parsing
  1438. - errors for cdecl and high()
  1439. - win32 import stabs
  1440. - win32 records<=8 are returned in eax:edx (turned off by default)
  1441. - heaptrc update
  1442. - more info for temp management in .s file with EXTDEBUG
  1443. Revision 1.25 2002/10/05 12:43:25 carl
  1444. * fixes for Delphi 6 compilation
  1445. (warning : Some features do not work under Delphi)
  1446. Revision 1.24 2002/09/30 07:00:45 florian
  1447. * fixes to common code to get the alpha compiler compiled applied
  1448. Revision 1.23 2002/09/17 18:54:02 jonas
  1449. * a_load_reg_reg() now has two size parameters: source and dest. This
  1450. allows some optimizations on architectures that don't encode the
  1451. register size in the register name.
  1452. Revision 1.22 2002/09/07 15:25:02 peter
  1453. * old logs removed and tabs fixed
  1454. Revision 1.21 2002/09/07 11:50:02 jonas
  1455. * fixed small regalloction info bug
  1456. Revision 1.20 2002/09/02 11:25:20 florian
  1457. * fixed generic procedure variable calling
  1458. Revision 1.19 2002/09/01 21:04:48 florian
  1459. * several powerpc related stuff fixed
  1460. Revision 1.18 2002/09/01 18:43:27 peter
  1461. * include accumulator in regs_to_push list
  1462. Revision 1.17 2002/09/01 12:13:00 peter
  1463. * use a_call_reg
  1464. * ungetiftemp for procvar of object temp
  1465. Revision 1.16 2002/08/25 19:25:18 peter
  1466. * sym.insert_in_data removed
  1467. * symtable.insertvardata/insertconstdata added
  1468. * removed insert_in_data call from symtable.insert, it needs to be
  1469. called separatly. This allows to deref the address calculation
  1470. * procedures now calculate the parast addresses after the procedure
  1471. directives are parsed. This fixes the cdecl parast problem
  1472. * push_addr_param has an extra argument that specifies if cdecl is used
  1473. or not
  1474. Revision 1.15 2002/08/23 16:14:48 peter
  1475. * tempgen cleanup
  1476. * tt_noreuse temp type added that will be used in genentrycode
  1477. Revision 1.14 2002/08/20 16:55:38 peter
  1478. * don't write (stabs)line info when inlining a procedure
  1479. Revision 1.13 2002/08/19 19:36:42 peter
  1480. * More fixes for cross unit inlining, all tnodes are now implemented
  1481. * Moved pocall_internconst to po_internconst because it is not a
  1482. calling type at all and it conflicted when inlining of these small
  1483. functions was requested
  1484. Revision 1.12 2002/08/18 20:06:23 peter
  1485. * inlining is now also allowed in interface
  1486. * renamed write/load to ppuwrite/ppuload
  1487. * tnode storing in ppu
  1488. * nld,ncon,nbas are already updated for storing in ppu
  1489. Revision 1.11 2002/08/17 22:09:44 florian
  1490. * result type handling in tcgcal.pass_2 overhauled
  1491. * better tnode.dowrite
  1492. * some ppc stuff fixed
  1493. Revision 1.10 2002/08/17 09:23:35 florian
  1494. * first part of procinfo rewrite
  1495. Revision 1.9 2002/08/13 21:40:55 florian
  1496. * more fixes for ppc calling conventions
  1497. Revision 1.8 2002/08/13 18:01:51 carl
  1498. * rename swatoperands to swapoperands
  1499. + m68k first compilable version (still needs a lot of testing):
  1500. assembler generator, system information , inline
  1501. assembler reader.
  1502. Revision 1.7 2002/08/12 15:08:39 carl
  1503. + stab register indexes for powerpc (moved from gdb to cpubase)
  1504. + tprocessor enumeration moved to cpuinfo
  1505. + linker in target_info is now a class
  1506. * many many updates for m68k (will soon start to compile)
  1507. - removed some ifdef or correct them for correct cpu
  1508. Revision 1.6 2002/08/11 14:32:26 peter
  1509. * renamed current_library to objectlibrary
  1510. Revision 1.5 2002/08/11 13:24:11 peter
  1511. * saving of asmsymbols in ppu supported
  1512. * asmsymbollist global is removed and moved into a new class
  1513. tasmlibrarydata that will hold the info of a .a file which
  1514. corresponds with a single module. Added librarydata to tmodule
  1515. to keep the library info stored for the module. In the future the
  1516. objectfiles will also be stored to the tasmlibrarydata class
  1517. * all getlabel/newasmsymbol and friends are moved to the new class
  1518. Revision 1.4 2002/08/06 20:55:20 florian
  1519. * first part of ppc calling conventions fix
  1520. Revision 1.3 2002/07/20 11:57:53 florian
  1521. * types.pas renamed to defbase.pas because D6 contains a types
  1522. unit so this would conflicts if D6 programms are compiled
  1523. + Willamette/SSE2 instructions to assembler added
  1524. Revision 1.2 2002/07/13 19:38:43 florian
  1525. * some more generic calling stuff fixed
  1526. }