n386cal.pas 67 KB

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