cg386cal.pas 67 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Generate i386 assembler for in call nodes
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit cg386cal;
  19. interface
  20. { $define AnsiStrRef}
  21. uses
  22. symtable,tree;
  23. procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
  24. push_from_left_to_right,inlined,dword_align : boolean;para_offset : longint);
  25. procedure secondcalln(var p : ptree);
  26. procedure secondprocinline(var p : ptree);
  27. implementation
  28. uses
  29. globtype,systems,
  30. cobjects,verbose,globals,
  31. aasm,types,
  32. {$ifdef GDB}
  33. gdb,
  34. {$endif GDB}
  35. hcodegen,temp_gen,pass_2,
  36. {$ifndef OLDASM}
  37. i386base,i386asm,
  38. {$else}
  39. i386,
  40. {$endif}
  41. cgai386,tgeni386,cg386ld;
  42. {*****************************************************************************
  43. SecondCallParaN
  44. *****************************************************************************}
  45. procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
  46. push_from_left_to_right,inlined,dword_align : boolean;para_offset : longint);
  47. procedure maybe_push_high;
  48. begin
  49. { open array ? }
  50. { defcoll^.data can be nil for read/write }
  51. if assigned(defcoll^.data) and
  52. push_high_param(defcoll^.data) then
  53. begin
  54. if assigned(p^.hightree) then
  55. begin
  56. secondpass(p^.hightree);
  57. { this is a longint anyway ! }
  58. push_value_para(p^.hightree,inlined,para_offset,4);
  59. end
  60. else
  61. internalerror(432645);
  62. end;
  63. end;
  64. var
  65. otlabel,oflabel : plabel;
  66. align : longint;
  67. { temporary variables: }
  68. tempdeftype : tdeftype;
  69. r : preference;
  70. begin
  71. { push from left to right if specified }
  72. if push_from_left_to_right and assigned(p^.right) then
  73. secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,
  74. inlined,dword_align,para_offset);
  75. otlabel:=truelabel;
  76. oflabel:=falselabel;
  77. getlabel(truelabel);
  78. getlabel(falselabel);
  79. secondpass(p^.left);
  80. { filter array constructor with c styled args }
  81. if is_array_constructor(p^.left^.resulttype) and p^.left^.cargs then
  82. begin
  83. { nothing, everything is already pushed }
  84. end
  85. { in codegen.handleread.. defcoll^.data is set to nil }
  86. else if assigned(defcoll^.data) and
  87. (defcoll^.data^.deftype=formaldef) then
  88. begin
  89. { allow @var }
  90. inc(pushedparasize,4);
  91. if p^.left^.treetype=addrn then
  92. begin
  93. { always a register }
  94. if inlined then
  95. begin
  96. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  97. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  98. p^.left^.location.register,r)));
  99. end
  100. else
  101. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
  102. ungetregister32(p^.left^.location.register);
  103. end
  104. else
  105. begin
  106. if not(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  107. CGMessage(type_e_mismatch)
  108. else
  109. begin
  110. if inlined then
  111. begin
  112. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  113. newreference(p^.left^.location.reference),R_EDI)));
  114. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  115. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  116. end
  117. else
  118. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  119. del_reference(p^.left^.location.reference);
  120. end;
  121. end;
  122. end
  123. { handle call by reference parameter }
  124. else if (defcoll^.paratyp=vs_var) then
  125. begin
  126. if (p^.left^.location.loc<>LOC_REFERENCE) then
  127. CGMessage(cg_e_var_must_be_reference);
  128. maybe_push_high;
  129. inc(pushedparasize,4);
  130. if inlined then
  131. begin
  132. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  133. newreference(p^.left^.location.reference),R_EDI)));
  134. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  135. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  136. end
  137. else
  138. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  139. del_reference(p^.left^.location.reference);
  140. end
  141. else
  142. begin
  143. tempdeftype:=p^.resulttype^.deftype;
  144. if tempdeftype=filedef then
  145. CGMessage(cg_e_file_must_call_by_reference);
  146. if push_addr_param(p^.resulttype) then
  147. begin
  148. maybe_push_high;
  149. inc(pushedparasize,4);
  150. if inlined then
  151. begin
  152. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  153. newreference(p^.left^.location.reference),R_EDI)));
  154. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  155. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  156. R_EDI,r)));
  157. end
  158. else
  159. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  160. del_reference(p^.left^.location.reference);
  161. end
  162. else
  163. begin
  164. align:=target_os.stackalignment;
  165. if dword_align then
  166. align:=4;
  167. push_value_para(p^.left,inlined,para_offset,align);
  168. end;
  169. end;
  170. freelabel(truelabel);
  171. freelabel(falselabel);
  172. truelabel:=otlabel;
  173. falselabel:=oflabel;
  174. { push from right to left }
  175. if not push_from_left_to_right and assigned(p^.right) then
  176. secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,
  177. inlined,dword_align,para_offset);
  178. end;
  179. {*****************************************************************************
  180. SecondCallN
  181. *****************************************************************************}
  182. procedure secondcalln(var p : ptree);
  183. var
  184. unusedregisters : tregisterset;
  185. pushed,pushedregs : tpushed;
  186. hr,funcretref : treference;
  187. hregister,hregister2 : tregister;
  188. oldpushedparasize : longint;
  189. { true if ESI must be loaded again after the subroutine }
  190. loadesi : boolean;
  191. { true if a virtual method must be called directly }
  192. no_virtual_call : boolean;
  193. { true if we produce a con- or destrutor in a call }
  194. is_con_or_destructor : boolean;
  195. { true if a constructor is called again }
  196. extended_new : boolean;
  197. { adress returned from an I/O-error }
  198. iolabel : plabel;
  199. { lexlevel count }
  200. i : longint;
  201. { help reference pointer }
  202. r : preference;
  203. hp,
  204. pp,params : ptree;
  205. inlined : boolean;
  206. inlinecode : ptree;
  207. para_offset : longint;
  208. { instruction for alignement correction }
  209. { corr : pai386;}
  210. { we must pop this size also after !! }
  211. { must_pop : boolean; }
  212. pop_size : longint;
  213. label
  214. dont_call;
  215. begin
  216. reset_reference(p^.location.reference);
  217. extended_new:=false;
  218. iolabel:=nil;
  219. inlinecode:=nil;
  220. inlined:=false;
  221. loadesi:=true;
  222. no_virtual_call:=false;
  223. unusedregisters:=unused;
  224. if not assigned(p^.procdefinition) then
  225. exit;
  226. if (p^.procdefinition^.options and poinline)<>0 then
  227. begin
  228. inlined:=true;
  229. inlinecode:=p^.right;
  230. { set it to the same lexical level as the local symtable, becuase
  231. the para's are stored there }
  232. pprocdef(p^.procdefinition)^.parast^.symtablelevel:=aktprocsym^.definition^.localst^.symtablelevel;
  233. if assigned(p^.left) then
  234. inlinecode^.para_offset:=gettempofsizepersistant(inlinecode^.para_size);
  235. pprocdef(p^.procdefinition)^.parast^.address_fixup:=inlinecode^.para_offset;
  236. {$ifdef extdebug}
  237. Comment(V_debug,
  238. 'inlined parasymtable is at offset '
  239. +tostr(pprocdef(p^.procdefinition)^.parast^.address_fixup));
  240. exprasmlist^.concat(new(pai_asm_comment,init(
  241. strpnew('inlined parasymtable is at offset '
  242. +tostr(pprocdef(p^.procdefinition)^.parast^.address_fixup)))));
  243. {$endif extdebug}
  244. p^.right:=nil;
  245. { disable further inlining of the same proc
  246. in the args }
  247. p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
  248. end;
  249. { only if no proc var }
  250. if not(assigned(p^.right)) then
  251. is_con_or_destructor:=((p^.procdefinition^.options and poconstructor)<>0)
  252. or ((p^.procdefinition^.options and podestructor)<>0);
  253. { proc variables destroy all registers }
  254. if (p^.right=nil) and
  255. { virtual methods too }
  256. ((p^.procdefinition^.options and povirtualmethod)=0) then
  257. begin
  258. if ((p^.procdefinition^.options and poiocheck)<>0) and
  259. ((aktprocsym^.definition^.options and poiocheck)=0) and
  260. (cs_check_io in aktlocalswitches) then
  261. begin
  262. getlabel(iolabel);
  263. emitlab(iolabel);
  264. end
  265. else
  266. iolabel:=nil;
  267. { save all used registers }
  268. pushusedregisters(exprasmlist,pushed,pprocdef(p^.procdefinition)^.usedregisters);
  269. { give used registers through }
  270. usedinproc:=usedinproc or pprocdef(p^.procdefinition)^.usedregisters;
  271. end
  272. else
  273. begin
  274. pushusedregisters(exprasmlist,pushed,$ff);
  275. usedinproc:=$ff;
  276. { no IO check for methods and procedure variables }
  277. iolabel:=nil;
  278. end;
  279. { generate the code for the parameter and push them }
  280. oldpushedparasize:=pushedparasize;
  281. pushedparasize:=0;
  282. pop_size:=0;
  283. if (not inlined) then
  284. begin
  285. { Old pushedsize aligned on 4 ? }
  286. i:=oldpushedparasize and 3;
  287. if i>0 then
  288. inc(pop_size,4-i);
  289. { This parasize aligned on 4 ? }
  290. i:=p^.procdefinition^.para_size and 3;
  291. if i>0 then
  292. inc(pop_size,4-i);
  293. { insert the opcode and update pushedparasize }
  294. if pop_size>0 then
  295. begin
  296. inc(pushedparasize,pop_size);
  297. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,pop_size,R_ESP)));
  298. {$ifdef GDB}
  299. if (cs_debuginfo in aktmoduleswitches) and
  300. (exprasmlist^.first=exprasmlist^.last) then
  301. exprasmlist^.concat(new(pai_force_line,init));
  302. {$endif GDB}
  303. end;
  304. end;
  305. if (p^.resulttype<>pdef(voiddef)) and
  306. ret_in_param(p^.resulttype) then
  307. begin
  308. funcretref.symbol:=nil;
  309. {$ifdef test_dest_loc}
  310. if dest_loc_known and (dest_loc_tree=p) and
  311. (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
  312. begin
  313. funcretref:=dest_loc.reference;
  314. if assigned(dest_loc.reference.symbol) then
  315. funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
  316. in_dest_loc:=true;
  317. end
  318. else
  319. {$endif test_dest_loc}
  320. if inlined then
  321. begin
  322. reset_reference(funcretref);
  323. funcretref.offset:=gettempofsizepersistant(p^.procdefinition^.retdef^.size);
  324. funcretref.base:=procinfo.framepointer;
  325. end
  326. else
  327. gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
  328. end;
  329. if assigned(p^.left) then
  330. begin
  331. { be found elsewhere }
  332. if inlined then
  333. para_offset:=pprocdef(p^.procdefinition)^.parast^.address_fixup+
  334. pprocdef(p^.procdefinition)^.parast^.datasize
  335. else
  336. para_offset:=0;
  337. if assigned(p^.right) then
  338. secondcallparan(p^.left,pabstractprocdef(p^.right^.resulttype)^.para1,
  339. (p^.procdefinition^.options and poleftright)<>0,
  340. inlined,(p^.procdefinition^.options and (pocdecl or postdcall))<>0,para_offset)
  341. else
  342. secondcallparan(p^.left,p^.procdefinition^.para1,
  343. (p^.procdefinition^.options and poleftright)<>0,
  344. inlined,(p^.procdefinition^.options and (pocdecl or postdcall))<>0,para_offset);
  345. end;
  346. params:=p^.left;
  347. p^.left:=nil;
  348. if inlined then
  349. inlinecode^.retoffset:=gettempofsizepersistant(4);
  350. if ret_in_param(p^.resulttype) then
  351. begin
  352. inc(pushedparasize,4);
  353. if inlined then
  354. begin
  355. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  356. newreference(funcretref),R_EDI)));
  357. r:=new_reference(procinfo.framepointer,inlinecode^.retoffset);
  358. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  359. R_EDI,r)));
  360. end
  361. else
  362. emitpushreferenceaddr(exprasmlist,funcretref);
  363. end;
  364. { procedure variable ? }
  365. if (p^.right=nil) then
  366. begin
  367. { overloaded operator have no symtable }
  368. { push self }
  369. if assigned(p^.symtable) and
  370. (p^.symtable^.symtabletype=withsymtable) then
  371. begin
  372. { dirty trick to avoid the secondcall below }
  373. p^.methodpointer:=genzeronode(callparan);
  374. p^.methodpointer^.location.loc:=LOC_REGISTER;
  375. p^.methodpointer^.location.register:=R_ESI;
  376. { ARGHHH this is wrong !!!
  377. if we can init from base class for a child
  378. class that the wrong VMT will be
  379. transfered to constructor !! }
  380. p^.methodpointer^.resulttype:=
  381. ptree(pwithsymtable(p^.symtable)^.withnode)^.left^.resulttype;
  382. { change dispose type !! }
  383. p^.disposetyp:=dt_mbleft_and_method;
  384. { make a reference }
  385. new(r);
  386. reset_reference(r^);
  387. { if assigned(ptree(pwithsymtable(p^.symtable)^.withnode)^.pref) then
  388. begin
  389. r^:=ptree(pwithsymtable(p^.symtable)^.withnode)^.pref^;
  390. end
  391. else
  392. begin
  393. r^.offset:=p^.symtable^.datasize;
  394. r^.base:=procinfo.framepointer;
  395. end; }
  396. r^:=ptree(pwithsymtable(p^.symtable)^.withnode)^.withreference^;
  397. if (not pwithsymtable(p^.symtable)^.direct_with) or
  398. pobjectdef(p^.methodpointer^.resulttype)^.isclass then
  399. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)))
  400. else
  401. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_ESI)));
  402. end;
  403. { push self }
  404. if assigned(p^.symtable) and
  405. ((p^.symtable^.symtabletype=objectsymtable) or
  406. (p^.symtable^.symtabletype=withsymtable)) then
  407. begin
  408. if assigned(p^.methodpointer) then
  409. begin
  410. {
  411. if p^.methodpointer^.resulttype=classrefdef then
  412. begin
  413. two possibilities:
  414. 1. constructor
  415. 2. class method
  416. end
  417. else }
  418. begin
  419. case p^.methodpointer^.treetype of
  420. typen:
  421. begin
  422. { direct call to inherited method }
  423. if (p^.procdefinition^.options and poabstractmethod)<>0 then
  424. begin
  425. CGMessage(cg_e_cant_call_abstract_method);
  426. goto dont_call;
  427. end;
  428. { generate no virtual call }
  429. no_virtual_call:=true;
  430. if (p^.symtableprocentry^.properties and sp_static)<>0 then
  431. begin
  432. { well lets put the VMT address directly into ESI }
  433. { it is kind of dirty but that is the simplest }
  434. { way to accept virtual static functions (PM) }
  435. loadesi:=true;
  436. { if no VMT just use $0 bug0214 PM }
  437. if (pobjectdef(p^.methodpointer^.resulttype)^.options and oo_hasvmt)=0 then
  438. exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,0,R_ESI)))
  439. else
  440. begin
  441. exprasmlist^.concat(new(pai386,op_sym_ofs_reg(A_MOV,S_L,
  442. newasmsymbol(pobjectdef(
  443. p^.methodpointer^.resulttype)^.vmt_mangledname),0,R_ESI)));
  444. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  445. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  446. end;
  447. { exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  448. this is done below !! }
  449. end
  450. else
  451. { this is a member call, so ESI isn't modfied }
  452. loadesi:=false;
  453. { a class destructor needs a flag }
  454. if pobjectdef(p^.methodpointer^.resulttype)^.isclass and
  455. assigned(aktprocsym) and
  456. ((aktprocsym^.definition^.options and
  457. (podestructor))<>0) then
  458. begin
  459. push_int(0);
  460. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  461. end;
  462. if not(is_con_or_destructor and
  463. pobjectdef(p^.methodpointer^.resulttype)^.isclass and
  464. assigned(aktprocsym) and
  465. ((aktprocsym^.definition^.options and (poconstructor or podestructor))<>0)
  466. ) then
  467. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  468. { if an inherited con- or destructor should be }
  469. { called in a con- or destructor then a warning }
  470. { will be made }
  471. { con- and destructors need a pointer to the vmt }
  472. if is_con_or_destructor and
  473. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) and
  474. assigned(aktprocsym) then
  475. begin
  476. if not ((aktprocsym^.definition^.options
  477. and (poconstructor or podestructor))<>0) then
  478. CGMessage(cg_w_member_cd_call_from_method);
  479. end;
  480. { class destructors get there flag below }
  481. if is_con_or_destructor and
  482. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass and
  483. assigned(aktprocsym) and
  484. ((aktprocsym^.definition^.options and
  485. (podestructor))<>0)) then
  486. push_int(0);
  487. end;
  488. hnewn:
  489. begin
  490. { extended syntax of new }
  491. { ESI must be zero }
  492. exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
  493. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  494. { insert the vmt }
  495. exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
  496. newasmsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname))));
  497. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  498. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  499. extended_new:=true;
  500. end;
  501. hdisposen:
  502. begin
  503. secondpass(p^.methodpointer);
  504. { destructor with extended syntax called from dispose }
  505. { hdisposen always deliver LOC_REFERENCE }
  506. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  507. newreference(p^.methodpointer^.location.reference),R_ESI)));
  508. del_reference(p^.methodpointer^.location.reference);
  509. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  510. exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
  511. newasmsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname))));
  512. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  513. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  514. end;
  515. else
  516. begin
  517. { call to an instance member }
  518. if (p^.symtable^.symtabletype<>withsymtable) then
  519. begin
  520. secondpass(p^.methodpointer);
  521. case p^.methodpointer^.location.loc of
  522. LOC_CREGISTER,
  523. LOC_REGISTER:
  524. begin
  525. emit_reg_reg(A_MOV,S_L,p^.methodpointer^.location.register,R_ESI);
  526. ungetregister32(p^.methodpointer^.location.register);
  527. end;
  528. else
  529. begin
  530. if (p^.methodpointer^.resulttype^.deftype=classrefdef) or
  531. ((p^.methodpointer^.resulttype^.deftype=objectdef) and
  532. pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  533. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  534. newreference(p^.methodpointer^.location.reference),R_ESI)))
  535. else
  536. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  537. newreference(p^.methodpointer^.location.reference),R_ESI)));
  538. del_reference(p^.methodpointer^.location.reference);
  539. end;
  540. end;
  541. end;
  542. { when calling a class method, we have to load ESI with the VMT !
  543. But, not for a class method via self }
  544. if ((p^.procdefinition^.options and pocontainsself)=0) then
  545. begin
  546. if ((p^.procdefinition^.options and poclassmethod)<>0)
  547. and not(p^.methodpointer^.resulttype^.deftype=classrefdef) then
  548. begin
  549. { class method needs current VMT }
  550. new(r);
  551. reset_reference(r^);
  552. r^.base:=R_ESI;
  553. r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
  554. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  555. end;
  556. { direct call to destructor: don't remove data! }
  557. if ((p^.procdefinition^.options and podestructor)<>0) and
  558. (p^.methodpointer^.resulttype^.deftype=objectdef) and
  559. (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  560. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,1)));
  561. { direct call to class constructor, don't allocate memory }
  562. if ((p^.procdefinition^.options and poconstructor)<>0) and
  563. (p^.methodpointer^.resulttype^.deftype=objectdef) and
  564. (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  565. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
  566. else
  567. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  568. end;
  569. if is_con_or_destructor then
  570. begin
  571. { classes don't get a VMT pointer pushed }
  572. if (p^.methodpointer^.resulttype^.deftype=objectdef) and
  573. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  574. begin
  575. if ((p^.procdefinition^.options and poconstructor)<>0) then
  576. begin
  577. { it's no bad idea, to insert the VMT }
  578. exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,newasmsymbol(
  579. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname))));
  580. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  581. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  582. end
  583. { destructors haven't to dispose the instance, if this is }
  584. { a direct call }
  585. else
  586. push_int(0);
  587. end;
  588. end;
  589. end;
  590. end;
  591. end;
  592. end
  593. else
  594. begin
  595. if ((p^.procdefinition^.options and poclassmethod)<>0) and
  596. not(
  597. assigned(aktprocsym) and
  598. ((aktprocsym^.definition^.options and poclassmethod)<>0)
  599. ) then
  600. begin
  601. { class method needs current VMT }
  602. new(r);
  603. reset_reference(r^);
  604. r^.base:=R_ESI;
  605. r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
  606. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  607. end
  608. else
  609. begin
  610. { member call, ESI isn't modified }
  611. loadesi:=false;
  612. end;
  613. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  614. { but a con- or destructor here would probably almost }
  615. { always be placed wrong }
  616. if is_con_or_destructor then
  617. begin
  618. CGMessage(cg_w_member_cd_call_from_method);
  619. push_int(0);
  620. end;
  621. end;
  622. end;
  623. { push base pointer ?}
  624. if (lexlevel>=normal_function_level) and assigned(pprocdef(p^.procdefinition)^.parast) and
  625. ((pprocdef(p^.procdefinition)^.parast^.symtablelevel)>normal_function_level) then
  626. begin
  627. { if we call a nested function in a method, we must }
  628. { push also SELF! }
  629. { THAT'S NOT TRUE, we have to load ESI via frame pointer }
  630. { access }
  631. {
  632. begin
  633. loadesi:=false;
  634. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  635. end;
  636. }
  637. if lexlevel=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) then
  638. begin
  639. new(r);
  640. reset_reference(r^);
  641. r^.offset:=procinfo.framepointer_offset;
  642. r^.base:=procinfo.framepointer;
  643. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)))
  644. end
  645. { this is only true if the difference is one !!
  646. but it cannot be more !! }
  647. else if (lexlevel=pprocdef(p^.procdefinition)^.parast^.symtablelevel-1) then
  648. begin
  649. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,procinfo.framepointer)))
  650. end
  651. else if (lexlevel>pprocdef(p^.procdefinition)^.parast^.symtablelevel) then
  652. begin
  653. hregister:=getregister32;
  654. new(r);
  655. reset_reference(r^);
  656. r^.offset:=procinfo.framepointer_offset;
  657. r^.base:=procinfo.framepointer;
  658. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  659. for i:=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) to lexlevel-1 do
  660. begin
  661. new(r);
  662. reset_reference(r^);
  663. {we should get the correct frame_pointer_offset at each level
  664. how can we do this !!! }
  665. r^.offset:=procinfo.framepointer_offset;
  666. r^.base:=hregister;
  667. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  668. end;
  669. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,hregister)));
  670. ungetregister32(hregister);
  671. end
  672. else
  673. internalerror(25000);
  674. end;
  675. if ((p^.procdefinition^.options and povirtualmethod)<>0) and
  676. not(no_virtual_call) then
  677. begin
  678. { static functions contain the vmt_address in ESI }
  679. { also class methods }
  680. { Here it is quite tricky because it also depends }
  681. { on the methodpointer PM }
  682. if assigned(aktprocsym) then
  683. begin
  684. if ((((aktprocsym^.properties and sp_static)<>0) or
  685. ((aktprocsym^.definition^.options and poclassmethod)<>0)) and
  686. ((p^.methodpointer=nil) or (p^.methodpointer^.treetype=typen)))
  687. or
  688. ((p^.procdefinition^.options and postaticmethod)<>0) or
  689. ((p^.procdefinition^.options and poconstructor)<>0) or
  690. { ESI is loaded earlier }
  691. ((p^.procdefinition^.options and poclassmethod)<>0)then
  692. begin
  693. new(r);
  694. reset_reference(r^);
  695. r^.base:=R_ESI;
  696. end
  697. else
  698. begin
  699. new(r);
  700. reset_reference(r^);
  701. r^.base:=R_ESI;
  702. { this is one point where we need vmt_offset (PM) }
  703. r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
  704. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  705. new(r);
  706. reset_reference(r^);
  707. r^.base:=R_EDI;
  708. end;
  709. end
  710. else
  711. { aktprocsym should be assigned, also in main program }
  712. internalerror(12345);
  713. {
  714. begin
  715. new(r);
  716. reset_reference(r^);
  717. r^.base:=R_ESI;
  718. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  719. new(r);
  720. reset_reference(r^);
  721. r^.base:=R_EDI;
  722. end;
  723. }
  724. if pprocdef(p^.procdefinition)^.extnumber=-1 then
  725. internalerror($Da);
  726. r^.offset:=pprocdef(p^.procdefinition)^.extnumber*4+12;
  727. {$ifndef TESTOBJEXT}
  728. if (cs_check_range in aktlocalswitches) then
  729. begin
  730. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
  731. emitcall('FPC_CHECK_OBJECT',true);
  732. end;
  733. {$else TESTOBJEXT}
  734. if (cs_check_range in aktlocalswitches) then
  735. begin
  736. exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
  737. newasmsymbol(pprocdef(p^.procdefinition)^._class^.vmt_mangledname))));
  738. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
  739. emitcall('FPC_CHECK_OBJECT_EXT',true);
  740. end;
  741. {$endif TESTOBJEXT}
  742. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,r)));
  743. end
  744. else if not inlined then
  745. emitcall(pprocdef(p^.procdefinition)^.mangledname,
  746. (p^.symtableproc^.symtabletype=unitsymtable) or
  747. ((p^.symtableproc^.symtabletype=objectsymtable) and
  748. (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable))or
  749. ((p^.symtableproc^.symtabletype=withsymtable) and
  750. (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable)))
  751. else { inlined proc }
  752. { inlined code is in inlinecode }
  753. begin
  754. { set poinline again }
  755. p^.procdefinition^.options:=p^.procdefinition^.options or poinline;
  756. { process the inlinecode }
  757. secondpass(inlinecode);
  758. { free the args }
  759. ungetpersistanttemp(pprocdef(p^.procdefinition)^.parast^.address_fixup);
  760. end;
  761. end
  762. else
  763. { now procedure variable case }
  764. begin
  765. secondpass(p^.right);
  766. { method pointer ? }
  767. if (p^.procdefinition^.options and pomethodpointer)<>0 then
  768. begin
  769. { method pointer can't be in a register }
  770. hregister:=R_NO;
  771. { do some hacking if we call a method pointer }
  772. { which is a class member }
  773. { else ESI is overwritten ! }
  774. if (p^.right^.location.reference.base=R_ESI) or
  775. (p^.right^.location.reference.index=R_ESI) then
  776. begin
  777. del_reference(p^.right^.location.reference);
  778. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  779. newreference(p^.right^.location.reference),R_EDI)));
  780. hregister:=R_EDI;
  781. end;
  782. if ((p^.procdefinition^.options and pocontainsself)=0) then
  783. begin
  784. { load ESI }
  785. inc(p^.right^.location.reference.offset,4);
  786. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  787. newreference(p^.right^.location.reference),R_ESI)));
  788. dec(p^.right^.location.reference.offset,4);
  789. { push self pointer }
  790. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  791. end;
  792. if hregister=R_NO then
  793. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))))
  794. else
  795. exprasmlist^.concat(new(pai386,op_reg(A_CALL,S_NO,hregister)));
  796. del_reference(p^.right^.location.reference);
  797. end
  798. else
  799. begin
  800. case p^.right^.location.loc of
  801. LOC_REGISTER,LOC_CREGISTER:
  802. begin
  803. exprasmlist^.concat(new(pai386,op_reg(A_CALL,S_NO,p^.right^.location.register)));
  804. ungetregister32(p^.right^.location.register);
  805. end
  806. else
  807. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))));
  808. del_reference(p^.right^.location.reference);
  809. end;
  810. end;
  811. end;
  812. { this was only for normal functions
  813. displaced here so we also get
  814. it to work for procvars PM }
  815. if (not inlined) and ((p^.procdefinition^.options and poclearstack)<>0) then
  816. begin
  817. { consider the alignment with the rest (PM) }
  818. inc(pushedparasize,pop_size);
  819. pop_size:=0;
  820. { better than an add on all processors }
  821. if pushedparasize=4 then
  822. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)))
  823. { the pentium has two pipes and pop reg is pairable }
  824. { but the registers must be different! }
  825. else if (pushedparasize=8) and
  826. not(cs_littlesize in aktglobalswitches) and
  827. (aktoptprocessor=ClassP5) and
  828. (procinfo._class=nil) then
  829. begin
  830. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  831. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ESI)));
  832. end
  833. else if pushedparasize<>0 then
  834. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pushedparasize,R_ESP)));
  835. end;
  836. dont_call:
  837. pushedparasize:=oldpushedparasize;
  838. unused:=unusedregisters;
  839. { handle function results }
  840. { structured results are easy to handle.... }
  841. { needed also when result_no_used !! }
  842. if (p^.resulttype<>pdef(voiddef)) and ret_in_param(p^.resulttype) then
  843. begin
  844. p^.location.loc:=LOC_MEM;
  845. p^.location.reference.symbol:=nil;
  846. p^.location.reference:=funcretref;
  847. end;
  848. { we have only to handle the result if it is used, but }
  849. { ansi/widestrings must be registered, so we can dispose them }
  850. if (p^.resulttype<>pdef(voiddef)) and (p^.return_value_used or
  851. is_ansistring(p^.resulttype) or is_widestring(p^.resulttype)) then
  852. begin
  853. { a contructor could be a function with boolean result }
  854. if (p^.right=nil) and
  855. ((p^.procdefinition^.options and poconstructor)<>0) and
  856. { quick'n'dirty check if it is a class or an object }
  857. (p^.resulttype^.deftype=orddef) then
  858. begin
  859. p^.location.loc:=LOC_FLAGS;
  860. p^.location.resflags:=F_NE;
  861. if extended_new then
  862. begin
  863. {$ifdef test_dest_loc}
  864. if dest_loc_known and (dest_loc_tree=p) then
  865. mov_reg_to_dest(p,S_L,R_EAX)
  866. else
  867. {$endif test_dest_loc}
  868. begin
  869. hregister:=getexplicitregister32(R_EAX);
  870. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  871. p^.location.register:=hregister;
  872. end;
  873. end;
  874. end
  875. { structed results are easy to handle.... }
  876. else if ret_in_param(p^.resulttype) then
  877. begin
  878. {p^.location.loc:=LOC_MEM;
  879. stringdispose(p^.location.reference.symbol);
  880. p^.location.reference:=funcretref;
  881. already done above (PM) }
  882. end
  883. else
  884. begin
  885. if (p^.resulttype^.deftype=orddef) then
  886. begin
  887. p^.location.loc:=LOC_REGISTER;
  888. case porddef(p^.resulttype)^.typ of
  889. s32bit,u32bit,bool32bit :
  890. begin
  891. {$ifdef test_dest_loc}
  892. if dest_loc_known and (dest_loc_tree=p) then
  893. mov_reg_to_dest(p,S_L,R_EAX)
  894. else
  895. {$endif test_dest_loc}
  896. begin
  897. hregister:=getexplicitregister32(R_EAX);
  898. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  899. p^.location.register:=hregister;
  900. end;
  901. end;
  902. uchar,u8bit,bool8bit,s8bit:
  903. begin
  904. {$ifdef test_dest_loc}
  905. if dest_loc_known and (dest_loc_tree=p) then
  906. mov_reg_to_dest(p,S_B,R_AL)
  907. else
  908. {$endif test_dest_loc}
  909. begin
  910. hregister:=getexplicitregister32(R_EAX);
  911. emit_reg_reg(A_MOV,S_B,R_AL,reg32toreg8(hregister));
  912. p^.location.register:=reg32toreg8(hregister);
  913. end;
  914. end;
  915. s16bit,u16bit,bool16bit :
  916. begin
  917. {$ifdef test_dest_loc}
  918. if dest_loc_known and (dest_loc_tree=p) then
  919. mov_reg_to_dest(p,S_W,R_AX)
  920. else
  921. {$endif test_dest_loc}
  922. begin
  923. hregister:=getexplicitregister32(R_EAX);
  924. emit_reg_reg(A_MOV,S_W,R_AX,reg32toreg16(hregister));
  925. p^.location.register:=reg32toreg16(hregister);
  926. end;
  927. end;
  928. s64bitint,u64bit:
  929. begin
  930. {$ifdef test_dest_loc}
  931. {$error Don't know what to do here}
  932. {$endif test_dest_loc}
  933. hregister:=getexplicitregister32(R_EAX);
  934. hregister2:=getexplicitregister32(R_EDX);
  935. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  936. emit_reg_reg(A_MOV,S_L,R_EDX,hregister2);
  937. p^.location.registerlow:=hregister;
  938. p^.location.registerhigh:=hregister2;
  939. end;
  940. else internalerror(7);
  941. end
  942. end
  943. else if (p^.resulttype^.deftype=floatdef) then
  944. case pfloatdef(p^.resulttype)^.typ of
  945. f32bit:
  946. begin
  947. p^.location.loc:=LOC_REGISTER;
  948. {$ifdef test_dest_loc}
  949. if dest_loc_known and (dest_loc_tree=p) then
  950. mov_reg_to_dest(p,S_L,R_EAX)
  951. else
  952. {$endif test_dest_loc}
  953. begin
  954. hregister:=getexplicitregister32(R_EAX);
  955. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  956. p^.location.register:=hregister;
  957. end;
  958. end;
  959. else
  960. p^.location.loc:=LOC_FPU;
  961. end
  962. else if is_ansistring(p^.resulttype) or
  963. is_widestring(p^.resulttype) then
  964. begin
  965. gettempansistringreference(hr);
  966. { cleanup the temp slot }
  967. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
  968. decrstringref(exprasmlist,p^.resulttype,hr);
  969. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
  970. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EAX,
  971. newreference(hr))));
  972. p^.location.loc:=LOC_MEM;
  973. p^.location.reference:=hr;
  974. end
  975. else
  976. begin
  977. p^.location.loc:=LOC_REGISTER;
  978. {$ifdef test_dest_loc}
  979. if dest_loc_known and (dest_loc_tree=p) then
  980. mov_reg_to_dest(p,S_L,R_EAX)
  981. else
  982. {$endif test_dest_loc}
  983. begin
  984. hregister:=getexplicitregister32(R_EAX);
  985. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  986. p^.location.register:=hregister;
  987. end;
  988. end;
  989. end;
  990. end;
  991. { perhaps i/o check ? }
  992. if iolabel<>nil then
  993. begin
  994. exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,newasmsymbol(lab2str(iolabel)))));
  995. emitcall('FPC_IOCHECK',true);
  996. end;
  997. if pop_size>0 then
  998. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pop_size,R_ESP)));
  999. { restore registers }
  1000. popusedregisters(exprasmlist,pushed);
  1001. { at last, restore instance pointer (SELF) }
  1002. if loadesi then
  1003. maybe_loadesi;
  1004. pp:=params;
  1005. while assigned(pp) do
  1006. begin
  1007. if assigned(pp^.left) then
  1008. begin
  1009. if (pp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM]) and
  1010. ungettempoftype(pp^.left^.resulttype) then
  1011. ungetiftemp(pp^.left^.location.reference);
  1012. { process also all nodes of an array of const }
  1013. if pp^.left^.treetype=arrayconstructn then
  1014. begin
  1015. if assigned(pp^.left^.left) then
  1016. begin
  1017. hp:=pp^.left;
  1018. while assigned(hp) do
  1019. begin
  1020. if (hp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM]) and
  1021. ungettempoftype(hp^.left^.resulttype) then
  1022. ungetiftemp(hp^.left^.location.reference);
  1023. hp:=hp^.right;
  1024. end;
  1025. end;
  1026. end;
  1027. end;
  1028. pp:=pp^.right;
  1029. end;
  1030. if inlined then
  1031. ungetpersistanttemp(inlinecode^.retoffset);
  1032. disposetree(params);
  1033. { from now on the result can be freed normally }
  1034. if inlined and ret_in_param(p^.resulttype) then
  1035. persistanttemptonormal(funcretref.offset);
  1036. { if return value is not used }
  1037. if (not p^.return_value_used) and (p^.resulttype<>pdef(voiddef)) then
  1038. begin
  1039. if p^.location.loc in [LOC_MEM,LOC_REFERENCE] then
  1040. begin
  1041. { data which must be finalized ? }
  1042. if (p^.resulttype^.needs_inittable) and
  1043. ( (p^.resulttype^.deftype<>objectdef) or
  1044. not(pobjectdef(p^.resulttype)^.isclass)) then
  1045. finalize(exprasmlist,p^.resulttype,p^.location.reference);
  1046. { release unused temp }
  1047. ungetiftemp(p^.location.reference)
  1048. end
  1049. else if p^.location.loc=LOC_FPU then
  1050. { release FPU stack }
  1051. exprasmlist^.concat(new(pai386,op_reg(A_FSTP,S_NO,R_ST0)));
  1052. end;
  1053. end;
  1054. {*****************************************************************************
  1055. SecondProcInlineN
  1056. *****************************************************************************}
  1057. procedure secondprocinline(var p : ptree);
  1058. var st : psymtable;
  1059. oldprocsym : pprocsym;
  1060. para_size : longint;
  1061. oldprocinfo : tprocinfo;
  1062. { just dummies for genentrycode }
  1063. nostackframe,make_global : boolean;
  1064. proc_names : tstringcontainer;
  1065. inlineentrycode,inlineexitcode : paasmoutput;
  1066. oldexitlabel,oldexit2label,oldquickexitlabel:Plabel;
  1067. begin
  1068. oldexitlabel:=aktexitlabel;
  1069. oldexit2label:=aktexit2label;
  1070. oldquickexitlabel:=quickexitlabel;
  1071. getlabel(aktexitlabel);
  1072. getlabel(aktexit2label);
  1073. oldprocsym:=aktprocsym;
  1074. oldprocinfo:=procinfo;
  1075. { set the return value }
  1076. aktprocsym:=p^.inlineprocsym;
  1077. procinfo.retdef:=aktprocsym^.definition^.retdef;
  1078. procinfo.retoffset:=p^.retoffset;
  1079. { arg space has been filled by the parent secondcall }
  1080. st:=aktprocsym^.definition^.localst;
  1081. { set it to the same lexical level }
  1082. st^.symtablelevel:=oldprocsym^.definition^.localst^.symtablelevel;
  1083. if st^.datasize>0 then
  1084. begin
  1085. st^.address_fixup:=gettempofsizepersistant(st^.datasize);
  1086. {$ifdef extdebug}
  1087. Comment(V_debug,'local symtable is at offset '+tostr(st^.address_fixup));
  1088. exprasmlist^.concat(new(pai_asm_comment,init(strpnew(
  1089. 'local symtable is at offset '+tostr(st^.address_fixup)))));
  1090. {$endif extdebug}
  1091. end;
  1092. {$ifdef extdebug}
  1093. exprasmlist^.concat(new(pai_asm_comment,init('Start of inlined proc')));
  1094. {$endif extdebug}
  1095. { takes care of local data initialization }
  1096. inlineentrycode:=new(paasmoutput,init);
  1097. inlineexitcode:=new(paasmoutput,init);
  1098. proc_names.init;
  1099. para_size:=p^.para_size;
  1100. make_global:=false; { to avoid warning }
  1101. genentrycode(inlineentrycode,proc_names,make_global,0,para_size,nostackframe,true);
  1102. exprasmlist^.concatlist(inlineentrycode);
  1103. secondpass(p^.inlinetree);
  1104. genexitcode(inlineexitcode,0,false,true);
  1105. exprasmlist^.concatlist(inlineexitcode);
  1106. {$ifdef extdebug}
  1107. exprasmlist^.concat(new(pai_asm_comment,init('End of inlined proc')));
  1108. {$endif extdebug}
  1109. {we can free the local data now, reset also the fixup address }
  1110. if st^.datasize>0 then
  1111. begin
  1112. ungetpersistanttemp(st^.address_fixup);
  1113. st^.address_fixup:=0;
  1114. end;
  1115. aktprocsym:=oldprocsym;
  1116. freelabel(aktexitlabel);
  1117. freelabel(aktexit2label);
  1118. aktexitlabel:=oldexitlabel;
  1119. aktexit2label:=oldexit2label;
  1120. quickexitlabel:=oldquickexitlabel;
  1121. procinfo:=oldprocinfo;
  1122. end;
  1123. end.
  1124. {
  1125. $Log$
  1126. Revision 1.84 1999-05-18 22:34:26 pierre
  1127. * extedebug problem solved
  1128. Revision 1.83 1999/05/18 21:58:24 florian
  1129. * fixed some bugs related to temp. ansistrings and functions results
  1130. which return records/objects/arrays which need init/final.
  1131. Revision 1.82 1999/05/18 14:15:23 peter
  1132. * containsself fixes
  1133. * checktypes()
  1134. Revision 1.81 1999/05/18 09:52:17 peter
  1135. * procedure of object and addrn fixes
  1136. Revision 1.80 1999/05/17 23:51:37 peter
  1137. * with temp vars now use a reference with a persistant temp instead
  1138. of setting datasize
  1139. Revision 1.79 1999/05/17 21:56:59 florian
  1140. * new temporary ansistring handling
  1141. Revision 1.78 1999/05/01 13:24:02 peter
  1142. * merged nasm compiler
  1143. * old asm moved to oldasm/
  1144. Revision 1.77 1999/04/29 22:12:21 pierre
  1145. * fix for ID 388 removing real from stack was wrong
  1146. Revision 1.76 1999/04/25 22:33:19 pierre
  1147. * fix for TESTOBJEXT code
  1148. Revision 1.75 1999/04/19 09:45:46 pierre
  1149. + cdecl or stdcall push all args with longint size
  1150. * tempansi stuff cleaned up
  1151. Revision 1.74 1999/04/16 13:42:23 jonas
  1152. * more regalloc fixes (still not complete)
  1153. Revision 1.73 1999/04/16 10:26:56 pierre
  1154. * no add $0,%esp for cdecl functions without parameters
  1155. Revision 1.72 1999/04/09 08:41:48 peter
  1156. * define to get ansistring returns in ref instead of reg
  1157. Revision 1.71 1999/03/31 13:55:04 peter
  1158. * assembler inlining working for ag386bin
  1159. Revision 1.70 1999/03/24 23:16:46 peter
  1160. * fixed bugs 212,222,225,227,229,231,233
  1161. Revision 1.69 1999/02/25 21:02:21 peter
  1162. * ag386bin updates
  1163. + coff writer
  1164. Revision 1.68 1999/02/22 02:15:04 peter
  1165. * updates for ag386bin
  1166. Revision 1.67 1999/02/11 09:46:21 pierre
  1167. * fix for normal method calls inside static methods :
  1168. WARNING there were both parser and codegen errors !!
  1169. added static_call boolean to calln tree
  1170. Revision 1.66 1999/02/09 15:45:46 florian
  1171. + complex results for assembler functions, fixes bug0155
  1172. Revision 1.65 1999/02/08 11:29:04 pierre
  1173. * fix for bug0214
  1174. several problems where combined
  1175. search_class_member did not set srsymtable
  1176. => in do_member_read the call node got a wrong symtable
  1177. in cg386cal the vmt was pushed twice without chacking if it exists
  1178. now %esi is set to zero and pushed if not vmt
  1179. (not very efficient but should work !)
  1180. Revision 1.64 1999/02/04 10:49:39 florian
  1181. + range checking for ansi- and widestrings
  1182. * made it compilable with TP
  1183. Revision 1.63 1999/02/03 10:18:14 pierre
  1184. * conditionnal code for extended check of virtual methods
  1185. Revision 1.62 1999/02/02 23:52:32 florian
  1186. * problem with calls to method pointers in methods fixed
  1187. - double ansistrings temp management removed
  1188. Revision 1.61 1999/02/02 11:04:36 florian
  1189. * class destructors fixed, class instances weren't disposed correctly
  1190. Revision 1.60 1999/01/28 23:56:44 florian
  1191. * the reference in the result location of a function call wasn't resetted =>
  1192. problem with unallowed far pointer, is solved now
  1193. Revision 1.59 1999/01/27 00:13:52 florian
  1194. * "procedure of object"-stuff fixed
  1195. Revision 1.58 1999/01/21 22:10:35 peter
  1196. * fixed array of const
  1197. * generic platform independent high() support
  1198. Revision 1.57 1999/01/21 16:40:51 pierre
  1199. * fix for constructor inside with statements
  1200. Revision 1.56 1998/12/30 13:41:05 peter
  1201. * released valuepara
  1202. Revision 1.55 1998/12/22 13:10:58 florian
  1203. * memory leaks for ansistring type casts fixed
  1204. Revision 1.54 1998/12/19 00:23:41 florian
  1205. * ansistring memory leaks fixed
  1206. Revision 1.53 1998/12/11 00:02:47 peter
  1207. + globtype,tokens,version unit splitted from globals
  1208. Revision 1.52 1998/12/10 14:39:29 florian
  1209. * bug with p(const a : ansistring) fixed
  1210. * duplicate constant ansistrings were handled wrong, fixed
  1211. Revision 1.51 1998/12/10 09:47:15 florian
  1212. + basic operations with int64/qord (compiler with -dint64)
  1213. + rtti of enumerations extended: names are now written
  1214. Revision 1.50 1998/12/06 13:12:44 florian
  1215. * better code generation for classes which are passed as parameters to
  1216. subroutines
  1217. Revision 1.49 1998/11/30 09:43:00 pierre
  1218. * some range check bugs fixed (still not working !)
  1219. + added DLL writing support for win32 (also accepts variables)
  1220. + TempAnsi for code that could be used for Temporary ansi strings
  1221. handling
  1222. Revision 1.48 1998/11/27 14:50:30 peter
  1223. + open strings, $P switch support
  1224. Revision 1.47 1998/11/26 21:30:03 peter
  1225. * fix for valuepara
  1226. Revision 1.46 1998/11/26 14:39:10 peter
  1227. * ansistring -> pchar fixed
  1228. * ansistring constants fixed
  1229. * ansistring constants are now written once
  1230. Revision 1.45 1998/11/18 15:44:07 peter
  1231. * VALUEPARA for tp7 compatible value parameters
  1232. Revision 1.44 1998/11/16 15:35:36 peter
  1233. * rename laod/copystring -> load/copyshortstring
  1234. * fixed int-bool cnv bug
  1235. + char-ansistring conversion
  1236. Revision 1.43 1998/11/15 16:32:33 florian
  1237. * some stuff of Pavel implement (win32 dll creation)
  1238. * bug with ansistring function results fixed
  1239. Revision 1.42 1998/11/13 15:40:13 pierre
  1240. + added -Se in Makefile cvstest target
  1241. + lexlevel cleanup
  1242. normal_function_level main_program_level and unit_init_level defined
  1243. * tins_cache grown to A_EMMS (gave range check error in asm readers)
  1244. (test added in code !)
  1245. * -Un option was wrong
  1246. * _FAIL and _SELF only keyword inside
  1247. constructors and methods respectively
  1248. Revision 1.41 1998/11/12 11:19:40 pierre
  1249. * fix for first line of function break
  1250. Revision 1.40 1998/11/10 10:09:08 peter
  1251. * va_list -> array of const
  1252. Revision 1.39 1998/11/09 11:44:33 peter
  1253. + va_list for printf support
  1254. Revision 1.38 1998/10/21 15:12:49 pierre
  1255. * bug fix for IOCHECK inside a procedure with iocheck modifier
  1256. * removed the GPF for unexistant overloading
  1257. (firstcall was called with procedinition=nil !)
  1258. * changed typen to what Florian proposed
  1259. gentypenode(p : pdef) sets the typenodetype field
  1260. and resulttype is only set if inside bt_type block !
  1261. Revision 1.37 1998/10/21 08:39:57 florian
  1262. + ansistring operator +
  1263. + $h and string[n] for n>255 added
  1264. * small problem with TP fixed
  1265. Revision 1.36 1998/10/20 08:06:39 pierre
  1266. * several memory corruptions due to double freemem solved
  1267. => never use p^.loc.location:=p^.left^.loc.location;
  1268. + finally I added now by default
  1269. that ra386dir translates global and unit symbols
  1270. + added a first field in tsymtable and
  1271. a nextsym field in tsym
  1272. (this allows to obtain ordered type info for
  1273. records and objects in gdb !)
  1274. Revision 1.35 1998/10/16 08:51:45 peter
  1275. + target_os.stackalignment
  1276. + stack can be aligned at 2 or 4 byte boundaries
  1277. Revision 1.34 1998/10/09 08:56:22 pierre
  1278. * several memory leaks fixed
  1279. Revision 1.33 1998/10/06 17:16:39 pierre
  1280. * some memory leaks fixed (thanks to Peter for heaptrc !)
  1281. Revision 1.32 1998/10/01 09:22:52 peter
  1282. * fixed value openarray
  1283. * ungettemp of arrayconstruct
  1284. Revision 1.31 1998/09/28 16:57:15 pierre
  1285. * changed all length(p^.value_str^) into str_length(p)
  1286. to get it work with and without ansistrings
  1287. * changed sourcefiles field of tmodule to a pointer
  1288. Revision 1.30 1998/09/26 15:03:02 florian
  1289. * small problems with DOM and excpetions fixed (code generation
  1290. of raise was wrong and self was sometimes destroyed :()
  1291. Revision 1.29 1998/09/25 00:04:00 florian
  1292. * problems when calling class methods fixed
  1293. Revision 1.28 1998/09/24 14:27:37 peter
  1294. * some better support for openarray
  1295. Revision 1.27 1998/09/24 09:02:13 peter
  1296. * rewritten isconvertable to use case
  1297. * array of .. and single variable are compatible
  1298. Revision 1.26 1998/09/21 08:45:06 pierre
  1299. + added vmt_offset in tobjectdef.write for fututre use
  1300. (first steps to have objects without vmt if no virtual !!)
  1301. + added fpu_used field for tabstractprocdef :
  1302. sets this level to 2 if the functions return with value in FPU
  1303. (is then set to correct value at parsing of implementation)
  1304. THIS MIGHT refuse some code with FPU expression too complex
  1305. that were accepted before and even in some cases
  1306. that don't overflow in fact
  1307. ( like if f : float; is a forward that finally in implementation
  1308. only uses one fpu register !!)
  1309. Nevertheless I think that it will improve security on
  1310. FPU operations !!
  1311. * most other changes only for UseBrowser code
  1312. (added symtable references for record and objects)
  1313. local switch for refs to args and local of each function
  1314. (static symtable still missing)
  1315. UseBrowser still not stable and probably broken by
  1316. the definition hash array !!
  1317. Revision 1.25 1998/09/20 12:26:35 peter
  1318. * merged fixes
  1319. Revision 1.24 1998/09/17 09:42:10 peter
  1320. + pass_2 for cg386
  1321. * Message() -> CGMessage() for pass_1/pass_2
  1322. Revision 1.23 1998/09/14 10:43:45 peter
  1323. * all internal RTL functions start with FPC_
  1324. Revision 1.22.2.1 1998/09/20 12:20:06 peter
  1325. * Fixed stack not on 4 byte boundary when doing a call
  1326. Revision 1.22 1998/09/04 08:41:37 peter
  1327. * updated some error CGMessages
  1328. Revision 1.21 1998/09/01 12:47:57 peter
  1329. * use pdef^.size instead of orddef^.typ
  1330. Revision 1.20 1998/08/31 12:22:15 peter
  1331. * secondinline moved to cg386inl
  1332. Revision 1.19 1998/08/31 08:52:03 peter
  1333. * fixed error 10 with succ() and pref()
  1334. Revision 1.18 1998/08/20 21:36:38 peter
  1335. * fixed 'with object do' bug
  1336. Revision 1.17 1998/08/19 16:07:36 jonas
  1337. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  1338. Revision 1.16 1998/08/18 09:24:36 pierre
  1339. * small warning position bug fixed
  1340. * support_mmx switches splitting was missing
  1341. * rhide error and warning output corrected
  1342. Revision 1.15 1998/08/13 11:00:09 peter
  1343. * fixed procedure<>procedure construct
  1344. Revision 1.14 1998/08/11 14:05:33 peter
  1345. * fixed sizeof(array of char)
  1346. Revision 1.13 1998/08/10 14:49:45 peter
  1347. + localswitches, moduleswitches, globalswitches splitting
  1348. Revision 1.12 1998/07/30 13:30:31 florian
  1349. * final implemenation of exception support, maybe it needs
  1350. some fixes :)
  1351. Revision 1.11 1998/07/24 22:16:52 florian
  1352. * internal error 10 together with array access fixed. I hope
  1353. that's the final fix.
  1354. Revision 1.10 1998/07/18 22:54:23 florian
  1355. * some ansi/wide/longstring support fixed:
  1356. o parameter passing
  1357. o returning as result from functions
  1358. Revision 1.9 1998/07/07 17:40:37 peter
  1359. * packrecords 4 works
  1360. * word aligning of parameters
  1361. Revision 1.8 1998/07/06 15:51:15 michael
  1362. Added length checking for string reading
  1363. Revision 1.7 1998/07/06 14:19:51 michael
  1364. + Added calls for reading/writing ansistrings
  1365. Revision 1.6 1998/07/01 15:28:48 peter
  1366. + better writeln/readln handling, now 100% like tp7
  1367. Revision 1.5 1998/06/25 14:04:17 peter
  1368. + internal inc/dec
  1369. Revision 1.4 1998/06/25 08:48:06 florian
  1370. * first version of rtti support
  1371. Revision 1.3 1998/06/09 16:01:33 pierre
  1372. + added procedure directive parsing for procvars
  1373. (accepted are popstack cdecl and pascal)
  1374. + added C vars with the following syntax
  1375. var C calias 'true_c_name';(can be followed by external)
  1376. reason is that you must add the Cprefix
  1377. which is target dependent
  1378. Revision 1.2 1998/06/08 13:13:29 pierre
  1379. + temporary variables now in temp_gen.pas unit
  1380. because it is processor independent
  1381. * mppc68k.bat modified to undefine i386 and support_mmx
  1382. (which are defaults for i386)
  1383. Revision 1.1 1998/06/05 17:44:10 peter
  1384. * splitted cgi386
  1385. }