n386cal.pas 65 KB

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