cg386cal.pas 68 KB

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