cg386cal.pas 71 KB

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