ncgcall.pas 74 KB

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