n386cal.pas 74 KB

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