n386cal.pas 65 KB

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