2
0

ncgcal.pas 66 KB

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