ncgcal.pas 66 KB

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