ncgcal.pas 57 KB

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