cg386cal.pas 63 KB

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