ncgcal.pas 66 KB

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