n386cal.pas 70 KB

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