cg386cal.pas 66 KB

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