ncgcal.pas 69 KB

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