cg386cal.pas 69 KB

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