ncgcal.pas 70 KB

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