n386cal.pas 76 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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 defines.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,aasm,types,
  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,
  51. nmem,nld,ncnv,
  52. tainst,cga,cgobj,tgobj,n386ld,n386util,regvars,rgobj,rgcpu,cg64f32,cgcpu;
  53. {*****************************************************************************
  54. TI386CALLPARANODE
  55. *****************************************************************************}
  56. procedure ti386callparanode.secondcallparan(defcoll : TParaItem;
  57. push_from_left_to_right,inlined,is_cdecl : boolean;para_alignment,para_offset : longint);
  58. procedure maybe_push_high;
  59. begin
  60. { open array ? }
  61. { defcoll.data can be nil for read/write }
  62. if assigned(defcoll.paratype.def) and
  63. assigned(hightree) then
  64. begin
  65. secondpass(hightree);
  66. { this is a longint anyway ! }
  67. push_value_para(hightree,inlined,false,para_offset,4);
  68. end;
  69. end;
  70. var
  71. otlabel,oflabel : tasmlabel;
  72. { temporary variables: }
  73. tempdeftype : tdeftype;
  74. href : treference;
  75. begin
  76. { set default para_alignment to target_info.stackalignment }
  77. if para_alignment=0 then
  78. para_alignment:=aktalignment.paraalign;
  79. { push from left to right if specified }
  80. if push_from_left_to_right and assigned(right) then
  81. begin
  82. if (nf_varargs_para in flags) then
  83. tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
  84. inlined,is_cdecl,para_alignment,para_offset)
  85. else
  86. tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
  87. inlined,is_cdecl,para_alignment,para_offset);
  88. end;
  89. otlabel:=truelabel;
  90. oflabel:=falselabel;
  91. getlabel(truelabel);
  92. getlabel(falselabel);
  93. secondpass(left);
  94. { handle varargs first, because defcoll is not valid }
  95. if (nf_varargs_para in flags) then
  96. begin
  97. if push_addr_param(left.resulttype.def) then
  98. begin
  99. inc(pushedparasize,4);
  100. emitpushreferenceaddr(left.location.reference);
  101. location_release(exprasmlist,left.location);
  102. end
  103. else
  104. push_value_para(left,inlined,is_cdecl,para_offset,para_alignment);
  105. end
  106. { filter array constructor with c styled args }
  107. else if is_array_constructor(left.resulttype.def) and (nf_cargs in left.flags) then
  108. begin
  109. { nothing, everything is already pushed }
  110. end
  111. { in codegen.handleread.. defcoll.data is set to nil }
  112. else if assigned(defcoll.paratype.def) and
  113. (defcoll.paratype.def.deftype=formaldef) then
  114. begin
  115. { allow @var }
  116. inc(pushedparasize,4);
  117. if (left.nodetype=addrn) and
  118. (not(nf_procvarload in left.flags)) then
  119. begin
  120. { always a register }
  121. if inlined then
  122. begin
  123. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  124. emit_reg_ref(A_MOV,S_L,left.location.register,href);
  125. end
  126. else
  127. emit_reg(A_PUSH,S_L,left.location.register);
  128. rg.ungetregisterint(exprasmlist,left.location.register);
  129. end
  130. else
  131. begin
  132. if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  133. CGMessage(type_e_mismatch)
  134. else
  135. begin
  136. if inlined then
  137. begin
  138. rg.getexplicitregisterint(exprasmlist,R_EDI);
  139. emit_ref_reg(A_LEA,S_L,left.location.reference,R_EDI);
  140. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  141. emit_reg_ref(A_MOV,S_L,R_EDI,href);
  142. rg.ungetregisterint(exprasmlist,R_EDI);
  143. end
  144. else
  145. cg.a_paramaddr_ref(exprasmlist,left.location.reference,-1);
  146. location_release(exprasmlist,left.location);
  147. end;
  148. end;
  149. end
  150. { handle call by reference parameter }
  151. else if (defcoll.paratyp in [vs_var,vs_out]) then
  152. begin
  153. { get temp for constants }
  154. if left.location.loc=LOC_CONSTANT then
  155. begin
  156. tg.gettempofsizereference(exprasmlist,left.resulttype.def.size,href);
  157. cg.a_load_loc_ref(exprasmlist,left.location,href);
  158. location_reset(left.location,LOC_REFERENCE,def_cgsize(left.resulttype.def));
  159. left.location.reference:=href;
  160. end;
  161. if (left.location.loc<>LOC_REFERENCE) then
  162. begin
  163. { passing self to a var parameter is allowed in
  164. TP and delphi }
  165. if not((left.location.loc=LOC_CREFERENCE) and
  166. (left.nodetype=selfn)) then
  167. internalerror(200106041);
  168. end;
  169. maybe_push_high;
  170. if (defcoll.paratyp=vs_out) and
  171. assigned(defcoll.paratype.def) and
  172. not is_class(defcoll.paratype.def) and
  173. defcoll.paratype.def.needs_inittable then
  174. finalize(defcoll.paratype.def,left.location.reference,false);
  175. inc(pushedparasize,4);
  176. if inlined then
  177. begin
  178. rg.getexplicitregisterint(exprasmlist,R_EDI);
  179. emit_ref_reg(A_LEA,S_L,left.location.reference,R_EDI);
  180. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  181. emit_reg_ref(A_MOV,S_L,R_EDI,href);
  182. rg.ungetregisterint(exprasmlist,R_EDI);
  183. end
  184. else
  185. cg.a_paramaddr_ref(exprasmlist,left.location.reference,-1);
  186. location_release(exprasmlist,left.location);
  187. end
  188. else
  189. begin
  190. tempdeftype:=resulttype.def.deftype;
  191. if tempdeftype=filedef then
  192. CGMessage(cg_e_file_must_call_by_reference);
  193. { open array must always push the address, this is needed to
  194. also push addr of small open arrays and with cdecl functions (PFV) }
  195. if (
  196. assigned(defcoll.paratype.def) and
  197. (is_open_array(defcoll.paratype.def) or
  198. is_array_of_const(defcoll.paratype.def))
  199. ) or
  200. (
  201. push_addr_param(resulttype.def) and
  202. not is_cdecl
  203. ) then
  204. begin
  205. if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  206. begin
  207. { allow passing nil to a procvardef (methodpointer) }
  208. if (left.nodetype=typeconvn) and
  209. (left.resulttype.def.deftype=procvardef) and
  210. (ttypeconvnode(left).left.nodetype=niln) then
  211. begin
  212. tg.gettempofsizereference(exprasmlist,tcgsize2size[left.location.size],href);
  213. cg.a_load_loc_ref(exprasmlist,left.location,href);
  214. location_reset(left.location,LOC_REFERENCE,left.location.size);
  215. left.location.reference:=href;
  216. end
  217. else
  218. internalerror(200204011);
  219. end;
  220. maybe_push_high;
  221. inc(pushedparasize,4);
  222. if inlined then
  223. begin
  224. rg.getexplicitregisterint(exprasmlist,R_EDI);
  225. emit_ref_reg(A_LEA,S_L,left.location.reference,R_EDI);
  226. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  227. emit_reg_ref(A_MOV,S_L,R_EDI,href);
  228. rg.ungetregisterint(exprasmlist,R_EDI);
  229. end
  230. else
  231. cg.a_paramaddr_ref(exprasmlist,left.location.reference,-1);
  232. location_release(exprasmlist,left.location);
  233. end
  234. else
  235. begin
  236. push_value_para(left,inlined,is_cdecl,
  237. para_offset,para_alignment);
  238. end;
  239. end;
  240. truelabel:=otlabel;
  241. falselabel:=oflabel;
  242. { push from right to left }
  243. if not push_from_left_to_right and assigned(right) then
  244. begin
  245. if (nf_varargs_para in flags) then
  246. tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
  247. inlined,is_cdecl,para_alignment,para_offset)
  248. else
  249. tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
  250. inlined,is_cdecl,para_alignment,para_offset);
  251. end;
  252. end;
  253. {*****************************************************************************
  254. TI386CALLNODE
  255. *****************************************************************************}
  256. procedure ti386callnode.pass_2;
  257. var
  258. regs_to_push : tregisterset;
  259. unusedstate: pointer;
  260. pushed : tpushedsaved;
  261. funcretref,refcountedtemp : treference;
  262. hregister : tregister;
  263. oldpushedparasize : longint;
  264. { true if ESI must be loaded again after the subroutine }
  265. loadesi : boolean;
  266. { true if a virtual method must be called directly }
  267. no_virtual_call : boolean;
  268. { true if we produce a con- or destrutor in a call }
  269. is_con_or_destructor : boolean;
  270. { true if a constructor is called again }
  271. extended_new : boolean;
  272. { adress returned from an I/O-error }
  273. iolabel : tasmlabel;
  274. { lexlevel count }
  275. i : longint;
  276. { help reference pointer }
  277. href : treference;
  278. hp : tnode;
  279. pp : tbinarynode;
  280. params : tnode;
  281. inlined : boolean;
  282. inlinecode : tprocinlinenode;
  283. store_parast_fixup,
  284. para_alignment,
  285. para_offset : longint;
  286. cgsize : tcgsize;
  287. { instruction for alignement correction }
  288. { corr : paicpu;}
  289. { we must pop this size also after !! }
  290. { must_pop : boolean; }
  291. pop_size : longint;
  292. {$ifdef OPTALIGN}
  293. pop_esp : boolean;
  294. push_size : longint;
  295. {$endif OPTALIGN}
  296. pop_allowed : 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. decrstringref(resulttype.def,refcountedtemp);
  314. end
  315. else if is_ansistring(resulttype.def) then
  316. begin
  317. tg.gettempansistringreference(exprasmlist,refcountedtemp);
  318. decrstringref(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. getaddrlabel(iolabel);
  366. emitlab(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. if (not is_void(resulttype.def)) and
  445. ret_in_param(resulttype.def) then
  446. begin
  447. funcretref.symbol:=nil;
  448. {$ifdef test_dest_loc}
  449. if dest_loc_known and (dest_loc_tree=p) and
  450. (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
  451. begin
  452. funcretref:=dest_loc.reference;
  453. if assigned(dest_loc.reference.symbol) then
  454. funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
  455. in_dest_loc:=true;
  456. end
  457. else
  458. {$endif test_dest_loc}
  459. if inlined then
  460. begin
  461. reference_reset(funcretref);
  462. funcretref.offset:=tg.gettempofsizepersistant(exprasmlist,resulttype.def.size);
  463. funcretref.base:=procinfo^.framepointer;
  464. {$ifdef extdebug}
  465. Comment(V_debug,'function return value is at offset '
  466. +tostr(funcretref.offset));
  467. exprasmlist.concat(tai_asm_comment.create(
  468. strpnew('function return value is at offset '
  469. +tostr(funcretref.offset))));
  470. {$endif extdebug}
  471. end
  472. else
  473. tg.gettempofsizereference(exprasmlist,resulttype.def.size,funcretref);
  474. end;
  475. if assigned(params) then
  476. begin
  477. { be found elsewhere }
  478. if inlined then
  479. para_offset:=tprocdef(procdefinition).parast.address_fixup+
  480. tprocdef(procdefinition).parast.datasize
  481. else
  482. para_offset:=0;
  483. if not(inlined) and
  484. assigned(right) then
  485. tcallparanode(params).secondcallparan(TParaItem(tabstractprocdef(right.resulttype.def).Para.first),
  486. (po_leftright in procdefinition.procoptions),inlined,
  487. (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
  488. para_alignment,para_offset)
  489. else
  490. tcallparanode(params).secondcallparan(TParaItem(procdefinition.Para.first),
  491. (po_leftright in procdefinition.procoptions),inlined,
  492. (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
  493. para_alignment,para_offset);
  494. end;
  495. if inlined then
  496. inlinecode.retoffset:=tg.gettempofsizepersistant(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign));
  497. if ret_in_param(resulttype.def) then
  498. begin
  499. { This must not be counted for C code
  500. complex return address is removed from stack
  501. by function itself ! }
  502. {$ifdef OLD_C_STACK}
  503. inc(pushedparasize,4); { lets try without it PM }
  504. {$endif not OLD_C_STACK}
  505. if inlined then
  506. begin
  507. rg.getexplicitregisterint(exprasmlist,R_EDI);
  508. emit_ref_reg(A_LEA,S_L,funcretref,R_EDI);
  509. reference_reset_base(href,procinfo^.framepointer,inlinecode.retoffset);
  510. emit_reg_ref(A_MOV,S_L,R_EDI,href);
  511. rg.ungetregisterint(exprasmlist,R_EDI);
  512. end
  513. else
  514. emitpushreferenceaddr(funcretref);
  515. end;
  516. { procedure variable ? }
  517. if inlined or
  518. (right=nil) then
  519. begin
  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. emit_ref_reg(A_MOV,S_L,href,R_ESI)
  542. else
  543. emit_ref_reg(A_LEA,S_L,href,R_ESI);
  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. emit_const_reg(A_MOV,S_L,0,R_ESI)
  582. else
  583. begin
  584. emit_sym_ofs_reg(A_MOV,S_L,
  585. newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),
  586. 0,R_ESI);
  587. end;
  588. { emit_reg(A_PUSH,S_L,R_ESI);
  589. this is done below !! }
  590. end
  591. else
  592. { this is a member call, so ESI isn't modfied }
  593. loadesi:=false;
  594. { a class destructor needs a flag }
  595. if is_class(tobjectdef(methodpointer.resulttype.def)) and
  596. (procdefinition.proctypeoption=potype_destructor) then
  597. begin
  598. push_int(0);
  599. emit_reg(A_PUSH,S_L,R_ESI);
  600. end;
  601. if not(is_con_or_destructor and
  602. is_class(methodpointer.resulttype.def) and
  603. (procdefinition.proctypeoption in [potype_constructor,potype_destructor])
  604. ) then
  605. emit_reg(A_PUSH,S_L,R_ESI);
  606. { if an inherited con- or destructor should be }
  607. { called in a con- or destructor then a warning }
  608. { will be made }
  609. { con- and destructors need a pointer to the vmt }
  610. if is_con_or_destructor and
  611. is_object(methodpointer.resulttype.def) and
  612. assigned(aktprocdef) then
  613. begin
  614. if not(aktprocdef.proctypeoption in
  615. [potype_constructor,potype_destructor]) then
  616. CGMessage(cg_w_member_cd_call_from_method);
  617. end;
  618. { class destructors get there flag above }
  619. { constructor flags ? }
  620. if is_con_or_destructor and
  621. not(
  622. is_class(methodpointer.resulttype.def) and
  623. assigned(aktprocdef) and
  624. (aktprocdef.proctypeoption=potype_destructor)) then
  625. begin
  626. { a constructor needs also a flag }
  627. if is_class(methodpointer.resulttype.def) then
  628. push_int(0);
  629. push_int(0);
  630. end;
  631. end;
  632. hnewn:
  633. begin
  634. { extended syntax of new }
  635. { ESI must be zero }
  636. rg.getexplicitregisterint(exprasmlist,R_ESI);
  637. emit_reg_reg(A_XOR,S_L,R_ESI,R_ESI);
  638. emit_reg(A_PUSH,S_L,R_ESI);
  639. { insert the vmt }
  640. emit_sym(A_PUSH,S_L,
  641. newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname));
  642. extended_new:=true;
  643. end;
  644. hdisposen:
  645. begin
  646. secondpass(methodpointer);
  647. { destructor with extended syntax called from dispose }
  648. { hdisposen always deliver LOC_REFERENCE }
  649. rg.getexplicitregisterint(exprasmlist,R_ESI);
  650. emit_ref_reg(A_LEA,S_L,methodpointer.location.reference,R_ESI);
  651. reference_release(exprasmlist,methodpointer.location.reference);
  652. emit_reg(A_PUSH,S_L,R_ESI);
  653. emit_sym(A_PUSH,S_L,
  654. newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname));
  655. end;
  656. else
  657. begin
  658. { call to an instance member }
  659. if (symtableproc.symtabletype<>withsymtable) then
  660. begin
  661. secondpass(methodpointer);
  662. rg.getexplicitregisterint(exprasmlist,R_ESI);
  663. case methodpointer.location.loc of
  664. LOC_CREGISTER,
  665. LOC_REGISTER:
  666. begin
  667. emit_reg_reg(A_MOV,S_L,methodpointer.location.register,R_ESI);
  668. rg.ungetregisterint(exprasmlist,methodpointer.location.register);
  669. end;
  670. else
  671. begin
  672. if (methodpointer.resulttype.def.deftype=classrefdef) or
  673. is_class_or_interface(methodpointer.resulttype.def) then
  674. emit_ref_reg(A_MOV,S_L,methodpointer.location.reference,R_ESI)
  675. else
  676. emit_ref_reg(A_LEA,S_L,methodpointer.location.reference,R_ESI);
  677. reference_release(exprasmlist,methodpointer.location.reference);
  678. end;
  679. end;
  680. end;
  681. { when calling a class method, we have to load ESI with the VMT !
  682. But, not for a class method via self }
  683. if not(po_containsself in procdefinition.procoptions) then
  684. begin
  685. if (po_classmethod in procdefinition.procoptions) and
  686. not(methodpointer.resulttype.def.deftype=classrefdef) then
  687. begin
  688. { class method needs current VMT }
  689. rg.getexplicitregisterint(exprasmlist,R_ESI);
  690. reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
  691. emit_ref_reg(A_MOV,S_L,href,R_ESI);
  692. end;
  693. { direct call to destructor: remove data }
  694. if (procdefinition.proctypeoption=potype_destructor) and
  695. is_class(methodpointer.resulttype.def) then
  696. emit_const(A_PUSH,S_L,1);
  697. { direct call to class constructor, don't allocate memory }
  698. if (procdefinition.proctypeoption=potype_constructor) and
  699. is_class(methodpointer.resulttype.def) then
  700. begin
  701. emit_const(A_PUSH,S_L,0);
  702. emit_const(A_PUSH,S_L,0);
  703. end
  704. else
  705. begin
  706. { constructor call via classreference => allocate memory }
  707. if (procdefinition.proctypeoption=potype_constructor) and
  708. (methodpointer.resulttype.def.deftype=classrefdef) and
  709. is_class(tclassrefdef(methodpointer.resulttype.def).pointertype.def) then
  710. emit_const(A_PUSH,S_L,1);
  711. emit_reg(A_PUSH,S_L,R_ESI);
  712. end;
  713. end;
  714. if is_con_or_destructor then
  715. begin
  716. { classes don't get a VMT pointer pushed }
  717. if is_object(methodpointer.resulttype.def) then
  718. begin
  719. if (procdefinition.proctypeoption=potype_constructor) then
  720. begin
  721. { it's no bad idea, to insert the VMT }
  722. emit_sym(A_PUSH,S_L,newasmsymbol(
  723. tobjectdef(methodpointer.resulttype.def).vmt_mangledname));
  724. end
  725. { destructors haven't to dispose the instance, if this is }
  726. { a direct call }
  727. else
  728. push_int(0);
  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. emit_ref_reg(A_MOV,S_L,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. emit_const(A_PUSH,S_L,0);
  759. emit_reg(A_PUSH,S_L,R_ESI);
  760. end
  761. else if (procdefinition.proctypeoption=potype_constructor) then
  762. begin
  763. emit_const(A_PUSH,S_L,0);
  764. emit_const(A_PUSH,S_L,0);
  765. end
  766. else
  767. emit_reg(A_PUSH,S_L,R_ESI);
  768. end
  769. else if is_object(procinfo^._class) then
  770. begin
  771. emit_reg(A_PUSH,S_L,R_ESI);
  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. emit_sym(A_PUSH,S_L,newasmsymbol(
  778. procinfo^._class.vmt_mangledname));
  779. end
  780. { destructors haven't to dispose the instance, if this is }
  781. { a direct call }
  782. else
  783. push_int(0);
  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. emit_reg(A_PUSH,S_L,R_ESI);
  799. reference_reset_base(href,R_ESI,0);
  800. rg.getexplicitregisterint(exprasmlist,R_EDI);
  801. emit_ref_reg(A_MOV,S_L,href,R_EDI);
  802. reference_reset_base(href,R_EDI,72);
  803. emit_ref(A_CALL,S_NO,href);
  804. rg.ungetregisterint(exprasmlist,R_EDI);
  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. emit_ref(A_PUSH,S_L,href)
  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. emit_reg(A_PUSH,S_L,procinfo^.framepointer)
  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. emit_ref_reg(A_MOV,S_L,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. emit_ref_reg(A_MOV,S_L,href,hregister);
  846. end;
  847. emit_reg(A_PUSH,S_L,hregister);
  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. rg.getexplicitregisterint(exprasmlist,R_ESI);
  862. if assigned(aktprocdef) then
  863. begin
  864. if (((sp_static in aktprocdef.procsym.symoptions) or
  865. (po_classmethod in aktprocdef.procoptions)) and
  866. ((methodpointer=nil) or (methodpointer.nodetype=typen)))
  867. or
  868. (po_staticmethod in procdefinition.procoptions) or
  869. ((procdefinition.proctypeoption=potype_constructor) and
  870. { esi contains the vmt if we call a constructor via a class ref }
  871. assigned(methodpointer) and
  872. (methodpointer.resulttype.def.deftype=classrefdef)
  873. ) or
  874. { is_interface(tprocdef(procdefinition)._class) or }
  875. { ESI is loaded earlier }
  876. (po_classmethod in procdefinition.procoptions) then
  877. begin
  878. reference_reset_base(href,R_ESI,0);
  879. end
  880. else
  881. begin
  882. { this is one point where we need vmt_offset (PM) }
  883. reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
  884. rg.getexplicitregisterint(exprasmlist,R_EDI);
  885. emit_ref_reg(A_MOV,S_L,href,R_EDI);
  886. reference_reset_base(href,R_EDI,0);
  887. end;
  888. end
  889. else
  890. { aktprocdef should be assigned, also in main program }
  891. internalerror(12345);
  892. {
  893. begin
  894. new(r);
  895. reset_reference(r^);
  896. r^.base:=R_ESI;
  897. emit_ref_reg(A_MOV,S_L,r,R_EDI);
  898. new(r);
  899. reset_reference(r^);
  900. r^.base:=R_EDI;
  901. end;
  902. }
  903. if tprocdef(procdefinition).extnumber=-1 then
  904. internalerror(44584);
  905. href.offset:=tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber);
  906. if not(is_interface(tprocdef(procdefinition)._class)) and
  907. not(is_cppclass(tprocdef(procdefinition)._class)) then
  908. begin
  909. if (cs_check_object_ext in aktlocalswitches) then
  910. begin
  911. emit_sym(A_PUSH,S_L,
  912. newasmsymbol(tprocdef(procdefinition)._class.vmt_mangledname));
  913. emit_reg(A_PUSH,S_L,href.base);
  914. emitcall('FPC_CHECK_OBJECT_EXT');
  915. end
  916. else if (cs_check_range in aktlocalswitches) then
  917. begin
  918. emit_reg(A_PUSH,S_L,href.base);
  919. emitcall('FPC_CHECK_OBJECT');
  920. end;
  921. end;
  922. emit_ref(A_CALL,S_NO,href);
  923. rg.ungetregisterint(exprasmlist,R_EDI);
  924. end
  925. else if not inlined then
  926. begin
  927. { We can call interrupts from within the smae code
  928. by just pushing the flags and CS PM }
  929. if (po_interrupt in procdefinition.procoptions) then
  930. begin
  931. emit_none(A_PUSHF,S_L);
  932. emit_reg(A_PUSH,S_L,R_CS);
  933. end;
  934. emitcall(tprocdef(procdefinition).mangledname);
  935. end
  936. else { inlined proc }
  937. { inlined code is in inlinecode }
  938. begin
  939. { process the inlinecode }
  940. secondpass(inlinecode);
  941. { free the args }
  942. if tprocdef(procdefinition).parast.datasize>0 then
  943. tg.ungetpersistanttemp(exprasmlist,tprocdef(procdefinition).parast.address_fixup);
  944. end;
  945. end
  946. else
  947. { now procedure variable case }
  948. begin
  949. secondpass(right);
  950. if (po_interrupt in procdefinition.procoptions) then
  951. begin
  952. emit_none(A_PUSHF,S_L);
  953. emit_reg(A_PUSH,S_L,R_CS);
  954. end;
  955. { procedure of object? }
  956. if (po_methodpointer in procdefinition.procoptions) then
  957. begin
  958. { method pointer can't be in a register }
  959. hregister:=R_NO;
  960. { do some hacking if we call a method pointer }
  961. { which is a class member }
  962. { else ESI is overwritten ! }
  963. if (right.location.reference.base=R_ESI) or
  964. (right.location.reference.index=R_ESI) then
  965. begin
  966. reference_release(exprasmlist,right.location.reference);
  967. rg.getexplicitregisterint(exprasmlist,R_EDI);
  968. emit_ref_reg(A_MOV,S_L,right.location.reference,R_EDI);
  969. hregister:=R_EDI;
  970. end;
  971. { load self, but not if it's already explicitly pushed }
  972. if not(po_containsself in procdefinition.procoptions) then
  973. begin
  974. { load ESI }
  975. inc(right.location.reference.offset,4);
  976. rg.getexplicitregisterint(exprasmlist,R_ESI);
  977. emit_ref_reg(A_MOV,S_L,right.location.reference,R_ESI);
  978. dec(right.location.reference.offset,4);
  979. { push self pointer }
  980. emit_reg(A_PUSH,S_L,R_ESI);
  981. end;
  982. rg.saveregvars(exprasmlist,ALL_REGISTERS);
  983. if hregister=R_NO then
  984. emit_ref(A_CALL,S_NO,right.location.reference)
  985. else
  986. begin
  987. emit_reg(A_CALL,S_NO,hregister);
  988. rg.ungetregisterint(exprasmlist,hregister);
  989. end;
  990. reference_release(exprasmlist,right.location.reference);
  991. end
  992. else
  993. begin
  994. rg.saveregvars(exprasmlist,ALL_REGISTERS);
  995. case right.location.loc of
  996. LOC_REGISTER,LOC_CREGISTER:
  997. emit_reg(A_CALL,S_NO,right.location.register);
  998. LOC_REFERENCE,LOC_CREFERENCE :
  999. emit_ref(A_CALL,S_NO,right.location.reference);
  1000. else
  1001. internalerror(200203311);
  1002. end;
  1003. location_release(exprasmlist,right.location);
  1004. end;
  1005. end;
  1006. { this was only for normal functions
  1007. displaced here so we also get
  1008. it to work for procvars PM }
  1009. if (not inlined) and (po_clearstack in procdefinition.procoptions) then
  1010. begin
  1011. { we also add the pop_size which is included in pushedparasize }
  1012. pop_size:=0;
  1013. { better than an add on all processors }
  1014. if pushedparasize=4 then
  1015. begin
  1016. rg.getexplicitregisterint(exprasmlist,R_EDI);
  1017. emit_reg(A_POP,S_L,R_EDI);
  1018. rg.ungetregisterint(exprasmlist,R_EDI);
  1019. end
  1020. { the pentium has two pipes and pop reg is pairable }
  1021. { but the registers must be different! }
  1022. else if (pushedparasize=8) and
  1023. not(cs_littlesize in aktglobalswitches) and
  1024. (aktoptprocessor=ClassP5) and
  1025. (procinfo^._class=nil) then
  1026. begin
  1027. rg.getexplicitregisterint(exprasmlist,R_EDI);
  1028. emit_reg(A_POP,S_L,R_EDI);
  1029. rg.ungetregisterint(exprasmlist,R_EDI);
  1030. exprasmList.concat(Tairegalloc.Alloc(R_ESI));
  1031. emit_reg(A_POP,S_L,R_ESI);
  1032. exprasmList.concat(Tairegalloc.DeAlloc(R_ESI));
  1033. end
  1034. else if pushedparasize<>0 then
  1035. emit_const_reg(A_ADD,S_L,pushedparasize,R_ESP);
  1036. end;
  1037. {$ifdef OPTALIGN}
  1038. if pop_esp then
  1039. emit_reg(A_POP,S_L,R_ESP);
  1040. {$endif OPTALIGN}
  1041. dont_call:
  1042. pushedparasize:=oldpushedparasize;
  1043. rg.restoreunusedstate(unusedstate);
  1044. {$ifdef TEMPREGDEBUG}
  1045. testregisters32;
  1046. {$endif TEMPREGDEBUG}
  1047. { a constructor could be a function with boolean result }
  1048. { if calling constructor called fail we
  1049. must jump directly to quickexitlabel PM
  1050. but only if it is a call of an inherited constructor }
  1051. if (inlined or
  1052. (right=nil)) and
  1053. (procdefinition.proctypeoption=potype_constructor) and
  1054. assigned(methodpointer) and
  1055. (methodpointer.nodetype=typen) and
  1056. (aktprocdef.proctypeoption=potype_constructor) then
  1057. begin
  1058. emitjmp(C_Z,faillabel);
  1059. end;
  1060. { call to AfterConstruction? }
  1061. if is_class(resulttype.def) and
  1062. (inlined or
  1063. (right=nil)) and
  1064. (procdefinition.proctypeoption=potype_constructor) and
  1065. assigned(methodpointer) and
  1066. (methodpointer.nodetype<>typen) then
  1067. begin
  1068. getlabel(constructorfailed);
  1069. emitjmp(C_Z,constructorfailed);
  1070. emit_reg(A_PUSH,S_L,R_ESI);
  1071. reference_reset_base(href,R_ESI,0);
  1072. rg.getexplicitregisterint(exprasmlist,R_EDI);
  1073. emit_ref_reg(A_MOV,S_L,href,R_EDI);
  1074. reference_reset_base(href,R_EDI,68);
  1075. emit_ref(A_CALL,S_NO,href);
  1076. rg.ungetregisterint(exprasmlist,R_EDI);
  1077. exprasmList.concat(Tairegalloc.Alloc(R_EAX));
  1078. emitlab(constructorfailed);
  1079. emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX);
  1080. end;
  1081. { handle function results }
  1082. if (not is_void(resulttype.def)) then
  1083. begin
  1084. { structured results are easy to handle.... }
  1085. { needed also when result_no_used !! }
  1086. if ret_in_param(resulttype.def) then
  1087. begin
  1088. location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
  1089. location.reference.symbol:=nil;
  1090. location.reference:=funcretref;
  1091. end
  1092. else
  1093. { ansi/widestrings must be registered, so we can dispose them }
  1094. if is_ansistring(resulttype.def) or
  1095. is_widestring(resulttype.def) then
  1096. begin
  1097. location_reset(location,LOC_CREFERENCE,OS_ADDR);
  1098. location.reference:=refcountedtemp;
  1099. cg.a_reg_alloc(exprasmlist,accumulator);
  1100. cg.a_load_reg_ref(exprasmlist,OS_ADDR,accumulator,location.reference);
  1101. cg.a_reg_dealloc(exprasmlist,accumulator);
  1102. end
  1103. else
  1104. { we have only to handle the result if it is used }
  1105. if (nf_return_value_used in flags) then
  1106. begin
  1107. case resulttype.def.deftype of
  1108. enumdef,
  1109. orddef :
  1110. begin
  1111. cgsize:=def_cgsize(resulttype.def);
  1112. { an object constructor is a function with boolean result }
  1113. if (inlined or (right=nil)) and
  1114. (procdefinition.proctypeoption=potype_constructor) then
  1115. begin
  1116. if extended_new then
  1117. cgsize:=OS_INT
  1118. else
  1119. begin
  1120. cgsize:=OS_NO;
  1121. { this fails if popsize > 0 PM }
  1122. location_reset(location,LOC_FLAGS,OS_NO);
  1123. location.resflags:=F_NE;
  1124. end;
  1125. end;
  1126. if cgsize<>OS_NO then
  1127. begin
  1128. location_reset(location,LOC_REGISTER,cgsize);
  1129. cg.a_reg_alloc(exprasmlist,accumulator);
  1130. if cgsize in [OS_64,OS_S64] then
  1131. begin
  1132. cg.a_reg_alloc(exprasmlist,accumulatorhigh);
  1133. if accumulatorhigh in rg.unusedregsint then
  1134. begin
  1135. location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
  1136. location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
  1137. end
  1138. else
  1139. begin
  1140. location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
  1141. location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
  1142. end;
  1143. tcg64f32(cg).a_load64_reg_reg(exprasmlist,accumulator,accumulatorhigh,
  1144. location.registerlow,location.registerhigh);
  1145. end
  1146. else
  1147. begin
  1148. location.register:=rg.getexplicitregisterint(exprasmlist,accumulator);
  1149. hregister:=rg.makeregsize(accumulator,cgsize);
  1150. location.register:=rg.makeregsize(location.register,cgsize);
  1151. cg.a_load_reg_reg(exprasmlist,cgsize,hregister,location.register);
  1152. end;
  1153. end;
  1154. end;
  1155. floatdef :
  1156. begin
  1157. location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
  1158. location.register:=R_ST;
  1159. inc(trgcpu(rg).fpuvaroffset);
  1160. end;
  1161. else
  1162. begin
  1163. location_reset(location,LOC_REGISTER,OS_INT);
  1164. location.register:=rg.getexplicitregisterint(exprasmlist,accumulator);
  1165. cg.a_load_reg_reg(exprasmlist,OS_INT,accumulator,location.register);
  1166. end;
  1167. end;
  1168. end;
  1169. end;
  1170. { perhaps i/o check ? }
  1171. if iolabel<>nil then
  1172. begin
  1173. emit_sym(A_PUSH,S_L,iolabel);
  1174. emitcall('FPC_IOCHECK');
  1175. end;
  1176. if pop_size>0 then
  1177. emit_const_reg(A_ADD,S_L,pop_size,R_ESP);
  1178. { restore registers }
  1179. rg.restoreusedregisters(exprasmlist,pushed);
  1180. { at last, restore instance pointer (SELF) }
  1181. if loadesi then
  1182. maybe_loadself;
  1183. pp:=tbinarynode(params);
  1184. while assigned(pp) do
  1185. begin
  1186. if assigned(pp.left) then
  1187. begin
  1188. if (pp.left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  1189. tg.ungetiftemp(exprasmlist,pp.left.location.reference);
  1190. { process also all nodes of an array of const }
  1191. if pp.left.nodetype=arrayconstructorn then
  1192. begin
  1193. if assigned(tarrayconstructornode(pp.left).left) then
  1194. begin
  1195. hp:=pp.left;
  1196. while assigned(hp) do
  1197. begin
  1198. if (tarrayconstructornode(tunarynode(hp).left).location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  1199. tg.ungetiftemp(exprasmlist,tarrayconstructornode(hp).left.location.reference);
  1200. hp:=tbinarynode(hp).right;
  1201. end;
  1202. end;
  1203. end;
  1204. end;
  1205. pp:=tbinarynode(pp.right);
  1206. end;
  1207. if inlined then
  1208. begin
  1209. tg.ungetpersistanttemp(exprasmlist,inlinecode.retoffset);
  1210. tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup;
  1211. right:=inlinecode;
  1212. end;
  1213. if assigned(params) then
  1214. params.free;
  1215. { from now on the result can be freed normally }
  1216. if inlined and ret_in_param(resulttype.def) then
  1217. tg.persistanttemptonormal(funcretref.offset);
  1218. { if return value is not used }
  1219. if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then
  1220. begin
  1221. if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
  1222. begin
  1223. { data which must be finalized ? }
  1224. if (resulttype.def.needs_inittable) then
  1225. finalize(resulttype.def,location.reference,false);
  1226. { release unused temp }
  1227. tg.ungetiftemp(exprasmlist,location.reference)
  1228. end
  1229. else if location.loc=LOC_FPUREGISTER then
  1230. begin
  1231. { release FPU stack }
  1232. emit_reg(A_FSTP,S_NO,R_ST);
  1233. {
  1234. dec(trgcpu(rg).fpuvaroffset);
  1235. do NOT decrement as the increment before
  1236. is not called for unused results PM }
  1237. end;
  1238. end;
  1239. end;
  1240. {*****************************************************************************
  1241. TI386PROCINLINENODE
  1242. *****************************************************************************}
  1243. procedure ti386procinlinenode.pass_2;
  1244. var st : tsymtable;
  1245. oldprocdef : tprocdef;
  1246. ps, i : longint;
  1247. tmpreg: tregister;
  1248. oldprocinfo : pprocinfo;
  1249. oldinlining_procedure,
  1250. nostackframe,make_global : boolean;
  1251. inlineentrycode,inlineexitcode : TAAsmoutput;
  1252. oldexitlabel,oldexit2label,oldquickexitlabel:tasmlabel;
  1253. oldregstate: pointer;
  1254. {$ifdef GDB}
  1255. startlabel,endlabel : tasmlabel;
  1256. pp : pchar;
  1257. mangled_length : longint;
  1258. {$endif GDB}
  1259. begin
  1260. { deallocate the registers used for the current procedure's regvars }
  1261. if assigned(aktprocdef.regvarinfo) then
  1262. begin
  1263. with pregvarinfo(aktprocdef.regvarinfo)^ do
  1264. for i := 1 to maxvarregs do
  1265. if assigned(regvars[i]) then
  1266. store_regvar(exprasmlist,regvars[i].reg);
  1267. rg.saveStateForInline(oldregstate);
  1268. { make sure the register allocator knows what the regvars in the }
  1269. { inlined code block are (JM) }
  1270. rg.resetusableregisters;
  1271. rg.clearregistercount;
  1272. rg.cleartempgen;
  1273. if assigned(inlineprocdef.regvarinfo) then
  1274. with pregvarinfo(inlineprocdef.regvarinfo)^ do
  1275. for i := 1 to maxvarregs do
  1276. if assigned(regvars[i]) then
  1277. begin
  1278. tmpreg:=rg.makeregsize(regvars[i].reg,OS_INT);
  1279. rg.makeregvar(tmpreg);
  1280. end;
  1281. end;
  1282. oldinlining_procedure:=inlining_procedure;
  1283. oldexitlabel:=aktexitlabel;
  1284. oldexit2label:=aktexit2label;
  1285. oldquickexitlabel:=quickexitlabel;
  1286. getlabel(aktexitlabel);
  1287. getlabel(aktexit2label);
  1288. { we're inlining a procedure }
  1289. inlining_procedure:=true;
  1290. { save old procinfo }
  1291. oldprocdef:=aktprocdef;
  1292. getmem(oldprocinfo,sizeof(tprocinfo));
  1293. move(procinfo^,oldprocinfo^,sizeof(tprocinfo));
  1294. { set new procinfo }
  1295. aktprocdef:=inlineprocdef;
  1296. procinfo^.return_offset:=retoffset;
  1297. procinfo^.para_offset:=para_offset;
  1298. procinfo^.no_fast_exit:=false;
  1299. { arg space has been filled by the parent secondcall }
  1300. st:=aktprocdef.localst;
  1301. { set it to the same lexical level }
  1302. st.symtablelevel:=oldprocdef.localst.symtablelevel;
  1303. if st.datasize>0 then
  1304. begin
  1305. st.address_fixup:=tg.gettempofsizepersistant(exprasmlist,st.datasize)+st.datasize;
  1306. {$ifdef extdebug}
  1307. Comment(V_debug,'local symtable is at offset '+tostr(st.address_fixup));
  1308. exprasmList.concat(Tai_asm_comment.Create(strpnew(
  1309. 'local symtable is at offset '+tostr(st.address_fixup))));
  1310. {$endif extdebug}
  1311. end;
  1312. exprasmList.concat(Tai_Marker.Create(InlineStart));
  1313. {$ifdef extdebug}
  1314. exprasmList.concat(Tai_asm_comment.Create(strpnew('Start of inlined proc')));
  1315. {$endif extdebug}
  1316. {$ifdef GDB}
  1317. if (cs_debuginfo in aktmoduleswitches) then
  1318. begin
  1319. getaddrlabel(startlabel);
  1320. getaddrlabel(endlabel);
  1321. emitlab(startlabel);
  1322. inlineprocdef.localst.symtabletype:=inlinelocalsymtable;
  1323. inlineprocdef.parast.symtabletype:=inlineparasymtable;
  1324. { Here we must include the para and local symtable info }
  1325. inlineprocdef.concatstabto(withdebuglist);
  1326. { set it back for safety }
  1327. inlineprocdef.localst.symtabletype:=localsymtable;
  1328. inlineprocdef.parast.symtabletype:=parasymtable;
  1329. mangled_length:=length(oldprocdef.mangledname);
  1330. getmem(pp,mangled_length+50);
  1331. strpcopy(pp,'192,0,0,'+startlabel.name);
  1332. if (target_info.use_function_relative_addresses) then
  1333. begin
  1334. strpcopy(strend(pp),'-');
  1335. strpcopy(strend(pp),oldprocdef.mangledname);
  1336. end;
  1337. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  1338. end;
  1339. {$endif GDB}
  1340. { takes care of local data initialization }
  1341. inlineentrycode:=TAAsmoutput.Create;
  1342. inlineexitcode:=TAAsmoutput.Create;
  1343. ps:=para_size;
  1344. make_global:=false; { to avoid warning }
  1345. genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
  1346. if po_assembler in aktprocdef.procoptions then
  1347. inlineentrycode.insert(Tai_marker.Create(asmblockstart));
  1348. exprasmList.concatlist(inlineentrycode);
  1349. secondpass(inlinetree);
  1350. genexitcode(inlineexitcode,0,false,true);
  1351. if po_assembler in aktprocdef.procoptions then
  1352. inlineexitcode.concat(Tai_marker.Create(asmblockend));
  1353. exprasmList.concatlist(inlineexitcode);
  1354. inlineentrycode.free;
  1355. inlineexitcode.free;
  1356. {$ifdef extdebug}
  1357. exprasmList.concat(Tai_asm_comment.Create(strpnew('End of inlined proc')));
  1358. {$endif extdebug}
  1359. exprasmList.concat(Tai_Marker.Create(InlineEnd));
  1360. {we can free the local data now, reset also the fixup address }
  1361. if st.datasize>0 then
  1362. begin
  1363. tg.ungetpersistanttemp(exprasmlist,st.address_fixup-st.datasize);
  1364. st.address_fixup:=0;
  1365. end;
  1366. { restore procinfo }
  1367. move(oldprocinfo^,procinfo^,sizeof(tprocinfo));
  1368. freemem(oldprocinfo,sizeof(tprocinfo));
  1369. {$ifdef GDB}
  1370. if (cs_debuginfo in aktmoduleswitches) then
  1371. begin
  1372. emitlab(endlabel);
  1373. strpcopy(pp,'224,0,0,'+endlabel.name);
  1374. if (target_info.use_function_relative_addresses) then
  1375. begin
  1376. strpcopy(strend(pp),'-');
  1377. strpcopy(strend(pp),oldprocdef.mangledname);
  1378. end;
  1379. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  1380. freemem(pp,mangled_length+50);
  1381. end;
  1382. {$endif GDB}
  1383. { restore }
  1384. aktprocdef:=oldprocdef;
  1385. aktexitlabel:=oldexitlabel;
  1386. aktexit2label:=oldexit2label;
  1387. quickexitlabel:=oldquickexitlabel;
  1388. inlining_procedure:=oldinlining_procedure;
  1389. { reallocate the registers used for the current procedure's regvars, }
  1390. { since they may have been used and then deallocated in the inlined }
  1391. { procedure (JM) }
  1392. if assigned(aktprocdef.regvarinfo) then
  1393. begin
  1394. rg.restoreStateAfterInline(oldregstate);
  1395. end;
  1396. end;
  1397. begin
  1398. ccallparanode:=ti386callparanode;
  1399. ccallnode:=ti386callnode;
  1400. cprocinlinenode:=ti386procinlinenode;
  1401. end.
  1402. {
  1403. $Log$
  1404. Revision 1.46 2002-04-21 15:34:25 carl
  1405. * changeregsize -> rg.makeregsize
  1406. Revision 1.45 2002/04/15 19:44:21 peter
  1407. * fixed stackcheck that would be called recursively when a stack
  1408. error was found
  1409. * generic changeregsize(reg,size) for i386 register resizing
  1410. * removed some more routines from cga unit
  1411. * fixed returnvalue handling
  1412. * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
  1413. Revision 1.44 2002/04/04 19:06:10 peter
  1414. * removed unused units
  1415. * use tlocation.size in cg.a_*loc*() routines
  1416. Revision 1.43 2002/04/02 17:11:35 peter
  1417. * tlocation,treference update
  1418. * LOC_CONSTANT added for better constant handling
  1419. * secondadd splitted in multiple routines
  1420. * location_force_reg added for loading a location to a register
  1421. of a specified size
  1422. * secondassignment parses now first the right and then the left node
  1423. (this is compatible with Kylix). This saves a lot of push/pop especially
  1424. with string operations
  1425. * adapted some routines to use the new cg methods
  1426. Revision 1.42 2002/03/31 20:26:38 jonas
  1427. + a_loadfpu_* and a_loadmm_* methods in tcg
  1428. * register allocation is now handled by a class and is mostly processor
  1429. independent (+rgobj.pas and i386/rgcpu.pas)
  1430. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  1431. * some small improvements and fixes to the optimizer
  1432. * some register allocation fixes
  1433. * some fpuvaroffset fixes in the unary minus node
  1434. * push/popusedregisters is now called rg.save/restoreusedregisters and
  1435. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  1436. also better optimizable)
  1437. * fixed and optimized register saving/restoring for new/dispose nodes
  1438. * LOC_FPU locations now also require their "register" field to be set to
  1439. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  1440. - list field removed of the tnode class because it's not used currently
  1441. and can cause hard-to-find bugs
  1442. Revision 1.41 2002/03/04 19:10:13 peter
  1443. * removed compiler warnings
  1444. Revision 1.40 2001/12/31 09:53:15 jonas
  1445. * changed remaining "getregister32" calls to "getregisterint"
  1446. Revision 1.39 2001/12/29 15:32:13 jonas
  1447. * powerpc/cgcpu.pas compiles :)
  1448. * several powerpc-related fixes
  1449. * cpuasm unit is now based on common tainst unit
  1450. + nppcmat unit for powerpc (almost complete)
  1451. Revision 1.38 2001/11/18 00:00:34 florian
  1452. * handling of ansi- and widestring results improved
  1453. Revision 1.37 2001/11/02 23:24:40 peter
  1454. * fixed crash with inlining after aktprocdef change
  1455. Revision 1.36 2001/11/02 22:58:09 peter
  1456. * procsym definition rewrite
  1457. Revision 1.35 2001/10/25 21:22:41 peter
  1458. * calling convention rewrite
  1459. Revision 1.34 2001/10/21 12:33:07 peter
  1460. * array access for properties added
  1461. Revision 1.33 2001/09/09 08:50:15 jonas
  1462. * when calling an inline procedure inside a nested procedure, the
  1463. framepointer was being pushed on the stack, but this pushed framepointer
  1464. was never used nor removed from the stack again after the inlining was
  1465. done. It's now simply not pushed anymore, because the inlined procedure
  1466. can get the previous framepointer from the procedure in which it is being
  1467. inlined (merged)
  1468. Revision 1.32 2001/09/01 23:02:30 jonas
  1469. * i386*: call and jmp read their first operand
  1470. * cgcal: deallocate hlper register only after call statement (fixes bug
  1471. with "procedure of object" and optimizer reported to bugrep on
  1472. 2001/08/30) ('merged')
  1473. Revision 1.31 2001/08/29 12:18:08 jonas
  1474. + new createinternres() constructor for tcallnode to support setting a
  1475. custom resulttype
  1476. * compilerproc typeconversions now set the resulttype from the type
  1477. conversion for the generated call node, because the resulttype of
  1478. of the compilerproc helper isn't always exact (e.g. the ones that
  1479. return shortstrings, actually return a shortstring[x], where x is
  1480. specified by the typeconversion node)
  1481. * ti386callnode.pass_2 now always uses resulttype instead of
  1482. procsym.definition.rettype (so the custom resulttype, if any, is
  1483. always used). Note that this "rettype" stuff is only for use with
  1484. compilerprocs.
  1485. Revision 1.30 2001/08/26 13:36:56 florian
  1486. * some cg reorganisation
  1487. * some PPC updates
  1488. Revision 1.29 2001/08/19 21:11:21 florian
  1489. * some bugs fix:
  1490. - overload; with external procedures fixed
  1491. - better selection of routine to do an overloaded
  1492. type case
  1493. - ... some more
  1494. Revision 1.28 2001/08/06 21:40:50 peter
  1495. * funcret moved from tprocinfo to tprocdef
  1496. Revision 1.27 2001/07/08 21:00:16 peter
  1497. * various widestring updates, it works now mostly without charset
  1498. mapping supported
  1499. Revision 1.26 2001/07/01 20:16:20 peter
  1500. * alignmentinfo record added
  1501. * -Oa argument supports more alignment settings that can be specified
  1502. per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
  1503. RECORDMAX,LOCALMIN,LOCALMAX. It is possible to set the mimimum
  1504. required alignment and the maximum usefull alignment. The final
  1505. alignment will be choosen per variable size dependent on these
  1506. settings
  1507. Revision 1.25 2001/06/04 11:48:02 peter
  1508. * better const to var checking
  1509. Revision 1.24 2001/05/19 21:22:53 peter
  1510. * function returning int64 inlining fixed
  1511. Revision 1.23 2001/05/16 15:11:42 jonas
  1512. * added missign begin..end pair (noticed by Carl)
  1513. Revision 1.22 2001/04/18 22:02:01 peter
  1514. * registration of targets and assemblers
  1515. Revision 1.21 2001/04/13 01:22:18 peter
  1516. * symtable change to classes
  1517. * range check generation and errors fixed, make cycle DEBUG=1 works
  1518. * memory leaks fixed
  1519. Revision 1.20 2001/04/02 21:20:36 peter
  1520. * resulttype rewrite
  1521. Revision 1.19 2001/03/11 22:58:51 peter
  1522. * getsym redesign, removed the globals srsym,srsymtable
  1523. Revision 1.18 2001/01/27 21:29:35 florian
  1524. * behavior -Oa optimized
  1525. Revision 1.17 2001/01/08 21:46:46 peter
  1526. * don't push high value for open array with cdecl;external;
  1527. Revision 1.16 2000/12/25 00:07:32 peter
  1528. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  1529. tlinkedlist objects)
  1530. Revision 1.15 2000/12/09 10:45:40 florian
  1531. * AfterConstructor isn't called anymore when a constructor failed
  1532. Revision 1.14 2000/12/07 17:19:46 jonas
  1533. * new constant handling: from now on, hex constants >$7fffffff are
  1534. parsed as unsigned constants (otherwise, $80000000 got sign extended
  1535. and became $ffffffff80000000), all constants in the longint range
  1536. become longints, all constants >$7fffffff and <=cardinal($ffffffff)
  1537. are cardinals and the rest are int64's.
  1538. * added lots of longint typecast to prevent range check errors in the
  1539. compiler and rtl
  1540. * type casts of symbolic ordinal constants are now preserved
  1541. * fixed bug where the original resulttype.def wasn't restored correctly
  1542. after doing a 64bit rangecheck
  1543. Revision 1.13 2000/12/05 11:44:33 jonas
  1544. + new integer regvar handling, should be much more efficient
  1545. Revision 1.12 2000/12/03 22:26:54 florian
  1546. * fixed web buzg 1275: problem with int64 functions results
  1547. Revision 1.11 2000/11/29 00:30:46 florian
  1548. * unused units removed from uses clause
  1549. * some changes for widestrings
  1550. Revision 1.10 2000/11/23 13:26:34 jonas
  1551. * fix for webbug 1066/1126
  1552. Revision 1.9 2000/11/22 15:12:06 jonas
  1553. * fixed inline-related problems (partially "merges")
  1554. Revision 1.8 2000/11/17 09:54:58 florian
  1555. * INT_CHECK_OBJECT_* isn't applied to interfaces anymore
  1556. Revision 1.7 2000/11/12 23:24:14 florian
  1557. * interfaces are basically running
  1558. Revision 1.6 2000/11/07 23:40:49 florian
  1559. + AfterConstruction and BeforeDestruction impemented
  1560. Revision 1.5 2000/11/06 23:15:01 peter
  1561. * added copyvaluepara call again
  1562. Revision 1.4 2000/11/04 14:25:23 florian
  1563. + merged Attila's changes for interfaces, not tested yet
  1564. Revision 1.3 2000/11/04 13:12:14 jonas
  1565. * check for nil pointers before calling getcopy
  1566. Revision 1.2 2000/10/31 22:02:56 peter
  1567. * symtable splitted, no real code changes
  1568. Revision 1.1 2000/10/15 09:33:31 peter
  1569. * moved n386*.pas to i386/ cpu_target dir
  1570. Revision 1.2 2000/10/14 10:14:48 peter
  1571. * moehrendorf oct 2000 rewrite
  1572. Revision 1.1 2000/10/10 17:31:56 florian
  1573. * initial revision
  1574. }