n386cal.pas 75 KB

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