2
0

n386cal.pas 69 KB

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