n386cal.pas 73 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577
  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 n386cal;
  19. {$i fpcdefs.inc}
  20. interface
  21. { $define AnsiStrRef}
  22. uses
  23. symdef,node,ncal;
  24. type
  25. ti386callparanode = class(tcallparanode)
  26. procedure secondcallparan(defcoll : TParaItem;
  27. push_from_left_to_right,inlined,is_cdecl : boolean;
  28. para_alignment,para_offset : longint);override;
  29. end;
  30. ti386callnode = class(tcallnode)
  31. procedure pass_2;override;
  32. end;
  33. ti386procinlinenode = class(tprocinlinenode)
  34. procedure pass_2;override;
  35. end;
  36. implementation
  37. uses
  38. globtype,systems,
  39. cutils,verbose,globals,
  40. symconst,symbase,symsym,symtable,types,
  41. {$ifdef GDB}
  42. {$ifdef delphi}
  43. sysutils,
  44. {$else}
  45. strings,
  46. {$endif}
  47. gdb,
  48. {$endif GDB}
  49. cginfo,cgbase,pass_2,
  50. cpubase,aasm,tainst,
  51. nmem,nld,ncnv,
  52. ncgutil,cga,cgobj,tgobj,regvars,rgobj,rgcpu,cg64f32,cgcpu;
  53. {*****************************************************************************
  54. TI386CALLPARANODE
  55. *****************************************************************************}
  56. procedure ti386callparanode.secondcallparan(defcoll : TParaItem;
  57. push_from_left_to_right,inlined,is_cdecl : boolean;para_alignment,para_offset : longint);
  58. procedure maybe_push_high;
  59. begin
  60. { open array ? }
  61. { defcoll.data can be nil for read/write }
  62. if assigned(defcoll.paratype.def) and
  63. assigned(hightree) then
  64. begin
  65. secondpass(hightree);
  66. { this is a longint anyway ! }
  67. push_value_para(hightree,inlined,false,para_offset,4);
  68. end;
  69. end;
  70. var
  71. otlabel,oflabel : tasmlabel;
  72. { temporary variables: }
  73. tempdeftype : tdeftype;
  74. tmpreg : tregister;
  75. href : treference;
  76. begin
  77. { set default para_alignment to target_info.stackalignment }
  78. if para_alignment=0 then
  79. para_alignment:=aktalignment.paraalign;
  80. { push from left to right if specified }
  81. if push_from_left_to_right and assigned(right) then
  82. begin
  83. if (nf_varargs_para in flags) then
  84. tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
  85. inlined,is_cdecl,para_alignment,para_offset)
  86. else
  87. tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
  88. inlined,is_cdecl,para_alignment,para_offset);
  89. end;
  90. otlabel:=truelabel;
  91. oflabel:=falselabel;
  92. getlabel(truelabel);
  93. getlabel(falselabel);
  94. secondpass(left);
  95. { handle varargs first, because defcoll is not valid }
  96. if (nf_varargs_para in flags) then
  97. begin
  98. if push_addr_param(left.resulttype.def) then
  99. begin
  100. inc(pushedparasize,4);
  101. cg.a_paramaddr_ref(exprasmlist,left.location.reference,-1);
  102. location_release(exprasmlist,left.location);
  103. end
  104. else
  105. push_value_para(left,inlined,is_cdecl,para_offset,para_alignment);
  106. end
  107. { filter array constructor with c styled args }
  108. else if is_array_constructor(left.resulttype.def) and (nf_cargs in left.flags) then
  109. begin
  110. { nothing, everything is already pushed }
  111. end
  112. { in codegen.handleread.. defcoll.data is set to nil }
  113. else if assigned(defcoll.paratype.def) and
  114. (defcoll.paratype.def.deftype=formaldef) then
  115. begin
  116. { allow passing of a constant to a const formaldef }
  117. if (defcoll.paratyp=vs_const) and
  118. (left.location.loc=LOC_CONSTANT) then
  119. location_force_mem(exprasmlist,left.location);
  120. { allow @var }
  121. inc(pushedparasize,4);
  122. if (left.nodetype=addrn) and
  123. (not(nf_procvarload in left.flags)) then
  124. begin
  125. if inlined then
  126. begin
  127. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  128. cg.a_load_loc_ref(exprasmlist,left.location,href);
  129. end
  130. else
  131. cg.a_param_loc(exprasmlist,left.location,-1);
  132. location_release(exprasmlist,left.location);
  133. end
  134. else
  135. begin
  136. if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  137. CGMessage(type_e_mismatch)
  138. else
  139. begin
  140. if inlined then
  141. begin
  142. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  143. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
  144. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  145. cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
  146. cg.free_scratch_reg(exprasmlist,tmpreg);
  147. end
  148. else
  149. cg.a_paramaddr_ref(exprasmlist,left.location.reference,-1);
  150. location_release(exprasmlist,left.location);
  151. end;
  152. end;
  153. end
  154. { handle call by reference parameter }
  155. else if (defcoll.paratyp in [vs_var,vs_out]) then
  156. begin
  157. { get temp for constants }
  158. if left.location.loc=LOC_CONSTANT then
  159. begin
  160. tg.gettempofsizereference(exprasmlist,left.resulttype.def.size,href);
  161. cg.a_load_loc_ref(exprasmlist,left.location,href);
  162. location_reset(left.location,LOC_REFERENCE,def_cgsize(left.resulttype.def));
  163. left.location.reference:=href;
  164. end;
  165. if (left.location.loc<>LOC_REFERENCE) then
  166. begin
  167. { passing self to a var parameter is allowed in
  168. TP and delphi }
  169. if not((left.location.loc=LOC_CREFERENCE) and
  170. (left.nodetype=selfn)) then
  171. internalerror(200106041);
  172. end;
  173. maybe_push_high;
  174. if (defcoll.paratyp=vs_out) and
  175. assigned(defcoll.paratype.def) and
  176. not is_class(defcoll.paratype.def) and
  177. defcoll.paratype.def.needs_inittable then
  178. cg.g_finalize(exprasmlist,defcoll.paratype.def,left.location.reference,false);
  179. inc(pushedparasize,4);
  180. if inlined then
  181. begin
  182. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  183. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
  184. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  185. cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
  186. cg.free_scratch_reg(exprasmlist,tmpreg);
  187. end
  188. else
  189. cg.a_paramaddr_ref(exprasmlist,left.location.reference,-1);
  190. location_release(exprasmlist,left.location);
  191. end
  192. else
  193. begin
  194. tempdeftype:=resulttype.def.deftype;
  195. if tempdeftype=filedef then
  196. CGMessage(cg_e_file_must_call_by_reference);
  197. { open array must always push the address, this is needed to
  198. also push addr of small open arrays and with cdecl functions (PFV) }
  199. if (
  200. assigned(defcoll.paratype.def) and
  201. (is_open_array(defcoll.paratype.def) or
  202. is_array_of_const(defcoll.paratype.def))
  203. ) or
  204. (
  205. push_addr_param(resulttype.def) and
  206. not is_cdecl
  207. ) then
  208. begin
  209. if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  210. begin
  211. { allow passing nil to a procvardef (methodpointer) }
  212. if (left.nodetype=typeconvn) and
  213. (left.resulttype.def.deftype=procvardef) and
  214. (ttypeconvnode(left).left.nodetype=niln) then
  215. begin
  216. tg.gettempofsizereference(exprasmlist,tcgsize2size[left.location.size],href);
  217. cg.a_load_loc_ref(exprasmlist,left.location,href);
  218. location_reset(left.location,LOC_REFERENCE,left.location.size);
  219. left.location.reference:=href;
  220. end
  221. else
  222. internalerror(200204011);
  223. end;
  224. maybe_push_high;
  225. inc(pushedparasize,4);
  226. if inlined then
  227. begin
  228. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  229. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
  230. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  231. cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
  232. cg.free_scratch_reg(exprasmlist,tmpreg);
  233. end
  234. else
  235. cg.a_paramaddr_ref(exprasmlist,left.location.reference,-1);
  236. location_release(exprasmlist,left.location);
  237. end
  238. else
  239. begin
  240. push_value_para(left,inlined,is_cdecl,
  241. para_offset,para_alignment);
  242. end;
  243. end;
  244. truelabel:=otlabel;
  245. falselabel:=oflabel;
  246. { push from right to left }
  247. if not push_from_left_to_right and assigned(right) then
  248. begin
  249. if (nf_varargs_para in flags) then
  250. tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
  251. inlined,is_cdecl,para_alignment,para_offset)
  252. else
  253. tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
  254. inlined,is_cdecl,para_alignment,para_offset);
  255. end;
  256. end;
  257. {*****************************************************************************
  258. TI386CALLNODE
  259. *****************************************************************************}
  260. procedure ti386callnode.pass_2;
  261. var
  262. regs_to_push : tregisterset;
  263. unusedstate: pointer;
  264. pushed : tpushedsaved;
  265. funcretref,refcountedtemp : treference;
  266. tmpreg : tregister;
  267. hregister : tregister;
  268. oldpushedparasize : longint;
  269. { true if ESI must be loaded again after the subroutine }
  270. loadesi : boolean;
  271. { true if a virtual method must be called directly }
  272. no_virtual_call : boolean;
  273. { true if we produce a con- or destrutor in a call }
  274. is_con_or_destructor : boolean;
  275. { true if a constructor is called again }
  276. extended_new : boolean;
  277. { adress returned from an I/O-error }
  278. iolabel : tasmlabel;
  279. { lexlevel count }
  280. i : longint;
  281. { help reference pointer }
  282. href : treference;
  283. hrefvmt : treference;
  284. hp : tnode;
  285. pp : tbinarynode;
  286. params : tnode;
  287. inlined : boolean;
  288. inlinecode : tprocinlinenode;
  289. store_parast_fixup,
  290. para_alignment,
  291. para_offset : longint;
  292. cgsize : tcgsize;
  293. { instruction for alignement correction }
  294. { corr : paicpu;}
  295. { we must pop this size also after !! }
  296. { must_pop : boolean; }
  297. pop_size : longint;
  298. {$ifdef OPTALIGN}
  299. pop_esp : boolean;
  300. push_size : longint;
  301. {$endif OPTALIGN}
  302. pop_allowed : boolean;
  303. release_tmpreg : boolean;
  304. constructorfailed : tasmlabel;
  305. label
  306. dont_call;
  307. begin
  308. extended_new:=false;
  309. iolabel:=nil;
  310. inlinecode:=nil;
  311. inlined:=false;
  312. loadesi:=true;
  313. no_virtual_call:=false;
  314. rg.saveunusedstate(unusedstate);
  315. { if we allocate the temp. location for ansi- or widestrings }
  316. { already here, we avoid later a push/pop }
  317. if is_widestring(resulttype.def) then
  318. begin
  319. tg.gettempwidestringreference(exprasmlist,refcountedtemp);
  320. cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
  321. end
  322. else if is_ansistring(resulttype.def) then
  323. begin
  324. tg.gettempansistringreference(exprasmlist,refcountedtemp);
  325. cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
  326. end;
  327. if (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_stdcall]) then
  328. para_alignment:=4
  329. else
  330. para_alignment:=aktalignment.paraalign;
  331. if not assigned(procdefinition) then
  332. exit;
  333. { Deciding whether we may still need the parameters happens next (JM) }
  334. if assigned(left) then
  335. params:=left.getcopy
  336. else params := nil;
  337. if (procdefinition.proccalloption=pocall_inline) then
  338. begin
  339. inlined:=true;
  340. inlinecode:=tprocinlinenode(right);
  341. right:=nil;
  342. { set it to the same lexical level as the local symtable, becuase
  343. the para's are stored there }
  344. tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel;
  345. if assigned(params) then
  346. inlinecode.para_offset:=tg.gettempofsizepersistant(exprasmlist,inlinecode.para_size);
  347. store_parast_fixup:=tprocdef(procdefinition).parast.address_fixup;
  348. tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset;
  349. {$ifdef extdebug}
  350. Comment(V_debug,
  351. 'inlined parasymtable is at offset '
  352. +tostr(tprocdef(procdefinition).parast.address_fixup));
  353. exprasmList.concat(Tai_asm_comment.Create(
  354. strpnew('inlined parasymtable is at offset '
  355. +tostr(tprocdef(procdefinition).parast.address_fixup))));
  356. {$endif extdebug}
  357. end;
  358. { only if no proc var }
  359. if inlined or
  360. not(assigned(right)) then
  361. is_con_or_destructor:=(procdefinition.proctypeoption in [potype_constructor,potype_destructor]);
  362. { proc variables destroy all registers }
  363. if (inlined or
  364. (right=nil)) and
  365. { virtual methods too }
  366. not(po_virtualmethod in procdefinition.procoptions) then
  367. begin
  368. if (cs_check_io in aktlocalswitches) and
  369. (po_iocheck in procdefinition.procoptions) and
  370. not(po_iocheck in aktprocdef.procoptions) then
  371. begin
  372. getaddrlabel(iolabel);
  373. cg.a_label(exprasmlist,iolabel);
  374. end
  375. else
  376. iolabel:=nil;
  377. { save all used registers }
  378. regs_to_push := tprocdef(procdefinition).usedregisters;
  379. rg.saveusedregisters(exprasmlist,pushed,regs_to_push);
  380. { give used registers through }
  381. rg.usedinproc:=rg.usedinproc + tprocdef(procdefinition).usedregisters;
  382. end
  383. else
  384. begin
  385. regs_to_push := all_registers;
  386. rg.saveusedregisters(exprasmlist,pushed,regs_to_push);
  387. rg.usedinproc:=all_registers;
  388. { no IO check for methods and procedure variables }
  389. iolabel:=nil;
  390. end;
  391. { generate the code for the parameter and push them }
  392. oldpushedparasize:=pushedparasize;
  393. pushedparasize:=0;
  394. pop_size:=0;
  395. { no inc esp for inlined procedure
  396. and for objects constructors PM }
  397. if inlined or
  398. ((procdefinition.proctypeoption=potype_constructor) and
  399. { quick'n'dirty check if it is a class or an object }
  400. (resulttype.def.deftype=orddef)) then
  401. pop_allowed:=false
  402. else
  403. pop_allowed:=true;
  404. if pop_allowed then
  405. begin
  406. { Old pushedsize aligned on 4 ? }
  407. i:=oldpushedparasize and 3;
  408. if i>0 then
  409. inc(pop_size,4-i);
  410. { This parasize aligned on 4 ? }
  411. i:=procdefinition.para_size(para_alignment) and 3;
  412. if i>0 then
  413. inc(pop_size,4-i);
  414. { insert the opcode and update pushedparasize }
  415. { never push 4 or more !! }
  416. pop_size:=pop_size mod 4;
  417. if pop_size>0 then
  418. begin
  419. inc(pushedparasize,pop_size);
  420. emit_const_reg(A_SUB,S_L,pop_size,R_ESP);
  421. {$ifdef GDB}
  422. if (cs_debuginfo in aktmoduleswitches) and
  423. (exprasmList.first=exprasmList.last) then
  424. exprasmList.concat(Tai_force_line.Create);
  425. {$endif GDB}
  426. end;
  427. end;
  428. {$ifdef OPTALIGN}
  429. if pop_allowed and (cs_align in aktglobalswitches) then
  430. begin
  431. pop_esp:=true;
  432. push_size:=procdefinition.para_size(para_alignment);
  433. { !!!! here we have to take care of return type, self
  434. and nested procedures
  435. }
  436. inc(push_size,12);
  437. emit_reg_reg(A_MOV,S_L,R_ESP,R_EDI);
  438. if (push_size mod 8)=0 then
  439. emit_const_reg(A_AND,S_L,$fffffff8,R_ESP)
  440. else
  441. begin
  442. emit_const_reg(A_SUB,S_L,push_size,R_ESP);
  443. emit_const_reg(A_AND,S_L,$fffffff8,R_ESP);
  444. emit_const_reg(A_SUB,S_L,push_size,R_ESP);
  445. end;
  446. emit_reg(A_PUSH,S_L,R_EDI);
  447. end
  448. else
  449. pop_esp:=false;
  450. {$endif OPTALIGN}
  451. { Push parameters }
  452. if assigned(params) then
  453. begin
  454. { be found elsewhere }
  455. if inlined then
  456. para_offset:=tprocdef(procdefinition).parast.address_fixup+
  457. tprocdef(procdefinition).parast.datasize
  458. else
  459. para_offset:=0;
  460. if not(inlined) and
  461. assigned(right) then
  462. tcallparanode(params).secondcallparan(TParaItem(tabstractprocdef(right.resulttype.def).Para.first),
  463. (po_leftright in procdefinition.procoptions),inlined,
  464. (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
  465. para_alignment,para_offset)
  466. else
  467. tcallparanode(params).secondcallparan(TParaItem(procdefinition.Para.first),
  468. (po_leftright in procdefinition.procoptions),inlined,
  469. (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
  470. para_alignment,para_offset);
  471. end;
  472. { Allocate return value for inlined routines }
  473. if inlined then
  474. inlinecode.retoffset:=tg.gettempofsizepersistant(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign));
  475. { Allocate return value when returned in argument }
  476. if ret_in_param(resulttype.def) then
  477. begin
  478. if assigned(funcretrefnode) then
  479. begin
  480. secondpass(funcretrefnode);
  481. if codegenerror then
  482. exit;
  483. if (funcretrefnode.location.loc<>LOC_REFERENCE) then
  484. internalerror(200204246);
  485. funcretref:=funcretrefnode.location.reference;
  486. end
  487. else
  488. begin
  489. if inlined then
  490. begin
  491. reference_reset(funcretref);
  492. funcretref.offset:=tg.gettempofsizepersistant(exprasmlist,resulttype.def.size);
  493. funcretref.base:=procinfo^.framepointer;
  494. {$ifdef extdebug}
  495. Comment(V_debug,'function return value is at offset '
  496. +tostr(funcretref.offset));
  497. exprasmlist.concat(tai_asm_comment.create(
  498. strpnew('function return value is at offset '
  499. +tostr(funcretref.offset))));
  500. {$endif extdebug}
  501. end
  502. else
  503. tg.gettempofsizereference(exprasmlist,resulttype.def.size,funcretref);
  504. end;
  505. { This must not be counted for C code
  506. complex return address is removed from stack
  507. by function itself ! }
  508. {$ifdef OLD_C_STACK}
  509. inc(pushedparasize,4); { lets try without it PM }
  510. {$endif not OLD_C_STACK}
  511. if inlined then
  512. begin
  513. hregister:=cg.get_scratch_reg_address(exprasmlist);
  514. cg.a_loadaddr_ref_reg(exprasmlist,funcretref,hregister);
  515. reference_reset_base(href,procinfo^.framepointer,inlinecode.retoffset);
  516. cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
  517. cg.free_scratch_reg(exprasmlist,hregister);
  518. end
  519. else
  520. cg.a_paramaddr_ref(exprasmlist,funcretref,-1);
  521. end;
  522. { procedure variable or normal function call ? }
  523. if inlined or
  524. (right=nil) then
  525. begin
  526. { Normal function call }
  527. { overloaded operator has no symtable }
  528. { push self }
  529. if assigned(symtableproc) and
  530. (symtableproc.symtabletype=withsymtable) then
  531. begin
  532. { dirty trick to avoid the secondcall below }
  533. methodpointer:=ccallparanode.create(nil,nil);
  534. location_reset(methodpointer.location,LOC_REGISTER,OS_ADDR);
  535. rg.getexplicitregisterint(exprasmlist,R_ESI);
  536. methodpointer.location.register:=R_ESI;
  537. { ARGHHH this is wrong !!!
  538. if we can init from base class for a child
  539. class that the wrong VMT will be
  540. transfered to constructor !! }
  541. methodpointer.resulttype:=
  542. twithnode(twithsymtable(symtableproc).withnode).left.resulttype;
  543. { make a reference }
  544. href:=twithnode(twithsymtable(symtableproc).withnode).withreference;
  545. if ((not(nf_islocal in twithnode(twithsymtable(symtableproc).withnode).flags)) and
  546. (not twithsymtable(symtableproc).direct_with)) or
  547. is_class_or_interface(methodpointer.resulttype.def) then
  548. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg)
  549. else
  550. cg.a_loadaddr_ref_reg(exprasmlist,href,self_pointer_reg);
  551. end;
  552. { push self }
  553. if assigned(symtableproc) and
  554. ((symtableproc.symtabletype=objectsymtable) or
  555. (symtableproc.symtabletype=withsymtable)) then
  556. begin
  557. if assigned(methodpointer) then
  558. begin
  559. {
  560. if methodpointer^.resulttype.def=classrefdef then
  561. begin
  562. two possibilities:
  563. 1. constructor
  564. 2. class method
  565. end
  566. else }
  567. begin
  568. case methodpointer.nodetype of
  569. typen:
  570. begin
  571. { direct call to inherited method }
  572. if (po_abstractmethod in procdefinition.procoptions) then
  573. begin
  574. CGMessage(cg_e_cant_call_abstract_method);
  575. goto dont_call;
  576. end;
  577. { generate no virtual call }
  578. no_virtual_call:=true;
  579. if (sp_static in symtableprocentry.symoptions) then
  580. begin
  581. { well lets put the VMT address directly into ESI }
  582. { it is kind of dirty but that is the simplest }
  583. { way to accept virtual static functions (PM) }
  584. loadesi:=true;
  585. { if no VMT just use $0 bug0214 PM }
  586. rg.getexplicitregisterint(exprasmlist,R_ESI);
  587. if not(oo_has_vmt in tobjectdef(methodpointer.resulttype.def).objectoptions) then
  588. cg.a_load_const_reg(exprasmlist,OS_ADDR,0,self_pointer_reg)
  589. else
  590. begin
  591. reference_reset_symbol(href,newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  592. cg.a_loadaddr_ref_reg(exprasmlist,href,self_pointer_reg);
  593. end;
  594. { emit_reg(A_PUSH,S_L,R_ESI);
  595. this is done below !! }
  596. end
  597. else
  598. { this is a member call, so ESI isn't modfied }
  599. loadesi:=false;
  600. { a class destructor needs a flag }
  601. if is_class(tobjectdef(methodpointer.resulttype.def)) and
  602. (procdefinition.proctypeoption=potype_destructor) then
  603. begin
  604. cg.a_param_const(exprasmlist,OS_ADDR,0,2);
  605. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
  606. end;
  607. if not(is_con_or_destructor and
  608. is_class(methodpointer.resulttype.def) and
  609. (procdefinition.proctypeoption in [potype_constructor,potype_destructor])
  610. ) then
  611. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
  612. { if an inherited con- or destructor should be }
  613. { called in a con- or destructor then a warning }
  614. { will be made }
  615. { con- and destructors need a pointer to the vmt }
  616. if is_con_or_destructor and
  617. is_object(methodpointer.resulttype.def) and
  618. assigned(aktprocdef) then
  619. begin
  620. if not(aktprocdef.proctypeoption in
  621. [potype_constructor,potype_destructor]) then
  622. CGMessage(cg_w_member_cd_call_from_method);
  623. end;
  624. { class destructors get there flag above }
  625. { constructor flags ? }
  626. if is_con_or_destructor and
  627. not(
  628. is_class(methodpointer.resulttype.def) and
  629. assigned(aktprocdef) and
  630. (aktprocdef.proctypeoption=potype_destructor)) then
  631. begin
  632. { a constructor needs also a flag }
  633. if is_class(methodpointer.resulttype.def) then
  634. cg.a_param_const(exprasmlist,OS_ADDR,0,2);
  635. cg.a_param_const(exprasmlist,OS_ADDR,0,1);
  636. end;
  637. end;
  638. hnewn:
  639. begin
  640. { extended syntax of new }
  641. { ESI must be zero }
  642. rg.getexplicitregisterint(exprasmlist,R_ESI);
  643. cg.a_load_const_reg(exprasmlist,OS_ADDR,0,self_pointer_reg);
  644. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,2);
  645. { insert the vmt }
  646. reference_reset_symbol(href,newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  647. cg.a_paramaddr_ref(exprasmlist,href,1);
  648. extended_new:=true;
  649. end;
  650. hdisposen:
  651. begin
  652. secondpass(methodpointer);
  653. { destructor with extended syntax called from dispose }
  654. { hdisposen always deliver LOC_REFERENCE }
  655. rg.getexplicitregisterint(exprasmlist,R_ESI);
  656. emit_ref_reg(A_LEA,S_L,methodpointer.location.reference,R_ESI);
  657. reference_release(exprasmlist,methodpointer.location.reference);
  658. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,2);
  659. reference_reset_symbol(href,newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  660. cg.a_paramaddr_ref(exprasmlist,href,1);
  661. end;
  662. else
  663. begin
  664. { call to an instance member }
  665. if (symtableproc.symtabletype<>withsymtable) then
  666. begin
  667. secondpass(methodpointer);
  668. rg.getexplicitregisterint(exprasmlist,R_ESI);
  669. case methodpointer.location.loc of
  670. LOC_CREGISTER,
  671. LOC_REGISTER:
  672. begin
  673. cg.a_load_reg_reg(exprasmlist,OS_ADDR,methodpointer.location.register,R_ESI);
  674. rg.ungetregisterint(exprasmlist,methodpointer.location.register);
  675. end;
  676. else
  677. begin
  678. if (methodpointer.resulttype.def.deftype=classrefdef) or
  679. is_class_or_interface(methodpointer.resulttype.def) then
  680. cg.a_load_ref_reg(exprasmlist,OS_ADDR,methodpointer.location.reference,R_ESI)
  681. else
  682. cg.a_loadaddr_ref_reg(exprasmlist,methodpointer.location.reference,R_ESI);
  683. reference_release(exprasmlist,methodpointer.location.reference);
  684. end;
  685. end;
  686. end;
  687. { when calling a class method, we have to load ESI with the VMT !
  688. But, not for a class method via self }
  689. if not(po_containsself in procdefinition.procoptions) then
  690. begin
  691. if (po_classmethod in procdefinition.procoptions) and
  692. not(methodpointer.resulttype.def.deftype=classrefdef) then
  693. begin
  694. { class method needs current VMT }
  695. rg.getexplicitregisterint(exprasmlist,R_ESI);
  696. reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
  697. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg);
  698. end;
  699. { direct call to destructor: remove data }
  700. if (procdefinition.proctypeoption=potype_destructor) and
  701. is_class(methodpointer.resulttype.def) then
  702. cg.a_param_const(exprasmlist,OS_INT,1,1);
  703. { direct call to class constructor, don't allocate memory }
  704. if (procdefinition.proctypeoption=potype_constructor) and
  705. is_class(methodpointer.resulttype.def) then
  706. begin
  707. cg.a_param_const(exprasmlist,OS_INT,0,2);
  708. cg.a_param_const(exprasmlist,OS_INT,0,1);
  709. end
  710. else
  711. begin
  712. { constructor call via classreference => allocate memory }
  713. if (procdefinition.proctypeoption=potype_constructor) and
  714. (methodpointer.resulttype.def.deftype=classrefdef) and
  715. is_class(tclassrefdef(methodpointer.resulttype.def).pointertype.def) then
  716. cg.a_param_const(exprasmlist,OS_INT,1,1);
  717. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
  718. end;
  719. end;
  720. if is_con_or_destructor then
  721. begin
  722. { classes don't get a VMT pointer pushed }
  723. if is_object(methodpointer.resulttype.def) then
  724. begin
  725. if (procdefinition.proctypeoption=potype_constructor) then
  726. begin
  727. { it's no bad idea, to insert the VMT }
  728. reference_reset_symbol(href,newasmsymbol(
  729. tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  730. cg.a_paramaddr_ref(exprasmlist,href,1);
  731. end
  732. { destructors haven't to dispose the instance, if this is }
  733. { a direct call }
  734. else
  735. cg.a_param_const(exprasmlist,OS_INT,0,1);
  736. end;
  737. end;
  738. end;
  739. end;
  740. end;
  741. end
  742. else
  743. begin
  744. if (po_classmethod in procdefinition.procoptions) and
  745. not(
  746. assigned(aktprocdef) and
  747. (po_classmethod in aktprocdef.procoptions)
  748. ) then
  749. begin
  750. { class method needs current VMT }
  751. rg.getexplicitregisterint(exprasmlist,R_ESI);
  752. reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
  753. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,R_ESI);
  754. end
  755. else
  756. begin
  757. { member call, ESI isn't modified }
  758. loadesi:=false;
  759. end;
  760. { direct call to destructor: don't remove data! }
  761. if is_class(procinfo^._class) then
  762. begin
  763. if (procdefinition.proctypeoption=potype_destructor) then
  764. begin
  765. cg.a_param_const(exprasmlist,OS_INT,0,2);
  766. cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
  767. end
  768. else if (procdefinition.proctypeoption=potype_constructor) then
  769. begin
  770. cg.a_param_const(exprasmlist,OS_INT,0,2);
  771. cg.a_param_const(exprasmlist,OS_INT,0,1);
  772. end
  773. else
  774. cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
  775. end
  776. else if is_object(procinfo^._class) then
  777. begin
  778. cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
  779. if is_con_or_destructor then
  780. begin
  781. if (procdefinition.proctypeoption=potype_constructor) then
  782. begin
  783. { it's no bad idea, to insert the VMT }
  784. reference_reset_symbol(href,newasmsymbol(procinfo^._class.vmt_mangledname),0);
  785. cg.a_paramaddr_ref(exprasmlist,href,1);
  786. end
  787. { destructors haven't to dispose the instance, if this is }
  788. { a direct call }
  789. else
  790. cg.a_param_const(exprasmlist,OS_INT,0,1);
  791. end;
  792. end
  793. else
  794. Internalerror(200006165);
  795. end;
  796. end;
  797. { call to BeforeDestruction? }
  798. if (procdefinition.proctypeoption=potype_destructor) and
  799. assigned(methodpointer) and
  800. (methodpointer.nodetype<>typen) and
  801. is_class(tobjectdef(methodpointer.resulttype.def)) and
  802. (inlined or
  803. (right=nil)) then
  804. begin
  805. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
  806. reference_reset_base(href,self_pointer_reg,0);
  807. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  808. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
  809. reference_reset_base(href,tmpreg,72);
  810. cg.a_call_ref(exprasmlist,href);
  811. cg.free_scratch_reg(exprasmlist,tmpreg);
  812. end;
  813. { push base pointer ?}
  814. { never when inlining, since if necessary, the base pointer }
  815. { can/will be gottten from the current procedure's symtable }
  816. { (JM) }
  817. if not inlined then
  818. if (lexlevel>=normal_function_level) and assigned(tprocdef(procdefinition).parast) and
  819. ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
  820. begin
  821. { if we call a nested function in a method, we must }
  822. { push also SELF! }
  823. { THAT'S NOT TRUE, we have to load ESI via frame pointer }
  824. { access }
  825. {
  826. begin
  827. loadesi:=false;
  828. emit_reg(A_PUSH,S_L,R_ESI);
  829. end;
  830. }
  831. if lexlevel=(tprocdef(procdefinition).parast.symtablelevel) then
  832. begin
  833. reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
  834. cg.a_param_ref(exprasmlist,OS_ADDR,href,-1);
  835. end
  836. { this is only true if the difference is one !!
  837. but it cannot be more !! }
  838. else if (lexlevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
  839. begin
  840. cg.a_param_reg(exprasmlist,OS_ADDR,procinfo^.framepointer,-1);
  841. end
  842. else if (lexlevel>(tprocdef(procdefinition).parast.symtablelevel)) then
  843. begin
  844. hregister:=rg.getregisterint(exprasmlist);
  845. reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
  846. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
  847. for i:=(tprocdef(procdefinition).parast.symtablelevel) to lexlevel-1 do
  848. begin
  849. {we should get the correct frame_pointer_offset at each level
  850. how can we do this !!! }
  851. reference_reset_base(href,hregister,procinfo^.framepointer_offset);
  852. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
  853. end;
  854. cg.a_param_reg(exprasmlist,OS_ADDR,hregister,-1);
  855. rg.ungetregisterint(exprasmlist,hregister);
  856. end
  857. else
  858. internalerror(25000);
  859. end;
  860. rg.saveregvars(exprasmlist,regs_to_push);
  861. if (po_virtualmethod in procdefinition.procoptions) and
  862. not(no_virtual_call) then
  863. begin
  864. { static functions contain the vmt_address in ESI }
  865. { also class methods }
  866. { Here it is quite tricky because it also depends }
  867. { on the methodpointer PM }
  868. release_tmpreg:=false;
  869. rg.getexplicitregisterint(exprasmlist,R_ESI);
  870. if assigned(aktprocdef) then
  871. begin
  872. if (((sp_static in aktprocdef.procsym.symoptions) or
  873. (po_classmethod in aktprocdef.procoptions)) and
  874. ((methodpointer=nil) or (methodpointer.nodetype=typen)))
  875. or
  876. (po_staticmethod in procdefinition.procoptions) or
  877. ((procdefinition.proctypeoption=potype_constructor) and
  878. { esi contains the vmt if we call a constructor via a class ref }
  879. assigned(methodpointer) and
  880. (methodpointer.resulttype.def.deftype=classrefdef)
  881. ) or
  882. { is_interface(tprocdef(procdefinition)._class) or }
  883. { ESI is loaded earlier }
  884. (po_classmethod in procdefinition.procoptions) then
  885. begin
  886. reference_reset_base(href,R_ESI,0);
  887. end
  888. else
  889. begin
  890. { this is one point where we need vmt_offset (PM) }
  891. reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
  892. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  893. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
  894. reference_reset_base(href,tmpreg,0);
  895. release_tmpreg:=true;
  896. end;
  897. end
  898. else
  899. { aktprocdef should be assigned, also in main program }
  900. internalerror(12345);
  901. if tprocdef(procdefinition).extnumber=-1 then
  902. internalerror(44584);
  903. href.offset:=tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber);
  904. if not(is_interface(tprocdef(procdefinition)._class)) and
  905. not(is_cppclass(tprocdef(procdefinition)._class)) then
  906. begin
  907. if (cs_check_object in aktlocalswitches) then
  908. begin
  909. reference_reset_symbol(hrefvmt,newasmsymbol(tprocdef(procdefinition)._class.vmt_mangledname),0);
  910. cg.a_paramaddr_ref(exprasmlist,hrefvmt,2);
  911. cg.a_param_reg(exprasmlist,OS_ADDR,href.base,1);
  912. cg.a_call_name(exprasmlist,'FPC_CHECK_OBJECT_EXT');
  913. end
  914. else if (cs_check_range in aktlocalswitches) then
  915. begin
  916. cg.a_param_reg(exprasmlist,OS_ADDR,href.base,1);
  917. cg.a_call_name(exprasmlist,'FPC_CHECK_OBJECT');
  918. end;
  919. end;
  920. cg.a_call_ref(exprasmlist,href);
  921. if release_tmpreg then
  922. cg.free_scratch_reg(exprasmlist,tmpreg);
  923. end
  924. else if not inlined then
  925. begin
  926. { We can call interrupts from within the smae code
  927. by just pushing the flags and CS PM }
  928. if (po_interrupt in procdefinition.procoptions) then
  929. begin
  930. emit_none(A_PUSHF,S_L);
  931. emit_reg(A_PUSH,S_L,R_CS);
  932. end;
  933. cg.a_call_name(exprasmlist,tprocdef(procdefinition).mangledname);
  934. end
  935. else { inlined proc }
  936. { inlined code is in inlinecode }
  937. begin
  938. { process the inlinecode }
  939. secondpass(inlinecode);
  940. { free the args }
  941. if tprocdef(procdefinition).parast.datasize>0 then
  942. tg.ungetpersistanttemp(exprasmlist,tprocdef(procdefinition).parast.address_fixup);
  943. end;
  944. end
  945. else
  946. { now procedure variable case }
  947. begin
  948. secondpass(right);
  949. if (po_interrupt in procdefinition.procoptions) then
  950. begin
  951. emit_none(A_PUSHF,S_L);
  952. emit_reg(A_PUSH,S_L,R_CS);
  953. end;
  954. { procedure of object? }
  955. if (po_methodpointer in procdefinition.procoptions) then
  956. begin
  957. { method pointer can't be in a register }
  958. hregister:=R_NO;
  959. { do some hacking if we call a method pointer }
  960. { which is a class member }
  961. { else ESI is overwritten ! }
  962. if (right.location.reference.base=R_ESI) or
  963. (right.location.reference.index=R_ESI) then
  964. begin
  965. reference_release(exprasmlist,right.location.reference);
  966. hregister:=cg.get_scratch_reg_address(exprasmlist);
  967. cg.a_load_ref_reg(exprasmlist,OS_ADDR,right.location.reference,hregister);
  968. end;
  969. { load self, but not if it's already explicitly pushed }
  970. if not(po_containsself in procdefinition.procoptions) then
  971. begin
  972. { load ESI }
  973. href:=right.location.reference;
  974. inc(href.offset,4);
  975. rg.getexplicitregisterint(exprasmlist,R_ESI);
  976. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg);
  977. { push self pointer }
  978. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,-1);
  979. end;
  980. rg.saveregvars(exprasmlist,ALL_REGISTERS);
  981. if hregister<>R_NO then
  982. reference_reset_base(href,hregister,0)
  983. else
  984. href:=right.location.reference;
  985. cg.a_call_ref(exprasmlist,href);
  986. if hregister<>R_NO then
  987. cg.free_scratch_reg(exprasmlist,hregister);
  988. reference_release(exprasmlist,right.location.reference);
  989. end
  990. else
  991. begin
  992. rg.saveregvars(exprasmlist,ALL_REGISTERS);
  993. case right.location.loc of
  994. LOC_REGISTER,LOC_CREGISTER:
  995. reference_reset_base(href,right.location.register,0);
  996. LOC_REFERENCE,LOC_CREFERENCE :
  997. href:=right.location.reference;
  998. else
  999. internalerror(200203311);
  1000. end;
  1001. cg.a_call_ref(exprasmlist,href);
  1002. location_release(exprasmlist,right.location);
  1003. end;
  1004. end;
  1005. { this was only for normal functions
  1006. displaced here so we also get
  1007. it to work for procvars PM }
  1008. if (not inlined) and (po_clearstack in procdefinition.procoptions) then
  1009. begin
  1010. { we also add the pop_size which is included in pushedparasize }
  1011. pop_size:=0;
  1012. { better than an add on all processors }
  1013. if pushedparasize=4 then
  1014. begin
  1015. rg.getexplicitregisterint(exprasmlist,R_EDI);
  1016. emit_reg(A_POP,S_L,R_EDI);
  1017. rg.ungetregisterint(exprasmlist,R_EDI);
  1018. end
  1019. { the pentium has two pipes and pop reg is pairable }
  1020. { but the registers must be different! }
  1021. else if (pushedparasize=8) and
  1022. not(cs_littlesize in aktglobalswitches) and
  1023. (aktoptprocessor=ClassP5) and
  1024. (procinfo^._class=nil) then
  1025. begin
  1026. rg.getexplicitregisterint(exprasmlist,R_EDI);
  1027. emit_reg(A_POP,S_L,R_EDI);
  1028. rg.ungetregisterint(exprasmlist,R_EDI);
  1029. exprasmList.concat(Tairegalloc.Alloc(R_ESI));
  1030. emit_reg(A_POP,S_L,R_ESI);
  1031. exprasmList.concat(Tairegalloc.DeAlloc(R_ESI));
  1032. end
  1033. else if pushedparasize<>0 then
  1034. emit_const_reg(A_ADD,S_L,pushedparasize,R_ESP);
  1035. end;
  1036. {$ifdef OPTALIGN}
  1037. if pop_esp then
  1038. emit_reg(A_POP,S_L,R_ESP);
  1039. {$endif OPTALIGN}
  1040. dont_call:
  1041. pushedparasize:=oldpushedparasize;
  1042. rg.restoreunusedstate(unusedstate);
  1043. {$ifdef TEMPREGDEBUG}
  1044. testregisters32;
  1045. {$endif TEMPREGDEBUG}
  1046. { a constructor could be a function with boolean result }
  1047. { if calling constructor called fail we
  1048. must jump directly to quickexitlabel PM
  1049. but only if it is a call of an inherited constructor }
  1050. if (inlined or
  1051. (right=nil)) and
  1052. (procdefinition.proctypeoption=potype_constructor) and
  1053. assigned(methodpointer) and
  1054. (methodpointer.nodetype=typen) and
  1055. (aktprocdef.proctypeoption=potype_constructor) then
  1056. begin
  1057. emitjmp(C_Z,faillabel);
  1058. end;
  1059. { call to AfterConstruction? }
  1060. if is_class(resulttype.def) and
  1061. (inlined or
  1062. (right=nil)) and
  1063. (procdefinition.proctypeoption=potype_constructor) and
  1064. assigned(methodpointer) and
  1065. (methodpointer.nodetype<>typen) then
  1066. begin
  1067. getlabel(constructorfailed);
  1068. emitjmp(C_Z,constructorfailed);
  1069. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
  1070. reference_reset_base(href,self_pointer_reg,0);
  1071. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  1072. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
  1073. reference_reset_base(href,tmpreg,68);
  1074. cg.a_call_ref(exprasmlist,href);
  1075. cg.free_scratch_reg(exprasmlist,tmpreg);
  1076. exprasmList.concat(Tairegalloc.Alloc(accumulator));
  1077. cg.a_label(exprasmlist,constructorfailed);
  1078. cg.a_load_reg_reg(exprasmlist,OS_ADDR,self_pointer_reg,accumulator);
  1079. end;
  1080. { handle function results }
  1081. if (not is_void(resulttype.def)) then
  1082. begin
  1083. { structured results are easy to handle.... }
  1084. { needed also when result_no_used !! }
  1085. if ret_in_param(resulttype.def) then
  1086. begin
  1087. location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
  1088. location.reference.symbol:=nil;
  1089. location.reference:=funcretref;
  1090. end
  1091. else
  1092. { ansi/widestrings must be registered, so we can dispose them }
  1093. if is_ansistring(resulttype.def) or
  1094. is_widestring(resulttype.def) then
  1095. begin
  1096. location_reset(location,LOC_CREFERENCE,OS_ADDR);
  1097. location.reference:=refcountedtemp;
  1098. cg.a_reg_alloc(exprasmlist,accumulator);
  1099. cg.a_load_reg_ref(exprasmlist,OS_ADDR,accumulator,location.reference);
  1100. cg.a_reg_dealloc(exprasmlist,accumulator);
  1101. end
  1102. else
  1103. { we have only to handle the result if it is used }
  1104. if (nf_return_value_used in flags) then
  1105. begin
  1106. case resulttype.def.deftype of
  1107. enumdef,
  1108. orddef :
  1109. begin
  1110. cgsize:=def_cgsize(resulttype.def);
  1111. { an object constructor is a function with boolean result }
  1112. if (inlined or (right=nil)) and
  1113. (procdefinition.proctypeoption=potype_constructor) then
  1114. begin
  1115. if extended_new then
  1116. cgsize:=OS_INT
  1117. else
  1118. begin
  1119. cgsize:=OS_NO;
  1120. { this fails if popsize > 0 PM }
  1121. location_reset(location,LOC_FLAGS,OS_NO);
  1122. location.resflags:=F_NE;
  1123. end;
  1124. end;
  1125. if cgsize<>OS_NO then
  1126. begin
  1127. location_reset(location,LOC_REGISTER,cgsize);
  1128. cg.a_reg_alloc(exprasmlist,accumulator);
  1129. if cgsize in [OS_64,OS_S64] then
  1130. begin
  1131. cg.a_reg_alloc(exprasmlist,accumulatorhigh);
  1132. if accumulatorhigh in rg.unusedregsint then
  1133. begin
  1134. location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
  1135. location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
  1136. end
  1137. else
  1138. begin
  1139. location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
  1140. location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
  1141. end;
  1142. tcg64f32(cg).a_load64_reg_reg(exprasmlist,accumulator,accumulatorhigh,
  1143. location.registerlow,location.registerhigh);
  1144. end
  1145. else
  1146. begin
  1147. location.register:=rg.getexplicitregisterint(exprasmlist,accumulator);
  1148. hregister:=rg.makeregsize(accumulator,cgsize);
  1149. location.register:=rg.makeregsize(location.register,cgsize);
  1150. cg.a_load_reg_reg(exprasmlist,cgsize,hregister,location.register);
  1151. end;
  1152. end;
  1153. end;
  1154. floatdef :
  1155. begin
  1156. location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
  1157. location.register:=R_ST;
  1158. inc(trgcpu(rg).fpuvaroffset);
  1159. end;
  1160. else
  1161. begin
  1162. location_reset(location,LOC_REGISTER,OS_INT);
  1163. location.register:=rg.getexplicitregisterint(exprasmlist,accumulator);
  1164. cg.a_load_reg_reg(exprasmlist,OS_INT,accumulator,location.register);
  1165. end;
  1166. end;
  1167. end;
  1168. end;
  1169. { perhaps i/o check ? }
  1170. if iolabel<>nil then
  1171. begin
  1172. reference_reset_symbol(href,iolabel,0);
  1173. cg.a_paramaddr_ref(exprasmlist,href,1);
  1174. cg.a_call_name(exprasmlist,'FPC_IOCHECK');
  1175. end;
  1176. if pop_size>0 then
  1177. emit_const_reg(A_ADD,S_L,pop_size,R_ESP);
  1178. { restore registers }
  1179. rg.restoreusedregisters(exprasmlist,pushed);
  1180. { at last, restore instance pointer (SELF) }
  1181. if loadesi then
  1182. cg.g_maybe_loadself(exprasmlist);
  1183. pp:=tbinarynode(params);
  1184. while assigned(pp) do
  1185. begin
  1186. if assigned(pp.left) then
  1187. begin
  1188. location_freetemp(exprasmlist,pp.left.location);
  1189. { process also all nodes of an array of const }
  1190. if pp.left.nodetype=arrayconstructorn then
  1191. begin
  1192. if assigned(tarrayconstructornode(pp.left).left) then
  1193. begin
  1194. hp:=pp.left;
  1195. while assigned(hp) do
  1196. begin
  1197. location_freetemp(exprasmlist,tarrayconstructornode(hp).left.location);
  1198. hp:=tarrayconstructornode(hp).right;
  1199. end;
  1200. end;
  1201. end;
  1202. end;
  1203. pp:=tbinarynode(pp.right);
  1204. end;
  1205. if inlined then
  1206. begin
  1207. tg.ungetpersistanttemp(exprasmlist,inlinecode.retoffset);
  1208. tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup;
  1209. right:=inlinecode;
  1210. end;
  1211. if assigned(params) then
  1212. params.free;
  1213. { from now on the result can be freed normally }
  1214. if inlined and ret_in_param(resulttype.def) then
  1215. tg.persistanttemptonormal(funcretref.offset);
  1216. { if return value is not used }
  1217. if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then
  1218. begin
  1219. if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
  1220. begin
  1221. { data which must be finalized ? }
  1222. if (resulttype.def.needs_inittable) then
  1223. cg.g_finalize(exprasmlist,resulttype.def,location.reference,false);
  1224. { release unused temp }
  1225. tg.ungetiftemp(exprasmlist,location.reference)
  1226. end
  1227. else if location.loc=LOC_FPUREGISTER then
  1228. begin
  1229. { release FPU stack }
  1230. emit_reg(A_FSTP,S_NO,R_ST);
  1231. {
  1232. dec(trgcpu(rg).fpuvaroffset);
  1233. do NOT decrement as the increment before
  1234. is not called for unused results PM }
  1235. end;
  1236. end;
  1237. end;
  1238. {*****************************************************************************
  1239. TI386PROCINLINENODE
  1240. *****************************************************************************}
  1241. procedure ti386procinlinenode.pass_2;
  1242. var st : tsymtable;
  1243. oldprocdef : tprocdef;
  1244. ps, i : longint;
  1245. tmpreg: tregister;
  1246. oldprocinfo : pprocinfo;
  1247. oldinlining_procedure,
  1248. nostackframe,make_global : boolean;
  1249. inlineentrycode,inlineexitcode : TAAsmoutput;
  1250. oldexitlabel,oldexit2label,oldquickexitlabel:tasmlabel;
  1251. oldregstate: pointer;
  1252. {$ifdef GDB}
  1253. startlabel,endlabel : tasmlabel;
  1254. pp : pchar;
  1255. mangled_length : longint;
  1256. {$endif GDB}
  1257. begin
  1258. { deallocate the registers used for the current procedure's regvars }
  1259. if assigned(aktprocdef.regvarinfo) then
  1260. begin
  1261. with pregvarinfo(aktprocdef.regvarinfo)^ do
  1262. for i := 1 to maxvarregs do
  1263. if assigned(regvars[i]) then
  1264. store_regvar(exprasmlist,regvars[i].reg);
  1265. rg.saveStateForInline(oldregstate);
  1266. { make sure the register allocator knows what the regvars in the }
  1267. { inlined code block are (JM) }
  1268. rg.resetusableregisters;
  1269. rg.clearregistercount;
  1270. rg.cleartempgen;
  1271. if assigned(inlineprocdef.regvarinfo) then
  1272. with pregvarinfo(inlineprocdef.regvarinfo)^ do
  1273. for i := 1 to maxvarregs do
  1274. if assigned(regvars[i]) then
  1275. begin
  1276. tmpreg:=rg.makeregsize(regvars[i].reg,OS_INT);
  1277. rg.makeregvar(tmpreg);
  1278. end;
  1279. end;
  1280. oldinlining_procedure:=inlining_procedure;
  1281. oldexitlabel:=aktexitlabel;
  1282. oldexit2label:=aktexit2label;
  1283. oldquickexitlabel:=quickexitlabel;
  1284. getlabel(aktexitlabel);
  1285. getlabel(aktexit2label);
  1286. { we're inlining a procedure }
  1287. inlining_procedure:=true;
  1288. { save old procinfo }
  1289. oldprocdef:=aktprocdef;
  1290. getmem(oldprocinfo,sizeof(tprocinfo));
  1291. move(procinfo^,oldprocinfo^,sizeof(tprocinfo));
  1292. { set new procinfo }
  1293. aktprocdef:=inlineprocdef;
  1294. procinfo^.return_offset:=retoffset;
  1295. procinfo^.para_offset:=para_offset;
  1296. procinfo^.no_fast_exit:=false;
  1297. { arg space has been filled by the parent secondcall }
  1298. st:=aktprocdef.localst;
  1299. { set it to the same lexical level }
  1300. st.symtablelevel:=oldprocdef.localst.symtablelevel;
  1301. if st.datasize>0 then
  1302. begin
  1303. st.address_fixup:=tg.gettempofsizepersistant(exprasmlist,st.datasize)+st.datasize;
  1304. {$ifdef extdebug}
  1305. Comment(V_debug,'local symtable is at offset '+tostr(st.address_fixup));
  1306. exprasmList.concat(Tai_asm_comment.Create(strpnew(
  1307. 'local symtable is at offset '+tostr(st.address_fixup))));
  1308. {$endif extdebug}
  1309. end;
  1310. exprasmList.concat(Tai_Marker.Create(InlineStart));
  1311. {$ifdef extdebug}
  1312. exprasmList.concat(Tai_asm_comment.Create(strpnew('Start of inlined proc')));
  1313. {$endif extdebug}
  1314. {$ifdef GDB}
  1315. if (cs_debuginfo in aktmoduleswitches) then
  1316. begin
  1317. getaddrlabel(startlabel);
  1318. getaddrlabel(endlabel);
  1319. cg.a_label(exprasmlist,startlabel);
  1320. inlineprocdef.localst.symtabletype:=inlinelocalsymtable;
  1321. inlineprocdef.parast.symtabletype:=inlineparasymtable;
  1322. { Here we must include the para and local symtable info }
  1323. inlineprocdef.concatstabto(withdebuglist);
  1324. { set it back for safety }
  1325. inlineprocdef.localst.symtabletype:=localsymtable;
  1326. inlineprocdef.parast.symtabletype:=parasymtable;
  1327. mangled_length:=length(oldprocdef.mangledname);
  1328. getmem(pp,mangled_length+50);
  1329. strpcopy(pp,'192,0,0,'+startlabel.name);
  1330. if (target_info.use_function_relative_addresses) then
  1331. begin
  1332. strpcopy(strend(pp),'-');
  1333. strpcopy(strend(pp),oldprocdef.mangledname);
  1334. end;
  1335. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  1336. end;
  1337. {$endif GDB}
  1338. { takes care of local data initialization }
  1339. inlineentrycode:=TAAsmoutput.Create;
  1340. inlineexitcode:=TAAsmoutput.Create;
  1341. ps:=para_size;
  1342. make_global:=false; { to avoid warning }
  1343. genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
  1344. if po_assembler in aktprocdef.procoptions then
  1345. inlineentrycode.insert(Tai_marker.Create(asmblockstart));
  1346. exprasmList.concatlist(inlineentrycode);
  1347. secondpass(inlinetree);
  1348. genexitcode(inlineexitcode,0,false,true);
  1349. if po_assembler in aktprocdef.procoptions then
  1350. inlineexitcode.concat(Tai_marker.Create(asmblockend));
  1351. exprasmList.concatlist(inlineexitcode);
  1352. inlineentrycode.free;
  1353. inlineexitcode.free;
  1354. {$ifdef extdebug}
  1355. exprasmList.concat(Tai_asm_comment.Create(strpnew('End of inlined proc')));
  1356. {$endif extdebug}
  1357. exprasmList.concat(Tai_Marker.Create(InlineEnd));
  1358. {we can free the local data now, reset also the fixup address }
  1359. if st.datasize>0 then
  1360. begin
  1361. tg.ungetpersistanttemp(exprasmlist,st.address_fixup-st.datasize);
  1362. st.address_fixup:=0;
  1363. end;
  1364. { restore procinfo }
  1365. move(oldprocinfo^,procinfo^,sizeof(tprocinfo));
  1366. freemem(oldprocinfo,sizeof(tprocinfo));
  1367. {$ifdef GDB}
  1368. if (cs_debuginfo in aktmoduleswitches) then
  1369. begin
  1370. cg.a_label(exprasmlist,endlabel);
  1371. strpcopy(pp,'224,0,0,'+endlabel.name);
  1372. if (target_info.use_function_relative_addresses) then
  1373. begin
  1374. strpcopy(strend(pp),'-');
  1375. strpcopy(strend(pp),oldprocdef.mangledname);
  1376. end;
  1377. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  1378. freemem(pp,mangled_length+50);
  1379. end;
  1380. {$endif GDB}
  1381. { restore }
  1382. aktprocdef:=oldprocdef;
  1383. aktexitlabel:=oldexitlabel;
  1384. aktexit2label:=oldexit2label;
  1385. quickexitlabel:=oldquickexitlabel;
  1386. inlining_procedure:=oldinlining_procedure;
  1387. { reallocate the registers used for the current procedure's regvars, }
  1388. { since they may have been used and then deallocated in the inlined }
  1389. { procedure (JM) }
  1390. if assigned(aktprocdef.regvarinfo) then
  1391. begin
  1392. rg.restoreStateAfterInline(oldregstate);
  1393. end;
  1394. end;
  1395. begin
  1396. ccallparanode:=ti386callparanode;
  1397. ccallnode:=ti386callnode;
  1398. cprocinlinenode:=ti386procinlinenode;
  1399. end.
  1400. {
  1401. $Log$
  1402. Revision 1.54 2002-05-20 13:30:40 carl
  1403. * bugfix of hdisponen (base must be set, not index)
  1404. * more portability fixes
  1405. Revision 1.53 2002/05/18 13:34:23 peter
  1406. * readded missing revisions
  1407. Revision 1.52 2002/05/16 19:46:51 carl
  1408. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1409. + try to fix temp allocation (still in ifdef)
  1410. + generic constructor calls
  1411. + start of tassembler / tmodulebase class cleanup
  1412. Revision 1.50 2002/05/13 19:54:38 peter
  1413. * removed n386ld and n386util units
  1414. * maybe_save/maybe_restore added instead of the old maybe_push
  1415. Revision 1.49 2002/05/12 16:53:17 peter
  1416. * moved entry and exitcode to ncgutil and cgobj
  1417. * foreach gets extra argument for passing local data to the
  1418. iterator function
  1419. * -CR checks also class typecasts at runtime by changing them
  1420. into as
  1421. * fixed compiler to cycle with the -CR option
  1422. * fixed stabs with elf writer, finally the global variables can
  1423. be watched
  1424. * removed a lot of routines from cga unit and replaced them by
  1425. calls to cgobj
  1426. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1427. u32bit then the other is typecasted also to u32bit without giving
  1428. a rangecheck warning/error.
  1429. * fixed pascal calling method with reversing also the high tree in
  1430. the parast, detected by tcalcst3 test
  1431. Revision 1.48 2002/04/25 20:16:40 peter
  1432. * moved more routines from cga/n386util
  1433. Revision 1.47 2002/04/21 19:02:07 peter
  1434. * removed newn and disposen nodes, the code is now directly
  1435. inlined from pexpr
  1436. * -an option that will write the secondpass nodes to the .s file, this
  1437. requires EXTDEBUG define to actually write the info
  1438. * fixed various internal errors and crashes due recent code changes
  1439. Revision 1.46 2002/04/21 15:34:25 carl
  1440. * changeregsize -> rg.makeregsize
  1441. Revision 1.45 2002/04/15 19:44:21 peter
  1442. * fixed stackcheck that would be called recursively when a stack
  1443. error was found
  1444. * generic changeregsize(reg,size) for i386 register resizing
  1445. * removed some more routines from cga unit
  1446. * fixed returnvalue handling
  1447. * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
  1448. Revision 1.44 2002/04/04 19:06:10 peter
  1449. * removed unused units
  1450. * use tlocation.size in cg.a_*loc*() routines
  1451. Revision 1.43 2002/04/02 17:11:35 peter
  1452. * tlocation,treference update
  1453. * LOC_CONSTANT added for better constant handling
  1454. * secondadd splitted in multiple routines
  1455. * location_force_reg added for loading a location to a register
  1456. of a specified size
  1457. * secondassignment parses now first the right and then the left node
  1458. (this is compatible with Kylix). This saves a lot of push/pop especially
  1459. with string operations
  1460. * adapted some routines to use the new cg methods
  1461. Revision 1.42 2002/03/31 20:26:38 jonas
  1462. + a_loadfpu_* and a_loadmm_* methods in tcg
  1463. * register allocation is now handled by a class and is mostly processor
  1464. independent (+rgobj.pas and i386/rgcpu.pas)
  1465. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  1466. * some small improvements and fixes to the optimizer
  1467. * some register allocation fixes
  1468. * some fpuvaroffset fixes in the unary minus node
  1469. * push/popusedregisters is now called rg.save/restoreusedregisters and
  1470. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  1471. also better optimizable)
  1472. * fixed and optimized register saving/restoring for new/dispose nodes
  1473. * LOC_FPU locations now also require their "register" field to be set to
  1474. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  1475. - list field removed of the tnode class because it's not used currently
  1476. and can cause hard-to-find bugs
  1477. Revision 1.41 2002/03/04 19:10:13 peter
  1478. * removed compiler warnings
  1479. }