cg386cal.pas 63 KB

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