n386cal.pas 67 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436
  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 by
  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. implementation
  34. uses
  35. globtype,systems,
  36. cutils,verbose,globals,
  37. symconst,symbase,symsym,symtable,defbase,
  38. {$ifdef GDB}
  39. {$ifdef delphi}
  40. sysutils,
  41. {$else}
  42. strings,
  43. {$endif}
  44. gdb,
  45. {$endif GDB}
  46. cginfo,cgbase,pass_2,
  47. cpubase,paramgr,
  48. aasmbase,aasmtai,aasmcpu,
  49. nmem,nld,ncnv,
  50. ncgutil,cga,cgobj,tgobj,regvars,rgobj,rgcpu,cg64f32,cgcpu,cpuinfo;
  51. {*****************************************************************************
  52. TI386CALLPARANODE
  53. *****************************************************************************}
  54. procedure ti386callparanode.secondcallparan(defcoll : TParaItem;
  55. push_from_left_to_right,inlined,is_cdecl : boolean;para_alignment,para_offset : longint);
  56. procedure maybe_push_high;
  57. begin
  58. { open array ? }
  59. { defcoll.data can be nil for read/write }
  60. if assigned(defcoll.paratype.def) and
  61. assigned(hightree) then
  62. begin
  63. secondpass(hightree);
  64. { this is a longint anyway ! }
  65. push_value_para(hightree,inlined,false,para_offset,4,paralocdummy);
  66. end;
  67. end;
  68. var
  69. otlabel,oflabel : tasmlabel;
  70. { temporary variables: }
  71. tempdeftype : tdeftype;
  72. tmpreg : tregister;
  73. href : treference;
  74. begin
  75. { set default para_alignment to target_info.stackalignment }
  76. if para_alignment=0 then
  77. para_alignment:=aktalignment.paraalign;
  78. { push from left to right if specified }
  79. if push_from_left_to_right and assigned(right) then
  80. begin
  81. if (nf_varargs_para in flags) then
  82. tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
  83. inlined,is_cdecl,para_alignment,para_offset)
  84. else
  85. tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
  86. inlined,is_cdecl,para_alignment,para_offset);
  87. end;
  88. otlabel:=truelabel;
  89. oflabel:=falselabel;
  90. objectlibrary.getlabel(truelabel);
  91. objectlibrary.getlabel(falselabel);
  92. secondpass(left);
  93. { handle varargs first, because defcoll is not valid }
  94. if (nf_varargs_para in flags) then
  95. begin
  96. if paramanager.push_addr_param(left.resulttype.def,is_cdecl) then
  97. begin
  98. inc(pushedparasize,4);
  99. cg.a_paramaddr_ref(exprasmlist,left.location.reference,paralocdummy);
  100. location_release(exprasmlist,left.location);
  101. end
  102. else
  103. push_value_para(left,inlined,is_cdecl,para_offset,para_alignment,paralocdummy);
  104. end
  105. { filter array constructor with c styled args }
  106. else if is_array_constructor(left.resulttype.def) and (nf_cargs in left.flags) then
  107. begin
  108. { nothing, everything is already pushed }
  109. end
  110. { in codegen.handleread.. defcoll.data is set to nil }
  111. else if assigned(defcoll.paratype.def) and
  112. (defcoll.paratype.def.deftype=formaldef) then
  113. begin
  114. { allow passing of a constant to a const formaldef }
  115. if (defcoll.paratyp=vs_const) and
  116. (left.location.loc=LOC_CONSTANT) then
  117. location_force_mem(exprasmlist,left.location);
  118. { allow @var }
  119. inc(pushedparasize,4);
  120. if (left.nodetype=addrn) and
  121. (not(nf_procvarload in left.flags)) then
  122. begin
  123. if inlined then
  124. begin
  125. reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
  126. cg.a_load_loc_ref(exprasmlist,left.location,href);
  127. end
  128. else
  129. cg.a_param_loc(exprasmlist,left.location,paralocdummy);
  130. location_release(exprasmlist,left.location);
  131. end
  132. else
  133. begin
  134. if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  135. CGMessage(type_e_mismatch)
  136. else
  137. begin
  138. if inlined then
  139. begin
  140. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  141. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
  142. reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
  143. cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
  144. cg.free_scratch_reg(exprasmlist,tmpreg);
  145. end
  146. else
  147. cg.a_paramaddr_ref(exprasmlist,left.location.reference,paralocdummy);
  148. location_release(exprasmlist,left.location);
  149. end;
  150. end;
  151. end
  152. { handle call by reference parameter }
  153. else if (defcoll.paratyp in [vs_var,vs_out]) then
  154. begin
  155. if (left.location.loc<>LOC_REFERENCE) then
  156. begin
  157. { passing self to a var parameter is allowed in
  158. TP and delphi }
  159. if not((left.location.loc=LOC_CREFERENCE) and
  160. (left.nodetype=selfn)) then
  161. internalerror(200106041);
  162. end;
  163. maybe_push_high;
  164. if (defcoll.paratyp=vs_out) and
  165. assigned(defcoll.paratype.def) and
  166. not is_class(defcoll.paratype.def) and
  167. defcoll.paratype.def.needs_inittable then
  168. cg.g_finalize(exprasmlist,defcoll.paratype.def,left.location.reference,false);
  169. inc(pushedparasize,4);
  170. if inlined then
  171. begin
  172. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  173. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
  174. reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
  175. cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
  176. cg.free_scratch_reg(exprasmlist,tmpreg);
  177. end
  178. else
  179. cg.a_paramaddr_ref(exprasmlist,left.location.reference,paralocdummy);
  180. location_release(exprasmlist,left.location);
  181. end
  182. else
  183. begin
  184. tempdeftype:=resulttype.def.deftype;
  185. if tempdeftype=filedef then
  186. CGMessage(cg_e_file_must_call_by_reference);
  187. { open array must always push the address, this is needed to
  188. also push addr of small open arrays and with cdecl functions (PFV) }
  189. if (
  190. assigned(defcoll.paratype.def) and
  191. (is_open_array(defcoll.paratype.def) or
  192. is_array_of_const(defcoll.paratype.def))
  193. ) or
  194. (
  195. paramanager.push_addr_param(resulttype.def,is_cdecl)
  196. ) then
  197. begin
  198. if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  199. begin
  200. { allow passing nil to a procvardef (methodpointer) }
  201. if (left.nodetype=typeconvn) and
  202. (left.resulttype.def.deftype=procvardef) and
  203. (ttypeconvnode(left).left.nodetype=niln) then
  204. begin
  205. tg.GetTemp(exprasmlist,tcgsize2size[left.location.size],tt_normal,href);
  206. cg.a_load_loc_ref(exprasmlist,left.location,href);
  207. location_reset(left.location,LOC_REFERENCE,left.location.size);
  208. left.location.reference:=href;
  209. end
  210. else
  211. internalerror(200204011);
  212. end;
  213. maybe_push_high;
  214. inc(pushedparasize,4);
  215. if inlined then
  216. begin
  217. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  218. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
  219. reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
  220. cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
  221. cg.free_scratch_reg(exprasmlist,tmpreg);
  222. end
  223. else
  224. cg.a_paramaddr_ref(exprasmlist,left.location.reference,paralocdummy);
  225. location_release(exprasmlist,left.location);
  226. end
  227. else
  228. begin
  229. push_value_para(left,inlined,is_cdecl,
  230. para_offset,para_alignment,paralocdummy);
  231. end;
  232. end;
  233. truelabel:=otlabel;
  234. falselabel:=oflabel;
  235. { push from right to left }
  236. if not push_from_left_to_right and assigned(right) then
  237. begin
  238. if (nf_varargs_para in flags) then
  239. tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
  240. inlined,is_cdecl,para_alignment,para_offset)
  241. else
  242. tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
  243. inlined,is_cdecl,para_alignment,para_offset);
  244. end;
  245. end;
  246. {*****************************************************************************
  247. TI386CALLNODE
  248. *****************************************************************************}
  249. procedure ti386callnode.pass_2;
  250. var
  251. regs_to_push : tregisterset;
  252. unusedstate: pointer;
  253. pushed : tpushedsaved;
  254. funcretref,refcountedtemp : treference;
  255. tmpreg : tregister;
  256. hregister : tregister;
  257. oldpushedparasize : longint;
  258. { true if ESI must be loaded again after the subroutine }
  259. loadesi : boolean;
  260. { true if a virtual method must be called directly }
  261. no_virtual_call : boolean;
  262. { true if we produce a con- or destrutor in a call }
  263. is_con_or_destructor : boolean;
  264. { true if a constructor is called again }
  265. extended_new : boolean;
  266. { adress returned from an I/O-error }
  267. iolabel : tasmlabel;
  268. { lexlevel count }
  269. i : longint;
  270. { help reference pointer }
  271. href : treference;
  272. hrefvmt : treference;
  273. hp : tnode;
  274. pp : tbinarynode;
  275. params : tnode;
  276. inlined : boolean;
  277. inlinecode : tprocinlinenode;
  278. store_parast_fixup,
  279. para_alignment,
  280. para_offset : longint;
  281. cgsize : tcgsize;
  282. { instruction for alignement correction }
  283. { corr : paicpu;}
  284. { we must pop this size also after !! }
  285. { must_pop : boolean; }
  286. pop_size : longint;
  287. {$ifdef OPTALIGN}
  288. pop_esp : boolean;
  289. push_size : longint;
  290. {$endif OPTALIGN}
  291. pop_allowed : boolean;
  292. release_tmpreg : boolean;
  293. constructorfailed : tasmlabel;
  294. returnref,
  295. pararef : treference;
  296. label
  297. dont_call;
  298. begin
  299. extended_new:=false;
  300. iolabel:=nil;
  301. inlinecode:=nil;
  302. inlined:=false;
  303. loadesi:=true;
  304. no_virtual_call:=false;
  305. rg.saveunusedstate(unusedstate);
  306. { if we allocate the temp. location for ansi- or widestrings }
  307. { already here, we avoid later a push/pop }
  308. if is_widestring(resulttype.def) then
  309. begin
  310. tg.GetTemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
  311. cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
  312. end
  313. else if is_ansistring(resulttype.def) then
  314. begin
  315. tg.GetTemp(exprasmlist,pointer_size,tt_ansistring,refcountedtemp);
  316. cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
  317. end;
  318. if (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_stdcall]) then
  319. para_alignment:=4
  320. else
  321. para_alignment:=aktalignment.paraalign;
  322. if not assigned(procdefinition) then
  323. exit;
  324. { Deciding whether we may still need the parameters happens next (JM) }
  325. if assigned(left) then
  326. params:=left.getcopy
  327. else params := nil;
  328. if (procdefinition.proccalloption=pocall_inline) then
  329. begin
  330. inlined:=true;
  331. inlinecode:=tprocinlinenode(right);
  332. right:=nil;
  333. { set it to the same lexical level as the local symtable, becuase
  334. the para's are stored there }
  335. tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel;
  336. if assigned(params) then
  337. begin
  338. tg.GetTemp(exprasmlist,inlinecode.para_size,tt_persistant,pararef);
  339. inlinecode.para_offset:=pararef.offset;
  340. end;
  341. store_parast_fixup:=tprocdef(procdefinition).parast.address_fixup;
  342. tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset;
  343. {$ifdef extdebug}
  344. Comment(V_debug,
  345. 'inlined parasymtable is at offset '
  346. +tostr(tprocdef(procdefinition).parast.address_fixup));
  347. exprasmList.concat(tai_comment.Create(
  348. strpnew('inlined parasymtable is at offset '
  349. +tostr(tprocdef(procdefinition).parast.address_fixup))));
  350. {$endif extdebug}
  351. end;
  352. { only if no proc var }
  353. if inlined or
  354. not(assigned(right)) then
  355. is_con_or_destructor:=(procdefinition.proctypeoption in [potype_constructor,potype_destructor]);
  356. { proc variables destroy all registers }
  357. if (inlined or
  358. (right=nil)) and
  359. { virtual methods too }
  360. not(po_virtualmethod in procdefinition.procoptions) then
  361. begin
  362. if (cs_check_io in aktlocalswitches) and
  363. (po_iocheck in procdefinition.procoptions) and
  364. not(po_iocheck in aktprocdef.procoptions) then
  365. begin
  366. objectlibrary.getaddrlabel(iolabel);
  367. cg.a_label(exprasmlist,iolabel);
  368. end
  369. else
  370. iolabel:=nil;
  371. { save all used registers and possible registers
  372. used for the return value }
  373. regs_to_push := tprocdef(procdefinition).usedregisters;
  374. if (not is_void(resulttype.def)) and
  375. (not paramanager.ret_in_param(resulttype.def)) then
  376. begin
  377. include(regs_to_push,accumulator);
  378. if resulttype.def.size>sizeof(aword) then
  379. include(regs_to_push,accumulatorhigh);
  380. end;
  381. rg.saveusedregisters(exprasmlist,pushed,regs_to_push);
  382. { give used registers through }
  383. rg.usedinproc:=rg.usedinproc + tprocdef(procdefinition).usedregisters;
  384. end
  385. else
  386. begin
  387. regs_to_push := all_registers;
  388. rg.saveusedregisters(exprasmlist,pushed,regs_to_push);
  389. rg.usedinproc:=all_registers;
  390. { no IO check for methods and procedure variables }
  391. iolabel:=nil;
  392. end;
  393. { generate the code for the parameter and push them }
  394. oldpushedparasize:=pushedparasize;
  395. pushedparasize:=0;
  396. pop_size:=0;
  397. { no inc esp for inlined procedure
  398. and for objects constructors PM }
  399. if inlined or
  400. ((procdefinition.proctypeoption=potype_constructor) and
  401. { quick'n'dirty check if it is a class or an object }
  402. (resulttype.def.deftype=orddef)) then
  403. pop_allowed:=false
  404. else
  405. pop_allowed:=true;
  406. if pop_allowed then
  407. begin
  408. { Old pushedsize aligned on 4 ? }
  409. i:=oldpushedparasize and 3;
  410. if i>0 then
  411. inc(pop_size,4-i);
  412. { This parasize aligned on 4 ? }
  413. i:=procdefinition.para_size(para_alignment) and 3;
  414. if i>0 then
  415. inc(pop_size,4-i);
  416. { insert the opcode and update pushedparasize }
  417. { never push 4 or more !! }
  418. pop_size:=pop_size mod 4;
  419. if pop_size>0 then
  420. begin
  421. inc(pushedparasize,pop_size);
  422. emit_const_reg(A_SUB,S_L,pop_size,R_ESP);
  423. {$ifdef GDB}
  424. if (cs_debuginfo in aktmoduleswitches) and
  425. (exprasmList.first=exprasmList.last) then
  426. exprasmList.concat(Tai_force_line.Create);
  427. {$endif GDB}
  428. end;
  429. end;
  430. {$ifdef OPTALIGN}
  431. if pop_allowed and (cs_align in aktglobalswitches) then
  432. begin
  433. pop_esp:=true;
  434. push_size:=procdefinition.para_size(para_alignment);
  435. { !!!! here we have to take care of return type, self
  436. and nested procedures
  437. }
  438. inc(push_size,12);
  439. emit_reg_reg(A_MOV,S_L,R_ESP,R_EDI);
  440. if (push_size mod 8)=0 then
  441. emit_const_reg(A_AND,S_L,$fffffff8,R_ESP)
  442. else
  443. begin
  444. emit_const_reg(A_SUB,S_L,push_size,R_ESP);
  445. emit_const_reg(A_AND,S_L,$fffffff8,R_ESP);
  446. emit_const_reg(A_SUB,S_L,push_size,R_ESP);
  447. end;
  448. emit_reg(A_PUSH,S_L,R_EDI);
  449. end
  450. else
  451. pop_esp:=false;
  452. {$endif OPTALIGN}
  453. { Push parameters }
  454. if assigned(params) then
  455. begin
  456. { be found elsewhere }
  457. if inlined then
  458. para_offset:=tprocdef(procdefinition).parast.address_fixup+
  459. tprocdef(procdefinition).parast.datasize
  460. else
  461. para_offset:=0;
  462. if not(inlined) and
  463. assigned(right) then
  464. tcallparanode(params).secondcallparan(TParaItem(tabstractprocdef(right.resulttype.def).Para.first),
  465. (po_leftright in procdefinition.procoptions),inlined,
  466. (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
  467. para_alignment,para_offset)
  468. else
  469. tcallparanode(params).secondcallparan(TParaItem(procdefinition.Para.first),
  470. (po_leftright in procdefinition.procoptions),inlined,
  471. (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
  472. para_alignment,para_offset);
  473. end;
  474. { Allocate return value for inlined routines }
  475. if inlined and
  476. (resulttype.def.size>0) then
  477. begin
  478. tg.GetTemp(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign),tt_persistant,returnref);
  479. inlinecode.retoffset:=returnref.offset;
  480. end;
  481. { Allocate return value when returned in argument }
  482. if paramanager.ret_in_param(resulttype.def) then
  483. begin
  484. if assigned(funcretrefnode) then
  485. begin
  486. secondpass(funcretrefnode);
  487. if codegenerror then
  488. exit;
  489. if (funcretrefnode.location.loc<>LOC_REFERENCE) then
  490. internalerror(200204246);
  491. funcretref:=funcretrefnode.location.reference;
  492. end
  493. else
  494. begin
  495. if inlined then
  496. begin
  497. tg.GetTemp(exprasmlist,resulttype.def.size,tt_persistant,funcretref);
  498. {$ifdef extdebug}
  499. Comment(V_debug,'function return value is at offset '
  500. +tostr(funcretref.offset));
  501. exprasmlist.concat(tai_comment.create(
  502. strpnew('function return value is at offset '
  503. +tostr(funcretref.offset))));
  504. {$endif extdebug}
  505. end
  506. else
  507. tg.GetTemp(exprasmlist,resulttype.def.size,tt_normal,funcretref);
  508. end;
  509. { This must not be counted for C code
  510. complex return address is removed from stack
  511. by function itself ! }
  512. {$ifdef OLD_C_STACK}
  513. inc(pushedparasize,4); { lets try without it PM }
  514. {$endif not OLD_C_STACK}
  515. if inlined then
  516. begin
  517. hregister:=cg.get_scratch_reg_address(exprasmlist);
  518. cg.a_loadaddr_ref_reg(exprasmlist,funcretref,hregister);
  519. reference_reset_base(href,procinfo.framepointer,inlinecode.retoffset);
  520. cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
  521. cg.free_scratch_reg(exprasmlist,hregister);
  522. end
  523. else
  524. cg.a_paramaddr_ref(exprasmlist,funcretref,paralocdummy);
  525. end;
  526. { procedure variable or normal function call ? }
  527. if inlined or
  528. (right=nil) then
  529. begin
  530. { Normal function call }
  531. { overloaded operator has no symtable }
  532. { push self }
  533. if assigned(symtableproc) and
  534. (symtableproc.symtabletype=withsymtable) then
  535. begin
  536. { dirty trick to avoid the secondcall below }
  537. methodpointer:=ccallparanode.create(nil,nil);
  538. location_reset(methodpointer.location,LOC_REGISTER,OS_ADDR);
  539. rg.getexplicitregisterint(exprasmlist,R_ESI);
  540. methodpointer.location.register:=R_ESI;
  541. { ARGHHH this is wrong !!!
  542. if we can init from base class for a child
  543. class that the wrong VMT will be
  544. transfered to constructor !! }
  545. methodpointer.resulttype:=
  546. twithnode(twithsymtable(symtableproc).withnode).left.resulttype;
  547. { make a reference }
  548. href:=twithnode(twithsymtable(symtableproc).withnode).withreference;
  549. if ((not(nf_islocal in twithnode(twithsymtable(symtableproc).withnode).flags)) and
  550. (not twithsymtable(symtableproc).direct_with)) or
  551. is_class_or_interface(methodpointer.resulttype.def) then
  552. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg)
  553. else
  554. cg.a_loadaddr_ref_reg(exprasmlist,href,self_pointer_reg);
  555. end;
  556. { push self }
  557. if assigned(symtableproc) and
  558. ((symtableproc.symtabletype=objectsymtable) or
  559. (symtableproc.symtabletype=withsymtable)) then
  560. begin
  561. if assigned(methodpointer) then
  562. begin
  563. {
  564. if methodpointer^.resulttype.def=classrefdef then
  565. begin
  566. two possibilities:
  567. 1. constructor
  568. 2. class method
  569. end
  570. else }
  571. begin
  572. case methodpointer.nodetype of
  573. typen:
  574. begin
  575. { direct call to inherited method }
  576. if (po_abstractmethod in procdefinition.procoptions) then
  577. begin
  578. CGMessage(cg_e_cant_call_abstract_method);
  579. goto dont_call;
  580. end;
  581. { generate no virtual call }
  582. no_virtual_call:=true;
  583. if (sp_static in symtableprocentry.symoptions) then
  584. begin
  585. { well lets put the VMT address directly into ESI }
  586. { it is kind of dirty but that is the simplest }
  587. { way to accept virtual static functions (PM) }
  588. loadesi:=true;
  589. { if no VMT just use $0 bug0214 PM }
  590. rg.getexplicitregisterint(exprasmlist,R_ESI);
  591. if not(oo_has_vmt in tobjectdef(methodpointer.resulttype.def).objectoptions) then
  592. cg.a_load_const_reg(exprasmlist,OS_ADDR,0,self_pointer_reg)
  593. else
  594. begin
  595. reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  596. cg.a_loadaddr_ref_reg(exprasmlist,href,self_pointer_reg);
  597. end;
  598. { emit_reg(A_PUSH,S_L,R_ESI);
  599. this is done below !! }
  600. end
  601. else
  602. { this is a member call, so ESI isn't modfied }
  603. loadesi:=false;
  604. { a class destructor needs a flag }
  605. if is_class(tobjectdef(methodpointer.resulttype.def)) and
  606. (procdefinition.proctypeoption=potype_destructor) then
  607. begin
  608. cg.a_param_const(exprasmlist,OS_ADDR,0,paramanager.getintparaloc(2));
  609. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
  610. end;
  611. if not(is_con_or_destructor and
  612. is_class(methodpointer.resulttype.def) and
  613. (procdefinition.proctypeoption in [potype_constructor,potype_destructor])
  614. ) then
  615. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
  616. { if an inherited con- or destructor should be }
  617. { called in a con- or destructor then a warning }
  618. { will be made }
  619. { con- and destructors need a pointer to the vmt }
  620. if is_con_or_destructor and
  621. is_object(methodpointer.resulttype.def) and
  622. assigned(aktprocdef) then
  623. begin
  624. if not(aktprocdef.proctypeoption in
  625. [potype_constructor,potype_destructor]) then
  626. CGMessage(cg_w_member_cd_call_from_method);
  627. end;
  628. { class destructors get there flag above }
  629. { constructor flags ? }
  630. if is_con_or_destructor and
  631. not(
  632. is_class(methodpointer.resulttype.def) and
  633. assigned(aktprocdef) and
  634. (aktprocdef.proctypeoption=potype_destructor)) then
  635. begin
  636. { a constructor needs also a flag }
  637. if is_class(methodpointer.resulttype.def) then
  638. cg.a_param_const(exprasmlist,OS_ADDR,0,paramanager.getintparaloc(2));
  639. cg.a_param_const(exprasmlist,OS_ADDR,0,paramanager.getintparaloc(1));
  640. end;
  641. end;
  642. hnewn:
  643. begin
  644. { extended syntax of new }
  645. { ESI must be zero }
  646. rg.getexplicitregisterint(exprasmlist,R_ESI);
  647. cg.a_load_const_reg(exprasmlist,OS_ADDR,0,self_pointer_reg);
  648. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(2));
  649. { insert the vmt }
  650. reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  651. cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
  652. extended_new:=true;
  653. end;
  654. hdisposen:
  655. begin
  656. secondpass(methodpointer);
  657. { destructor with extended syntax called from dispose }
  658. { hdisposen always deliver LOC_REFERENCE }
  659. rg.getexplicitregisterint(exprasmlist,R_ESI);
  660. emit_ref_reg(A_LEA,S_L,methodpointer.location.reference,R_ESI);
  661. reference_release(exprasmlist,methodpointer.location.reference);
  662. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(2));
  663. reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  664. cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
  665. end;
  666. else
  667. begin
  668. { call to an instance member }
  669. if (symtableproc.symtabletype<>withsymtable) then
  670. begin
  671. secondpass(methodpointer);
  672. rg.getexplicitregisterint(exprasmlist,R_ESI);
  673. case methodpointer.location.loc of
  674. LOC_CREGISTER,
  675. LOC_REGISTER:
  676. begin
  677. cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,methodpointer.location.register,R_ESI);
  678. rg.ungetregisterint(exprasmlist,methodpointer.location.register);
  679. end;
  680. else
  681. begin
  682. if (methodpointer.resulttype.def.deftype=classrefdef) or
  683. is_class_or_interface(methodpointer.resulttype.def) then
  684. cg.a_load_ref_reg(exprasmlist,OS_ADDR,methodpointer.location.reference,R_ESI)
  685. else
  686. cg.a_loadaddr_ref_reg(exprasmlist,methodpointer.location.reference,R_ESI);
  687. reference_release(exprasmlist,methodpointer.location.reference);
  688. end;
  689. end;
  690. end;
  691. { when calling a class method, we have to load ESI with the VMT !
  692. But, not for a class method via self }
  693. if not(po_containsself in procdefinition.procoptions) then
  694. begin
  695. if (po_classmethod in procdefinition.procoptions) and
  696. not(methodpointer.resulttype.def.deftype=classrefdef) then
  697. begin
  698. { class method needs current VMT }
  699. rg.getexplicitregisterint(exprasmlist,R_ESI);
  700. reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
  701. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg);
  702. end;
  703. { direct call to destructor: remove data }
  704. if (procdefinition.proctypeoption=potype_destructor) and
  705. is_class(methodpointer.resulttype.def) then
  706. cg.a_param_const(exprasmlist,OS_INT,1,paramanager.getintparaloc(1));
  707. { direct call to class constructor, don't allocate memory }
  708. if (procdefinition.proctypeoption=potype_constructor) and
  709. is_class(methodpointer.resulttype.def) then
  710. begin
  711. cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(2));
  712. cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(1));
  713. end
  714. else
  715. begin
  716. { constructor call via classreference => allocate memory }
  717. if (procdefinition.proctypeoption=potype_constructor) and
  718. (methodpointer.resulttype.def.deftype=classrefdef) and
  719. is_class(tclassrefdef(methodpointer.resulttype.def).pointertype.def) then
  720. cg.a_param_const(exprasmlist,OS_INT,1,paramanager.getintparaloc(1));
  721. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
  722. end;
  723. end;
  724. if is_con_or_destructor then
  725. begin
  726. { classes don't get a VMT pointer pushed }
  727. if is_object(methodpointer.resulttype.def) then
  728. begin
  729. if (procdefinition.proctypeoption=potype_constructor) then
  730. begin
  731. { it's no bad idea, to insert the VMT }
  732. reference_reset_symbol(href,objectlibrary.newasmsymbol(
  733. tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  734. cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
  735. end
  736. { destructors haven't to dispose the instance, if this is }
  737. { a direct call }
  738. else
  739. cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(1));
  740. end;
  741. end;
  742. end;
  743. end;
  744. end;
  745. end
  746. else
  747. begin
  748. if (po_classmethod in procdefinition.procoptions) and
  749. not(
  750. assigned(aktprocdef) and
  751. (po_classmethod in aktprocdef.procoptions)
  752. ) then
  753. begin
  754. { class method needs current VMT }
  755. rg.getexplicitregisterint(exprasmlist,R_ESI);
  756. reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
  757. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,R_ESI);
  758. end
  759. else
  760. begin
  761. { member call, ESI isn't modified }
  762. loadesi:=false;
  763. end;
  764. { direct call to destructor: don't remove data! }
  765. if is_class(procinfo._class) then
  766. begin
  767. if (procdefinition.proctypeoption=potype_destructor) then
  768. begin
  769. cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(2));
  770. cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,paramanager.getintparaloc(1));
  771. end
  772. else if (procdefinition.proctypeoption=potype_constructor) then
  773. begin
  774. cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(2));
  775. cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(1));
  776. end
  777. else
  778. cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,paramanager.getintparaloc(1));
  779. end
  780. else if is_object(procinfo._class) then
  781. begin
  782. cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,paramanager.getintparaloc(1));
  783. if is_con_or_destructor then
  784. begin
  785. (*
  786. The constructor/destructor is called from the class
  787. itself, no need to push the VMT to create a new object
  788. if (procdefinition.proctypeoption=potype_constructor) then
  789. begin
  790. { it's no bad idea, to insert the VMT }
  791. reference_reset_symbol(href,objectlibrary.newasmsymbol(procinfo._class.vmt_mangledname),0);
  792. cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
  793. end
  794. { destructors haven't to dispose the instance, if this is }
  795. { a direct call }
  796. else
  797. *)
  798. cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(1));
  799. end;
  800. end
  801. else
  802. Internalerror(200006165);
  803. end;
  804. end;
  805. { call to BeforeDestruction? }
  806. if (procdefinition.proctypeoption=potype_destructor) and
  807. assigned(methodpointer) and
  808. (methodpointer.nodetype<>typen) and
  809. is_class(tobjectdef(methodpointer.resulttype.def)) and
  810. (inlined or
  811. (right=nil)) then
  812. begin
  813. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
  814. reference_reset_base(href,self_pointer_reg,0);
  815. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  816. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
  817. reference_reset_base(href,tmpreg,72);
  818. cg.a_call_ref(exprasmlist,href);
  819. cg.free_scratch_reg(exprasmlist,tmpreg);
  820. end;
  821. { push base pointer ?}
  822. { never when inlining, since if necessary, the base pointer }
  823. { can/will be gottten from the current procedure's symtable }
  824. { (JM) }
  825. if not inlined then
  826. if (lexlevel>=normal_function_level) and assigned(tprocdef(procdefinition).parast) and
  827. ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
  828. begin
  829. { if we call a nested function in a method, we must }
  830. { push also SELF! }
  831. { THAT'S NOT TRUE, we have to load ESI via frame pointer }
  832. { access }
  833. {
  834. begin
  835. loadesi:=false;
  836. emit_reg(A_PUSH,S_L,R_ESI);
  837. end;
  838. }
  839. if lexlevel=(tprocdef(procdefinition).parast.symtablelevel) then
  840. begin
  841. reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
  842. cg.a_param_ref(exprasmlist,OS_ADDR,href,paralocdummy);
  843. end
  844. { this is only true if the difference is one !!
  845. but it cannot be more !! }
  846. else if (lexlevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
  847. begin
  848. cg.a_param_reg(exprasmlist,OS_ADDR,procinfo.framepointer,paralocdummy);
  849. end
  850. else if (lexlevel>(tprocdef(procdefinition).parast.symtablelevel)) then
  851. begin
  852. hregister:=rg.getregisterint(exprasmlist);
  853. reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
  854. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
  855. for i:=(tprocdef(procdefinition).parast.symtablelevel) to lexlevel-1 do
  856. begin
  857. {we should get the correct frame_pointer_offset at each level
  858. how can we do this !!! }
  859. reference_reset_base(href,hregister,procinfo.framepointer_offset);
  860. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
  861. end;
  862. cg.a_param_reg(exprasmlist,OS_ADDR,hregister,paralocdummy);
  863. rg.ungetregisterint(exprasmlist,hregister);
  864. end
  865. else
  866. internalerror(25000);
  867. end;
  868. rg.saveregvars(exprasmlist,regs_to_push);
  869. if (po_virtualmethod in procdefinition.procoptions) and
  870. not(no_virtual_call) then
  871. begin
  872. { static functions contain the vmt_address in ESI }
  873. { also class methods }
  874. { Here it is quite tricky because it also depends }
  875. { on the methodpointer PM }
  876. release_tmpreg:=false;
  877. rg.getexplicitregisterint(exprasmlist,R_ESI);
  878. if assigned(aktprocdef) then
  879. begin
  880. if (((sp_static in aktprocdef.procsym.symoptions) or
  881. (po_classmethod in aktprocdef.procoptions)) and
  882. ((methodpointer=nil) or (methodpointer.nodetype=typen)))
  883. or
  884. (po_staticmethod in procdefinition.procoptions) or
  885. ((procdefinition.proctypeoption=potype_constructor) and
  886. { esi contains the vmt if we call a constructor via a class ref }
  887. assigned(methodpointer) and
  888. (methodpointer.resulttype.def.deftype=classrefdef)
  889. ) or
  890. { is_interface(tprocdef(procdefinition)._class) or }
  891. { ESI is loaded earlier }
  892. (po_classmethod in procdefinition.procoptions) then
  893. begin
  894. reference_reset_base(href,R_ESI,0);
  895. end
  896. else
  897. begin
  898. { this is one point where we need vmt_offset (PM) }
  899. reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
  900. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  901. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
  902. reference_reset_base(href,tmpreg,0);
  903. release_tmpreg:=true;
  904. end;
  905. end
  906. else
  907. { aktprocdef should be assigned, also in main program }
  908. internalerror(12345);
  909. if tprocdef(procdefinition).extnumber=-1 then
  910. internalerror(44584);
  911. href.offset:=tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber);
  912. if not(is_interface(tprocdef(procdefinition)._class)) and
  913. not(is_cppclass(tprocdef(procdefinition)._class)) then
  914. begin
  915. if (cs_check_object in aktlocalswitches) then
  916. begin
  917. reference_reset_symbol(hrefvmt,objectlibrary.newasmsymbol(tprocdef(procdefinition)._class.vmt_mangledname),0);
  918. cg.a_paramaddr_ref(exprasmlist,hrefvmt,paramanager.getintparaloc(2));
  919. cg.a_param_reg(exprasmlist,OS_ADDR,href.base,paramanager.getintparaloc(1));
  920. cg.a_call_name(exprasmlist,'FPC_CHECK_OBJECT_EXT');
  921. end
  922. else if (cs_check_range in aktlocalswitches) then
  923. begin
  924. cg.a_param_reg(exprasmlist,OS_ADDR,href.base,paramanager.getintparaloc(1));
  925. cg.a_call_name(exprasmlist,'FPC_CHECK_OBJECT');
  926. end;
  927. end;
  928. cg.a_call_ref(exprasmlist,href);
  929. if release_tmpreg then
  930. cg.free_scratch_reg(exprasmlist,tmpreg);
  931. end
  932. else if not inlined then
  933. begin
  934. { We can call interrupts from within the smae code
  935. by just pushing the flags and CS PM }
  936. if (po_interrupt in procdefinition.procoptions) then
  937. begin
  938. emit_none(A_PUSHF,S_L);
  939. emit_reg(A_PUSH,S_L,R_CS);
  940. end;
  941. cg.a_call_name(exprasmlist,tprocdef(procdefinition).mangledname);
  942. end
  943. else { inlined proc }
  944. { inlined code is in inlinecode }
  945. begin
  946. { process the inlinecode }
  947. secondpass(tnode(inlinecode));
  948. { free the args }
  949. if tprocdef(procdefinition).parast.datasize>0 then
  950. tg.UnGetTemp(exprasmlist,pararef);
  951. end;
  952. end
  953. else
  954. { now procedure variable case }
  955. begin
  956. secondpass(right);
  957. if (po_interrupt in procdefinition.procoptions) then
  958. begin
  959. emit_none(A_PUSHF,S_L);
  960. emit_reg(A_PUSH,S_L,R_CS);
  961. end;
  962. { procedure of object? }
  963. if (po_methodpointer in procdefinition.procoptions) then
  964. begin
  965. { method pointer can't be in a register }
  966. hregister:=R_NO;
  967. { do some hacking if we call a method pointer }
  968. { which is a class member }
  969. { else ESI is overwritten ! }
  970. if (right.location.reference.base=R_ESI) or
  971. (right.location.reference.index=R_ESI) then
  972. begin
  973. reference_release(exprasmlist,right.location.reference);
  974. hregister:=cg.get_scratch_reg_address(exprasmlist);
  975. cg.a_load_ref_reg(exprasmlist,OS_ADDR,right.location.reference,hregister);
  976. end;
  977. { load self, but not if it's already explicitly pushed }
  978. if not(po_containsself in procdefinition.procoptions) then
  979. begin
  980. { load ESI }
  981. href:=right.location.reference;
  982. inc(href.offset,4);
  983. rg.getexplicitregisterint(exprasmlist,R_ESI);
  984. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg);
  985. { push self pointer }
  986. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paralocdummy);
  987. end;
  988. rg.saveregvars(exprasmlist,ALL_REGISTERS);
  989. if hregister<>R_NO then
  990. cg.a_call_reg(exprasmlist,hregister)
  991. else
  992. cg.a_call_ref(exprasmlist,right.location.reference);
  993. if hregister<>R_NO then
  994. cg.free_scratch_reg(exprasmlist,hregister);
  995. reference_release(exprasmlist,right.location.reference);
  996. tg.Ungetiftemp(exprasmlist,right.location.reference);
  997. end
  998. else
  999. begin
  1000. rg.saveregvars(exprasmlist,ALL_REGISTERS);
  1001. cg.a_call_loc(exprasmlist,right.location);
  1002. location_release(exprasmlist,right.location);
  1003. location_freetemp(exprasmlist,right.location);
  1004. end;
  1005. end;
  1006. { this was only for normal functions
  1007. displaced here so we also get
  1008. it to work for procvars PM }
  1009. if (not inlined) and (po_clearstack in procdefinition.procoptions) then
  1010. begin
  1011. { we also add the pop_size which is included in pushedparasize }
  1012. pop_size:=0;
  1013. { better than an add on all processors }
  1014. if pushedparasize=4 then
  1015. begin
  1016. rg.getexplicitregisterint(exprasmlist,R_EDI);
  1017. emit_reg(A_POP,S_L,R_EDI);
  1018. rg.ungetregisterint(exprasmlist,R_EDI);
  1019. end
  1020. { the pentium has two pipes and pop reg is pairable }
  1021. { but the registers must be different! }
  1022. else if (pushedparasize=8) and
  1023. not(cs_littlesize in aktglobalswitches) and
  1024. (aktoptprocessor=ClassP5) and
  1025. (procinfo._class=nil) then
  1026. begin
  1027. rg.getexplicitregisterint(exprasmlist,R_EDI);
  1028. emit_reg(A_POP,S_L,R_EDI);
  1029. rg.ungetregisterint(exprasmlist,R_EDI);
  1030. exprasmList.concat(tai_regalloc.Alloc(R_ESI));
  1031. emit_reg(A_POP,S_L,R_ESI);
  1032. exprasmList.concat(tai_regalloc.DeAlloc(R_ESI));
  1033. end
  1034. else if pushedparasize<>0 then
  1035. emit_const_reg(A_ADD,S_L,pushedparasize,R_ESP);
  1036. end;
  1037. {$ifdef OPTALIGN}
  1038. if pop_esp then
  1039. emit_reg(A_POP,S_L,R_ESP);
  1040. {$endif OPTALIGN}
  1041. dont_call:
  1042. pushedparasize:=oldpushedparasize;
  1043. rg.restoreunusedstate(unusedstate);
  1044. {$ifdef TEMPREGDEBUG}
  1045. testregisters32;
  1046. {$endif TEMPREGDEBUG}
  1047. { a constructor could be a function with boolean result }
  1048. { if calling constructor called fail we
  1049. must jump directly to quickexitlabel PM
  1050. but only if it is a call of an inherited constructor }
  1051. if (inlined or
  1052. (right=nil)) and
  1053. (procdefinition.proctypeoption=potype_constructor) and
  1054. assigned(methodpointer) and
  1055. (methodpointer.nodetype=typen) and
  1056. (aktprocdef.proctypeoption=potype_constructor) then
  1057. begin
  1058. emitjmp(C_Z,faillabel);
  1059. {$ifdef TEST_GENERIC}
  1060. { should be moved to generic version! }
  1061. reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
  1062. cg.a_load_ref_reg(exprasmlist, OS_ADDR, href, SELF_POINTER_REG);
  1063. {$endif}
  1064. end;
  1065. { call to AfterConstruction? }
  1066. if is_class(resulttype.def) and
  1067. (inlined or
  1068. (right=nil)) and
  1069. (procdefinition.proctypeoption=potype_constructor) and
  1070. assigned(methodpointer) and
  1071. (methodpointer.nodetype<>typen) then
  1072. begin
  1073. objectlibrary.getlabel(constructorfailed);
  1074. emitjmp(C_Z,constructorfailed);
  1075. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
  1076. reference_reset_base(href,self_pointer_reg,0);
  1077. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  1078. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
  1079. reference_reset_base(href,tmpreg,68);
  1080. cg.a_call_ref(exprasmlist,href);
  1081. cg.free_scratch_reg(exprasmlist,tmpreg);
  1082. exprasmList.concat(tai_regalloc.Alloc(accumulator));
  1083. cg.a_label(exprasmlist,constructorfailed);
  1084. cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,self_pointer_reg,accumulator);
  1085. end;
  1086. { handle function results }
  1087. if (not is_void(resulttype.def)) then
  1088. begin
  1089. { structured results are easy to handle.... }
  1090. { needed also when result_no_used !! }
  1091. if paramanager.ret_in_param(resulttype.def) then
  1092. begin
  1093. location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
  1094. location.reference.symbol:=nil;
  1095. location.reference:=funcretref;
  1096. end
  1097. else
  1098. { ansi/widestrings must be registered, so we can dispose them }
  1099. if is_ansistring(resulttype.def) or
  1100. is_widestring(resulttype.def) then
  1101. begin
  1102. location_reset(location,LOC_CREFERENCE,OS_ADDR);
  1103. location.reference:=refcountedtemp;
  1104. cg.a_reg_alloc(exprasmlist,accumulator);
  1105. cg.a_load_reg_ref(exprasmlist,OS_ADDR,accumulator,location.reference);
  1106. cg.a_reg_dealloc(exprasmlist,accumulator);
  1107. end
  1108. else
  1109. { we have only to handle the result if it is used }
  1110. if (nf_return_value_used in flags) then
  1111. begin
  1112. case resulttype.def.deftype of
  1113. enumdef,
  1114. orddef :
  1115. begin
  1116. cgsize:=def_cgsize(resulttype.def);
  1117. { an object constructor is a function with boolean result }
  1118. if (inlined or (right=nil)) and
  1119. (procdefinition.proctypeoption=potype_constructor) then
  1120. begin
  1121. if extended_new then
  1122. cgsize:=OS_INT
  1123. else
  1124. begin
  1125. cgsize:=OS_NO;
  1126. { this fails if popsize > 0 PM }
  1127. location_reset(location,LOC_FLAGS,OS_NO);
  1128. location.resflags:=F_NE;
  1129. end;
  1130. end;
  1131. if cgsize<>OS_NO then
  1132. begin
  1133. location_reset(location,LOC_REGISTER,cgsize);
  1134. cg.a_reg_alloc(exprasmlist,accumulator);
  1135. if cgsize in [OS_64,OS_S64] then
  1136. begin
  1137. cg.a_reg_alloc(exprasmlist,accumulatorhigh);
  1138. location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
  1139. location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
  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,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,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.UnGetTemp(exprasmlist,returnref);
  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.ChangeTempType(funcretref,tt_normal);
  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. begin
  1237. ccallparanode:=ti386callparanode;
  1238. ccallnode:=ti386callnode;
  1239. end.
  1240. {
  1241. $Log$
  1242. Revision 1.73 2002-10-05 12:43:29 carl
  1243. * fixes for Delphi 6 compilation
  1244. (warning : Some features do not work under Delphi)
  1245. Revision 1.72 2002/09/17 18:54:03 jonas
  1246. * a_load_reg_reg() now has two size parameters: source and dest. This
  1247. allows some optimizations on architectures that don't encode the
  1248. register size in the register name.
  1249. Revision 1.71 2002/09/16 19:07:37 peter
  1250. * push 0 instead of VMT when calling a constructor from a member
  1251. Revision 1.70 2002/09/07 15:25:10 peter
  1252. * old logs removed and tabs fixed
  1253. Revision 1.69 2002/09/01 18:43:27 peter
  1254. * include accumulator in regs_to_push list
  1255. Revision 1.68 2002/09/01 12:13:00 peter
  1256. * use a_call_reg
  1257. * ungetiftemp for procvar of object temp
  1258. Revision 1.67 2002/08/25 19:25:21 peter
  1259. * sym.insert_in_data removed
  1260. * symtable.insertvardata/insertconstdata added
  1261. * removed insert_in_data call from symtable.insert, it needs to be
  1262. called separatly. This allows to deref the address calculation
  1263. * procedures now calculate the parast addresses after the procedure
  1264. directives are parsed. This fixes the cdecl parast problem
  1265. * push_addr_param has an extra argument that specifies if cdecl is used
  1266. or not
  1267. Revision 1.66 2002/08/23 16:14:49 peter
  1268. * tempgen cleanup
  1269. * tt_noreuse temp type added that will be used in genentrycode
  1270. Revision 1.65 2002/08/18 20:06:30 peter
  1271. * inlining is now also allowed in interface
  1272. * renamed write/load to ppuwrite/ppuload
  1273. * tnode storing in ppu
  1274. * nld,ncon,nbas are already updated for storing in ppu
  1275. Revision 1.64 2002/08/17 09:23:45 florian
  1276. * first part of procinfo rewrite
  1277. Revision 1.63 2002/08/12 15:08:42 carl
  1278. + stab register indexes for powerpc (moved from gdb to cpubase)
  1279. + tprocessor enumeration moved to cpuinfo
  1280. + linker in target_info is now a class
  1281. * many many updates for m68k (will soon start to compile)
  1282. - removed some ifdef or correct them for correct cpu
  1283. Revision 1.62 2002/08/11 14:32:30 peter
  1284. * renamed current_library to objectlibrary
  1285. Revision 1.61 2002/08/11 13:24:16 peter
  1286. * saving of asmsymbols in ppu supported
  1287. * asmsymbollist global is removed and moved into a new class
  1288. tasmlibrarydata that will hold the info of a .a file which
  1289. corresponds with a single module. Added librarydata to tmodule
  1290. to keep the library info stored for the module. In the future the
  1291. objectfiles will also be stored to the tasmlibrarydata class
  1292. * all getlabel/newasmsymbol and friends are moved to the new class
  1293. Revision 1.60 2002/07/20 11:58:01 florian
  1294. * types.pas renamed to defbase.pas because D6 contains a types
  1295. unit so this would conflicts if D6 programms are compiled
  1296. + Willamette/SSE2 instructions to assembler added
  1297. Revision 1.59 2002/07/11 14:41:33 florian
  1298. * start of the new generic parameter handling
  1299. Revision 1.58 2002/07/07 09:52:34 florian
  1300. * powerpc target fixed, very simple units can be compiled
  1301. * some basic stuff for better callparanode handling, far from being finished
  1302. Revision 1.57 2002/07/06 20:27:26 carl
  1303. + generic set handling
  1304. Revision 1.56 2002/07/01 18:46:31 peter
  1305. * internal linker
  1306. * reorganized aasm layer
  1307. Revision 1.55 2002/07/01 16:23:56 peter
  1308. * cg64 patch
  1309. * basics for currency
  1310. * asnode updates for class and interface (not finished)
  1311. Revision 1.54 2002/05/20 13:30:40 carl
  1312. * bugfix of hdisponen (base must be set, not index)
  1313. * more portability fixes
  1314. Revision 1.53 2002/05/18 13:34:23 peter
  1315. * readded missing revisions
  1316. Revision 1.52 2002/05/16 19:46:51 carl
  1317. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1318. + try to fix temp allocation (still in ifdef)
  1319. + generic constructor calls
  1320. + start of tassembler / tmodulebase class cleanup
  1321. Revision 1.50 2002/05/13 19:54:38 peter
  1322. * removed n386ld and n386util units
  1323. * maybe_save/maybe_restore added instead of the old maybe_push
  1324. Revision 1.49 2002/05/12 16:53:17 peter
  1325. * moved entry and exitcode to ncgutil and cgobj
  1326. * foreach gets extra argument for passing local data to the
  1327. iterator function
  1328. * -CR checks also class typecasts at runtime by changing them
  1329. into as
  1330. * fixed compiler to cycle with the -CR option
  1331. * fixed stabs with elf writer, finally the global variables can
  1332. be watched
  1333. * removed a lot of routines from cga unit and replaced them by
  1334. calls to cgobj
  1335. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1336. u32bit then the other is typecasted also to u32bit without giving
  1337. a rangecheck warning/error.
  1338. * fixed pascal calling method with reversing also the high tree in
  1339. the parast, detected by tcalcst3 test
  1340. }