n386cal.pas 76 KB

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