n386cal.pas 69 KB

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