cg386cal.pas 70 KB

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