cg386cal.pas 66 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503
  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 by
  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. {$ifdef FPC}
  19. {$goto on}
  20. {$endif FPC}
  21. unit cg386cal;
  22. interface
  23. { $define AnsiStrRef}
  24. uses
  25. symtable,tree;
  26. procedure secondcallparan(var p : ptree;defcoll : pparaitem;
  27. push_from_left_to_right,inlined : boolean;para_alignment,para_offset : longint);
  28. procedure secondcalln(var p : ptree);
  29. procedure secondprocinline(var p : ptree);
  30. implementation
  31. uses
  32. globtype,systems,
  33. cobjects,verbose,globals,
  34. symconst,aasm,types,
  35. {$ifdef GDB}
  36. strings,gdb,
  37. {$endif GDB}
  38. hcodegen,temp_gen,pass_2,
  39. cpubase,cpuasm,
  40. cgai386,tgeni386,cg386ld;
  41. {*****************************************************************************
  42. SecondCallParaN
  43. *****************************************************************************}
  44. procedure secondcallparan(var p : ptree;defcoll : pparaitem;
  45. push_from_left_to_right,inlined : boolean;para_alignment,para_offset : longint);
  46. procedure maybe_push_high;
  47. begin
  48. { open array ? }
  49. { defcoll^.data can be nil for read/write }
  50. if assigned(defcoll^.paratype.def) and
  51. push_high_param(defcoll^.paratype.def) then
  52. begin
  53. if assigned(p^.hightree) then
  54. begin
  55. secondpass(p^.hightree);
  56. { this is a longint anyway ! }
  57. push_value_para(p^.hightree,inlined,para_offset,4);
  58. end
  59. else
  60. internalerror(432645);
  61. end;
  62. end;
  63. var
  64. otlabel,oflabel : pasmlabel;
  65. { temporary variables: }
  66. tempdeftype : tdeftype;
  67. r : preference;
  68. begin
  69. { set default para_alignment to target_os.stackalignment }
  70. if para_alignment=0 then
  71. para_alignment:=target_os.stackalignment;
  72. { push from left to right if specified }
  73. if push_from_left_to_right and assigned(p^.right) then
  74. secondcallparan(p^.right,pparaitem(defcoll^.next),push_from_left_to_right,
  75. inlined,para_alignment,para_offset);
  76. otlabel:=truelabel;
  77. oflabel:=falselabel;
  78. getlabel(truelabel);
  79. getlabel(falselabel);
  80. secondpass(p^.left);
  81. { filter array constructor with c styled args }
  82. if is_array_constructor(p^.left^.resulttype) and p^.left^.cargs then
  83. begin
  84. { nothing, everything is already pushed }
  85. end
  86. { in codegen.handleread.. defcoll^.data is set to nil }
  87. else if assigned(defcoll^.paratype.def) and
  88. (defcoll^.paratype.def^.deftype=formaldef) then
  89. begin
  90. { allow @var }
  91. inc(pushedparasize,4);
  92. if p^.left^.treetype=addrn then
  93. begin
  94. { always a register }
  95. if inlined then
  96. begin
  97. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  98. emit_reg_ref(A_MOV,S_L,
  99. p^.left^.location.register,r);
  100. end
  101. else
  102. emit_reg(A_PUSH,S_L,p^.left^.location.register);
  103. ungetregister32(p^.left^.location.register);
  104. end
  105. else
  106. begin
  107. if not(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  108. CGMessage(type_e_mismatch)
  109. else
  110. begin
  111. if inlined then
  112. begin
  113. {$ifndef noAllocEdi}
  114. getexplicitregister32(R_EDI);
  115. {$endif noAllocEdi}
  116. emit_ref_reg(A_LEA,S_L,
  117. newreference(p^.left^.location.reference),R_EDI);
  118. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  119. emit_reg_ref(A_MOV,S_L,R_EDI,r);
  120. {$ifndef noAllocEdi}
  121. ungetregister32(R_EDI);
  122. {$endif noAllocEdi}
  123. end
  124. else
  125. emitpushreferenceaddr(p^.left^.location.reference);
  126. del_reference(p^.left^.location.reference);
  127. end;
  128. end;
  129. end
  130. { handle call by reference parameter }
  131. else if (defcoll^.paratyp=vs_var) then
  132. begin
  133. if (p^.left^.location.loc<>LOC_REFERENCE) then
  134. CGMessage(cg_e_var_must_be_reference);
  135. maybe_push_high;
  136. inc(pushedparasize,4);
  137. if inlined then
  138. begin
  139. {$ifndef noAllocEdi}
  140. getexplicitregister32(R_EDI);
  141. {$endif noAllocEdi}
  142. emit_ref_reg(A_LEA,S_L,
  143. newreference(p^.left^.location.reference),R_EDI);
  144. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  145. emit_reg_ref(A_MOV,S_L,R_EDI,r);
  146. {$ifndef noAllocEdi}
  147. ungetregister32(R_EDI);
  148. {$endif noAllocEdi}
  149. end
  150. else
  151. emitpushreferenceaddr(p^.left^.location.reference);
  152. del_reference(p^.left^.location.reference);
  153. end
  154. else
  155. begin
  156. tempdeftype:=p^.resulttype^.deftype;
  157. if tempdeftype=filedef then
  158. CGMessage(cg_e_file_must_call_by_reference);
  159. { open array must always push the address, this is needed to
  160. also push addr of small arrays (PFV) }
  161. if (assigned(defcoll^.paratype.def) and
  162. is_open_array(defcoll^.paratype.def)) or
  163. push_addr_param(p^.resulttype) then
  164. begin
  165. maybe_push_high;
  166. inc(pushedparasize,4);
  167. if inlined then
  168. begin
  169. {$ifndef noAllocEdi}
  170. getexplicitregister32(R_EDI);
  171. {$endif noAllocEdi}
  172. emit_ref_reg(A_LEA,S_L,
  173. newreference(p^.left^.location.reference),R_EDI);
  174. r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
  175. emit_reg_ref(A_MOV,S_L,R_EDI,r);
  176. {$ifndef noAllocEdi}
  177. ungetregister32(R_EDI);
  178. {$endif noAllocEdi}
  179. end
  180. else
  181. emitpushreferenceaddr(p^.left^.location.reference);
  182. del_reference(p^.left^.location.reference);
  183. end
  184. else
  185. begin
  186. push_value_para(p^.left,inlined,para_offset,para_alignment);
  187. end;
  188. end;
  189. truelabel:=otlabel;
  190. falselabel:=oflabel;
  191. { push from right to left }
  192. if not push_from_left_to_right and assigned(p^.right) then
  193. secondcallparan(p^.right,pparaitem(defcoll^.next),push_from_left_to_right,
  194. inlined,para_alignment,para_offset);
  195. end;
  196. {*****************************************************************************
  197. SecondCallN
  198. *****************************************************************************}
  199. procedure secondcalln(var p : ptree);
  200. var
  201. unusedregisters : tregisterset;
  202. usablecount : byte;
  203. pushed : tpushed;
  204. hr,funcretref : treference;
  205. hregister,hregister2 : tregister;
  206. oldpushedparasize : longint;
  207. { true if ESI must be loaded again after the subroutine }
  208. loadesi : boolean;
  209. { true if a virtual method must be called directly }
  210. no_virtual_call : boolean;
  211. { true if we produce a con- or destrutor in a call }
  212. is_con_or_destructor : boolean;
  213. { true if a constructor is called again }
  214. extended_new : boolean;
  215. { adress returned from an I/O-error }
  216. iolabel : pasmlabel;
  217. { lexlevel count }
  218. i : longint;
  219. { help reference pointer }
  220. r : preference;
  221. hp,
  222. pp,params : ptree;
  223. inlined : boolean;
  224. inlinecode : ptree;
  225. para_alignment,
  226. para_offset : longint;
  227. { instruction for alignement correction }
  228. { corr : paicpu;}
  229. { we must pop this size also after !! }
  230. { must_pop : boolean; }
  231. pop_size : longint;
  232. pop_allowed : boolean;
  233. label
  234. dont_call;
  235. begin
  236. reset_reference(p^.location.reference);
  237. extended_new:=false;
  238. iolabel:=nil;
  239. inlinecode:=nil;
  240. inlined:=false;
  241. loadesi:=true;
  242. no_virtual_call:=false;
  243. unusedregisters:=unused;
  244. usablecount:=usablereg32;
  245. if (pocall_cdecl in p^.procdefinition^.proccalloptions) or
  246. (pocall_stdcall in p^.procdefinition^.proccalloptions) then
  247. para_alignment:=4
  248. else
  249. para_alignment:=target_os.stackalignment;
  250. if not assigned(p^.procdefinition) then
  251. exit;
  252. if (pocall_inline in p^.procdefinition^.proccalloptions) then
  253. begin
  254. inlined:=true;
  255. inlinecode:=p^.right;
  256. { set it to the same lexical level as the local symtable, becuase
  257. the para's are stored there }
  258. pprocdef(p^.procdefinition)^.parast^.symtablelevel:=aktprocsym^.definition^.localst^.symtablelevel;
  259. if assigned(p^.left) then
  260. inlinecode^.para_offset:=gettempofsizepersistant(inlinecode^.para_size);
  261. pprocdef(p^.procdefinition)^.parast^.address_fixup:=inlinecode^.para_offset;
  262. {$ifdef extdebug}
  263. Comment(V_debug,
  264. 'inlined parasymtable is at offset '
  265. +tostr(pprocdef(p^.procdefinition)^.parast^.address_fixup));
  266. exprasmlist^.concat(new(pai_asm_comment,init(
  267. strpnew('inlined parasymtable is at offset '
  268. +tostr(pprocdef(p^.procdefinition)^.parast^.address_fixup)))));
  269. {$endif extdebug}
  270. p^.right:=nil;
  271. { disable further inlining of the same proc
  272. in the args }
  273. {$ifdef INCLUDEOK}
  274. exclude(p^.procdefinition^.proccalloptions,pocall_inline);
  275. {$else}
  276. p^.procdefinition^.proccalloptions:=p^.procdefinition^.proccalloptions-[pocall_inline];
  277. {$endif}
  278. end;
  279. { only if no proc var }
  280. if not(assigned(p^.right)) then
  281. is_con_or_destructor:=(p^.procdefinition^.proctypeoption in [potype_constructor,potype_destructor]);
  282. { proc variables destroy all registers }
  283. if (p^.right=nil) and
  284. { virtual methods too }
  285. not(po_virtualmethod in p^.procdefinition^.procoptions) then
  286. begin
  287. if (cs_check_io in aktlocalswitches) and
  288. (po_iocheck in p^.procdefinition^.procoptions) and
  289. not(po_iocheck in aktprocsym^.definition^.procoptions) then
  290. begin
  291. getlabel(iolabel);
  292. emitlab(iolabel);
  293. end
  294. else
  295. iolabel:=nil;
  296. { save all used registers }
  297. pushusedregisters(pushed,pprocdef(p^.procdefinition)^.usedregisters);
  298. { give used registers through }
  299. usedinproc:=usedinproc or pprocdef(p^.procdefinition)^.usedregisters;
  300. end
  301. else
  302. begin
  303. pushusedregisters(pushed,$ff);
  304. usedinproc:=$ff;
  305. { no IO check for methods and procedure variables }
  306. iolabel:=nil;
  307. end;
  308. { generate the code for the parameter and push them }
  309. oldpushedparasize:=pushedparasize;
  310. pushedparasize:=0;
  311. pop_size:=0;
  312. { no inc esp for inlined procedure
  313. and for objects constructors PM }
  314. if inlined or
  315. ((p^.right=nil) and
  316. (p^.procdefinition^.proctypeoption=potype_constructor) and
  317. { quick'n'dirty check if it is a class or an object }
  318. (p^.resulttype^.deftype=orddef)) then
  319. pop_allowed:=false
  320. else
  321. pop_allowed:=true;
  322. if pop_allowed then
  323. begin
  324. { Old pushedsize aligned on 4 ? }
  325. i:=oldpushedparasize and 3;
  326. if i>0 then
  327. inc(pop_size,4-i);
  328. { This parasize aligned on 4 ? }
  329. i:=p^.procdefinition^.para_size(para_alignment) and 3;
  330. if i>0 then
  331. inc(pop_size,4-i);
  332. { insert the opcode and update pushedparasize }
  333. { never push 4 or more !! }
  334. pop_size:=pop_size mod 4;
  335. if pop_size>0 then
  336. begin
  337. inc(pushedparasize,pop_size);
  338. emit_const_reg(A_SUB,S_L,pop_size,R_ESP);
  339. {$ifdef GDB}
  340. if (cs_debuginfo in aktmoduleswitches) and
  341. (exprasmlist^.first=exprasmlist^.last) then
  342. exprasmlist^.concat(new(pai_force_line,init));
  343. {$endif GDB}
  344. end;
  345. end;
  346. if (p^.resulttype<>pdef(voiddef)) and
  347. ret_in_param(p^.resulttype) then
  348. begin
  349. funcretref.symbol:=nil;
  350. {$ifdef test_dest_loc}
  351. if dest_loc_known and (dest_loc_tree=p) and
  352. (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
  353. begin
  354. funcretref:=dest_loc.reference;
  355. if assigned(dest_loc.reference.symbol) then
  356. funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
  357. in_dest_loc:=true;
  358. end
  359. else
  360. {$endif test_dest_loc}
  361. if inlined then
  362. begin
  363. reset_reference(funcretref);
  364. funcretref.offset:=gettempofsizepersistant(p^.procdefinition^.rettype.def^.size);
  365. funcretref.base:=procinfo^.framepointer;
  366. end
  367. else
  368. gettempofsizereference(p^.procdefinition^.rettype.def^.size,funcretref);
  369. end;
  370. if assigned(p^.left) then
  371. begin
  372. { be found elsewhere }
  373. if inlined then
  374. para_offset:=pprocdef(p^.procdefinition)^.parast^.address_fixup+
  375. pprocdef(p^.procdefinition)^.parast^.datasize
  376. else
  377. para_offset:=0;
  378. if assigned(p^.right) then
  379. secondcallparan(p^.left,pparaitem(pabstractprocdef(p^.right^.resulttype)^.para^.first),
  380. (pocall_leftright in p^.procdefinition^.proccalloptions),
  381. inlined,para_alignment,para_offset)
  382. else
  383. secondcallparan(p^.left,pparaitem(p^.procdefinition^.para^.first),
  384. (pocall_leftright in p^.procdefinition^.proccalloptions),
  385. inlined,para_alignment,para_offset);
  386. end;
  387. params:=p^.left;
  388. p^.left:=nil;
  389. if inlined then
  390. inlinecode^.retoffset:=gettempofsizepersistant(4);
  391. if ret_in_param(p^.resulttype) then
  392. begin
  393. { This must not be counted for C code
  394. complex return address is removed from stack
  395. by function itself ! }
  396. {$ifdef OLD_C_STACK}
  397. inc(pushedparasize,4); { lets try without it PM }
  398. {$endif not OLD_C_STACK}
  399. if inlined then
  400. begin
  401. {$ifndef noAllocEdi}
  402. getexplicitregister32(R_EDI);
  403. {$endif noAllocEdi}
  404. emit_ref_reg(A_LEA,S_L,
  405. newreference(funcretref),R_EDI);
  406. r:=new_reference(procinfo^.framepointer,inlinecode^.retoffset);
  407. emit_reg_ref(A_MOV,S_L,R_EDI,r);
  408. {$ifndef noAllocEdi}
  409. ungetregister32(R_EDI);
  410. {$endif noAllocEdi}
  411. end
  412. else
  413. emitpushreferenceaddr(funcretref);
  414. end;
  415. { procedure variable ? }
  416. if (p^.right=nil) then
  417. begin
  418. { overloaded operator have no symtable }
  419. { push self }
  420. if assigned(p^.symtable) and
  421. (p^.symtable^.symtabletype=withsymtable) then
  422. begin
  423. { dirty trick to avoid the secondcall below }
  424. p^.methodpointer:=genzeronode(callparan);
  425. p^.methodpointer^.location.loc:=LOC_REGISTER;
  426. {$ifndef noAllocEDI}
  427. getexplicitregister32(R_ESI);
  428. {$endif noAllocEDI}
  429. p^.methodpointer^.location.register:=R_ESI;
  430. { ARGHHH this is wrong !!!
  431. if we can init from base class for a child
  432. class that the wrong VMT will be
  433. transfered to constructor !! }
  434. p^.methodpointer^.resulttype:=
  435. ptree(pwithsymtable(p^.symtable)^.withnode)^.left^.resulttype;
  436. { change dispose type !! }
  437. p^.disposetyp:=dt_mbleft_and_method;
  438. { make a reference }
  439. new(r);
  440. reset_reference(r^);
  441. { if assigned(ptree(pwithsymtable(p^.symtable)^.withnode)^.pref) then
  442. begin
  443. r^:=ptree(pwithsymtable(p^.symtable)^.withnode)^.pref^;
  444. end
  445. else
  446. begin
  447. r^.offset:=p^.symtable^.datasize;
  448. r^.base:=procinfo^.framepointer;
  449. end; }
  450. r^:=ptree(pwithsymtable(p^.symtable)^.withnode)^.withreference^;
  451. if (not pwithsymtable(p^.symtable)^.direct_with) or
  452. pobjectdef(p^.methodpointer^.resulttype)^.is_class then
  453. emit_ref_reg(A_MOV,S_L,r,R_ESI)
  454. else
  455. emit_ref_reg(A_LEA,S_L,r,R_ESI);
  456. end;
  457. { push self }
  458. if assigned(p^.symtable) and
  459. ((p^.symtable^.symtabletype=objectsymtable) or
  460. (p^.symtable^.symtabletype=withsymtable)) then
  461. begin
  462. if assigned(p^.methodpointer) then
  463. begin
  464. {
  465. if p^.methodpointer^.resulttype=classrefdef then
  466. begin
  467. two possibilities:
  468. 1. constructor
  469. 2. class method
  470. end
  471. else }
  472. begin
  473. case p^.methodpointer^.treetype of
  474. typen:
  475. begin
  476. { direct call to inherited method }
  477. if (po_abstractmethod in p^.procdefinition^.procoptions) then
  478. begin
  479. CGMessage(cg_e_cant_call_abstract_method);
  480. goto dont_call;
  481. end;
  482. { generate no virtual call }
  483. no_virtual_call:=true;
  484. if (sp_static in p^.symtableprocentry^.symoptions) then
  485. begin
  486. { well lets put the VMT address directly into ESI }
  487. { it is kind of dirty but that is the simplest }
  488. { way to accept virtual static functions (PM) }
  489. loadesi:=true;
  490. { if no VMT just use $0 bug0214 PM }
  491. {$ifndef noAllocEDI}
  492. getexplicitregister32(R_ESI);
  493. {$endif noAllocEDI}
  494. if not(oo_has_vmt in pobjectdef(p^.methodpointer^.resulttype)^.objectoptions) then
  495. emit_const_reg(A_MOV,S_L,0,R_ESI)
  496. else
  497. begin
  498. emit_sym_ofs_reg(A_MOV,S_L,
  499. newasmsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname),
  500. 0,R_ESI);
  501. end;
  502. { emit_reg(A_PUSH,S_L,R_ESI);
  503. this is done below !! }
  504. end
  505. else
  506. { this is a member call, so ESI isn't modfied }
  507. loadesi:=false;
  508. { a class destructor needs a flag }
  509. if pobjectdef(p^.methodpointer^.resulttype)^.is_class and
  510. assigned(aktprocsym) and
  511. (aktprocsym^.definition^.proctypeoption=potype_destructor) then
  512. begin
  513. push_int(0);
  514. emit_reg(A_PUSH,S_L,R_ESI);
  515. end;
  516. if not(is_con_or_destructor and
  517. pobjectdef(p^.methodpointer^.resulttype)^.is_class and
  518. assigned(aktprocsym) and
  519. (aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor])
  520. ) then
  521. emit_reg(A_PUSH,S_L,R_ESI);
  522. { if an inherited con- or destructor should be }
  523. { called in a con- or destructor then a warning }
  524. { will be made }
  525. { con- and destructors need a pointer to the vmt }
  526. if is_con_or_destructor and
  527. not(pobjectdef(p^.methodpointer^.resulttype)^.is_class) and
  528. assigned(aktprocsym) then
  529. begin
  530. if not(aktprocsym^.definition^.proctypeoption in
  531. [potype_constructor,potype_destructor]) then
  532. CGMessage(cg_w_member_cd_call_from_method);
  533. end;
  534. { class destructors get there flag above }
  535. { constructor flags ? }
  536. if is_con_or_destructor and
  537. not(pobjectdef(p^.methodpointer^.resulttype)^.is_class and
  538. assigned(aktprocsym) and
  539. (aktprocsym^.definition^.proctypeoption=potype_destructor)) then
  540. begin
  541. { a constructor needs also a flag }
  542. if pobjectdef(p^.methodpointer^.resulttype)^.is_class then
  543. push_int(0);
  544. push_int(0);
  545. end;
  546. end;
  547. hnewn:
  548. begin
  549. { extended syntax of new }
  550. { ESI must be zero }
  551. {$ifndef noAllocEDI}
  552. getexplicitregister32(R_ESI);
  553. {$endif noAllocEDI}
  554. emit_reg_reg(A_XOR,S_L,R_ESI,R_ESI);
  555. emit_reg(A_PUSH,S_L,R_ESI);
  556. { insert the vmt }
  557. emit_sym(A_PUSH,S_L,
  558. newasmsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname));
  559. extended_new:=true;
  560. end;
  561. hdisposen:
  562. begin
  563. secondpass(p^.methodpointer);
  564. { destructor with extended syntax called from dispose }
  565. { hdisposen always deliver LOC_REFERENCE }
  566. {$ifndef noAllocEDI}
  567. getexplicitregister32(R_ESI);
  568. {$endif noAllocEDI}
  569. emit_ref_reg(A_LEA,S_L,
  570. newreference(p^.methodpointer^.location.reference),R_ESI);
  571. del_reference(p^.methodpointer^.location.reference);
  572. emit_reg(A_PUSH,S_L,R_ESI);
  573. emit_sym(A_PUSH,S_L,
  574. newasmsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname));
  575. end;
  576. else
  577. begin
  578. { call to an instance member }
  579. if (p^.symtable^.symtabletype<>withsymtable) then
  580. begin
  581. secondpass(p^.methodpointer);
  582. {$ifndef noAllocEDI}
  583. getexplicitregister32(R_ESI);
  584. {$endif noAllocEDI}
  585. case p^.methodpointer^.location.loc of
  586. LOC_CREGISTER,
  587. LOC_REGISTER:
  588. begin
  589. emit_reg_reg(A_MOV,S_L,p^.methodpointer^.location.register,R_ESI);
  590. ungetregister32(p^.methodpointer^.location.register);
  591. end;
  592. else
  593. begin
  594. if (p^.methodpointer^.resulttype^.deftype=classrefdef) or
  595. ((p^.methodpointer^.resulttype^.deftype=objectdef) and
  596. pobjectdef(p^.methodpointer^.resulttype)^.is_class) then
  597. emit_ref_reg(A_MOV,S_L,
  598. newreference(p^.methodpointer^.location.reference),R_ESI)
  599. else
  600. emit_ref_reg(A_LEA,S_L,
  601. newreference(p^.methodpointer^.location.reference),R_ESI);
  602. del_reference(p^.methodpointer^.location.reference);
  603. end;
  604. end;
  605. end;
  606. { when calling a class method, we have to load ESI with the VMT !
  607. But, not for a class method via self }
  608. if not(po_containsself in p^.procdefinition^.procoptions) then
  609. begin
  610. if (po_classmethod in p^.procdefinition^.procoptions) and
  611. not(p^.methodpointer^.resulttype^.deftype=classrefdef) then
  612. begin
  613. { class method needs current VMT }
  614. getexplicitregister32(R_ESI);
  615. new(r);
  616. reset_reference(r^);
  617. r^.base:=R_ESI;
  618. r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
  619. emit_ref_reg(A_MOV,S_L,r,R_ESI);
  620. end;
  621. { direct call to destructor: remove data }
  622. if (p^.procdefinition^.proctypeoption=potype_destructor) and
  623. (p^.methodpointer^.resulttype^.deftype=objectdef) and
  624. (pobjectdef(p^.methodpointer^.resulttype)^.is_class) then
  625. emit_const(A_PUSH,S_L,1);
  626. { direct call to class constructor, don't allocate memory }
  627. if (p^.procdefinition^.proctypeoption=potype_constructor) and
  628. (p^.methodpointer^.resulttype^.deftype=objectdef) and
  629. (pobjectdef(p^.methodpointer^.resulttype)^.is_class) then
  630. begin
  631. emit_const(A_PUSH,S_L,0);
  632. emit_const(A_PUSH,S_L,0);
  633. end
  634. else
  635. begin
  636. { constructor call via classreference => allocate memory }
  637. if (p^.procdefinition^.proctypeoption=potype_constructor) and
  638. (p^.methodpointer^.resulttype^.deftype=classrefdef) and
  639. (pobjectdef(pclassrefdef(p^.methodpointer^.resulttype)^.pointertype.def)^.is_class) then
  640. emit_const(A_PUSH,S_L,1);
  641. emit_reg(A_PUSH,S_L,R_ESI);
  642. end;
  643. end;
  644. if is_con_or_destructor then
  645. begin
  646. { classes don't get a VMT pointer pushed }
  647. if (p^.methodpointer^.resulttype^.deftype=objectdef) and
  648. not(pobjectdef(p^.methodpointer^.resulttype)^.is_class) then
  649. begin
  650. if (p^.procdefinition^.proctypeoption=potype_constructor) then
  651. begin
  652. { it's no bad idea, to insert the VMT }
  653. emit_sym(A_PUSH,S_L,newasmsymbol(
  654. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname));
  655. end
  656. { destructors haven't to dispose the instance, if this is }
  657. { a direct call }
  658. else
  659. push_int(0);
  660. end;
  661. end;
  662. end;
  663. end;
  664. end;
  665. end
  666. else
  667. begin
  668. if (po_classmethod in p^.procdefinition^.procoptions) and
  669. not(
  670. assigned(aktprocsym) and
  671. (po_classmethod in aktprocsym^.definition^.procoptions)
  672. ) then
  673. begin
  674. { class method needs current VMT }
  675. getexplicitregister32(R_ESI);
  676. new(r);
  677. reset_reference(r^);
  678. r^.base:=R_ESI;
  679. r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
  680. emit_ref_reg(A_MOV,S_L,r,R_ESI);
  681. end
  682. else
  683. begin
  684. { member call, ESI isn't modified }
  685. loadesi:=false;
  686. end;
  687. { direct call to destructor: don't remove data! }
  688. if procinfo^._class^.is_class then
  689. begin
  690. if (p^.procdefinition^.proctypeoption=potype_destructor) then
  691. begin
  692. emit_const(A_PUSH,S_L,0);
  693. emit_reg(A_PUSH,S_L,R_ESI);
  694. end
  695. else if (p^.procdefinition^.proctypeoption=potype_constructor) then
  696. begin
  697. emit_const(A_PUSH,S_L,0);
  698. emit_const(A_PUSH,S_L,0);
  699. end
  700. else
  701. emit_reg(A_PUSH,S_L,R_ESI);
  702. end
  703. else
  704. begin
  705. emit_reg(A_PUSH,S_L,R_ESI);
  706. if is_con_or_destructor then
  707. begin
  708. if (p^.procdefinition^.proctypeoption=potype_constructor) then
  709. begin
  710. { it's no bad idea, to insert the VMT }
  711. emit_sym(A_PUSH,S_L,newasmsymbol(
  712. procinfo^._class^.vmt_mangledname));
  713. end
  714. { destructors haven't to dispose the instance, if this is }
  715. { a direct call }
  716. else
  717. push_int(0);
  718. end;
  719. end;
  720. end;
  721. end;
  722. { push base pointer ?}
  723. if (lexlevel>=normal_function_level) and assigned(pprocdef(p^.procdefinition)^.parast) and
  724. ((pprocdef(p^.procdefinition)^.parast^.symtablelevel)>normal_function_level) then
  725. begin
  726. { if we call a nested function in a method, we must }
  727. { push also SELF! }
  728. { THAT'S NOT TRUE, we have to load ESI via frame pointer }
  729. { access }
  730. {
  731. begin
  732. loadesi:=false;
  733. emit_reg(A_PUSH,S_L,R_ESI);
  734. end;
  735. }
  736. if lexlevel=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) then
  737. begin
  738. new(r);
  739. reset_reference(r^);
  740. r^.offset:=procinfo^.framepointer_offset;
  741. r^.base:=procinfo^.framepointer;
  742. emit_ref(A_PUSH,S_L,r)
  743. end
  744. { this is only true if the difference is one !!
  745. but it cannot be more !! }
  746. else if (lexlevel=pprocdef(p^.procdefinition)^.parast^.symtablelevel-1) then
  747. begin
  748. emit_reg(A_PUSH,S_L,procinfo^.framepointer)
  749. end
  750. else if (lexlevel>pprocdef(p^.procdefinition)^.parast^.symtablelevel) then
  751. begin
  752. hregister:=getregister32;
  753. new(r);
  754. reset_reference(r^);
  755. r^.offset:=procinfo^.framepointer_offset;
  756. r^.base:=procinfo^.framepointer;
  757. emit_ref_reg(A_MOV,S_L,r,hregister);
  758. for i:=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) to lexlevel-1 do
  759. begin
  760. new(r);
  761. reset_reference(r^);
  762. {we should get the correct frame_pointer_offset at each level
  763. how can we do this !!! }
  764. r^.offset:=procinfo^.framepointer_offset;
  765. r^.base:=hregister;
  766. emit_ref_reg(A_MOV,S_L,r,hregister);
  767. end;
  768. emit_reg(A_PUSH,S_L,hregister);
  769. ungetregister32(hregister);
  770. end
  771. else
  772. internalerror(25000);
  773. end;
  774. if (po_virtualmethod in p^.procdefinition^.procoptions) and
  775. not(no_virtual_call) then
  776. begin
  777. { static functions contain the vmt_address in ESI }
  778. { also class methods }
  779. { Here it is quite tricky because it also depends }
  780. { on the methodpointer PM }
  781. getexplicitregister32(R_ESI);
  782. if assigned(aktprocsym) then
  783. begin
  784. if (((sp_static in aktprocsym^.symoptions) or
  785. (po_classmethod in aktprocsym^.definition^.procoptions)) and
  786. ((p^.methodpointer=nil) or (p^.methodpointer^.treetype=typen)))
  787. or
  788. (po_staticmethod in p^.procdefinition^.procoptions) or
  789. ((p^.procdefinition^.proctypeoption=potype_constructor) and
  790. { if we call a constructor from anther constructor }
  791. { esi contains self }
  792. (assigned(p^.methodpointer))) or
  793. { ESI is loaded earlier }
  794. (po_classmethod in p^.procdefinition^.procoptions) then
  795. begin
  796. new(r);
  797. reset_reference(r^);
  798. r^.base:=R_ESI;
  799. end
  800. else
  801. begin
  802. new(r);
  803. reset_reference(r^);
  804. r^.base:=R_ESI;
  805. { this is one point where we need vmt_offset (PM) }
  806. r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
  807. {$ifndef noAllocEdi}
  808. getexplicitregister32(R_EDI);
  809. {$endif noAllocEdi}
  810. emit_ref_reg(A_MOV,S_L,r,R_EDI);
  811. new(r);
  812. reset_reference(r^);
  813. r^.base:=R_EDI;
  814. end;
  815. end
  816. else
  817. { aktprocsym should be assigned, also in main program }
  818. internalerror(12345);
  819. {
  820. begin
  821. new(r);
  822. reset_reference(r^);
  823. r^.base:=R_ESI;
  824. emit_ref_reg(A_MOV,S_L,r,R_EDI);
  825. new(r);
  826. reset_reference(r^);
  827. r^.base:=R_EDI;
  828. end;
  829. }
  830. if pprocdef(p^.procdefinition)^.extnumber=-1 then
  831. internalerror(44584);
  832. r^.offset:=pprocdef(p^.procdefinition)^._class^.vmtmethodoffset(pprocdef(p^.procdefinition)^.extnumber);
  833. {$ifndef TESTOBJEXT}
  834. if (cs_check_range in aktlocalswitches) then
  835. begin
  836. emit_reg(A_PUSH,S_L,r^.base);
  837. emitcall('FPC_CHECK_OBJECT');
  838. end;
  839. {$else TESTOBJEXT}
  840. if (cs_check_range in aktlocalswitches) then
  841. begin
  842. emit_sym(A_PUSH,S_L,
  843. newasmsymbol(pprocdef(p^.procdefinition)^._class^.vmt_mangledname));
  844. emit_reg(A_PUSH,S_L,r^.base);
  845. emitcall('FPC_CHECK_OBJECT_EXT');
  846. end;
  847. {$endif TESTOBJEXT}
  848. emit_ref(A_CALL,S_NO,r);
  849. {$ifndef noAllocEdi}
  850. ungetregister32(R_EDI);
  851. {$endif noAllocEdi}
  852. end
  853. else if not inlined then
  854. emitcall(pprocdef(p^.procdefinition)^.mangledname)
  855. else { inlined proc }
  856. { inlined code is in inlinecode }
  857. begin
  858. { set poinline again }
  859. {$ifdef INCLUDEOK}
  860. include(p^.procdefinition^.proccalloptions,pocall_inline);
  861. {$else}
  862. p^.procdefinition^.proccalloptions:=p^.procdefinition^.proccalloptions+[pocall_inline];
  863. {$endif}
  864. { process the inlinecode }
  865. secondpass(inlinecode);
  866. { free the args }
  867. ungetpersistanttemp(pprocdef(p^.procdefinition)^.parast^.address_fixup);
  868. end;
  869. end
  870. else
  871. { now procedure variable case }
  872. begin
  873. secondpass(p^.right);
  874. { procedure of object? }
  875. if (po_methodpointer in p^.procdefinition^.procoptions) then
  876. begin
  877. { method pointer can't be in a register }
  878. hregister:=R_NO;
  879. { do some hacking if we call a method pointer }
  880. { which is a class member }
  881. { else ESI is overwritten ! }
  882. if (p^.right^.location.reference.base=R_ESI) or
  883. (p^.right^.location.reference.index=R_ESI) then
  884. begin
  885. del_reference(p^.right^.location.reference);
  886. {$ifndef noAllocEdi}
  887. getexplicitregister32(R_EDI);
  888. {$endif noAllocEdi}
  889. emit_ref_reg(A_MOV,S_L,
  890. newreference(p^.right^.location.reference),R_EDI);
  891. hregister:=R_EDI;
  892. end;
  893. { load self, but not if it's already explicitly pushed }
  894. if not(po_containsself in p^.procdefinition^.procoptions) then
  895. begin
  896. { load ESI }
  897. inc(p^.right^.location.reference.offset,4);
  898. getexplicitregister32(R_ESI);
  899. emit_ref_reg(A_MOV,S_L,
  900. newreference(p^.right^.location.reference),R_ESI);
  901. dec(p^.right^.location.reference.offset,4);
  902. { push self pointer }
  903. emit_reg(A_PUSH,S_L,R_ESI);
  904. end;
  905. if hregister=R_NO then
  906. emit_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))
  907. else
  908. begin
  909. {$ifndef noAllocEdi}
  910. ungetregister32(hregister);
  911. {$else noAllocEdi}
  912. { the same code, the previous line is just to }
  913. { indicate EDI actually is deallocated if allocated }
  914. { above (JM) }
  915. ungetregister32(hregister);
  916. {$endif noAllocEdi}
  917. emit_reg(A_CALL,S_NO,hregister);
  918. end;
  919. del_reference(p^.right^.location.reference);
  920. end
  921. else
  922. begin
  923. case p^.right^.location.loc of
  924. LOC_REGISTER,LOC_CREGISTER:
  925. begin
  926. emit_reg(A_CALL,S_NO,p^.right^.location.register);
  927. ungetregister32(p^.right^.location.register);
  928. end
  929. else
  930. emit_ref(A_CALL,S_NO,newreference(p^.right^.location.reference));
  931. del_reference(p^.right^.location.reference);
  932. end;
  933. end;
  934. end;
  935. { this was only for normal functions
  936. displaced here so we also get
  937. it to work for procvars PM }
  938. if (not inlined) and (pocall_clearstack in p^.procdefinition^.proccalloptions) then
  939. begin
  940. { we also add the pop_size which is included in pushedparasize }
  941. pop_size:=0;
  942. { better than an add on all processors }
  943. if pushedparasize=4 then
  944. begin
  945. {$ifndef noAllocEdi}
  946. getexplicitregister32(R_EDI);
  947. {$endif noAllocEdi}
  948. emit_reg(A_POP,S_L,R_EDI);
  949. {$ifndef noAllocEdi}
  950. ungetregister32(R_EDI);
  951. {$endif noAllocEdi}
  952. end
  953. { the pentium has two pipes and pop reg is pairable }
  954. { but the registers must be different! }
  955. else if (pushedparasize=8) and
  956. not(cs_littlesize in aktglobalswitches) and
  957. (aktoptprocessor=ClassP5) and
  958. (procinfo^._class=nil) then
  959. begin
  960. {$ifndef noAllocEdi}
  961. getexplicitregister32(R_EDI);
  962. {$endif noAllocEdi}
  963. emit_reg(A_POP,S_L,R_EDI);
  964. {$ifndef noAllocEdi}
  965. ungetregister32(R_EDI);
  966. {$endif noAllocEdi}
  967. {$ifndef noAllocEdi}
  968. exprasmlist^.concat(new(pairegalloc,alloc(R_ESI)));
  969. {$endif noAllocEdi}
  970. emit_reg(A_POP,S_L,R_ESI);
  971. {$ifndef noAllocEdi}
  972. exprasmlist^.concat(new(pairegalloc,alloc(R_ESI)));
  973. {$endif noAllocEdi}
  974. end
  975. else if pushedparasize<>0 then
  976. emit_const_reg(A_ADD,S_L,pushedparasize,R_ESP);
  977. end;
  978. dont_call:
  979. pushedparasize:=oldpushedparasize;
  980. unused:=unusedregisters;
  981. usablereg32:=usablecount;
  982. {$ifdef TEMPREGDEBUG}
  983. testregisters32;
  984. {$endif TEMPREGDEBUG}
  985. { a constructor could be a function with boolean result }
  986. { if calling constructor called fail we
  987. must jump directly to quickexitlabel PM
  988. but only if it is a call of an inherited constructor }
  989. if (p^.right=nil) and
  990. (p^.procdefinition^.proctypeoption=potype_constructor) and
  991. assigned(p^.methodpointer) and
  992. (p^.methodpointer^.treetype=typen) and
  993. (aktprocsym^.definition^.proctypeoption=potype_constructor) then
  994. begin
  995. emitjmp(C_Z,faillabel);
  996. end;
  997. { handle function results }
  998. { structured results are easy to handle.... }
  999. { needed also when result_no_used !! }
  1000. if (p^.resulttype<>pdef(voiddef)) and ret_in_param(p^.resulttype) then
  1001. begin
  1002. p^.location.loc:=LOC_MEM;
  1003. p^.location.reference.symbol:=nil;
  1004. p^.location.reference:=funcretref;
  1005. end;
  1006. { we have only to handle the result if it is used, but }
  1007. { ansi/widestrings must be registered, so we can dispose them }
  1008. if (p^.resulttype<>pdef(voiddef)) and (p^.return_value_used or
  1009. is_ansistring(p^.resulttype) or is_widestring(p^.resulttype)) then
  1010. begin
  1011. { a contructor could be a function with boolean result }
  1012. if (p^.right=nil) and
  1013. (p^.procdefinition^.proctypeoption=potype_constructor) and
  1014. { quick'n'dirty check if it is a class or an object }
  1015. (p^.resulttype^.deftype=orddef) then
  1016. begin
  1017. { this fails if popsize > 0 PM }
  1018. p^.location.loc:=LOC_FLAGS;
  1019. p^.location.resflags:=F_NE;
  1020. if extended_new then
  1021. begin
  1022. {$ifdef test_dest_loc}
  1023. if dest_loc_known and (dest_loc_tree=p) then
  1024. mov_reg_to_dest(p,S_L,R_EAX)
  1025. else
  1026. {$endif test_dest_loc}
  1027. begin
  1028. hregister:=getexplicitregister32(R_EAX);
  1029. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1030. p^.location.register:=hregister;
  1031. end;
  1032. end;
  1033. end
  1034. { structed results are easy to handle.... }
  1035. else if ret_in_param(p^.resulttype) then
  1036. begin
  1037. {p^.location.loc:=LOC_MEM;
  1038. stringdispose(p^.location.reference.symbol);
  1039. p^.location.reference:=funcretref;
  1040. already done above (PM) }
  1041. end
  1042. else
  1043. begin
  1044. if (p^.resulttype^.deftype in [orddef,enumdef]) then
  1045. begin
  1046. p^.location.loc:=LOC_REGISTER;
  1047. case p^.resulttype^.size of
  1048. 4 :
  1049. begin
  1050. {$ifdef test_dest_loc}
  1051. if dest_loc_known and (dest_loc_tree=p) then
  1052. mov_reg_to_dest(p,S_L,R_EAX)
  1053. else
  1054. {$endif test_dest_loc}
  1055. begin
  1056. hregister:=getexplicitregister32(R_EAX);
  1057. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1058. p^.location.register:=hregister;
  1059. end;
  1060. end;
  1061. 1 :
  1062. begin
  1063. {$ifdef test_dest_loc}
  1064. if dest_loc_known and (dest_loc_tree=p) then
  1065. mov_reg_to_dest(p,S_B,R_AL)
  1066. else
  1067. {$endif test_dest_loc}
  1068. begin
  1069. hregister:=getexplicitregister32(R_EAX);
  1070. emit_reg_reg(A_MOV,S_B,R_AL,reg32toreg8(hregister));
  1071. p^.location.register:=reg32toreg8(hregister);
  1072. end;
  1073. end;
  1074. 2 :
  1075. begin
  1076. {$ifdef test_dest_loc}
  1077. if dest_loc_known and (dest_loc_tree=p) then
  1078. mov_reg_to_dest(p,S_W,R_AX)
  1079. else
  1080. {$endif test_dest_loc}
  1081. begin
  1082. hregister:=getexplicitregister32(R_EAX);
  1083. emit_reg_reg(A_MOV,S_W,R_AX,reg32toreg16(hregister));
  1084. p^.location.register:=reg32toreg16(hregister);
  1085. end;
  1086. end;
  1087. 8 :
  1088. begin
  1089. {$ifdef test_dest_loc}
  1090. {$error Don't know what to do here}
  1091. {$endif test_dest_loc}
  1092. hregister:=getexplicitregister32(R_EAX);
  1093. hregister2:=getexplicitregister32(R_EDX);
  1094. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1095. emit_reg_reg(A_MOV,S_L,R_EDX,hregister2);
  1096. p^.location.registerlow:=hregister;
  1097. p^.location.registerhigh:=hregister2;
  1098. end;
  1099. else internalerror(7);
  1100. end
  1101. end
  1102. else if (p^.resulttype^.deftype=floatdef) then
  1103. case pfloatdef(p^.resulttype)^.typ of
  1104. f32bit:
  1105. begin
  1106. p^.location.loc:=LOC_REGISTER;
  1107. {$ifdef test_dest_loc}
  1108. if dest_loc_known and (dest_loc_tree=p) then
  1109. mov_reg_to_dest(p,S_L,R_EAX)
  1110. else
  1111. {$endif test_dest_loc}
  1112. begin
  1113. hregister:=getexplicitregister32(R_EAX);
  1114. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1115. p^.location.register:=hregister;
  1116. end;
  1117. end;
  1118. else
  1119. begin
  1120. p^.location.loc:=LOC_FPU;
  1121. inc(fpuvaroffset);
  1122. end;
  1123. end
  1124. else if is_ansistring(p^.resulttype) or
  1125. is_widestring(p^.resulttype) then
  1126. begin
  1127. hregister:=getexplicitregister32(R_EAX);
  1128. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1129. gettempansistringreference(hr);
  1130. decrstringref(p^.resulttype,hr);
  1131. emit_reg_ref(A_MOV,S_L,hregister,
  1132. newreference(hr));
  1133. ungetregister32(hregister);
  1134. p^.location.loc:=LOC_MEM;
  1135. p^.location.reference:=hr;
  1136. end
  1137. else
  1138. begin
  1139. p^.location.loc:=LOC_REGISTER;
  1140. {$ifdef test_dest_loc}
  1141. if dest_loc_known and (dest_loc_tree=p) then
  1142. mov_reg_to_dest(p,S_L,R_EAX)
  1143. else
  1144. {$endif test_dest_loc}
  1145. begin
  1146. hregister:=getexplicitregister32(R_EAX);
  1147. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1148. p^.location.register:=hregister;
  1149. end;
  1150. end;
  1151. end;
  1152. end;
  1153. { perhaps i/o check ? }
  1154. if iolabel<>nil then
  1155. begin
  1156. emit_sym(A_PUSH,S_L,iolabel);
  1157. emitcall('FPC_IOCHECK');
  1158. end;
  1159. if pop_size>0 then
  1160. emit_const_reg(A_ADD,S_L,pop_size,R_ESP);
  1161. { restore registers }
  1162. popusedregisters(pushed);
  1163. { at last, restore instance pointer (SELF) }
  1164. if loadesi then
  1165. maybe_loadesi;
  1166. pp:=params;
  1167. while assigned(pp) do
  1168. begin
  1169. if assigned(pp^.left) then
  1170. begin
  1171. if (pp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM]) then
  1172. ungetiftemp(pp^.left^.location.reference);
  1173. { process also all nodes of an array of const }
  1174. if pp^.left^.treetype=arrayconstructn then
  1175. begin
  1176. if assigned(pp^.left^.left) then
  1177. begin
  1178. hp:=pp^.left;
  1179. while assigned(hp) do
  1180. begin
  1181. if (hp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM]) then
  1182. ungetiftemp(hp^.left^.location.reference);
  1183. hp:=hp^.right;
  1184. end;
  1185. end;
  1186. end;
  1187. end;
  1188. pp:=pp^.right;
  1189. end;
  1190. if inlined then
  1191. ungetpersistanttemp(inlinecode^.retoffset);
  1192. disposetree(params);
  1193. { from now on the result can be freed normally }
  1194. if inlined and ret_in_param(p^.resulttype) then
  1195. persistanttemptonormal(funcretref.offset);
  1196. { if return value is not used }
  1197. if (not p^.return_value_used) and (p^.resulttype<>pdef(voiddef)) then
  1198. begin
  1199. if p^.location.loc in [LOC_MEM,LOC_REFERENCE] then
  1200. begin
  1201. { data which must be finalized ? }
  1202. if (p^.resulttype^.needs_inittable) and
  1203. ( (p^.resulttype^.deftype<>objectdef) or
  1204. not(pobjectdef(p^.resulttype)^.is_class)) then
  1205. finalize(p^.resulttype,p^.location.reference,ret_in_param(p^.resulttype));
  1206. { release unused temp }
  1207. ungetiftemp(p^.location.reference)
  1208. end
  1209. else if p^.location.loc=LOC_FPU then
  1210. begin
  1211. { release FPU stack }
  1212. emit_reg(A_FSTP,S_NO,R_ST0);
  1213. {
  1214. dec(fpuvaroffset);
  1215. do NOT decrement as the increment before
  1216. is not called for unused results PM }
  1217. end;
  1218. end;
  1219. end;
  1220. {*****************************************************************************
  1221. SecondProcInlineN
  1222. *****************************************************************************}
  1223. procedure secondprocinline(var p : ptree);
  1224. var st : psymtable;
  1225. oldprocsym : pprocsym;
  1226. para_size : longint;
  1227. oldprocinfo : pprocinfo;
  1228. oldinlining_procedure,
  1229. nostackframe,make_global : boolean;
  1230. proc_names : tstringcontainer;
  1231. inlineentrycode,inlineexitcode : paasmoutput;
  1232. oldexitlabel,oldexit2label,oldquickexitlabel:Pasmlabel;
  1233. {$ifdef GDB}
  1234. startlabel,endlabel : pasmlabel;
  1235. pp : pchar;
  1236. mangled_length : longint;
  1237. {$endif GDB}
  1238. begin
  1239. oldinlining_procedure:=inlining_procedure;
  1240. oldexitlabel:=aktexitlabel;
  1241. oldexit2label:=aktexit2label;
  1242. oldquickexitlabel:=quickexitlabel;
  1243. getlabel(aktexitlabel);
  1244. getlabel(aktexit2label);
  1245. oldprocsym:=aktprocsym;
  1246. { we're inlining a procedure }
  1247. inlining_procedure:=true;
  1248. { save old procinfo }
  1249. getmem(oldprocinfo,sizeof(tprocinfo));
  1250. move(procinfo^,oldprocinfo^,sizeof(tprocinfo));
  1251. { set the return value }
  1252. aktprocsym:=p^.inlineprocsym;
  1253. procinfo^.returntype:=aktprocsym^.definition^.rettype;
  1254. procinfo^.return_offset:=p^.retoffset;
  1255. procinfo^.para_offset:=p^.para_offset;
  1256. { arg space has been filled by the parent secondcall }
  1257. st:=aktprocsym^.definition^.localst;
  1258. { set it to the same lexical level }
  1259. st^.symtablelevel:=oldprocsym^.definition^.localst^.symtablelevel;
  1260. if st^.datasize>0 then
  1261. begin
  1262. st^.address_fixup:=gettempofsizepersistant(st^.datasize)+st^.datasize;
  1263. {$ifdef extdebug}
  1264. Comment(V_debug,'local symtable is at offset '+tostr(st^.address_fixup));
  1265. exprasmlist^.concat(new(pai_asm_comment,init(strpnew(
  1266. 'local symtable is at offset '+tostr(st^.address_fixup)))));
  1267. {$endif extdebug}
  1268. end;
  1269. exprasmlist^.concat(new(Pai_Marker, Init(InlineStart)));
  1270. {$ifdef extdebug}
  1271. exprasmlist^.concat(new(pai_asm_comment,init(strpnew('Start of inlined proc'))));
  1272. {$endif extdebug}
  1273. {$ifdef GDB}
  1274. if (cs_debuginfo in aktmoduleswitches) then
  1275. begin
  1276. getlabel(startlabel);
  1277. getlabel(endlabel);
  1278. emitlab(startlabel);
  1279. p^.inlineprocsym^.definition^.localst^.symtabletype:=inlinelocalsymtable;
  1280. p^.inlineprocsym^.definition^.parast^.symtabletype:=inlineparasymtable;
  1281. { Here we must include the para and local symtable info }
  1282. p^.inlineprocsym^.concatstabto(withdebuglist);
  1283. { set it back for savety }
  1284. p^.inlineprocsym^.definition^.localst^.symtabletype:=localsymtable;
  1285. p^.inlineprocsym^.definition^.parast^.symtabletype:=parasymtable;
  1286. mangled_length:=length(oldprocsym^.definition^.mangledname);
  1287. getmem(pp,mangled_length+50);
  1288. strpcopy(pp,'192,0,0,'+startlabel^.name);
  1289. if (target_os.use_function_relative_addresses) then
  1290. begin
  1291. strpcopy(strend(pp),'-');
  1292. strpcopy(strend(pp),oldprocsym^.definition^.mangledname);
  1293. end;
  1294. withdebuglist^.concat(new(pai_stabn,init(strnew(pp))));
  1295. end;
  1296. {$endif GDB}
  1297. { takes care of local data initialization }
  1298. inlineentrycode:=new(paasmoutput,init);
  1299. inlineexitcode:=new(paasmoutput,init);
  1300. proc_names.init;
  1301. para_size:=p^.para_size;
  1302. make_global:=false; { to avoid warning }
  1303. genentrycode(inlineentrycode,proc_names,make_global,0,para_size,nostackframe,true);
  1304. exprasmlist^.concatlist(inlineentrycode);
  1305. secondpass(p^.inlinetree);
  1306. genexitcode(inlineexitcode,0,false,true);
  1307. exprasmlist^.concatlist(inlineexitcode);
  1308. {$ifdef extdebug}
  1309. exprasmlist^.concat(new(pai_asm_comment,init(strpnew('End of inlined proc'))));
  1310. {$endif extdebug}
  1311. exprasmlist^.concat(new(Pai_Marker, Init(InlineEnd)));
  1312. {we can free the local data now, reset also the fixup address }
  1313. if st^.datasize>0 then
  1314. begin
  1315. ungetpersistanttemp(st^.address_fixup-st^.datasize);
  1316. st^.address_fixup:=0;
  1317. end;
  1318. { restore procinfo }
  1319. move(oldprocinfo^,procinfo^,sizeof(tprocinfo));
  1320. freemem(oldprocinfo,sizeof(tprocinfo));
  1321. {$ifdef GDB}
  1322. if (cs_debuginfo in aktmoduleswitches) then
  1323. begin
  1324. emitlab(endlabel);
  1325. strpcopy(pp,'224,0,0,'+endlabel^.name);
  1326. if (target_os.use_function_relative_addresses) then
  1327. begin
  1328. strpcopy(strend(pp),'-');
  1329. strpcopy(strend(pp),oldprocsym^.definition^.mangledname);
  1330. end;
  1331. withdebuglist^.concat(new(pai_stabn,init(strnew(pp))));
  1332. freemem(pp,mangled_length+50);
  1333. end;
  1334. {$endif GDB}
  1335. { restore }
  1336. aktprocsym:=oldprocsym;
  1337. aktexitlabel:=oldexitlabel;
  1338. aktexit2label:=oldexit2label;
  1339. quickexitlabel:=oldquickexitlabel;
  1340. inlining_procedure:=oldinlining_procedure;
  1341. end;
  1342. end.
  1343. {
  1344. $Log$
  1345. Revision 1.127 2000-03-01 00:03:11 pierre
  1346. * fixes for locals in inlined procedures
  1347. fix for bug797
  1348. + stabs generation for inlined paras and locals
  1349. Revision 1.126 2000/02/09 18:08:33 jonas
  1350. * added regallocs for esi
  1351. Revision 1.125 2000/02/09 13:22:45 peter
  1352. * log truncated
  1353. Revision 1.124 2000/02/04 20:00:21 florian
  1354. * an exception in a construcor calls now the destructor (this applies only
  1355. to classes)
  1356. Revision 1.123 2000/01/26 15:03:59 peter
  1357. * fixed pop_size included twice with clearstack
  1358. Revision 1.122 2000/01/26 12:02:29 peter
  1359. * abstractprocdef.para_size needs alignment parameter
  1360. * secondcallparan gets para_alignment size instead of dword_align
  1361. Revision 1.121 2000/01/23 18:50:07 peter
  1362. * fixed missing push esi for constructor calling
  1363. Revision 1.120 2000/01/21 22:06:16 florian
  1364. * fixed for the fix of bug 793
  1365. * fpu variables modified by nested subroutines aren't regable anymore
  1366. * $maxfpuregisters doesn't modify anymore the behavior of a procedure before
  1367. Revision 1.119 2000/01/21 12:17:41 jonas
  1368. * regallocation fixes
  1369. Revision 1.118 2000/01/20 12:14:47 florian
  1370. * bug 793 fixed
  1371. Revision 1.117 2000/01/16 22:17:11 peter
  1372. * renamed call_offset to para_offset
  1373. Revision 1.116 2000/01/09 12:35:00 jonas
  1374. * changed edi allocation to use getexplicitregister32/ungetregister
  1375. (adapted tgeni386 a bit for this) and enabled it by default
  1376. * fixed very big and stupid bug of mine in cg386mat that broke the
  1377. include() code (and make cycle :( ) if you compiled without
  1378. -dnewoptimizations
  1379. Revision 1.115 2000/01/09 01:44:19 jonas
  1380. + (de)allocation info for EDI to fix reported bug on mailinglist.
  1381. Also some (de)allocation info for ESI added. Between -dallocEDI
  1382. because at this time of the night bugs could easily slip in ;)
  1383. Revision 1.114 2000/01/07 01:14:20 peter
  1384. * updated copyright to 2000
  1385. Revision 1.113 1999/12/22 01:01:46 peter
  1386. - removed freelabel()
  1387. * added undefined label detection in internal assembler, this prevents
  1388. a lot of ld crashes and wrong .o files
  1389. * .o files aren't written anymore if errors have occured
  1390. * inlining of assembler labels is now correct
  1391. Revision 1.112 1999/12/13 21:49:54 pierre
  1392. * bug in extdebugg code for inlined procedures
  1393. Revision 1.111 1999/11/30 10:40:42 peter
  1394. + ttype, tsymlist
  1395. Revision 1.110 1999/11/06 14:34:17 peter
  1396. * truncated log to 20 revs
  1397. Revision 1.109 1999/11/04 00:23:58 pierre
  1398. * fix for fpuvaroffset for unused return value
  1399. Revision 1.108 1999/10/26 12:30:40 peter
  1400. * const parameter is now checked
  1401. * better and generic check if a node can be used for assigning
  1402. * export fixes
  1403. * procvar equal works now (it never had worked at least from 0.99.8)
  1404. * defcoll changed to linkedlist with pparaitem so it can easily be
  1405. walked both directions
  1406. Revision 1.107 1999/10/08 15:40:47 pierre
  1407. * use and remember that C functions with complex data results use ret $4
  1408. Revision 1.106 1999/09/27 23:44:46 peter
  1409. * procinfo is now a pointer
  1410. * support for result setting in sub procedure
  1411. Revision 1.105 1999/09/26 13:26:02 florian
  1412. * exception patch of Romio nevertheless the excpetion handling
  1413. needs some corections regarding register saving
  1414. * gettempansistring is again a procedure
  1415. }