cg386cal.pas 67 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560
  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. i386base,i386asm,
  37. {$ifdef dummy}
  38. end { this overcomes the annoying highlighting problem in my TP IDE,
  39. the IDE assumes i386asm start a asm block (FK) }
  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 : pasmlabel;
  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(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(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(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 : 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 : pasmlabel;
  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(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(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(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. end;
  445. { exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  446. this is done below !! }
  447. end
  448. else
  449. { this is a member call, so ESI isn't modfied }
  450. loadesi:=false;
  451. { a class destructor needs a flag }
  452. if pobjectdef(p^.methodpointer^.resulttype)^.isclass and
  453. assigned(aktprocsym) and
  454. ((aktprocsym^.definition^.options and
  455. (podestructor))<>0) then
  456. begin
  457. push_int(0);
  458. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  459. end;
  460. if not(is_con_or_destructor and
  461. pobjectdef(p^.methodpointer^.resulttype)^.isclass and
  462. assigned(aktprocsym) and
  463. ((aktprocsym^.definition^.options and (poconstructor or podestructor))<>0)
  464. ) then
  465. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  466. { if an inherited con- or destructor should be }
  467. { called in a con- or destructor then a warning }
  468. { will be made }
  469. { con- and destructors need a pointer to the vmt }
  470. if is_con_or_destructor and
  471. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) and
  472. assigned(aktprocsym) then
  473. begin
  474. if not ((aktprocsym^.definition^.options
  475. and (poconstructor or podestructor))<>0) then
  476. CGMessage(cg_w_member_cd_call_from_method);
  477. end;
  478. { class destructors get there flag below }
  479. if is_con_or_destructor and
  480. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass and
  481. assigned(aktprocsym) and
  482. ((aktprocsym^.definition^.options and
  483. (podestructor))<>0)) then
  484. push_int(0);
  485. end;
  486. hnewn:
  487. begin
  488. { extended syntax of new }
  489. { ESI must be zero }
  490. exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
  491. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  492. { insert the vmt }
  493. exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
  494. newasmsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname))));
  495. extended_new:=true;
  496. end;
  497. hdisposen:
  498. begin
  499. secondpass(p^.methodpointer);
  500. { destructor with extended syntax called from dispose }
  501. { hdisposen always deliver LOC_REFERENCE }
  502. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  503. newreference(p^.methodpointer^.location.reference),R_ESI)));
  504. del_reference(p^.methodpointer^.location.reference);
  505. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  506. exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
  507. newasmsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname))));
  508. end;
  509. else
  510. begin
  511. { call to an instance member }
  512. if (p^.symtable^.symtabletype<>withsymtable) then
  513. begin
  514. secondpass(p^.methodpointer);
  515. case p^.methodpointer^.location.loc of
  516. LOC_CREGISTER,
  517. LOC_REGISTER:
  518. begin
  519. emit_reg_reg(A_MOV,S_L,p^.methodpointer^.location.register,R_ESI);
  520. ungetregister32(p^.methodpointer^.location.register);
  521. end;
  522. else
  523. begin
  524. if (p^.methodpointer^.resulttype^.deftype=classrefdef) or
  525. ((p^.methodpointer^.resulttype^.deftype=objectdef) and
  526. pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  527. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  528. newreference(p^.methodpointer^.location.reference),R_ESI)))
  529. else
  530. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  531. newreference(p^.methodpointer^.location.reference),R_ESI)));
  532. del_reference(p^.methodpointer^.location.reference);
  533. end;
  534. end;
  535. end;
  536. { when calling a class method, we have to load ESI with the VMT !
  537. But, not for a class method via self }
  538. if ((p^.procdefinition^.options and pocontainsself)=0) then
  539. begin
  540. if ((p^.procdefinition^.options and poclassmethod)<>0)
  541. and not(p^.methodpointer^.resulttype^.deftype=classrefdef) then
  542. begin
  543. { class method needs current VMT }
  544. new(r);
  545. reset_reference(r^);
  546. r^.base:=R_ESI;
  547. r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
  548. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  549. end;
  550. { direct call to destructor: don't remove data! }
  551. if ((p^.procdefinition^.options and podestructor)<>0) and
  552. (p^.methodpointer^.resulttype^.deftype=objectdef) and
  553. (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  554. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,1)));
  555. { direct call to class constructor, don't allocate memory }
  556. if ((p^.procdefinition^.options and poconstructor)<>0) and
  557. (p^.methodpointer^.resulttype^.deftype=objectdef) and
  558. (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  559. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
  560. else
  561. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  562. end;
  563. if is_con_or_destructor then
  564. begin
  565. { classes don't get a VMT pointer pushed }
  566. if (p^.methodpointer^.resulttype^.deftype=objectdef) and
  567. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  568. begin
  569. if ((p^.procdefinition^.options and poconstructor)<>0) then
  570. begin
  571. { it's no bad idea, to insert the VMT }
  572. exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,newasmsymbol(
  573. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname))));
  574. end
  575. { destructors haven't to dispose the instance, if this is }
  576. { a direct call }
  577. else
  578. push_int(0);
  579. end;
  580. end;
  581. end;
  582. end;
  583. end;
  584. end
  585. else
  586. begin
  587. if ((p^.procdefinition^.options and poclassmethod)<>0) and
  588. not(
  589. assigned(aktprocsym) and
  590. ((aktprocsym^.definition^.options and poclassmethod)<>0)
  591. ) then
  592. begin
  593. { class method needs current VMT }
  594. new(r);
  595. reset_reference(r^);
  596. r^.base:=R_ESI;
  597. r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
  598. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  599. end
  600. else
  601. begin
  602. { member call, ESI isn't modified }
  603. loadesi:=false;
  604. end;
  605. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  606. { but a con- or destructor here would probably almost }
  607. { always be placed wrong }
  608. if is_con_or_destructor then
  609. begin
  610. CGMessage(cg_w_member_cd_call_from_method);
  611. push_int(0);
  612. end;
  613. end;
  614. end;
  615. { push base pointer ?}
  616. if (lexlevel>=normal_function_level) and assigned(pprocdef(p^.procdefinition)^.parast) and
  617. ((pprocdef(p^.procdefinition)^.parast^.symtablelevel)>normal_function_level) then
  618. begin
  619. { if we call a nested function in a method, we must }
  620. { push also SELF! }
  621. { THAT'S NOT TRUE, we have to load ESI via frame pointer }
  622. { access }
  623. {
  624. begin
  625. loadesi:=false;
  626. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  627. end;
  628. }
  629. if lexlevel=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) then
  630. begin
  631. new(r);
  632. reset_reference(r^);
  633. r^.offset:=procinfo.framepointer_offset;
  634. r^.base:=procinfo.framepointer;
  635. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)))
  636. end
  637. { this is only true if the difference is one !!
  638. but it cannot be more !! }
  639. else if (lexlevel=pprocdef(p^.procdefinition)^.parast^.symtablelevel-1) then
  640. begin
  641. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,procinfo.framepointer)))
  642. end
  643. else if (lexlevel>pprocdef(p^.procdefinition)^.parast^.symtablelevel) then
  644. begin
  645. hregister:=getregister32;
  646. new(r);
  647. reset_reference(r^);
  648. r^.offset:=procinfo.framepointer_offset;
  649. r^.base:=procinfo.framepointer;
  650. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  651. for i:=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) to lexlevel-1 do
  652. begin
  653. new(r);
  654. reset_reference(r^);
  655. {we should get the correct frame_pointer_offset at each level
  656. how can we do this !!! }
  657. r^.offset:=procinfo.framepointer_offset;
  658. r^.base:=hregister;
  659. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  660. end;
  661. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,hregister)));
  662. ungetregister32(hregister);
  663. end
  664. else
  665. internalerror(25000);
  666. end;
  667. if ((p^.procdefinition^.options and povirtualmethod)<>0) and
  668. not(no_virtual_call) then
  669. begin
  670. { static functions contain the vmt_address in ESI }
  671. { also class methods }
  672. { Here it is quite tricky because it also depends }
  673. { on the methodpointer PM }
  674. if assigned(aktprocsym) then
  675. begin
  676. if ((((aktprocsym^.properties and sp_static)<>0) or
  677. ((aktprocsym^.definition^.options and poclassmethod)<>0)) and
  678. ((p^.methodpointer=nil) or (p^.methodpointer^.treetype=typen)))
  679. or
  680. ((p^.procdefinition^.options and postaticmethod)<>0) or
  681. ((p^.procdefinition^.options and poconstructor)<>0) or
  682. { ESI is loaded earlier }
  683. ((p^.procdefinition^.options and poclassmethod)<>0)then
  684. begin
  685. new(r);
  686. reset_reference(r^);
  687. r^.base:=R_ESI;
  688. end
  689. else
  690. begin
  691. new(r);
  692. reset_reference(r^);
  693. r^.base:=R_ESI;
  694. { this is one point where we need vmt_offset (PM) }
  695. r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
  696. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  697. new(r);
  698. reset_reference(r^);
  699. r^.base:=R_EDI;
  700. end;
  701. end
  702. else
  703. { aktprocsym should be assigned, also in main program }
  704. internalerror(12345);
  705. {
  706. begin
  707. new(r);
  708. reset_reference(r^);
  709. r^.base:=R_ESI;
  710. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  711. new(r);
  712. reset_reference(r^);
  713. r^.base:=R_EDI;
  714. end;
  715. }
  716. if pprocdef(p^.procdefinition)^.extnumber=-1 then
  717. internalerror($Da);
  718. r^.offset:=pprocdef(p^.procdefinition)^.extnumber*4+12;
  719. {$ifndef TESTOBJEXT}
  720. if (cs_check_range in aktlocalswitches) then
  721. begin
  722. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
  723. emitcall('FPC_CHECK_OBJECT');
  724. end;
  725. {$else TESTOBJEXT}
  726. if (cs_check_range in aktlocalswitches) then
  727. begin
  728. exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
  729. newasmsymbol(pprocdef(p^.procdefinition)^._class^.vmt_mangledname))));
  730. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
  731. emitcall('FPC_CHECK_OBJECT_EXT');
  732. end;
  733. {$endif TESTOBJEXT}
  734. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,r)));
  735. end
  736. else if not inlined then
  737. emitcall(pprocdef(p^.procdefinition)^.mangledname)
  738. else { inlined proc }
  739. { inlined code is in inlinecode }
  740. begin
  741. { set poinline again }
  742. p^.procdefinition^.options:=p^.procdefinition^.options or poinline;
  743. { process the inlinecode }
  744. secondpass(inlinecode);
  745. { free the args }
  746. ungetpersistanttemp(pprocdef(p^.procdefinition)^.parast^.address_fixup);
  747. end;
  748. end
  749. else
  750. { now procedure variable case }
  751. begin
  752. secondpass(p^.right);
  753. { method pointer ? }
  754. if (p^.procdefinition^.options and pomethodpointer)<>0 then
  755. begin
  756. { method pointer can't be in a register }
  757. hregister:=R_NO;
  758. { do some hacking if we call a method pointer }
  759. { which is a class member }
  760. { else ESI is overwritten ! }
  761. if (p^.right^.location.reference.base=R_ESI) or
  762. (p^.right^.location.reference.index=R_ESI) then
  763. begin
  764. del_reference(p^.right^.location.reference);
  765. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  766. newreference(p^.right^.location.reference),R_EDI)));
  767. hregister:=R_EDI;
  768. end;
  769. if ((p^.procdefinition^.options and pocontainsself)=0) then
  770. begin
  771. { load ESI }
  772. inc(p^.right^.location.reference.offset,4);
  773. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  774. newreference(p^.right^.location.reference),R_ESI)));
  775. dec(p^.right^.location.reference.offset,4);
  776. { push self pointer }
  777. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  778. end;
  779. if hregister=R_NO then
  780. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))))
  781. else
  782. exprasmlist^.concat(new(pai386,op_reg(A_CALL,S_NO,hregister)));
  783. del_reference(p^.right^.location.reference);
  784. end
  785. else
  786. begin
  787. case p^.right^.location.loc of
  788. LOC_REGISTER,LOC_CREGISTER:
  789. begin
  790. exprasmlist^.concat(new(pai386,op_reg(A_CALL,S_NO,p^.right^.location.register)));
  791. ungetregister32(p^.right^.location.register);
  792. end
  793. else
  794. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))));
  795. del_reference(p^.right^.location.reference);
  796. end;
  797. end;
  798. end;
  799. { this was only for normal functions
  800. displaced here so we also get
  801. it to work for procvars PM }
  802. if (not inlined) and ((p^.procdefinition^.options and poclearstack)<>0) then
  803. begin
  804. { consider the alignment with the rest (PM) }
  805. inc(pushedparasize,pop_size);
  806. pop_size:=0;
  807. { better than an add on all processors }
  808. if pushedparasize=4 then
  809. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)))
  810. { the pentium has two pipes and pop reg is pairable }
  811. { but the registers must be different! }
  812. else if (pushedparasize=8) and
  813. not(cs_littlesize in aktglobalswitches) and
  814. (aktoptprocessor=ClassP5) and
  815. (procinfo._class=nil) then
  816. begin
  817. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  818. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ESI)));
  819. end
  820. else if pushedparasize<>0 then
  821. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pushedparasize,R_ESP)));
  822. end;
  823. dont_call:
  824. pushedparasize:=oldpushedparasize;
  825. unused:=unusedregisters;
  826. { handle function results }
  827. { structured results are easy to handle.... }
  828. { needed also when result_no_used !! }
  829. if (p^.resulttype<>pdef(voiddef)) and ret_in_param(p^.resulttype) then
  830. begin
  831. p^.location.loc:=LOC_MEM;
  832. p^.location.reference.symbol:=nil;
  833. p^.location.reference:=funcretref;
  834. end;
  835. { we have only to handle the result if it is used, but }
  836. { ansi/widestrings must be registered, so we can dispose them }
  837. if (p^.resulttype<>pdef(voiddef)) and (p^.return_value_used or
  838. is_ansistring(p^.resulttype) or is_widestring(p^.resulttype)) then
  839. begin
  840. { a contructor could be a function with boolean result }
  841. if (p^.right=nil) and
  842. ((p^.procdefinition^.options and poconstructor)<>0) and
  843. { quick'n'dirty check if it is a class or an object }
  844. (p^.resulttype^.deftype=orddef) then
  845. begin
  846. p^.location.loc:=LOC_FLAGS;
  847. p^.location.resflags:=F_NE;
  848. if extended_new then
  849. begin
  850. {$ifdef test_dest_loc}
  851. if dest_loc_known and (dest_loc_tree=p) then
  852. mov_reg_to_dest(p,S_L,R_EAX)
  853. else
  854. {$endif test_dest_loc}
  855. begin
  856. hregister:=getexplicitregister32(R_EAX);
  857. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  858. p^.location.register:=hregister;
  859. end;
  860. end;
  861. end
  862. { structed results are easy to handle.... }
  863. else if ret_in_param(p^.resulttype) then
  864. begin
  865. {p^.location.loc:=LOC_MEM;
  866. stringdispose(p^.location.reference.symbol);
  867. p^.location.reference:=funcretref;
  868. already done above (PM) }
  869. end
  870. else
  871. begin
  872. if (p^.resulttype^.deftype=orddef) then
  873. begin
  874. p^.location.loc:=LOC_REGISTER;
  875. case porddef(p^.resulttype)^.typ of
  876. s32bit,u32bit,bool32bit :
  877. begin
  878. {$ifdef test_dest_loc}
  879. if dest_loc_known and (dest_loc_tree=p) then
  880. mov_reg_to_dest(p,S_L,R_EAX)
  881. else
  882. {$endif test_dest_loc}
  883. begin
  884. hregister:=getexplicitregister32(R_EAX);
  885. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  886. p^.location.register:=hregister;
  887. end;
  888. end;
  889. uchar,u8bit,bool8bit,s8bit:
  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_B,R_AL)
  894. else
  895. {$endif test_dest_loc}
  896. begin
  897. hregister:=getexplicitregister32(R_EAX);
  898. emit_reg_reg(A_MOV,S_B,R_AL,reg32toreg8(hregister));
  899. p^.location.register:=reg32toreg8(hregister);
  900. end;
  901. end;
  902. s16bit,u16bit,bool16bit :
  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_W,R_AX)
  907. else
  908. {$endif test_dest_loc}
  909. begin
  910. hregister:=getexplicitregister32(R_EAX);
  911. emit_reg_reg(A_MOV,S_W,R_AX,reg32toreg16(hregister));
  912. p^.location.register:=reg32toreg16(hregister);
  913. end;
  914. end;
  915. s64bitint,u64bit:
  916. begin
  917. {$ifdef test_dest_loc}
  918. {$error Don't know what to do here}
  919. {$endif test_dest_loc}
  920. hregister:=getexplicitregister32(R_EAX);
  921. hregister2:=getexplicitregister32(R_EDX);
  922. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  923. emit_reg_reg(A_MOV,S_L,R_EDX,hregister2);
  924. p^.location.registerlow:=hregister;
  925. p^.location.registerhigh:=hregister2;
  926. end;
  927. else internalerror(7);
  928. end
  929. end
  930. else if (p^.resulttype^.deftype=floatdef) then
  931. case pfloatdef(p^.resulttype)^.typ of
  932. f32bit:
  933. begin
  934. p^.location.loc:=LOC_REGISTER;
  935. {$ifdef test_dest_loc}
  936. if dest_loc_known and (dest_loc_tree=p) then
  937. mov_reg_to_dest(p,S_L,R_EAX)
  938. else
  939. {$endif test_dest_loc}
  940. begin
  941. hregister:=getexplicitregister32(R_EAX);
  942. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  943. p^.location.register:=hregister;
  944. end;
  945. end;
  946. else
  947. p^.location.loc:=LOC_FPU;
  948. end
  949. else if is_ansistring(p^.resulttype) or
  950. is_widestring(p^.resulttype) then
  951. begin
  952. hregister:=getexplicitregister32(R_EAX);
  953. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  954. if gettempansistringreference(hr) then
  955. decrstringref(p^.resulttype,hr);
  956. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,hregister,
  957. newreference(hr))));
  958. ungetregister32(hregister);
  959. p^.location.loc:=LOC_MEM;
  960. p^.location.reference:=hr;
  961. end
  962. else
  963. begin
  964. p^.location.loc:=LOC_REGISTER;
  965. {$ifdef test_dest_loc}
  966. if dest_loc_known and (dest_loc_tree=p) then
  967. mov_reg_to_dest(p,S_L,R_EAX)
  968. else
  969. {$endif test_dest_loc}
  970. begin
  971. hregister:=getexplicitregister32(R_EAX);
  972. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  973. p^.location.register:=hregister;
  974. end;
  975. end;
  976. end;
  977. end;
  978. { perhaps i/o check ? }
  979. if iolabel<>nil then
  980. begin
  981. exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,iolabel)));
  982. emitcall('FPC_IOCHECK');
  983. end;
  984. if pop_size>0 then
  985. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pop_size,R_ESP)));
  986. { restore registers }
  987. popusedregisters(pushed);
  988. { at last, restore instance pointer (SELF) }
  989. if loadesi then
  990. maybe_loadesi;
  991. pp:=params;
  992. while assigned(pp) do
  993. begin
  994. if assigned(pp^.left) then
  995. begin
  996. if (pp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM]) then
  997. ungetiftemp(pp^.left^.location.reference);
  998. { process also all nodes of an array of const }
  999. if pp^.left^.treetype=arrayconstructn then
  1000. begin
  1001. if assigned(pp^.left^.left) then
  1002. begin
  1003. hp:=pp^.left;
  1004. while assigned(hp) do
  1005. begin
  1006. if (hp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM]) then
  1007. ungetiftemp(hp^.left^.location.reference);
  1008. hp:=hp^.right;
  1009. end;
  1010. end;
  1011. end;
  1012. end;
  1013. pp:=pp^.right;
  1014. end;
  1015. if inlined then
  1016. ungetpersistanttemp(inlinecode^.retoffset);
  1017. disposetree(params);
  1018. { from now on the result can be freed normally }
  1019. if inlined and ret_in_param(p^.resulttype) then
  1020. persistanttemptonormal(funcretref.offset);
  1021. { if return value is not used }
  1022. if (not p^.return_value_used) and (p^.resulttype<>pdef(voiddef)) then
  1023. begin
  1024. if p^.location.loc in [LOC_MEM,LOC_REFERENCE] then
  1025. begin
  1026. { data which must be finalized ? }
  1027. if (p^.resulttype^.needs_inittable) and
  1028. ( (p^.resulttype^.deftype<>objectdef) or
  1029. not(pobjectdef(p^.resulttype)^.isclass)) then
  1030. finalize(p^.resulttype,p^.location.reference);
  1031. { release unused temp }
  1032. ungetiftemp(p^.location.reference)
  1033. end
  1034. else if p^.location.loc=LOC_FPU then
  1035. { release FPU stack }
  1036. exprasmlist^.concat(new(pai386,op_reg(A_FSTP,S_NO,R_ST0)));
  1037. end;
  1038. end;
  1039. {*****************************************************************************
  1040. SecondProcInlineN
  1041. *****************************************************************************}
  1042. procedure secondprocinline(var p : ptree);
  1043. var st : psymtable;
  1044. oldprocsym : pprocsym;
  1045. para_size : longint;
  1046. oldprocinfo : tprocinfo;
  1047. { just dummies for genentrycode }
  1048. nostackframe,make_global : boolean;
  1049. proc_names : tstringcontainer;
  1050. inlineentrycode,inlineexitcode : paasmoutput;
  1051. oldexitlabel,oldexit2label,oldquickexitlabel:Pasmlabel;
  1052. begin
  1053. oldexitlabel:=aktexitlabel;
  1054. oldexit2label:=aktexit2label;
  1055. oldquickexitlabel:=quickexitlabel;
  1056. getlabel(aktexitlabel);
  1057. getlabel(aktexit2label);
  1058. oldprocsym:=aktprocsym;
  1059. oldprocinfo:=procinfo;
  1060. { set the return value }
  1061. aktprocsym:=p^.inlineprocsym;
  1062. procinfo.retdef:=aktprocsym^.definition^.retdef;
  1063. procinfo.retoffset:=p^.retoffset;
  1064. { arg space has been filled by the parent secondcall }
  1065. st:=aktprocsym^.definition^.localst;
  1066. { set it to the same lexical level }
  1067. st^.symtablelevel:=oldprocsym^.definition^.localst^.symtablelevel;
  1068. if st^.datasize>0 then
  1069. begin
  1070. st^.address_fixup:=gettempofsizepersistant(st^.datasize);
  1071. {$ifdef extdebug}
  1072. Comment(V_debug,'local symtable is at offset '+tostr(st^.address_fixup));
  1073. exprasmlist^.concat(new(pai_asm_comment,init(strpnew(
  1074. 'local symtable is at offset '+tostr(st^.address_fixup)))));
  1075. {$endif extdebug}
  1076. end;
  1077. {$ifdef extdebug}
  1078. exprasmlist^.concat(new(pai_asm_comment,init('Start of inlined proc')));
  1079. {$endif extdebug}
  1080. { takes care of local data initialization }
  1081. inlineentrycode:=new(paasmoutput,init);
  1082. inlineexitcode:=new(paasmoutput,init);
  1083. proc_names.init;
  1084. para_size:=p^.para_size;
  1085. make_global:=false; { to avoid warning }
  1086. genentrycode(inlineentrycode,proc_names,make_global,0,para_size,nostackframe,true);
  1087. exprasmlist^.concatlist(inlineentrycode);
  1088. secondpass(p^.inlinetree);
  1089. genexitcode(inlineexitcode,0,false,true);
  1090. exprasmlist^.concatlist(inlineexitcode);
  1091. {$ifdef extdebug}
  1092. exprasmlist^.concat(new(pai_asm_comment,init('End of inlined proc')));
  1093. {$endif extdebug}
  1094. {we can free the local data now, reset also the fixup address }
  1095. if st^.datasize>0 then
  1096. begin
  1097. ungetpersistanttemp(st^.address_fixup);
  1098. st^.address_fixup:=0;
  1099. end;
  1100. aktprocsym:=oldprocsym;
  1101. freelabel(aktexitlabel);
  1102. freelabel(aktexit2label);
  1103. aktexitlabel:=oldexitlabel;
  1104. aktexit2label:=oldexit2label;
  1105. quickexitlabel:=oldquickexitlabel;
  1106. procinfo:=oldprocinfo;
  1107. end;
  1108. end.
  1109. {
  1110. $Log$
  1111. Revision 1.92 1999-06-16 09:32:45 peter
  1112. * merged
  1113. Revision 1.91 1999/06/14 17:47:47 peter
  1114. * merged
  1115. Revision 1.90.2.2 1999/06/16 09:30:44 peter
  1116. * fixed loading of ansistring when eax was already used
  1117. Revision 1.90.2.1 1999/06/14 17:24:42 peter
  1118. * fixed saving of registers with decr_ansistr
  1119. Revision 1.90 1999/06/02 10:11:40 florian
  1120. * make cycle fixed i.e. compilation with 0.99.10
  1121. * some fixes for qword
  1122. * start of register calling conventions
  1123. Revision 1.89 1999/05/28 15:59:46 pierre
  1124. * forgotten emitcall change in conditionnal
  1125. Revision 1.88 1999/05/28 11:00:49 peter
  1126. * removed ungettempoftype
  1127. Revision 1.87 1999/05/27 19:44:07 peter
  1128. * removed oldasm
  1129. * plabel -> pasmlabel
  1130. * -a switches to source writing automaticly
  1131. * assembler readers OOPed
  1132. * asmsymbol automaticly external
  1133. * jumptables and other label fixes for asm readers
  1134. Revision 1.86 1999/05/23 18:41:58 florian
  1135. * better error recovering in typed constants
  1136. * some problems with arrays of const fixed, some problems
  1137. due my previous
  1138. - the location type of array constructor is now LOC_MEM
  1139. - the pushing of high fixed
  1140. - parameter copying fixed
  1141. - zero temp. allocation removed
  1142. * small problem in the assembler writers fixed:
  1143. ref to nil wasn't written correctly
  1144. Revision 1.85 1999/05/21 13:54:44 peter
  1145. * NEWLAB for label as symbol
  1146. Revision 1.84 1999/05/18 22:34:26 pierre
  1147. * extedebug problem solved
  1148. Revision 1.83 1999/05/18 21:58:24 florian
  1149. * fixed some bugs related to temp. ansistrings and functions results
  1150. which return records/objects/arrays which need init/final.
  1151. Revision 1.82 1999/05/18 14:15:23 peter
  1152. * containsself fixes
  1153. * checktypes()
  1154. Revision 1.81 1999/05/18 09:52:17 peter
  1155. * procedure of object and addrn fixes
  1156. Revision 1.80 1999/05/17 23:51:37 peter
  1157. * with temp vars now use a reference with a persistant temp instead
  1158. of setting datasize
  1159. Revision 1.79 1999/05/17 21:56:59 florian
  1160. * new temporary ansistring handling
  1161. Revision 1.78 1999/05/01 13:24:02 peter
  1162. * merged nasm compiler
  1163. * old asm moved to oldasm/
  1164. Revision 1.77 1999/04/29 22:12:21 pierre
  1165. * fix for ID 388 removing real from stack was wrong
  1166. Revision 1.76 1999/04/25 22:33:19 pierre
  1167. * fix for TESTOBJEXT code
  1168. Revision 1.75 1999/04/19 09:45:46 pierre
  1169. + cdecl or stdcall push all args with longint size
  1170. * tempansi stuff cleaned up
  1171. Revision 1.74 1999/04/16 13:42:23 jonas
  1172. * more regalloc fixes (still not complete)
  1173. Revision 1.73 1999/04/16 10:26:56 pierre
  1174. * no add $0,%esp for cdecl functions without parameters
  1175. Revision 1.72 1999/04/09 08:41:48 peter
  1176. * define to get ansistring returns in ref instead of reg
  1177. Revision 1.71 1999/03/31 13:55:04 peter
  1178. * assembler inlining working for ag386bin
  1179. Revision 1.70 1999/03/24 23:16:46 peter
  1180. * fixed bugs 212,222,225,227,229,231,233
  1181. Revision 1.69 1999/02/25 21:02:21 peter
  1182. * ag386bin updates
  1183. + coff writer
  1184. Revision 1.68 1999/02/22 02:15:04 peter
  1185. * updates for ag386bin
  1186. Revision 1.67 1999/02/11 09:46:21 pierre
  1187. * fix for normal method calls inside static methods :
  1188. WARNING there were both parser and codegen errors !!
  1189. added static_call boolean to calln tree
  1190. Revision 1.66 1999/02/09 15:45:46 florian
  1191. + complex results for assembler functions, fixes bug0155
  1192. Revision 1.65 1999/02/08 11:29:04 pierre
  1193. * fix for bug0214
  1194. several problems where combined
  1195. search_class_member did not set srsymtable
  1196. => in do_member_read the call node got a wrong symtable
  1197. in cg386cal the vmt was pushed twice without chacking if it exists
  1198. now %esi is set to zero and pushed if not vmt
  1199. (not very efficient but should work !)
  1200. Revision 1.64 1999/02/04 10:49:39 florian
  1201. + range checking for ansi- and widestrings
  1202. * made it compilable with TP
  1203. Revision 1.63 1999/02/03 10:18:14 pierre
  1204. * conditionnal code for extended check of virtual methods
  1205. Revision 1.62 1999/02/02 23:52:32 florian
  1206. * problem with calls to method pointers in methods fixed
  1207. - double ansistrings temp management removed
  1208. Revision 1.61 1999/02/02 11:04:36 florian
  1209. * class destructors fixed, class instances weren't disposed correctly
  1210. Revision 1.60 1999/01/28 23:56:44 florian
  1211. * the reference in the result location of a function call wasn't resetted =>
  1212. problem with unallowed far pointer, is solved now
  1213. Revision 1.59 1999/01/27 00:13:52 florian
  1214. * "procedure of object"-stuff fixed
  1215. Revision 1.58 1999/01/21 22:10:35 peter
  1216. * fixed array of const
  1217. * generic platform independent high() support
  1218. Revision 1.57 1999/01/21 16:40:51 pierre
  1219. * fix for constructor inside with statements
  1220. Revision 1.56 1998/12/30 13:41:05 peter
  1221. * released valuepara
  1222. Revision 1.55 1998/12/22 13:10:58 florian
  1223. * memory leaks for ansistring type casts fixed
  1224. Revision 1.54 1998/12/19 00:23:41 florian
  1225. * ansistring memory leaks fixed
  1226. Revision 1.53 1998/12/11 00:02:47 peter
  1227. + globtype,tokens,version unit splitted from globals
  1228. Revision 1.52 1998/12/10 14:39:29 florian
  1229. * bug with p(const a : ansistring) fixed
  1230. * duplicate constant ansistrings were handled wrong, fixed
  1231. Revision 1.51 1998/12/10 09:47:15 florian
  1232. + basic operations with int64/qord (compiler with -dint64)
  1233. + rtti of enumerations extended: names are now written
  1234. Revision 1.50 1998/12/06 13:12:44 florian
  1235. * better code generation for classes which are passed as parameters to
  1236. subroutines
  1237. Revision 1.49 1998/11/30 09:43:00 pierre
  1238. * some range check bugs fixed (still not working !)
  1239. + added DLL writing support for win32 (also accepts variables)
  1240. + TempAnsi for code that could be used for Temporary ansi strings
  1241. handling
  1242. Revision 1.48 1998/11/27 14:50:30 peter
  1243. + open strings, $P switch support
  1244. Revision 1.47 1998/11/26 21:30:03 peter
  1245. * fix for valuepara
  1246. Revision 1.46 1998/11/26 14:39:10 peter
  1247. * ansistring -> pchar fixed
  1248. * ansistring constants fixed
  1249. * ansistring constants are now written once
  1250. Revision 1.45 1998/11/18 15:44:07 peter
  1251. * VALUEPARA for tp7 compatible value parameters
  1252. Revision 1.44 1998/11/16 15:35:36 peter
  1253. * rename laod/copystring -> load/copyshortstring
  1254. * fixed int-bool cnv bug
  1255. + char-ansistring conversion
  1256. Revision 1.43 1998/11/15 16:32:33 florian
  1257. * some stuff of Pavel implement (win32 dll creation)
  1258. * bug with ansistring function results fixed
  1259. Revision 1.42 1998/11/13 15:40:13 pierre
  1260. + added -Se in Makefile cvstest target
  1261. + lexlevel cleanup
  1262. normal_function_level main_program_level and unit_init_level defined
  1263. * tins_cache grown to A_EMMS (gave range check error in asm readers)
  1264. (test added in code !)
  1265. * -Un option was wrong
  1266. * _FAIL and _SELF only keyword inside
  1267. constructors and methods respectively
  1268. Revision 1.41 1998/11/12 11:19:40 pierre
  1269. * fix for first line of function break
  1270. Revision 1.40 1998/11/10 10:09:08 peter
  1271. * va_list -> array of const
  1272. Revision 1.39 1998/11/09 11:44:33 peter
  1273. + va_list for printf support
  1274. Revision 1.38 1998/10/21 15:12:49 pierre
  1275. * bug fix for IOCHECK inside a procedure with iocheck modifier
  1276. * removed the GPF for unexistant overloading
  1277. (firstcall was called with procedinition=nil !)
  1278. * changed typen to what Florian proposed
  1279. gentypenode(p : pdef) sets the typenodetype field
  1280. and resulttype is only set if inside bt_type block !
  1281. Revision 1.37 1998/10/21 08:39:57 florian
  1282. + ansistring operator +
  1283. + $h and string[n] for n>255 added
  1284. * small problem with TP fixed
  1285. Revision 1.36 1998/10/20 08:06:39 pierre
  1286. * several memory corruptions due to double freemem solved
  1287. => never use p^.loc.location:=p^.left^.loc.location;
  1288. + finally I added now by default
  1289. that ra386dir translates global and unit symbols
  1290. + added a first field in tsymtable and
  1291. a nextsym field in tsym
  1292. (this allows to obtain ordered type info for
  1293. records and objects in gdb !)
  1294. Revision 1.35 1998/10/16 08:51:45 peter
  1295. + target_os.stackalignment
  1296. + stack can be aligned at 2 or 4 byte boundaries
  1297. Revision 1.34 1998/10/09 08:56:22 pierre
  1298. * several memory leaks fixed
  1299. Revision 1.33 1998/10/06 17:16:39 pierre
  1300. * some memory leaks fixed (thanks to Peter for heaptrc !)
  1301. Revision 1.32 1998/10/01 09:22:52 peter
  1302. * fixed value openarray
  1303. * ungettemp of arrayconstruct
  1304. Revision 1.31 1998/09/28 16:57:15 pierre
  1305. * changed all length(p^.value_str^) into str_length(p)
  1306. to get it work with and without ansistrings
  1307. * changed sourcefiles field of tmodule to a pointer
  1308. Revision 1.30 1998/09/26 15:03:02 florian
  1309. * small problems with DOM and excpetions fixed (code generation
  1310. of raise was wrong and self was sometimes destroyed :()
  1311. Revision 1.29 1998/09/25 00:04:00 florian
  1312. * problems when calling class methods fixed
  1313. Revision 1.28 1998/09/24 14:27:37 peter
  1314. * some better support for openarray
  1315. Revision 1.27 1998/09/24 09:02:13 peter
  1316. * rewritten isconvertable to use case
  1317. * array of .. and single variable are compatible
  1318. Revision 1.26 1998/09/21 08:45:06 pierre
  1319. + added vmt_offset in tobjectdef.write for fututre use
  1320. (first steps to have objects without vmt if no virtual !!)
  1321. + added fpu_used field for tabstractprocdef :
  1322. sets this level to 2 if the functions return with value in FPU
  1323. (is then set to correct value at parsing of implementation)
  1324. THIS MIGHT refuse some code with FPU expression too complex
  1325. that were accepted before and even in some cases
  1326. that don't overflow in fact
  1327. ( like if f : float; is a forward that finally in implementation
  1328. only uses one fpu register !!)
  1329. Nevertheless I think that it will improve security on
  1330. FPU operations !!
  1331. * most other changes only for UseBrowser code
  1332. (added symtable references for record and objects)
  1333. local switch for refs to args and local of each function
  1334. (static symtable still missing)
  1335. UseBrowser still not stable and probably broken by
  1336. the definition hash array !!
  1337. Revision 1.25 1998/09/20 12:26:35 peter
  1338. * merged fixes
  1339. Revision 1.24 1998/09/17 09:42:10 peter
  1340. + pass_2 for cg386
  1341. * Message() -> CGMessage() for pass_1/pass_2
  1342. Revision 1.23 1998/09/14 10:43:45 peter
  1343. * all internal RTL functions start with FPC_
  1344. Revision 1.22.2.1 1998/09/20 12:20:06 peter
  1345. * Fixed stack not on 4 byte boundary when doing a call
  1346. Revision 1.22 1998/09/04 08:41:37 peter
  1347. * updated some error CGMessages
  1348. Revision 1.21 1998/09/01 12:47:57 peter
  1349. * use pdef^.size instead of orddef^.typ
  1350. Revision 1.20 1998/08/31 12:22:15 peter
  1351. * secondinline moved to cg386inl
  1352. Revision 1.19 1998/08/31 08:52:03 peter
  1353. * fixed error 10 with succ() and pref()
  1354. Revision 1.18 1998/08/20 21:36:38 peter
  1355. * fixed 'with object do' bug
  1356. Revision 1.17 1998/08/19 16:07:36 jonas
  1357. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  1358. Revision 1.16 1998/08/18 09:24:36 pierre
  1359. * small warning position bug fixed
  1360. * support_mmx switches splitting was missing
  1361. * rhide error and warning output corrected
  1362. Revision 1.15 1998/08/13 11:00:09 peter
  1363. * fixed procedure<>procedure construct
  1364. Revision 1.14 1998/08/11 14:05:33 peter
  1365. * fixed sizeof(array of char)
  1366. Revision 1.13 1998/08/10 14:49:45 peter
  1367. + localswitches, moduleswitches, globalswitches splitting
  1368. Revision 1.12 1998/07/30 13:30:31 florian
  1369. * final implemenation of exception support, maybe it needs
  1370. some fixes :)
  1371. Revision 1.11 1998/07/24 22:16:52 florian
  1372. * internal error 10 together with array access fixed. I hope
  1373. that's the final fix.
  1374. Revision 1.10 1998/07/18 22:54:23 florian
  1375. * some ansi/wide/longstring support fixed:
  1376. o parameter passing
  1377. o returning as result from functions
  1378. Revision 1.9 1998/07/07 17:40:37 peter
  1379. * packrecords 4 works
  1380. * word aligning of parameters
  1381. Revision 1.8 1998/07/06 15:51:15 michael
  1382. Added length checking for string reading
  1383. Revision 1.7 1998/07/06 14:19:51 michael
  1384. + Added calls for reading/writing ansistrings
  1385. Revision 1.6 1998/07/01 15:28:48 peter
  1386. + better writeln/readln handling, now 100% like tp7
  1387. Revision 1.5 1998/06/25 14:04:17 peter
  1388. + internal inc/dec
  1389. Revision 1.4 1998/06/25 08:48:06 florian
  1390. * first version of rtti support
  1391. Revision 1.3 1998/06/09 16:01:33 pierre
  1392. + added procedure directive parsing for procvars
  1393. (accepted are popstack cdecl and pascal)
  1394. + added C vars with the following syntax
  1395. var C calias 'true_c_name';(can be followed by external)
  1396. reason is that you must add the Cprefix
  1397. which is target dependent
  1398. Revision 1.2 1998/06/08 13:13:29 pierre
  1399. + temporary variables now in temp_gen.pas unit
  1400. because it is processor independent
  1401. * mppc68k.bat modified to undefine i386 and support_mmx
  1402. (which are defaults for i386)
  1403. Revision 1.1 1998/06/05 17:44:10 peter
  1404. * splitted cgi386
  1405. }