n386cal.pas 76 KB

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