ncgcal.pas 69 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688
  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,current_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,current_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,current_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,current_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. (current_procdef.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(current_procdef) and
  391. (current_procdef.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(current_procdef) and
  536. (po_classmethod in current_procdef.procoptions))
  537. ) or
  538. (
  539. (po_staticmethod in procdefinition.procoptions) and
  540. not(assigned(current_procdef) and
  541. (po_staticmethod in current_procdef.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 current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
  622. begin
  623. reference_reset_base(href,current_procinfo.framepointer,current_procinfo.framepointer_offset);
  624. cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
  625. end
  626. { one nesting level }
  627. else if (current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
  628. begin
  629. cg.a_param_reg(exprasmlist,OS_ADDR,current_procinfo.framepointer,paramanager.getintparaloc(1));
  630. end
  631. { very complex nesting level ... }
  632. else if (current_procdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
  633. begin
  634. hregister:=rg.getaddressregister(exprasmlist);
  635. reference_reset_base(href,current_procinfo.framepointer,current_procinfo.framepointer_offset);
  636. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
  637. i:=current_procdef.parast.symtablelevel;
  638. while (i>tprocdef(procdefinition).parast.symtablelevel) do
  639. begin
  640. reference_reset_base(href,hregister,current_procinfo.framepointer_offset);
  641. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
  642. dec(i);
  643. end;
  644. cg.a_param_reg(exprasmlist,OS_ADDR,hregister,paramanager.getintparaloc(1));
  645. rg.ungetaddressregister(exprasmlist,hregister);
  646. end;
  647. end;
  648. procedure tcgcallnode.handle_return_value(inlined:boolean);
  649. var
  650. cgsize : tcgsize;
  651. r,hregister : tregister;
  652. nr:Tnewregister;
  653. begin
  654. { structured results are easy to handle.... }
  655. { needed also when result_no_used !! }
  656. if paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
  657. begin
  658. { Location should be setup by the funcret para }
  659. if location.loc<>LOC_REFERENCE then
  660. internalerror(200304241);
  661. end
  662. else
  663. { ansi/widestrings must be registered, so we can dispose them }
  664. if is_ansistring(resulttype.def) or
  665. is_widestring(resulttype.def) then
  666. begin
  667. location_reset(location,LOC_CREFERENCE,OS_ADDR);
  668. location.reference:=refcountedtemp;
  669. r.enum:=accumulator;
  670. cg.a_reg_alloc(exprasmlist,r);
  671. cg.a_load_reg_ref(exprasmlist,OS_ADDR,r,location.reference);
  672. cg.a_reg_dealloc(exprasmlist,r);
  673. end
  674. else
  675. { we have only to handle the result if it is used }
  676. if (nf_return_value_used in flags) then
  677. begin
  678. case resulttype.def.deftype of
  679. enumdef,
  680. orddef :
  681. begin
  682. cgsize:=def_cgsize(resulttype.def);
  683. { an object constructor is a function with pointer result }
  684. if (inlined or (right=nil)) and
  685. (procdefinition.proctypeoption=potype_constructor) then
  686. cgsize:=OS_ADDR;
  687. if cgsize<>OS_NO then
  688. begin
  689. location_reset(location,LOC_REGISTER,cgsize);
  690. {$ifndef cpu64bit}
  691. if cgsize in [OS_64,OS_S64] then
  692. begin
  693. {Move the function result to free registers, preferably the
  694. accumulator/accumulatorhigh, so no move is necessary.}
  695. r.enum:=R_INTREGISTER;
  696. r.number:=NR_ACCUMULATOR;
  697. hregister.enum:=R_INTREGISTER;
  698. hregister.number:=NR_ACCUMULATORHIGH;
  699. {$ifdef newra}
  700. rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR);
  701. rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATORHIGH);
  702. rg.ungetregisterint(exprasmlist,r);
  703. rg.ungetregisterint(exprasmlist,hregister);
  704. location.registerlow:=rg.getregisterint(exprasmlist,OS_INT);
  705. location.registerhigh:=rg.getregisterint(exprasmlist,OS_INT);
  706. {$else newra}
  707. cg.a_reg_alloc(exprasmlist,r);
  708. cg.a_reg_alloc(exprasmlist,hregister);
  709. if RS_ACCUMULATOR in rg.unusedregsint then
  710. location.registerlow:=rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR)
  711. else
  712. location.registerlow:=rg.getregisterint(exprasmlist,OS_INT);
  713. if RS_ACCUMULATORHIGH in rg.unusedregsint then
  714. location.registerhigh:=rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATORHIGH)
  715. else
  716. location.registerhigh:=rg.getregisterint(exprasmlist,OS_INT);
  717. {$endif newra}
  718. cg64.a_load64_reg_reg(exprasmlist,joinreg64(r,hregister),
  719. location.register64);
  720. end
  721. else
  722. {$endif cpu64bit}
  723. begin
  724. {Move the function result to a free register, preferably the
  725. accumulator, so no move is necessary.}
  726. nr:=RS_ACCUMULATOR shl 8 or cgsize2subreg(cgsize);
  727. r.enum:=R_INTREGISTER;
  728. r.number:=nr;
  729. {$ifdef newra}
  730. rg.getexplicitregisterint(exprasmlist,nr);
  731. rg.ungetregisterint(exprasmlist,r);
  732. location.register:=rg.getregisterint(exprasmlist,cgsize);
  733. {$else newra}
  734. cg.a_reg_alloc(exprasmlist,r);
  735. if RS_ACCUMULATOR in rg.unusedregsint then
  736. location.register:=rg.getexplicitregisterint(exprasmlist,nr)
  737. else
  738. location.register:=rg.getregisterint(exprasmlist,cgsize);
  739. {$endif newra}
  740. cg.a_load_reg_reg(exprasmlist,cgsize,cgsize,r,location.register);
  741. end;
  742. end;
  743. end;
  744. floatdef :
  745. begin
  746. location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
  747. {$ifdef cpufpemu}
  748. if cs_fp_emulation in aktmoduleswitches then
  749. location.register.enum := accumulator
  750. else
  751. {$endif cpufpemu}
  752. location.register.enum:=FPU_RESULT_REG;
  753. {$ifdef x86}
  754. inc(trgcpu(rg).fpuvaroffset);
  755. {$endif x86}
  756. end;
  757. {$ifdef TEST_WIN32_RECORDS}
  758. recorddef :
  759. begin
  760. if (target_info.system=system_i386_win32) then
  761. begin
  762. location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def));
  763. tg.GetTemp(exprasmlist,resulttype.size,tt_normal,location);
  764. {$ifndef cpu64bit}
  765. if cgsize in [OS_64,OS_S64] then
  766. cg64.a_load64_reg_loc(exprasmlist,joinreg64(accumulator,accumulatorhigh),location)
  767. else
  768. {$endif cpu64bit}
  769. cg.a_load_reg_loc(exprasmlist,accumulator,location);
  770. end
  771. else
  772. internalerror(200211141);
  773. end;
  774. {$endif TEST_WIN32_RECORDS}
  775. else
  776. begin
  777. location_reset(location,LOC_REGISTER,OS_INT);
  778. r.enum:=R_INTREGISTER;
  779. r.number:=NR_ACCUMULATOR;
  780. {$ifdef newra}
  781. rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR);
  782. rg.ungetregisterint(exprasmlist,r);
  783. location.register:=rg.getregisterint(exprasmlist,OS_INT);
  784. {$else newra}
  785. if RS_ACCUMULATOR in rg.unusedregsint then
  786. location.register:=rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR)
  787. else
  788. location.register:=rg.getregisterint(exprasmlist,OS_INT);
  789. {$endif newra}
  790. cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,r,location.register);
  791. end;
  792. end;
  793. end
  794. else
  795. location_reset(location,LOC_VOID,OS_NO);
  796. end;
  797. procedure tcgcallnode.pass_2;
  798. var
  799. regs_to_push_int : Tsupregset;
  800. regs_to_push_other : tregisterset;
  801. unusedstate: pointer;
  802. pushed : tpushedsaved;
  803. pushedint : tpushedsavedint;
  804. oldpushedparasize : longint;
  805. { adress returned from an I/O-error }
  806. iolabel : tasmlabel;
  807. { help reference pointer }
  808. href : treference;
  809. hp : tnode;
  810. pp : tcallparanode;
  811. virtual_vmt_call,
  812. inlined : boolean;
  813. inlinecode : tprocinlinenode;
  814. store_parast_fixup,
  815. para_alignment,
  816. para_offset : longint;
  817. pop_size : longint;
  818. returnref,
  819. pararef : treference;
  820. accreg,
  821. vmtreg : tregister;
  822. oldaktcallnode : tcallnode;
  823. begin
  824. iolabel:=nil;
  825. inlinecode:=nil;
  826. inlined:=false;
  827. rg.saveunusedstate(unusedstate);
  828. { if we allocate the temp. location for ansi- or widestrings }
  829. { already here, we avoid later a push/pop }
  830. if is_widestring(resulttype.def) then
  831. begin
  832. tg.GetTemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
  833. cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
  834. end
  835. else if is_ansistring(resulttype.def) then
  836. begin
  837. tg.GetTemp(exprasmlist,pointer_size,tt_ansistring,refcountedtemp);
  838. cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
  839. end;
  840. if (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_stdcall]) then
  841. para_alignment:=4
  842. else
  843. para_alignment:=aktalignment.paraalign;
  844. if not assigned(procdefinition) then
  845. exit;
  846. if (procdefinition.proccalloption=pocall_inline) then
  847. begin
  848. inlined:=true;
  849. inlinecode:=tprocinlinenode(right);
  850. right:=nil;
  851. { set it to the same lexical level as the local symtable, becuase
  852. the para's are stored there }
  853. tprocdef(procdefinition).parast.symtablelevel:=current_procdef.localst.symtablelevel;
  854. if assigned(left) then
  855. begin
  856. inlinecode.para_size:=tprocdef(procdefinition).para_size(para_alignment);
  857. tg.GetTemp(exprasmlist,inlinecode.para_size,tt_persistant,pararef);
  858. inlinecode.para_offset:=pararef.offset;
  859. end;
  860. store_parast_fixup:=tprocdef(procdefinition).parast.address_fixup;
  861. tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset;
  862. {$ifdef extdebug}
  863. Comment(V_debug,
  864. 'inlined parasymtable is at offset '
  865. +tostr(tprocdef(procdefinition).parast.address_fixup));
  866. exprasmList.concat(tai_comment.Create(
  867. strpnew('inlined parasymtable is at offset '
  868. +tostr(tprocdef(procdefinition).parast.address_fixup))));
  869. {$endif extdebug}
  870. end;
  871. { proc variables destroy all registers }
  872. if (inlined or
  873. (right=nil)) and
  874. { virtual methods too }
  875. not(po_virtualmethod in procdefinition.procoptions) then
  876. begin
  877. if (cs_check_io in aktlocalswitches) and
  878. (po_iocheck in procdefinition.procoptions) and
  879. not(po_iocheck in current_procdef.procoptions) then
  880. begin
  881. objectlibrary.getaddrlabel(iolabel);
  882. cg.a_label(exprasmlist,iolabel);
  883. end
  884. else
  885. iolabel:=nil;
  886. { save all used registers and possible registers
  887. used for the return value }
  888. regs_to_push_int := tprocdef(procdefinition).usedintregisters;
  889. regs_to_push_other := tprocdef(procdefinition).usedotherregisters;
  890. if (not is_void(resulttype.def)) and
  891. (not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption)) then
  892. begin
  893. include(regs_to_push_int,RS_ACCUMULATOR);
  894. {$ifndef cpu64bit}
  895. if resulttype.def.size>sizeof(aword) then
  896. include(regs_to_push_int,RS_ACCUMULATORHIGH);
  897. {$endif cpu64bit}
  898. end;
  899. rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
  900. rg.saveusedotherregisters(exprasmlist,pushed,regs_to_push_other);
  901. { give used registers through }
  902. rg.usedintinproc:=rg.usedintinproc + tprocdef(procdefinition).usedintregisters;
  903. rg.usedinproc:=rg.usedinproc + tprocdef(procdefinition).usedotherregisters;
  904. end
  905. else
  906. begin
  907. regs_to_push_int := all_intregisters;
  908. regs_to_push_other := all_registers;
  909. rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
  910. rg.saveusedotherregisters(exprasmlist,pushed,regs_to_push_other);
  911. rg.usedinproc:=all_registers;
  912. { no IO check for methods and procedure variables }
  913. iolabel:=nil;
  914. end;
  915. { Initialize for pushing the parameters }
  916. oldpushedparasize:=pushedparasize;
  917. pushedparasize:=0;
  918. pop_size:=0;
  919. { Align stack if required }
  920. if not inlined then
  921. pop_size:=align_parasize(oldpushedparasize,para_alignment);
  922. { Push parameters }
  923. oldaktcallnode:=aktcallnode;
  924. aktcallnode:=self;
  925. if assigned(left) then
  926. begin
  927. { be found elsewhere }
  928. if inlined then
  929. para_offset:=tprocdef(procdefinition).parast.address_fixup+
  930. tprocdef(procdefinition).parast.datasize
  931. else
  932. para_offset:=0;
  933. if not(inlined) and
  934. assigned(right) then
  935. tcallparanode(left).secondcallparan(
  936. (po_leftright in procdefinition.procoptions),procdefinition.proccalloption,
  937. para_alignment,para_offset)
  938. else
  939. tcallparanode(left).secondcallparan(
  940. (po_leftright in procdefinition.procoptions),procdefinition.proccalloption,
  941. para_alignment,para_offset);
  942. end;
  943. aktcallnode:=oldaktcallnode;
  944. { Allocate return value for inlined routines }
  945. if inlined and
  946. (resulttype.def.size>0) then
  947. begin
  948. tg.GetTemp(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign),tt_persistant,returnref);
  949. inlinecode.retoffset:=returnref.offset;
  950. end;
  951. { procedure variable or normal function call ? }
  952. if inlined or
  953. (right=nil) then
  954. begin
  955. { Virtual function call through VMT? }
  956. vmtreg.enum:=R_INTREGISTER;
  957. vmtreg.number:=NR_NO;
  958. virtual_vmt_call:=(po_virtualmethod in procdefinition.procoptions) and
  959. not(assigned(methodpointer) and
  960. (methodpointer.nodetype=typen));
  961. { push self/vmt for methods }
  962. if assigned(symtableproc) and
  963. (symtableproc.symtabletype in [withsymtable,objectsymtable]) then
  964. vmtreg:=push_self_and_vmt(virtual_vmt_call);
  965. { push base pointer ?}
  966. { never when inlining, since if necessary, the base pointer }
  967. { can/will be gottten from the current procedure's symtable }
  968. { (JM) }
  969. if not inlined then
  970. if (current_procdef.parast.symtablelevel>=normal_function_level) and
  971. assigned(tprocdef(procdefinition).parast) and
  972. ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
  973. push_framepointer;
  974. rg.saveintregvars(exprasmlist,regs_to_push_int);
  975. rg.saveotherregvars(exprasmlist,regs_to_push_other);
  976. if virtual_vmt_call then
  977. begin
  978. { virtual methods require an index }
  979. if tprocdef(procdefinition).extnumber=-1 then
  980. internalerror(200304021);
  981. { VMT should already be loaded in a register }
  982. if vmtreg.number=NR_NO then
  983. internalerror(200304022);
  984. { test validity of VMT }
  985. if not(is_interface(tprocdef(procdefinition)._class)) and
  986. not(is_cppclass(tprocdef(procdefinition)._class)) then
  987. cg.g_maybe_testvmt(exprasmlist,vmtreg,tprocdef(procdefinition)._class);
  988. { call method }
  989. reference_reset_base(href,vmtreg,
  990. tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber));
  991. cg.a_call_ref(exprasmlist,href);
  992. { release self }
  993. rg.ungetregisterint(exprasmlist,vmtreg);
  994. end
  995. else
  996. begin
  997. if not inlined then
  998. begin
  999. { Calling interrupt from the same code requires some
  1000. extra code }
  1001. if (po_interrupt in procdefinition.procoptions) then
  1002. extra_interrupt_code;
  1003. cg.a_call_name(exprasmlist,tprocdef(procdefinition).mangledname);
  1004. end
  1005. else { inlined proc }
  1006. begin
  1007. { process the inlinecode }
  1008. secondpass(tnode(inlinecode));
  1009. { free the args }
  1010. if tprocdef(procdefinition).parast.datasize>0 then
  1011. tg.UnGetTemp(exprasmlist,pararef);
  1012. end;
  1013. end;
  1014. end
  1015. else
  1016. { now procedure variable case }
  1017. begin
  1018. secondpass(right);
  1019. { Calling interrupt from the same code requires some
  1020. extra code }
  1021. if (po_interrupt in procdefinition.procoptions) then
  1022. extra_interrupt_code;
  1023. if (po_methodpointer in procdefinition.procoptions) then
  1024. begin
  1025. { push self, but not if it's already explicitly pushed }
  1026. if not(po_containsself in procdefinition.procoptions) then
  1027. begin
  1028. { push self }
  1029. href:=right.location.reference;
  1030. inc(href.offset,POINTER_SIZE);
  1031. cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
  1032. end;
  1033. rg.saveintregvars(exprasmlist,ALL_INTREGISTERS);
  1034. rg.saveotherregvars(exprasmlist,ALL_REGISTERS);
  1035. cg.a_call_ref(exprasmlist,right.location.reference);
  1036. reference_release(exprasmlist,right.location.reference);
  1037. tg.Ungetiftemp(exprasmlist,right.location.reference);
  1038. end
  1039. else
  1040. begin
  1041. rg.saveintregvars(exprasmlist,ALL_INTREGISTERS);
  1042. rg.saveotherregvars(exprasmlist,ALL_REGISTERS);
  1043. cg.a_call_loc(exprasmlist,right.location);
  1044. location_release(exprasmlist,right.location);
  1045. location_freetemp(exprasmlist,right.location);
  1046. end;
  1047. end;
  1048. { Need to remove the parameters from the stack? }
  1049. if (not inlined) and (po_clearstack in procdefinition.procoptions) then
  1050. begin
  1051. { the old pop_size was already included in pushedparasize }
  1052. pop_size:=pushedparasize;
  1053. end;
  1054. { Remove parameters/alignment from the stack }
  1055. if pop_size>0 then
  1056. pop_parasize(pop_size);
  1057. {$ifdef powerpc}
  1058. { this calculation must be done in pass_1 anyway, so don't worry }
  1059. if tppcprocinfo(current_procinfo).maxpushedparasize<pushedparasize then
  1060. tppcprocinfo(current_procinfo).maxpushedparasize:=pushedparasize;
  1061. {$endif powerpc}
  1062. { Restore }
  1063. pushedparasize:=oldpushedparasize;
  1064. rg.restoreunusedstate(unusedstate);
  1065. {$ifdef TEMPREGDEBUG}
  1066. testregisters32;
  1067. {$endif TEMPREGDEBUG}
  1068. { Called an inherited constructor? Then
  1069. we need to check the result }
  1070. if (inlined or (right=nil)) and
  1071. (procdefinition.proctypeoption=potype_constructor) and
  1072. assigned(methodpointer) and
  1073. (methodpointer.nodetype=typen) and
  1074. (current_procdef.proctypeoption=potype_constructor) then
  1075. begin
  1076. accreg.enum:=R_INTREGISTER;
  1077. accreg.number:=NR_ACCUMULATOR;
  1078. cg.a_reg_alloc(exprasmlist,accreg);
  1079. cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,accreg,faillabel);
  1080. cg.a_reg_dealloc(exprasmlist,accreg);
  1081. end;
  1082. { handle function results }
  1083. if (not is_void(resulttype.def)) then
  1084. handle_return_value(inlined)
  1085. else
  1086. location_reset(location,LOC_VOID,OS_NO);
  1087. { perhaps i/o check ? }
  1088. if iolabel<>nil then
  1089. begin
  1090. reference_reset_symbol(href,iolabel,0);
  1091. cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
  1092. cg.a_call_name(exprasmlist,'FPC_IOCHECK');
  1093. end;
  1094. { restore registers }
  1095. rg.restoreusedotherregisters(exprasmlist,pushed);
  1096. rg.restoreusedintregisters(exprasmlist,pushedint);
  1097. { Release temps from parameters }
  1098. pp:=tcallparanode(left);
  1099. while assigned(pp) do
  1100. begin
  1101. if assigned(pp.left) then
  1102. begin
  1103. { don't release the funcret temp }
  1104. if not(vo_is_funcret in tvarsym(pp.paraitem.parasym).varoptions) then
  1105. location_freetemp(exprasmlist,pp.left.location);
  1106. { process also all nodes of an array of const }
  1107. if pp.left.nodetype=arrayconstructorn then
  1108. begin
  1109. if assigned(tarrayconstructornode(pp.left).left) then
  1110. begin
  1111. hp:=pp.left;
  1112. while assigned(hp) do
  1113. begin
  1114. location_freetemp(exprasmlist,tarrayconstructornode(hp).left.location);
  1115. hp:=tarrayconstructornode(hp).right;
  1116. end;
  1117. end;
  1118. end;
  1119. end;
  1120. pp:=tcallparanode(pp.right);
  1121. end;
  1122. if inlined then
  1123. begin
  1124. if (resulttype.def.size>0) then
  1125. tg.UnGetTemp(exprasmlist,returnref);
  1126. tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup;
  1127. right:=inlinecode;
  1128. { from now on the result can be freed normally }
  1129. if paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
  1130. tg.ChangeTempType(exprasmlist,funcretnode.location.reference,tt_normal);
  1131. end;
  1132. { if return value is not used }
  1133. if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then
  1134. begin
  1135. if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
  1136. begin
  1137. { data which must be finalized ? }
  1138. if (resulttype.def.needs_inittable) then
  1139. cg.g_finalize(exprasmlist,resulttype.def,location.reference,false);
  1140. { release unused temp }
  1141. tg.ungetiftemp(exprasmlist,location.reference)
  1142. end
  1143. else if location.loc=LOC_FPUREGISTER then
  1144. begin
  1145. {$ifdef x86}
  1146. { release FPU stack }
  1147. accreg.enum:=FPU_RESULT_REG;
  1148. emit_reg(A_FSTP,S_NO,accreg);
  1149. {
  1150. dec(trgcpu(rg).fpuvaroffset);
  1151. do NOT decrement as the increment before
  1152. is not called for unused results PM }
  1153. {$endif x86}
  1154. end;
  1155. end;
  1156. end;
  1157. {*****************************************************************************
  1158. TCGPROCINLINENODE
  1159. *****************************************************************************}
  1160. procedure tcgprocinlinenode.pass_2;
  1161. var st : tsymtable;
  1162. oldprocdef : tprocdef;
  1163. ps, i : longint;
  1164. oldprocinfo : tprocinfo;
  1165. oldinlining_procedure,
  1166. nostackframe,make_global : boolean;
  1167. inlineentrycode,inlineexitcode : TAAsmoutput;
  1168. oldexitlabel,oldexit2label,oldquickexitlabel:tasmlabel;
  1169. oldregstate: pointer;
  1170. localsref : treference;
  1171. {$ifdef GDB}
  1172. startlabel,endlabel : tasmlabel;
  1173. pp : pchar;
  1174. mangled_length : longint;
  1175. {$endif GDB}
  1176. begin
  1177. { deallocate the registers used for the current procedure's regvars }
  1178. if assigned(current_procdef.regvarinfo) then
  1179. begin
  1180. with pregvarinfo(current_procdef.regvarinfo)^ do
  1181. for i := 1 to maxvarregs do
  1182. if assigned(regvars[i]) then
  1183. store_regvar(exprasmlist,regvars[i].reg);
  1184. rg.saveStateForInline(oldregstate);
  1185. { make sure the register allocator knows what the regvars in the }
  1186. { inlined code block are (JM) }
  1187. rg.resetusableregisters;
  1188. rg.clearregistercount;
  1189. {$ifndef newra}
  1190. rg.cleartempgen;
  1191. {$endif}
  1192. if assigned(inlineprocdef.regvarinfo) then
  1193. with pregvarinfo(inlineprocdef.regvarinfo)^ do
  1194. for i := 1 to maxvarregs do
  1195. if assigned(regvars[i]) then
  1196. begin
  1197. {Fix me!!}
  1198. {tmpreg:=rg.makeregsize(regvars[i].reg,OS_INT);
  1199. rg.makeregvar(tmpreg);}
  1200. internalerror(200301232);
  1201. end;
  1202. end;
  1203. oldinlining_procedure:=inlining_procedure;
  1204. oldexitlabel:=aktexitlabel;
  1205. oldexit2label:=aktexit2label;
  1206. oldquickexitlabel:=quickexitlabel;
  1207. oldprocdef:=current_procdef;
  1208. oldprocinfo:=current_procinfo;
  1209. objectlibrary.getlabel(aktexitlabel);
  1210. objectlibrary.getlabel(aktexit2label);
  1211. { we're inlining a procedure }
  1212. inlining_procedure:=true;
  1213. current_procdef:=inlineprocdef;
  1214. { clone procinfo, but not the asmlists }
  1215. current_procinfo:=tprocinfo(cprocinfo.newinstance);
  1216. move(pointer(oldprocinfo)^,pointer(current_procinfo)^,cprocinfo.InstanceSize);
  1217. current_procinfo.aktentrycode:=nil;
  1218. current_procinfo.aktexitcode:=nil;
  1219. current_procinfo.aktproccode:=nil;
  1220. current_procinfo.aktlocaldata:=nil;
  1221. { set new procinfo }
  1222. current_procinfo.return_offset:=retoffset;
  1223. { arg space has been filled by the parent secondcall }
  1224. st:=current_procdef.localst;
  1225. { set it to the same lexical level }
  1226. st.symtablelevel:=oldprocdef.localst.symtablelevel;
  1227. if st.datasize>0 then
  1228. begin
  1229. tg.GetTemp(exprasmlist,st.datasize,tt_persistant,localsref);
  1230. st.address_fixup:=localsref.offset+st.datasize;
  1231. {$ifdef extdebug}
  1232. Comment(V_debug,'local symtable is at offset '+tostr(st.address_fixup));
  1233. exprasmList.concat(tai_comment.Create(strpnew(
  1234. 'local symtable is at offset '+tostr(st.address_fixup))));
  1235. {$endif extdebug}
  1236. end;
  1237. exprasmList.concat(Tai_Marker.Create(InlineStart));
  1238. {$ifdef extdebug}
  1239. exprasmList.concat(tai_comment.Create(strpnew('Start of inlined proc')));
  1240. {$endif extdebug}
  1241. {$ifdef GDB}
  1242. if (cs_debuginfo in aktmoduleswitches) then
  1243. begin
  1244. objectlibrary.getaddrlabel(startlabel);
  1245. objectlibrary.getaddrlabel(endlabel);
  1246. cg.a_label(exprasmlist,startlabel);
  1247. inlineprocdef.localst.symtabletype:=inlinelocalsymtable;
  1248. inlineprocdef.parast.symtabletype:=inlineparasymtable;
  1249. { Here we must include the para and local symtable info }
  1250. inlineprocdef.concatstabto(withdebuglist);
  1251. { set it back for safety }
  1252. inlineprocdef.localst.symtabletype:=localsymtable;
  1253. inlineprocdef.parast.symtabletype:=parasymtable;
  1254. mangled_length:=length(oldprocdef.mangledname);
  1255. getmem(pp,mangled_length+50);
  1256. strpcopy(pp,'192,0,0,'+startlabel.name);
  1257. if (target_info.use_function_relative_addresses) then
  1258. begin
  1259. strpcopy(strend(pp),'-');
  1260. strpcopy(strend(pp),oldprocdef.mangledname);
  1261. end;
  1262. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  1263. end;
  1264. {$endif GDB}
  1265. { takes care of local data initialization }
  1266. inlineentrycode:=TAAsmoutput.Create;
  1267. inlineexitcode:=TAAsmoutput.Create;
  1268. ps:=para_size;
  1269. make_global:=false; { to avoid warning }
  1270. genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
  1271. if po_assembler in current_procdef.procoptions then
  1272. inlineentrycode.insert(Tai_marker.Create(asmblockstart));
  1273. exprasmList.concatlist(inlineentrycode);
  1274. secondpass(inlinetree);
  1275. genexitcode(inlineexitcode,0,false,true);
  1276. if po_assembler in current_procdef.procoptions then
  1277. inlineexitcode.concat(Tai_marker.Create(asmblockend));
  1278. exprasmList.concatlist(inlineexitcode);
  1279. inlineentrycode.free;
  1280. inlineexitcode.free;
  1281. {$ifdef extdebug}
  1282. exprasmList.concat(tai_comment.Create(strpnew('End of inlined proc')));
  1283. {$endif extdebug}
  1284. exprasmList.concat(Tai_Marker.Create(InlineEnd));
  1285. {we can free the local data now, reset also the fixup address }
  1286. if st.datasize>0 then
  1287. begin
  1288. tg.UnGetTemp(exprasmlist,localsref);
  1289. st.address_fixup:=0;
  1290. end;
  1291. { restore procinfo }
  1292. current_procinfo.free;
  1293. current_procinfo:=oldprocinfo;
  1294. {$ifdef GDB}
  1295. if (cs_debuginfo in aktmoduleswitches) then
  1296. begin
  1297. cg.a_label(exprasmlist,endlabel);
  1298. strpcopy(pp,'224,0,0,'+endlabel.name);
  1299. if (target_info.use_function_relative_addresses) then
  1300. begin
  1301. strpcopy(strend(pp),'-');
  1302. strpcopy(strend(pp),oldprocdef.mangledname);
  1303. end;
  1304. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  1305. freemem(pp,mangled_length+50);
  1306. end;
  1307. {$endif GDB}
  1308. { restore }
  1309. current_procdef:=oldprocdef;
  1310. aktexitlabel:=oldexitlabel;
  1311. aktexit2label:=oldexit2label;
  1312. quickexitlabel:=oldquickexitlabel;
  1313. inlining_procedure:=oldinlining_procedure;
  1314. { reallocate the registers used for the current procedure's regvars, }
  1315. { since they may have been used and then deallocated in the inlined }
  1316. { procedure (JM) }
  1317. if assigned(current_procdef.regvarinfo) then
  1318. begin
  1319. rg.restoreStateAfterInline(oldregstate);
  1320. end;
  1321. end;
  1322. begin
  1323. ccallparanode:=tcgcallparanode;
  1324. ccallnode:=tcgcallnode;
  1325. cprocinlinenode:=tcgprocinlinenode;
  1326. end.
  1327. {
  1328. $Log$
  1329. Revision 1.56 2003-04-29 07:28:52 michael
  1330. + Patch from peter to fix wrong pushing of ansistring function results in open array
  1331. Revision 1.55 2003/04/27 11:21:33 peter
  1332. * aktprocdef renamed to current_procdef
  1333. * procinfo renamed to current_procinfo
  1334. * procinfo will now be stored in current_module so it can be
  1335. cleaned up properly
  1336. * gen_main_procsym changed to create_main_proc and release_main_proc
  1337. to also generate a tprocinfo structure
  1338. * fixed unit implicit initfinal
  1339. Revision 1.54 2003/04/27 07:29:50 peter
  1340. * current_procdef cleanup, current_procdef is now always nil when parsing
  1341. a new procdef declaration
  1342. * aktprocsym removed
  1343. * lexlevel removed, use symtable.symtablelevel instead
  1344. * implicit init/final code uses the normal genentry/genexit
  1345. * funcret state checking updated for new funcret handling
  1346. Revision 1.53 2003/04/25 20:59:33 peter
  1347. * removed funcretn,funcretsym, function result is now in varsym
  1348. and aliases for result and function name are added using absolutesym
  1349. * vs_hidden parameter for funcret passed in parameter
  1350. * vs_hidden fixes
  1351. * writenode changed to printnode and released from extdebug
  1352. * -vp option added to generate a tree.log with the nodetree
  1353. * nicer printnode for statements, callnode
  1354. Revision 1.52 2003/04/25 08:25:26 daniel
  1355. * Ifdefs around a lot of calls to cleartempgen
  1356. * Fixed registers that are allocated but not freed in several nodes
  1357. * Tweak to register allocator to cause less spills
  1358. * 8-bit registers now interfere with esi,edi and ebp
  1359. Compiler can now compile rtl successfully when using new register
  1360. allocator
  1361. Revision 1.51 2003/04/22 23:50:22 peter
  1362. * firstpass uses expectloc
  1363. * checks if there are differences between the expectloc and
  1364. location.loc from secondpass in EXTDEBUG
  1365. Revision 1.50 2003/04/22 14:33:38 peter
  1366. * removed some notes/hints
  1367. Revision 1.49 2003/04/22 13:47:08 peter
  1368. * fixed C style array of const
  1369. * fixed C array passing
  1370. * fixed left to right with high parameters
  1371. Revision 1.48 2003/04/22 10:09:34 daniel
  1372. + Implemented the actual register allocator
  1373. + Scratch registers unavailable when new register allocator used
  1374. + maybe_save/maybe_restore unavailable when new register allocator used
  1375. Revision 1.47 2003/04/22 09:49:44 peter
  1376. * do not load self when calling a non-inherited class constructor
  1377. Revision 1.46 2003/04/21 20:03:32 peter
  1378. * forgot to copy vmtrefaddr to selfrefaddr when self=vmt
  1379. Revision 1.45 2003/04/21 13:53:16 jonas
  1380. - removed copying of all paras when secondpassing a callnode (this used
  1381. to be necessary for inlinign support, but currently the whole inlined
  1382. procedure is already copied in advance). Note that the compiler crashes
  1383. when compiling ucomplex with -dTEST_INLINE (also after fixing the
  1384. syntax errors), but that was also the case before this change.
  1385. Revision 1.44 2003/04/10 17:57:52 peter
  1386. * vs_hidden released
  1387. Revision 1.43 2003/04/06 21:11:23 olle
  1388. * changed newasmsymbol to newasmsymboldata for data symbols
  1389. Revision 1.42 2003/04/04 15:38:56 peter
  1390. * moved generic code from n386cal to ncgcal, i386 now also
  1391. uses the generic ncgcal
  1392. Revision 1.41 2003/03/28 19:16:56 peter
  1393. * generic constructor working for i386
  1394. * remove fixed self register
  1395. * esi added as address register for i386
  1396. Revision 1.40 2003/03/06 11:35:50 daniel
  1397. * Fixed internalerror 7843 issue
  1398. Revision 1.39 2003/02/19 22:00:14 daniel
  1399. * Code generator converted to new register notation
  1400. - Horribily outdated todo.txt removed
  1401. Revision 1.38 2003/02/15 22:17:38 carl
  1402. * bugfix of FPU emulation code
  1403. Revision 1.37 2003/02/12 22:10:07 carl
  1404. * load_frame_pointer is now generic
  1405. * change fpu emulation routine names
  1406. Revision 1.36 2003/01/30 21:46:57 peter
  1407. * self fixes for static methods (merged)
  1408. Revision 1.35 2003/01/22 20:45:15 mazen
  1409. * making math code in RTL compiling.
  1410. *NB : This does NOT mean necessary that it will generate correct code!
  1411. Revision 1.34 2003/01/17 12:03:45 daniel
  1412. * Optalign conditional code adapted to record Tregister
  1413. Revision 1.33 2003/01/08 18:43:56 daniel
  1414. * Tregister changed into a record
  1415. Revision 1.32 2002/12/15 22:50:00 florian
  1416. + some stuff for the new hidden parameter handling added
  1417. Revision 1.31 2002/12/15 21:30:12 florian
  1418. * tcallnode.paraitem introduced, all references to defcoll removed
  1419. Revision 1.30 2002/11/27 20:04:39 peter
  1420. * cdecl array of const fixes
  1421. Revision 1.29 2002/11/25 17:43:17 peter
  1422. * splitted defbase in defutil,symutil,defcmp
  1423. * merged isconvertable and is_equal into compare_defs(_ext)
  1424. * made operator search faster by walking the list only once
  1425. Revision 1.28 2002/11/18 17:31:54 peter
  1426. * pass proccalloption to ret_in_xxx and push_xxx functions
  1427. Revision 1.27 2002/11/16 15:34:30 florian
  1428. * generic location for float results
  1429. Revision 1.26 2002/11/15 01:58:51 peter
  1430. * merged changes from 1.0.7 up to 04-11
  1431. - -V option for generating bug report tracing
  1432. - more tracing for option parsing
  1433. - errors for cdecl and high()
  1434. - win32 import stabs
  1435. - win32 records<=8 are returned in eax:edx (turned off by default)
  1436. - heaptrc update
  1437. - more info for temp management in .s file with EXTDEBUG
  1438. Revision 1.25 2002/10/05 12:43:25 carl
  1439. * fixes for Delphi 6 compilation
  1440. (warning : Some features do not work under Delphi)
  1441. Revision 1.24 2002/09/30 07:00:45 florian
  1442. * fixes to common code to get the alpha compiler compiled applied
  1443. Revision 1.23 2002/09/17 18:54:02 jonas
  1444. * a_load_reg_reg() now has two size parameters: source and dest. This
  1445. allows some optimizations on architectures that don't encode the
  1446. register size in the register name.
  1447. Revision 1.22 2002/09/07 15:25:02 peter
  1448. * old logs removed and tabs fixed
  1449. Revision 1.21 2002/09/07 11:50:02 jonas
  1450. * fixed small regalloction info bug
  1451. Revision 1.20 2002/09/02 11:25:20 florian
  1452. * fixed generic procedure variable calling
  1453. Revision 1.19 2002/09/01 21:04:48 florian
  1454. * several powerpc related stuff fixed
  1455. Revision 1.18 2002/09/01 18:43:27 peter
  1456. * include accumulator in regs_to_push list
  1457. Revision 1.17 2002/09/01 12:13:00 peter
  1458. * use a_call_reg
  1459. * ungetiftemp for procvar of object temp
  1460. Revision 1.16 2002/08/25 19:25:18 peter
  1461. * sym.insert_in_data removed
  1462. * symtable.insertvardata/insertconstdata added
  1463. * removed insert_in_data call from symtable.insert, it needs to be
  1464. called separatly. This allows to deref the address calculation
  1465. * procedures now calculate the parast addresses after the procedure
  1466. directives are parsed. This fixes the cdecl parast problem
  1467. * push_addr_param has an extra argument that specifies if cdecl is used
  1468. or not
  1469. Revision 1.15 2002/08/23 16:14:48 peter
  1470. * tempgen cleanup
  1471. * tt_noreuse temp type added that will be used in genentrycode
  1472. Revision 1.14 2002/08/20 16:55:38 peter
  1473. * don't write (stabs)line info when inlining a procedure
  1474. Revision 1.13 2002/08/19 19:36:42 peter
  1475. * More fixes for cross unit inlining, all tnodes are now implemented
  1476. * Moved pocall_internconst to po_internconst because it is not a
  1477. calling type at all and it conflicted when inlining of these small
  1478. functions was requested
  1479. Revision 1.12 2002/08/18 20:06:23 peter
  1480. * inlining is now also allowed in interface
  1481. * renamed write/load to ppuwrite/ppuload
  1482. * tnode storing in ppu
  1483. * nld,ncon,nbas are already updated for storing in ppu
  1484. Revision 1.11 2002/08/17 22:09:44 florian
  1485. * result type handling in tcgcal.pass_2 overhauled
  1486. * better tnode.dowrite
  1487. * some ppc stuff fixed
  1488. Revision 1.10 2002/08/17 09:23:35 florian
  1489. * first part of procinfo rewrite
  1490. Revision 1.9 2002/08/13 21:40:55 florian
  1491. * more fixes for ppc calling conventions
  1492. Revision 1.8 2002/08/13 18:01:51 carl
  1493. * rename swatoperands to swapoperands
  1494. + m68k first compilable version (still needs a lot of testing):
  1495. assembler generator, system information , inline
  1496. assembler reader.
  1497. Revision 1.7 2002/08/12 15:08:39 carl
  1498. + stab register indexes for powerpc (moved from gdb to cpubase)
  1499. + tprocessor enumeration moved to cpuinfo
  1500. + linker in target_info is now a class
  1501. * many many updates for m68k (will soon start to compile)
  1502. - removed some ifdef or correct them for correct cpu
  1503. Revision 1.6 2002/08/11 14:32:26 peter
  1504. * renamed current_library to objectlibrary
  1505. Revision 1.5 2002/08/11 13:24:11 peter
  1506. * saving of asmsymbols in ppu supported
  1507. * asmsymbollist global is removed and moved into a new class
  1508. tasmlibrarydata that will hold the info of a .a file which
  1509. corresponds with a single module. Added librarydata to tmodule
  1510. to keep the library info stored for the module. In the future the
  1511. objectfiles will also be stored to the tasmlibrarydata class
  1512. * all getlabel/newasmsymbol and friends are moved to the new class
  1513. Revision 1.4 2002/08/06 20:55:20 florian
  1514. * first part of ppc calling conventions fix
  1515. Revision 1.3 2002/07/20 11:57:53 florian
  1516. * types.pas renamed to defbase.pas because D6 contains a types
  1517. unit so this would conflicts if D6 programms are compiled
  1518. + Willamette/SSE2 instructions to assembler added
  1519. Revision 1.2 2002/07/13 19:38:43 florian
  1520. * some more generic calling stuff fixed
  1521. }