ncgcal.pas 68 KB

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