ncgcal.pas 69 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509
  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 bymethodpointer
  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 ncgcal;
  19. {$i fpcdefs.inc}
  20. interface
  21. { $define AnsiStrRef}
  22. uses
  23. symdef,node,ncal;
  24. type
  25. tcgcallparanode = class(tcallparanode)
  26. procedure secondcallparan(defcoll : TParaItem;
  27. push_from_left_to_right,inlined,is_cdecl : boolean;
  28. para_alignment,para_offset : longint);override;
  29. end;
  30. tcgcallnode = class(tcallnode)
  31. procedure pass_2;override;
  32. procedure load_framepointer;virtual;abstract;
  33. end;
  34. tcgprocinlinenode = class(tprocinlinenode)
  35. procedure pass_2;override;
  36. end;
  37. implementation
  38. uses
  39. globtype,systems,
  40. cutils,verbose,globals,
  41. symconst,symbase,symsym,symtable,defbase,paramgr,
  42. {$ifdef GDB}
  43. {$ifdef delphi}
  44. sysutils,
  45. {$else}
  46. strings,
  47. {$endif}
  48. gdb,
  49. {$endif GDB}
  50. cginfo,cgbase,pass_2,
  51. cpuinfo,cpubase,aasmbase,aasmtai,aasmcpu,
  52. nmem,nld,ncnv,
  53. ncgutil,cgobj,tgobj,regvars,rgobj,rgcpu,cg64f32,cgcpu;
  54. {*****************************************************************************
  55. TCGCALLPARANODE
  56. *****************************************************************************}
  57. procedure tcgcallparanode.secondcallparan(defcoll : TParaItem;
  58. push_from_left_to_right,inlined,is_cdecl : boolean;para_alignment,para_offset : longint);
  59. { goes to pass 1 }
  60. procedure maybe_push_high;
  61. begin
  62. { open array ? }
  63. { defcoll.data can be nil for read/write }
  64. if assigned(defcoll.paratype.def) and
  65. assigned(hightree) then
  66. begin
  67. secondpass(hightree);
  68. { this is a longint anyway ! }
  69. push_value_para(hightree,inlined,false,para_offset,4,defcoll.paraloc);
  70. end;
  71. end;
  72. var
  73. otlabel,oflabel : tasmlabel;
  74. { temporary variables: }
  75. tempdeftype : tdeftype;
  76. tmpreg : tregister;
  77. href : treference;
  78. begin
  79. { push from left to right if specified }
  80. if push_from_left_to_right and assigned(right) then
  81. begin
  82. if (nf_varargs_para in flags) then
  83. tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
  84. inlined,is_cdecl,para_alignment,para_offset)
  85. else
  86. tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
  87. inlined,is_cdecl,para_alignment,para_offset);
  88. end;
  89. otlabel:=truelabel;
  90. oflabel:=falselabel;
  91. objectlibrary.getlabel(truelabel);
  92. objectlibrary.getlabel(falselabel);
  93. secondpass(left);
  94. { handle varargs first, because defcoll is not valid }
  95. if (nf_varargs_para in flags) then
  96. begin
  97. if paramanager.push_addr_param(left.resulttype.def) then
  98. begin
  99. inc(pushedparasize,4);
  100. cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc);
  101. location_release(exprasmlist,left.location);
  102. end
  103. else
  104. push_value_para(left,inlined,is_cdecl,para_offset,para_alignment,defcoll.paraloc);
  105. end
  106. { filter array constructor with c styled args }
  107. else if is_array_constructor(left.resulttype.def) and (nf_cargs in left.flags) then
  108. begin
  109. { nothing, everything is already pushed }
  110. end
  111. { in codegen.handleread.. defcoll.data is set to nil }
  112. else if assigned(defcoll.paratype.def) and
  113. (defcoll.paratype.def.deftype=formaldef) then
  114. begin
  115. { allow passing of a constant to a const formaldef }
  116. if (defcoll.paratyp=vs_const) and
  117. (left.location.loc=LOC_CONSTANT) then
  118. location_force_mem(exprasmlist,left.location);
  119. { allow @var }
  120. inc(pushedparasize,4);
  121. if (left.nodetype=addrn) and
  122. (not(nf_procvarload in left.flags)) then
  123. begin
  124. if inlined then
  125. begin
  126. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  127. cg.a_load_loc_ref(exprasmlist,left.location,href);
  128. end
  129. else
  130. cg.a_param_loc(exprasmlist,left.location,defcoll.paraloc);
  131. location_release(exprasmlist,left.location);
  132. end
  133. else
  134. begin
  135. if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  136. CGMessage(type_e_mismatch)
  137. else
  138. begin
  139. if inlined then
  140. begin
  141. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  142. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
  143. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  144. cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
  145. cg.free_scratch_reg(exprasmlist,tmpreg);
  146. end
  147. else
  148. cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc);
  149. location_release(exprasmlist,left.location);
  150. end;
  151. end;
  152. end
  153. { handle call by reference parameter }
  154. else if (defcoll.paratyp in [vs_var,vs_out]) then
  155. begin
  156. if (left.location.loc<>LOC_REFERENCE) then
  157. begin
  158. { passing self to a var parameter is allowed in
  159. TP and delphi }
  160. if not((left.location.loc=LOC_CREFERENCE) and
  161. (left.nodetype=selfn)) then
  162. internalerror(200106041);
  163. end;
  164. maybe_push_high;
  165. if (defcoll.paratyp=vs_out) and
  166. assigned(defcoll.paratype.def) and
  167. not is_class(defcoll.paratype.def) and
  168. defcoll.paratype.def.needs_inittable then
  169. cg.g_finalize(exprasmlist,defcoll.paratype.def,left.location.reference,false);
  170. inc(pushedparasize,4);
  171. if inlined then
  172. begin
  173. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  174. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
  175. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  176. cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
  177. cg.free_scratch_reg(exprasmlist,tmpreg);
  178. end
  179. else
  180. cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc);
  181. location_release(exprasmlist,left.location);
  182. end
  183. else
  184. begin
  185. tempdeftype:=resulttype.def.deftype;
  186. if tempdeftype=filedef then
  187. CGMessage(cg_e_file_must_call_by_reference);
  188. { open array must always push the address, this is needed to
  189. also push addr of small open arrays and with cdecl functions (PFV) }
  190. if (
  191. assigned(defcoll.paratype.def) and
  192. (is_open_array(defcoll.paratype.def) or
  193. is_array_of_const(defcoll.paratype.def))
  194. ) or
  195. (
  196. paramanager.push_addr_param(resulttype.def) and
  197. not is_cdecl
  198. ) then
  199. begin
  200. if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  201. begin
  202. { allow passing nil to a procvardef (methodpointer) }
  203. if (left.nodetype=typeconvn) and
  204. (left.resulttype.def.deftype=procvardef) and
  205. (ttypeconvnode(left).left.nodetype=niln) then
  206. begin
  207. tg.gettempofsizereference(exprasmlist,tcgsize2size[left.location.size],href);
  208. cg.a_load_loc_ref(exprasmlist,left.location,href);
  209. location_reset(left.location,LOC_REFERENCE,left.location.size);
  210. left.location.reference:=href;
  211. end
  212. else
  213. internalerror(200204011);
  214. end;
  215. maybe_push_high;
  216. inc(pushedparasize,4);
  217. if inlined then
  218. begin
  219. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  220. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
  221. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  222. cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
  223. cg.free_scratch_reg(exprasmlist,tmpreg);
  224. end
  225. else
  226. cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc);
  227. location_release(exprasmlist,left.location);
  228. end
  229. else
  230. begin
  231. push_value_para(left,inlined,is_cdecl,
  232. para_offset,para_alignment,defcoll.paraloc);
  233. end;
  234. end;
  235. truelabel:=otlabel;
  236. falselabel:=oflabel;
  237. { push from right to left }
  238. if not push_from_left_to_right and assigned(right) then
  239. begin
  240. if (nf_varargs_para in flags) then
  241. tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
  242. inlined,is_cdecl,para_alignment,para_offset)
  243. else
  244. tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
  245. inlined,is_cdecl,para_alignment,para_offset);
  246. end;
  247. end;
  248. {*****************************************************************************
  249. TCGCALLNODE
  250. *****************************************************************************}
  251. procedure tcgcallnode.pass_2;
  252. var
  253. regs_to_push : tregisterset;
  254. unusedstate: pointer;
  255. pushed : tpushedsaved;
  256. funcretref,refcountedtemp : treference;
  257. tmpreg : tregister;
  258. hregister : tregister;
  259. oldpushedparasize : longint;
  260. { true if ESI must be loaded again after the subroutine }
  261. loadesi : boolean;
  262. { true if a virtual method must be called directly }
  263. no_virtual_call : boolean;
  264. { true if we produce a con- or destrutor in a call }
  265. is_con_or_destructor : boolean;
  266. { true if a constructor is called again }
  267. extended_new : boolean;
  268. { adress returned from an I/O-error }
  269. iolabel : tasmlabel;
  270. { lexlevel count }
  271. i : longint;
  272. { help reference pointer }
  273. href : treference;
  274. hrefvmt : treference;
  275. hp : tnode;
  276. pp : tbinarynode;
  277. params : tnode;
  278. inlined : boolean;
  279. inlinecode : tprocinlinenode;
  280. store_parast_fixup,
  281. para_alignment,
  282. para_offset : longint;
  283. cgsize : tcgsize;
  284. { instruction for alignement correction }
  285. { corr : paicpu;}
  286. { we must pop this size also after !! }
  287. { must_pop : boolean; }
  288. pop_size : longint;
  289. {$ifdef OPTALIGN}
  290. pop_esp : boolean;
  291. push_size : longint;
  292. {$endif OPTALIGN}
  293. pop_allowed : boolean;
  294. release_tmpreg : boolean;
  295. constructorfailed : tasmlabel;
  296. label
  297. dont_call;
  298. begin
  299. extended_new:=false;
  300. iolabel:=nil;
  301. inlinecode:=nil;
  302. inlined:=false;
  303. loadesi:=true;
  304. no_virtual_call:=false;
  305. rg.saveunusedstate(unusedstate);
  306. { if we allocate the temp. location for ansi- or widestrings }
  307. { already here, we avoid later a push/pop }
  308. if is_widestring(resulttype.def) then
  309. begin
  310. tg.gettempwidestringreference(exprasmlist,refcountedtemp);
  311. cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
  312. end
  313. else if is_ansistring(resulttype.def) then
  314. begin
  315. tg.gettempansistringreference(exprasmlist,refcountedtemp);
  316. cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
  317. end;
  318. if (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_stdcall]) then
  319. para_alignment:=4
  320. else
  321. para_alignment:=aktalignment.paraalign;
  322. if not assigned(procdefinition) then
  323. exit;
  324. { Deciding whether we may still need the parameters happens next (JM) }
  325. if assigned(left) then
  326. params:=left.getcopy
  327. else params := nil;
  328. if (procdefinition.proccalloption=pocall_inline) then
  329. begin
  330. inlined:=true;
  331. inlinecode:=tprocinlinenode(right);
  332. right:=nil;
  333. { set it to the same lexical level as the local symtable, becuase
  334. the para's are stored there }
  335. tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel;
  336. if assigned(params) then
  337. inlinecode.para_offset:=tg.gettempofsizepersistant(exprasmlist,inlinecode.para_size);
  338. store_parast_fixup:=tprocdef(procdefinition).parast.address_fixup;
  339. tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset;
  340. {$ifdef extdebug}
  341. Comment(V_debug,
  342. 'inlined parasymtable is at offset '
  343. +tostr(tprocdef(procdefinition).parast.address_fixup));
  344. exprasmList.concat(Tai_asm_comment.Create(
  345. strpnew('inlined parasymtable is at offset '
  346. +tostr(tprocdef(procdefinition).parast.address_fixup))));
  347. {$endif extdebug}
  348. end;
  349. { only if no proc var }
  350. if inlined or
  351. not(assigned(right)) then
  352. is_con_or_destructor:=(procdefinition.proctypeoption in [potype_constructor,potype_destructor]);
  353. { proc variables destroy all registers }
  354. if (inlined or
  355. (right=nil)) and
  356. { virtual methods too }
  357. not(po_virtualmethod in procdefinition.procoptions) then
  358. begin
  359. if (cs_check_io in aktlocalswitches) and
  360. (po_iocheck in procdefinition.procoptions) and
  361. not(po_iocheck in aktprocdef.procoptions) then
  362. begin
  363. objectlibrary.getaddrlabel(iolabel);
  364. cg.a_label(exprasmlist,iolabel);
  365. end
  366. else
  367. iolabel:=nil;
  368. { save all used registers }
  369. regs_to_push := tprocdef(procdefinition).usedregisters;
  370. rg.saveusedregisters(exprasmlist,pushed,regs_to_push);
  371. { give used registers through }
  372. rg.usedinproc:=rg.usedinproc + tprocdef(procdefinition).usedregisters;
  373. end
  374. else
  375. begin
  376. regs_to_push := all_registers;
  377. rg.saveusedregisters(exprasmlist,pushed,regs_to_push);
  378. rg.usedinproc:=all_registers;
  379. { no IO check for methods and procedure variables }
  380. iolabel:=nil;
  381. end;
  382. { generate the code for the parameter and push them }
  383. oldpushedparasize:=pushedparasize;
  384. pushedparasize:=0;
  385. pop_size:=0;
  386. {$ifdef dummy}
  387. { no inc esp for inlined procedure
  388. and for objects constructors PM }
  389. if inlined or
  390. ((procdefinition.proctypeoption=potype_constructor) and
  391. { quick'n'dirty check if it is a class or an object }
  392. (resulttype.def.deftype=orddef)) then
  393. pop_allowed:=false
  394. else
  395. pop_allowed:=true;
  396. if pop_allowed then
  397. begin
  398. { Old pushedsize aligned on 4 ? }
  399. i:=oldpushedparasize and 3;
  400. if i>0 then
  401. inc(pop_size,4-i);
  402. { This parasize aligned on 4 ? }
  403. i:=procdefinition.para_size(para_alignment) and 3;
  404. if i>0 then
  405. inc(pop_size,4-i);
  406. { insert the opcode and update pushedparasize }
  407. { never push 4 or more !! }
  408. pop_size:=pop_size mod 4;
  409. if pop_size>0 then
  410. begin
  411. inc(pushedparasize,pop_size);
  412. cg.a_const_reg(A_SUB,S_L,pop_size,R_ESP);
  413. {$ifdef GDB}
  414. if (cs_debuginfo in aktmoduleswitches) and
  415. (exprasmList.first=exprasmList.last) then
  416. exprasmList.concat(Tai_force_line.Create);
  417. {$endif GDB}
  418. end;
  419. end;
  420. {$endif dummy}
  421. {$ifdef OPTALIGN}
  422. if pop_allowed and (cs_align in aktglobalswitches) then
  423. begin
  424. pop_esp:=true;
  425. push_size:=procdefinition.para_size(para_alignment);
  426. { !!!! here we have to take care of return type, self
  427. and nested procedures
  428. }
  429. inc(push_size,12);
  430. emit_reg_reg(A_MOV,S_L,R_ESP,R_EDI);
  431. if (push_size mod 8)=0 then
  432. emit_const_reg(A_AND,S_L,$fffffff8,R_ESP)
  433. else
  434. begin
  435. emit_const_reg(A_SUB,S_L,push_size,R_ESP);
  436. emit_const_reg(A_AND,S_L,$fffffff8,R_ESP);
  437. emit_const_reg(A_SUB,S_L,push_size,R_ESP);
  438. end;
  439. emit_reg(A_PUSH,S_L,R_EDI);
  440. end
  441. else
  442. pop_esp:=false;
  443. {$endif OPTALIGN}
  444. { Push parameters }
  445. if assigned(params) then
  446. begin
  447. { be found elsewhere }
  448. if inlined then
  449. para_offset:=tprocdef(procdefinition).parast.address_fixup+
  450. tprocdef(procdefinition).parast.datasize
  451. else
  452. para_offset:=0;
  453. if not(inlined) and
  454. assigned(right) then
  455. tcallparanode(params).secondcallparan(TParaItem(tabstractprocdef(right.resulttype.def).Para.first),
  456. (po_leftright in procdefinition.procoptions),inlined,
  457. (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
  458. para_alignment,para_offset)
  459. else
  460. tcallparanode(params).secondcallparan(TParaItem(procdefinition.Para.first),
  461. (po_leftright in procdefinition.procoptions),inlined,
  462. (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
  463. para_alignment,para_offset);
  464. end;
  465. { Allocate return value for inlined routines }
  466. if inlined then
  467. inlinecode.retoffset:=tg.gettempofsizepersistant(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign));
  468. { Allocate return value when returned in argument }
  469. if paramanager.ret_in_param(resulttype.def) then
  470. begin
  471. if assigned(funcretrefnode) then
  472. begin
  473. secondpass(funcretrefnode);
  474. if codegenerror then
  475. exit;
  476. if (funcretrefnode.location.loc<>LOC_REFERENCE) then
  477. internalerror(200204246);
  478. funcretref:=funcretrefnode.location.reference;
  479. end
  480. else
  481. begin
  482. if inlined then
  483. begin
  484. reference_reset(funcretref);
  485. funcretref.offset:=tg.gettempofsizepersistant(exprasmlist,resulttype.def.size);
  486. funcretref.base:=procinfo^.framepointer;
  487. {$ifdef extdebug}
  488. Comment(V_debug,'function return value is at offset '
  489. +tostr(funcretref.offset));
  490. exprasmlist.concat(tai_asm_comment.create(
  491. strpnew('function return value is at offset '
  492. +tostr(funcretref.offset))));
  493. {$endif extdebug}
  494. end
  495. else
  496. tg.gettempofsizereference(exprasmlist,resulttype.def.size,funcretref);
  497. end;
  498. { This must not be counted for C code
  499. complex return address is removed from stack
  500. by function itself ! }
  501. {$ifdef OLD_C_STACK}
  502. inc(pushedparasize,4); { lets try without it PM }
  503. {$endif not OLD_C_STACK}
  504. if inlined then
  505. begin
  506. hregister:=cg.get_scratch_reg_address(exprasmlist);
  507. cg.a_loadaddr_ref_reg(exprasmlist,funcretref,hregister);
  508. reference_reset_base(href,procinfo^.framepointer,inlinecode.retoffset);
  509. cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
  510. cg.free_scratch_reg(exprasmlist,hregister);
  511. end
  512. else
  513. cg.a_paramaddr_ref(exprasmlist,funcretref,
  514. paramanager.getfuncretloc(procdefinition));
  515. end;
  516. { procedure variable or normal function call ? }
  517. if inlined or
  518. (right=nil) then
  519. begin
  520. { Normal function call }
  521. {$ifdef dummy}
  522. { overloaded operator has no symtable }
  523. { push self }
  524. if assigned(symtableproc) and
  525. (symtableproc.symtabletype=withsymtable) then
  526. begin
  527. { dirty trick to avoid the secondcall below }
  528. methodpointer:=ccallparanode.create(nil,nil);
  529. location_reset(methodpointer.location,LOC_REGISTER,OS_ADDR);
  530. rg.getexplicitregisterint(exprasmlist,R_ESI);
  531. methodpointer.location.register:=R_ESI;
  532. { ARGHHH this is wrong !!!
  533. if we can init from base class for a child
  534. class that the wrong VMT will be
  535. transfered to constructor !! }
  536. methodpointer.resulttype:=
  537. twithnode(twithsymtable(symtableproc).withnode).left.resulttype;
  538. { make a reference }
  539. href:=twithnode(twithsymtable(symtableproc).withnode).withreference;
  540. if ((not(nf_islocal in twithnode(twithsymtable(symtableproc).withnode).flags)) and
  541. (not twithsymtable(symtableproc).direct_with)) or
  542. is_class_or_interface(methodpointer.resulttype.def) then
  543. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg)
  544. else
  545. cg.a_loadaddr_ref_reg(exprasmlist,href,self_pointer_reg);
  546. end;
  547. { push self }
  548. if assigned(symtableproc) and
  549. ((symtableproc.symtabletype=objectsymtable) or
  550. (symtableproc.symtabletype=withsymtable)) then
  551. begin
  552. if assigned(methodpointer) then
  553. begin
  554. {
  555. if methodpointer^.resulttype.def=classrefdef then
  556. begin
  557. two possibilities:
  558. 1. constructor
  559. 2. class method
  560. end
  561. else }
  562. begin
  563. case methodpointer.nodetype of
  564. typen:
  565. begin
  566. { direct call to inherited method }
  567. if (po_abstractmethod in procdefinition.procoptions) then
  568. begin
  569. CGMessage(cg_e_cant_call_abstract_method);
  570. goto dont_call;
  571. end;
  572. { generate no virtual call }
  573. no_virtual_call:=true;
  574. if (sp_static in symtableprocentry.symoptions) then
  575. begin
  576. { well lets put the VMT address directly into ESI }
  577. { it is kind of dirty but that is the simplest }
  578. { way to accept virtual static functions (PM) }
  579. loadesi:=true;
  580. { if no VMT just use $0 bug0214 PM }
  581. rg.getexplicitregisterint(exprasmlist,R_ESI);
  582. if not(oo_has_vmt in tobjectdef(methodpointer.resulttype.def).objectoptions) then
  583. cg.a_load_const_reg(exprasmlist,OS_ADDR,0,self_pointer_reg)
  584. else
  585. begin
  586. reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  587. cg.a_loadaddr_ref_reg(exprasmlist,href,self_pointer_reg);
  588. end;
  589. { emit_reg(A_PUSH,S_L,R_ESI);
  590. this is done below !! }
  591. end
  592. else
  593. { this is a member call, so ESI isn't modfied }
  594. loadesi:=false;
  595. { a class destructor needs a flag }
  596. if is_class(tobjectdef(methodpointer.resulttype.def)) and
  597. (procdefinition.proctypeoption=potype_destructor) then
  598. begin
  599. cg.a_param_const(exprasmlist,OS_ADDR,0,2);
  600. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
  601. end;
  602. if not(is_con_or_destructor and
  603. is_class(methodpointer.resulttype.def) and
  604. (procdefinition.proctypeoption in [potype_constructor,potype_destructor])
  605. ) then
  606. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
  607. { if an inherited con- or destructor should be }
  608. { called in a con- or destructor then a warning }
  609. { will be made }
  610. { con- and destructors need a pointer to the vmt }
  611. if is_con_or_destructor and
  612. is_object(methodpointer.resulttype.def) and
  613. assigned(aktprocdef) then
  614. begin
  615. if not(aktprocdef.proctypeoption in
  616. [potype_constructor,potype_destructor]) then
  617. CGMessage(cg_w_member_cd_call_from_method);
  618. end;
  619. { class destructors get there flag above }
  620. { constructor flags ? }
  621. if is_con_or_destructor and
  622. not(
  623. is_class(methodpointer.resulttype.def) and
  624. assigned(aktprocdef) and
  625. (aktprocdef.proctypeoption=potype_destructor)) then
  626. begin
  627. { a constructor needs also a flag }
  628. if is_class(methodpointer.resulttype.def) then
  629. cg.a_param_const(exprasmlist,OS_ADDR,0,2);
  630. cg.a_param_const(exprasmlist,OS_ADDR,0,1);
  631. end;
  632. end;
  633. hnewn:
  634. begin
  635. { extended syntax of new }
  636. { ESI must be zero }
  637. rg.getexplicitregisterint(exprasmlist,R_ESI);
  638. cg.a_load_const_reg(exprasmlist,OS_ADDR,0,self_pointer_reg);
  639. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,2);
  640. { insert the vmt }
  641. reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  642. cg.a_paramaddr_ref(exprasmlist,href,1);
  643. extended_new:=true;
  644. end;
  645. hdisposen:
  646. begin
  647. secondpass(methodpointer);
  648. { destructor with extended syntax called from dispose }
  649. { hdisposen always deliver LOC_REFERENCE }
  650. rg.getexplicitregisterint(exprasmlist,R_ESI);
  651. emit_ref_reg(A_LEA,S_L,methodpointer.location.reference,R_ESI);
  652. reference_release(exprasmlist,methodpointer.location.reference);
  653. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,2);
  654. reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  655. cg.a_paramaddr_ref(exprasmlist,href,1);
  656. end;
  657. else
  658. begin
  659. { call to an instance member }
  660. if (symtableproc.symtabletype<>withsymtable) then
  661. begin
  662. secondpass(methodpointer);
  663. rg.getexplicitregisterint(exprasmlist,R_ESI);
  664. case methodpointer.location.loc of
  665. LOC_CREGISTER,
  666. LOC_REGISTER:
  667. begin
  668. cg.a_load_reg_reg(exprasmlist,OS_ADDR,methodpointer.location.register,R_ESI);
  669. rg.ungetregisterint(exprasmlist,methodpointer.location.register);
  670. end;
  671. else
  672. begin
  673. if (methodpointer.resulttype.def.deftype=classrefdef) or
  674. is_class_or_interface(methodpointer.resulttype.def) then
  675. cg.a_load_ref_reg(exprasmlist,OS_ADDR,methodpointer.location.reference,R_ESI)
  676. else
  677. cg.a_loadaddr_ref_reg(exprasmlist,methodpointer.location.reference,R_ESI);
  678. reference_release(exprasmlist,methodpointer.location.reference);
  679. end;
  680. end;
  681. end;
  682. { when calling a class method, we have to load ESI with the VMT !
  683. But, not for a class method via self }
  684. if not(po_containsself in procdefinition.procoptions) then
  685. begin
  686. if (po_classmethod in procdefinition.procoptions) and
  687. not(methodpointer.resulttype.def.deftype=classrefdef) then
  688. begin
  689. { class method needs current VMT }
  690. rg.getexplicitregisterint(exprasmlist,R_ESI);
  691. reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
  692. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg);
  693. end;
  694. { direct call to destructor: remove data }
  695. if (procdefinition.proctypeoption=potype_destructor) and
  696. is_class(methodpointer.resulttype.def) then
  697. cg.a_param_const(exprasmlist,OS_INT,1,1);
  698. { direct call to class constructor, don't allocate memory }
  699. if (procdefinition.proctypeoption=potype_constructor) and
  700. is_class(methodpointer.resulttype.def) then
  701. begin
  702. cg.a_param_const(exprasmlist,OS_INT,0,2);
  703. cg.a_param_const(exprasmlist,OS_INT,0,1);
  704. end
  705. else
  706. begin
  707. { constructor call via classreference => allocate memory }
  708. if (procdefinition.proctypeoption=potype_constructor) and
  709. (methodpointer.resulttype.def.deftype=classrefdef) and
  710. is_class(tclassrefdef(methodpointer.resulttype.def).pointertype.def) then
  711. cg.a_param_const(exprasmlist,OS_INT,1,1);
  712. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
  713. end;
  714. end;
  715. if is_con_or_destructor then
  716. begin
  717. { classes don't get a VMT pointer pushed }
  718. if is_object(methodpointer.resulttype.def) then
  719. begin
  720. if (procdefinition.proctypeoption=potype_constructor) then
  721. begin
  722. { it's no bad idea, to insert the VMT }
  723. reference_reset_symbol(href,objectlibrary.newasmsymbol(
  724. tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
  725. cg.a_paramaddr_ref(exprasmlist,href,1);
  726. end
  727. { destructors haven't to dispose the instance, if this is }
  728. { a direct call }
  729. else
  730. cg.a_param_const(exprasmlist,OS_INT,0,1);
  731. end;
  732. end;
  733. end;
  734. end;
  735. end;
  736. end
  737. else
  738. begin
  739. if (po_classmethod in procdefinition.procoptions) and
  740. not(
  741. assigned(aktprocdef) and
  742. (po_classmethod in aktprocdef.procoptions)
  743. ) then
  744. begin
  745. { class method needs current VMT }
  746. rg.getexplicitregisterint(exprasmlist,R_ESI);
  747. reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
  748. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,R_ESI);
  749. end
  750. else
  751. begin
  752. { member call, ESI isn't modified }
  753. loadesi:=false;
  754. end;
  755. { direct call to destructor: don't remove data! }
  756. if is_class(procinfo^._class) then
  757. begin
  758. if (procdefinition.proctypeoption=potype_destructor) then
  759. begin
  760. cg.a_param_const(exprasmlist,OS_INT,0,2);
  761. cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
  762. end
  763. else if (procdefinition.proctypeoption=potype_constructor) then
  764. begin
  765. cg.a_param_const(exprasmlist,OS_INT,0,2);
  766. cg.a_param_const(exprasmlist,OS_INT,0,1);
  767. end
  768. else
  769. cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
  770. end
  771. else if is_object(procinfo^._class) then
  772. begin
  773. cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
  774. if is_con_or_destructor then
  775. begin
  776. if (procdefinition.proctypeoption=potype_constructor) then
  777. begin
  778. { it's no bad idea, to insert the VMT }
  779. reference_reset_symbol(href,objectlibrary.newasmsymbol(procinfo^._class.vmt_mangledname),0);
  780. cg.a_paramaddr_ref(exprasmlist,href,1);
  781. end
  782. { destructors haven't to dispose the instance, if this is }
  783. { a direct call }
  784. else
  785. cg.a_param_const(exprasmlist,OS_INT,0,1);
  786. end;
  787. end
  788. else
  789. Internalerror(200006165);
  790. end;
  791. end;
  792. {$endif dummy}
  793. { call to BeforeDestruction? }
  794. if (procdefinition.proctypeoption=potype_destructor) and
  795. assigned(methodpointer) and
  796. (methodpointer.nodetype<>typen) and
  797. is_class(tobjectdef(methodpointer.resulttype.def)) and
  798. (inlined or
  799. (right=nil)) then
  800. begin
  801. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
  802. reference_reset_base(href,self_pointer_reg,0);
  803. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  804. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
  805. reference_reset_base(href,tmpreg,72);
  806. cg.a_call_ref(exprasmlist,href);
  807. cg.free_scratch_reg(exprasmlist,tmpreg);
  808. end;
  809. { push base pointer ?}
  810. { never when inlining, since if necessary, the base pointer }
  811. { can/will be gottten from the current procedure's symtable }
  812. { (JM) }
  813. if not inlined then
  814. if (lexlevel>=normal_function_level) and assigned(tprocdef(procdefinition).parast) and
  815. ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
  816. load_framepointer;
  817. rg.saveregvars(exprasmlist,regs_to_push);
  818. {$ifdef dummy}
  819. if (po_virtualmethod in procdefinition.procoptions) and
  820. not(no_virtual_call) then
  821. begin
  822. { static functions contain the vmt_address in ESI }
  823. { also class methods }
  824. { Here it is quite tricky because it also depends }
  825. { on the methodpointer PM }
  826. release_tmpreg:=false;
  827. rg.getexplicitregisterint(exprasmlist,R_ESI);
  828. if assigned(aktprocdef) then
  829. begin
  830. if (((sp_static in aktprocdef.procsym.symoptions) or
  831. (po_classmethod in aktprocdef.procoptions)) and
  832. ((methodpointer=nil) or (methodpointer.nodetype=typen)))
  833. or
  834. (po_staticmethod in procdefinition.procoptions) or
  835. ((procdefinition.proctypeoption=potype_constructor) and
  836. { esi contains the vmt if we call a constructor via a class ref }
  837. assigned(methodpointer) and
  838. (methodpointer.resulttype.def.deftype=classrefdef)
  839. ) or
  840. { is_interface(tprocdef(procdefinition)._class) or }
  841. { ESI is loaded earlier }
  842. (po_classmethod in procdefinition.procoptions) then
  843. begin
  844. reference_reset_base(href,R_ESI,0);
  845. end
  846. else
  847. begin
  848. { this is one point where we need vmt_offset (PM) }
  849. reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
  850. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  851. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
  852. reference_reset_base(href,tmpreg,0);
  853. release_tmpreg:=true;
  854. end;
  855. end
  856. else
  857. { aktprocdef should be assigned, also in main program }
  858. internalerror(12345);
  859. if tprocdef(procdefinition).extnumber=-1 then
  860. internalerror(44584);
  861. href.offset:=tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber);
  862. if not(is_interface(tprocdef(procdefinition)._class)) and
  863. not(is_cppclass(tprocdef(procdefinition)._class)) then
  864. begin
  865. if (cs_check_object in aktlocalswitches) then
  866. begin
  867. reference_reset_symbol(hrefvmt,objectlibrary.newasmsymbol(tprocdef(procdefinition)._class.vmt_mangledname),0);
  868. cg.a_paramaddr_ref(exprasmlist,hrefvmt,2);
  869. cg.a_param_reg(exprasmlist,OS_ADDR,href.base,1);
  870. cg.a_call_name(exprasmlist,'FPC_CHECK_OBJECT_EXT');
  871. end
  872. else if (cs_check_range in aktlocalswitches) then
  873. begin
  874. cg.a_param_reg(exprasmlist,OS_ADDR,href.base,1);
  875. cg.a_call_name(exprasmlist,'FPC_CHECK_OBJECT');
  876. end;
  877. end;
  878. cg.a_call_ref(exprasmlist,href);
  879. if release_tmpreg then
  880. cg.free_scratch_reg(exprasmlist,tmpreg);
  881. end
  882. else
  883. {$endif dummy}
  884. if not inlined then
  885. begin
  886. {$ifdef i386}
  887. { We can call interrupts from within the smae code
  888. by just pushing the flags and CS PM }
  889. if (po_interrupt in procdefinition.procoptions) then
  890. begin
  891. emit_none(A_PUSHF,S_L);
  892. emit_reg(A_PUSH,S_L,R_CS);
  893. end;
  894. {$endif i386}
  895. cg.a_call_name(exprasmlist,tprocdef(procdefinition).mangledname);
  896. end
  897. else { inlined proc }
  898. { inlined code is in inlinecode }
  899. begin
  900. { process the inlinecode }
  901. secondpass(inlinecode);
  902. { free the args }
  903. if tprocdef(procdefinition).parast.datasize>0 then
  904. tg.ungetpersistanttemp(exprasmlist,tprocdef(procdefinition).parast.address_fixup);
  905. end;
  906. end;
  907. {$ifdef dummy}
  908. else
  909. { now procedure variable case }
  910. begin
  911. secondpass(right);
  912. {$ifdef i386}
  913. if (po_interrupt in procdefinition.procoptions) then
  914. begin
  915. emit_none(A_PUSHF,S_L);
  916. emit_reg(A_PUSH,S_L,R_CS);
  917. end;
  918. {$endif i386}
  919. { procedure of object? }
  920. if (po_methodpointer in procdefinition.procoptions) then
  921. begin
  922. { method pointer can't be in a register }
  923. hregister:=R_NO;
  924. { do some hacking if we call a method pointer }
  925. { which is a class member }
  926. { else ESI is overwritten ! }
  927. if (right.location.reference.base=R_ESI) or
  928. (right.location.reference.index=R_ESI) then
  929. begin
  930. reference_release(exprasmlist,right.location.reference);
  931. hregister:=cg.get_scratch_reg_address(exprasmlist);
  932. cg.a_load_ref_reg(exprasmlist,OS_ADDR,right.location.reference,hregister);
  933. end;
  934. { load self, but not if it's already explicitly pushed }
  935. if not(po_containsself in procdefinition.procoptions) then
  936. begin
  937. { load ESI }
  938. href:=right.location.reference;
  939. inc(href.offset,4);
  940. rg.getexplicitregisterint(exprasmlist,R_ESI);
  941. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg);
  942. { push self pointer }
  943. cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,-1);
  944. end;
  945. rg.saveregvars(exprasmlist,ALL_REGISTERS);
  946. if hregister<>R_NO then
  947. reference_reset_base(href,hregister,0)
  948. else
  949. href:=right.location.reference;
  950. cg.a_call_ref(exprasmlist,href);
  951. if hregister<>R_NO then
  952. cg.free_scratch_reg(exprasmlist,hregister);
  953. reference_release(exprasmlist,right.location.reference);
  954. end
  955. else
  956. begin
  957. rg.saveregvars(exprasmlist,ALL_REGISTERS);
  958. case right.location.loc of
  959. LOC_REGISTER,LOC_CREGISTER:
  960. reference_reset_base(href,right.location.register,0);
  961. LOC_REFERENCE,LOC_CREFERENCE :
  962. href:=right.location.reference;
  963. else
  964. internalerror(200203311);
  965. end;
  966. cg.a_call_ref(exprasmlist,href);
  967. location_release(exprasmlist,right.location);
  968. end;
  969. end;
  970. {$endif dummy}
  971. {$ifdef dummy}
  972. { this was only for normal functions
  973. displaced here so we also get
  974. it to work for procvars PM }
  975. if (not inlined) and (po_clearstack in procdefinition.procoptions) then
  976. begin
  977. { we also add the pop_size which is included in pushedparasize }
  978. pop_size:=0;
  979. { better than an add on all processors }
  980. if pushedparasize=4 then
  981. begin
  982. rg.getexplicitregisterint(exprasmlist,R_EDI);
  983. emit_reg(A_POP,S_L,R_EDI);
  984. rg.ungetregisterint(exprasmlist,R_EDI);
  985. end
  986. { the pentium has two pipes and pop reg is pairable }
  987. { but the registers must be different! }
  988. else if (pushedparasize=8) and
  989. not(cs_littlesize in aktglobalswitches) and
  990. {$ifdef i386}
  991. (aktoptprocessor=ClassP5) and
  992. {$endif}
  993. (procinfo^._class=nil) then
  994. begin
  995. rg.getexplicitregisterint(exprasmlist,R_EDI);
  996. emit_reg(A_POP,S_L,R_EDI);
  997. rg.ungetregisterint(exprasmlist,R_EDI);
  998. exprasmList.concat(tai_regalloc.Alloc(R_ESI));
  999. emit_reg(A_POP,S_L,R_ESI);
  1000. exprasmList.concat(tai_regalloc.DeAlloc(R_ESI));
  1001. end
  1002. else if pushedparasize<>0 then
  1003. emit_const_reg(A_ADD,S_L,pushedparasize,R_ESP);
  1004. end;
  1005. {$endif dummy}
  1006. if procinfo^.maxpushedparasize<pushedparasize then
  1007. procinfo^.maxpushedparasize:=pushedparasize;
  1008. {$ifdef OPTALIGN}
  1009. if pop_esp then
  1010. emit_reg(A_POP,S_L,R_ESP);
  1011. {$endif OPTALIGN}
  1012. dont_call:
  1013. pushedparasize:=oldpushedparasize;
  1014. rg.restoreunusedstate(unusedstate);
  1015. {$ifdef TEMPREGDEBUG}
  1016. testregisters32;
  1017. {$endif TEMPREGDEBUG}
  1018. { a constructor could be a function with boolean result }
  1019. { if calling constructor called fail we
  1020. must jump directly to quickexitlabel PM
  1021. but only if it is a call of an inherited constructor }
  1022. if (inlined or
  1023. (right=nil)) and
  1024. (procdefinition.proctypeoption=potype_constructor) and
  1025. assigned(methodpointer) and
  1026. (methodpointer.nodetype=typen) and
  1027. (aktprocdef.proctypeoption=potype_constructor) then
  1028. begin
  1029. cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,accumulator,faillabel);
  1030. end;
  1031. { call to AfterConstruction? }
  1032. if is_class(resulttype.def) and
  1033. (inlined or
  1034. (right=nil)) and
  1035. (procdefinition.proctypeoption=potype_constructor) and
  1036. assigned(methodpointer) and
  1037. (methodpointer.nodetype<>typen) then
  1038. begin
  1039. objectlibrary.getlabel(constructorfailed);
  1040. cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,self_pointer_reg,constructorfailed);
  1041. cg.a_param_reg(exprasmlist,OS_ADDR,accumulator,paramanager.getintparaloc(1));
  1042. reference_reset_base(href,self_pointer_reg,0);
  1043. tmpreg:=cg.get_scratch_reg_address(exprasmlist);
  1044. cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
  1045. reference_reset_base(href,tmpreg,17*pointer_size);
  1046. cg.a_call_ref(exprasmlist,href);
  1047. cg.free_scratch_reg(exprasmlist,tmpreg);
  1048. exprasmList.concat(tai_regalloc.Alloc(accumulator));
  1049. cg.a_label(exprasmlist,constructorfailed);
  1050. cg.a_load_reg_reg(exprasmlist,OS_ADDR,self_pointer_reg,accumulator);
  1051. end;
  1052. { handle function results }
  1053. if (not is_void(resulttype.def)) then
  1054. begin
  1055. { structured results are easy to handle.... }
  1056. { needed also when result_no_used !! }
  1057. if paramanager.ret_in_param(resulttype.def) then
  1058. begin
  1059. location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
  1060. location.reference.symbol:=nil;
  1061. location.reference:=funcretref;
  1062. end
  1063. else
  1064. { ansi/widestrings must be registered, so we can dispose them }
  1065. if is_ansistring(resulttype.def) or
  1066. is_widestring(resulttype.def) then
  1067. begin
  1068. location_reset(location,LOC_CREFERENCE,OS_ADDR);
  1069. location.reference:=refcountedtemp;
  1070. cg.a_reg_alloc(exprasmlist,accumulator);
  1071. cg.a_load_reg_ref(exprasmlist,OS_ADDR,accumulator,location.reference);
  1072. cg.a_reg_dealloc(exprasmlist,accumulator);
  1073. end
  1074. else
  1075. { we have only to handle the result if it is used }
  1076. if (nf_return_value_used in flags) then
  1077. begin
  1078. case resulttype.def.deftype of
  1079. enumdef,
  1080. orddef :
  1081. begin
  1082. cgsize:=def_cgsize(resulttype.def);
  1083. { an object constructor is a function with boolean result }
  1084. if (inlined or (right=nil)) and
  1085. (procdefinition.proctypeoption=potype_constructor) then
  1086. begin
  1087. if extended_new then
  1088. cgsize:=OS_INT
  1089. else
  1090. begin
  1091. {$ifdef dummy}
  1092. cgsize:=OS_NO;
  1093. { this fails if popsize > 0 PM }
  1094. location_reset(location,LOC_FLAGS,OS_NO);
  1095. location.resflags:=F_NE;
  1096. {$endif dummy}
  1097. end;
  1098. end;
  1099. if cgsize<>OS_NO then
  1100. begin
  1101. location_reset(location,LOC_REGISTER,cgsize);
  1102. cg.a_reg_alloc(exprasmlist,accumulator);
  1103. if cgsize in [OS_64,OS_S64] then
  1104. begin
  1105. cg.a_reg_alloc(exprasmlist,accumulatorhigh);
  1106. if accumulatorhigh in rg.unusedregsint then
  1107. begin
  1108. location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
  1109. location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
  1110. end
  1111. else
  1112. begin
  1113. location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
  1114. location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
  1115. end;
  1116. cg64.a_load64_reg_reg(exprasmlist,joinreg64(accumulator,accumulatorhigh),
  1117. location.register64);
  1118. end
  1119. else
  1120. begin
  1121. location.register:=rg.getexplicitregisterint(exprasmlist,accumulator);
  1122. hregister:=rg.makeregsize(accumulator,cgsize);
  1123. location.register:=rg.makeregsize(location.register,cgsize);
  1124. cg.a_load_reg_reg(exprasmlist,cgsize,hregister,location.register);
  1125. end;
  1126. end;
  1127. end;
  1128. floatdef :
  1129. begin
  1130. {$ifdef dummy}
  1131. location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
  1132. location.register:=R_ST;
  1133. inc(trgcpu(rg).fpuvaroffset);
  1134. {$endif dummy}
  1135. end;
  1136. else
  1137. begin
  1138. location_reset(location,LOC_REGISTER,OS_INT);
  1139. location.register:=rg.getexplicitregisterint(exprasmlist,accumulator);
  1140. cg.a_load_reg_reg(exprasmlist,OS_INT,accumulator,location.register);
  1141. end;
  1142. end;
  1143. end;
  1144. end;
  1145. { perhaps i/o check ? }
  1146. if iolabel<>nil then
  1147. begin
  1148. reference_reset_symbol(href,iolabel,0);
  1149. cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
  1150. cg.a_call_name(exprasmlist,'FPC_IOCHECK');
  1151. end;
  1152. {$ifdef i386}
  1153. if pop_size>0 then
  1154. emit_const_reg(A_ADD,S_L,pop_size,R_ESP);
  1155. {$endif i386}
  1156. { restore registers }
  1157. rg.restoreusedregisters(exprasmlist,pushed);
  1158. { at last, restore instance pointer (SELF) }
  1159. if loadesi then
  1160. cg.g_maybe_loadself(exprasmlist);
  1161. pp:=tbinarynode(params);
  1162. while assigned(pp) do
  1163. begin
  1164. if assigned(pp.left) then
  1165. begin
  1166. location_freetemp(exprasmlist,pp.left.location);
  1167. { process also all nodes of an array of const }
  1168. if pp.left.nodetype=arrayconstructorn then
  1169. begin
  1170. if assigned(tarrayconstructornode(pp.left).left) then
  1171. begin
  1172. hp:=pp.left;
  1173. while assigned(hp) do
  1174. begin
  1175. location_freetemp(exprasmlist,tarrayconstructornode(hp).left.location);
  1176. hp:=tarrayconstructornode(hp).right;
  1177. end;
  1178. end;
  1179. end;
  1180. end;
  1181. pp:=tbinarynode(pp.right);
  1182. end;
  1183. if inlined then
  1184. begin
  1185. tg.ungetpersistanttemp(exprasmlist,inlinecode.retoffset);
  1186. tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup;
  1187. right:=inlinecode;
  1188. end;
  1189. if assigned(params) then
  1190. params.free;
  1191. { from now on the result can be freed normally }
  1192. if inlined and paramanager.ret_in_param(resulttype.def) then
  1193. tg.persistanttemptonormal(funcretref.offset);
  1194. { if return value is not used }
  1195. if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then
  1196. begin
  1197. if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
  1198. begin
  1199. { data which must be finalized ? }
  1200. if (resulttype.def.needs_inittable) then
  1201. cg.g_finalize(exprasmlist,resulttype.def,location.reference,false);
  1202. { release unused temp }
  1203. tg.ungetiftemp(exprasmlist,location.reference)
  1204. end
  1205. else if location.loc=LOC_FPUREGISTER then
  1206. begin
  1207. {$ifdef i386}
  1208. { release FPU stack }
  1209. emit_reg(A_FSTP,S_NO,R_ST);
  1210. {
  1211. dec(trgcpu(rg).fpuvaroffset);
  1212. do NOT decrement as the increment before
  1213. is not called for unused results PM }
  1214. {$endif i386}
  1215. end;
  1216. end;
  1217. end;
  1218. {*****************************************************************************
  1219. TCGPROCINLINENODE
  1220. *****************************************************************************}
  1221. procedure tcgprocinlinenode.pass_2;
  1222. var st : tsymtable;
  1223. oldprocdef : tprocdef;
  1224. ps, i : longint;
  1225. tmpreg: tregister;
  1226. oldprocinfo : pprocinfo;
  1227. oldinlining_procedure,
  1228. nostackframe,make_global : boolean;
  1229. inlineentrycode,inlineexitcode : TAAsmoutput;
  1230. oldexitlabel,oldexit2label,oldquickexitlabel:tasmlabel;
  1231. oldregstate: pointer;
  1232. {$ifdef GDB}
  1233. startlabel,endlabel : tasmlabel;
  1234. pp : pchar;
  1235. mangled_length : longint;
  1236. {$endif GDB}
  1237. begin
  1238. { deallocate the registers used for the current procedure's regvars }
  1239. if assigned(aktprocdef.regvarinfo) then
  1240. begin
  1241. with pregvarinfo(aktprocdef.regvarinfo)^ do
  1242. for i := 1 to maxvarregs do
  1243. if assigned(regvars[i]) then
  1244. store_regvar(exprasmlist,regvars[i].reg);
  1245. rg.saveStateForInline(oldregstate);
  1246. { make sure the register allocator knows what the regvars in the }
  1247. { inlined code block are (JM) }
  1248. rg.resetusableregisters;
  1249. rg.clearregistercount;
  1250. rg.cleartempgen;
  1251. if assigned(inlineprocdef.regvarinfo) then
  1252. with pregvarinfo(inlineprocdef.regvarinfo)^ do
  1253. for i := 1 to maxvarregs do
  1254. if assigned(regvars[i]) then
  1255. begin
  1256. tmpreg:=rg.makeregsize(regvars[i].reg,OS_INT);
  1257. rg.makeregvar(tmpreg);
  1258. end;
  1259. end;
  1260. oldinlining_procedure:=inlining_procedure;
  1261. oldexitlabel:=aktexitlabel;
  1262. oldexit2label:=aktexit2label;
  1263. oldquickexitlabel:=quickexitlabel;
  1264. objectlibrary.getlabel(aktexitlabel);
  1265. objectlibrary.getlabel(aktexit2label);
  1266. { we're inlining a procedure }
  1267. inlining_procedure:=true;
  1268. { save old procinfo }
  1269. oldprocdef:=aktprocdef;
  1270. getmem(oldprocinfo,sizeof(tprocinfo));
  1271. move(procinfo^,oldprocinfo^,sizeof(tprocinfo));
  1272. { set new procinfo }
  1273. aktprocdef:=inlineprocdef;
  1274. procinfo^.return_offset:=retoffset;
  1275. procinfo^.para_offset:=para_offset;
  1276. procinfo^.no_fast_exit:=false;
  1277. { arg space has been filled by the parent secondcall }
  1278. st:=aktprocdef.localst;
  1279. { set it to the same lexical level }
  1280. st.symtablelevel:=oldprocdef.localst.symtablelevel;
  1281. if st.datasize>0 then
  1282. begin
  1283. st.address_fixup:=tg.gettempofsizepersistant(exprasmlist,st.datasize)+st.datasize;
  1284. {$ifdef extdebug}
  1285. Comment(V_debug,'local symtable is at offset '+tostr(st.address_fixup));
  1286. exprasmList.concat(Tai_asm_comment.Create(strpnew(
  1287. 'local symtable is at offset '+tostr(st.address_fixup))));
  1288. {$endif extdebug}
  1289. end;
  1290. exprasmList.concat(Tai_Marker.Create(InlineStart));
  1291. {$ifdef extdebug}
  1292. exprasmList.concat(Tai_asm_comment.Create(strpnew('Start of inlined proc')));
  1293. {$endif extdebug}
  1294. {$ifdef GDB}
  1295. if (cs_debuginfo in aktmoduleswitches) then
  1296. begin
  1297. objectlibrary.getaddrlabel(startlabel);
  1298. objectlibrary.getaddrlabel(endlabel);
  1299. cg.a_label(exprasmlist,startlabel);
  1300. inlineprocdef.localst.symtabletype:=inlinelocalsymtable;
  1301. inlineprocdef.parast.symtabletype:=inlineparasymtable;
  1302. { Here we must include the para and local symtable info }
  1303. inlineprocdef.concatstabto(withdebuglist);
  1304. { set it back for safety }
  1305. inlineprocdef.localst.symtabletype:=localsymtable;
  1306. inlineprocdef.parast.symtabletype:=parasymtable;
  1307. mangled_length:=length(oldprocdef.mangledname);
  1308. getmem(pp,mangled_length+50);
  1309. strpcopy(pp,'192,0,0,'+startlabel.name);
  1310. if (target_info.use_function_relative_addresses) then
  1311. begin
  1312. strpcopy(strend(pp),'-');
  1313. strpcopy(strend(pp),oldprocdef.mangledname);
  1314. end;
  1315. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  1316. end;
  1317. {$endif GDB}
  1318. { takes care of local data initialization }
  1319. inlineentrycode:=TAAsmoutput.Create;
  1320. inlineexitcode:=TAAsmoutput.Create;
  1321. ps:=para_size;
  1322. make_global:=false; { to avoid warning }
  1323. genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
  1324. if po_assembler in aktprocdef.procoptions then
  1325. inlineentrycode.insert(Tai_marker.Create(asmblockstart));
  1326. exprasmList.concatlist(inlineentrycode);
  1327. secondpass(inlinetree);
  1328. genexitcode(inlineexitcode,0,false,true);
  1329. if po_assembler in aktprocdef.procoptions then
  1330. inlineexitcode.concat(Tai_marker.Create(asmblockend));
  1331. exprasmList.concatlist(inlineexitcode);
  1332. inlineentrycode.free;
  1333. inlineexitcode.free;
  1334. {$ifdef extdebug}
  1335. exprasmList.concat(Tai_asm_comment.Create(strpnew('End of inlined proc')));
  1336. {$endif extdebug}
  1337. exprasmList.concat(Tai_Marker.Create(InlineEnd));
  1338. {we can free the local data now, reset also the fixup address }
  1339. if st.datasize>0 then
  1340. begin
  1341. tg.ungetpersistanttemp(exprasmlist,st.address_fixup-st.datasize);
  1342. st.address_fixup:=0;
  1343. end;
  1344. { restore procinfo }
  1345. move(oldprocinfo^,procinfo^,sizeof(tprocinfo));
  1346. freemem(oldprocinfo,sizeof(tprocinfo));
  1347. {$ifdef GDB}
  1348. if (cs_debuginfo in aktmoduleswitches) then
  1349. begin
  1350. cg.a_label(exprasmlist,endlabel);
  1351. strpcopy(pp,'224,0,0,'+endlabel.name);
  1352. if (target_info.use_function_relative_addresses) then
  1353. begin
  1354. strpcopy(strend(pp),'-');
  1355. strpcopy(strend(pp),oldprocdef.mangledname);
  1356. end;
  1357. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  1358. freemem(pp,mangled_length+50);
  1359. end;
  1360. {$endif GDB}
  1361. { restore }
  1362. aktprocdef:=oldprocdef;
  1363. aktexitlabel:=oldexitlabel;
  1364. aktexit2label:=oldexit2label;
  1365. quickexitlabel:=oldquickexitlabel;
  1366. inlining_procedure:=oldinlining_procedure;
  1367. { reallocate the registers used for the current procedure's regvars, }
  1368. { since they may have been used and then deallocated in the inlined }
  1369. { procedure (JM) }
  1370. if assigned(aktprocdef.regvarinfo) then
  1371. begin
  1372. rg.restoreStateAfterInline(oldregstate);
  1373. end;
  1374. end;
  1375. begin
  1376. ccallparanode:=tcgcallparanode;
  1377. ccallnode:=tcgcallnode;
  1378. cprocinlinenode:=tcgprocinlinenode;
  1379. end.
  1380. {
  1381. $Log$
  1382. Revision 1.9 2002-08-13 21:40:55 florian
  1383. * more fixes for ppc calling conventions
  1384. Revision 1.8 2002/08/13 18:01:51 carl
  1385. * rename swatoperands to swapoperands
  1386. + m68k first compilable version (still needs a lot of testing):
  1387. assembler generator, system information , inline
  1388. assembler reader.
  1389. Revision 1.7 2002/08/12 15:08:39 carl
  1390. + stab register indexes for powerpc (moved from gdb to cpubase)
  1391. + tprocessor enumeration moved to cpuinfo
  1392. + linker in target_info is now a class
  1393. * many many updates for m68k (will soon start to compile)
  1394. - removed some ifdef or correct them for correct cpu
  1395. Revision 1.6 2002/08/11 14:32:26 peter
  1396. * renamed current_library to objectlibrary
  1397. Revision 1.5 2002/08/11 13:24:11 peter
  1398. * saving of asmsymbols in ppu supported
  1399. * asmsymbollist global is removed and moved into a new class
  1400. tasmlibrarydata that will hold the info of a .a file which
  1401. corresponds with a single module. Added librarydata to tmodule
  1402. to keep the library info stored for the module. In the future the
  1403. objectfiles will also be stored to the tasmlibrarydata class
  1404. * all getlabel/newasmsymbol and friends are moved to the new class
  1405. Revision 1.4 2002/08/06 20:55:20 florian
  1406. * first part of ppc calling conventions fix
  1407. Revision 1.3 2002/07/20 11:57:53 florian
  1408. * types.pas renamed to defbase.pas because D6 contains a types
  1409. unit so this would conflicts if D6 programms are compiled
  1410. + Willamette/SSE2 instructions to assembler added
  1411. Revision 1.2 2002/07/13 19:38:43 florian
  1412. * some more generic calling stuff fixed
  1413. Revision 1.1 2002/07/11 14:41:28 florian
  1414. * start of the new generic parameter handling
  1415. }