n386cal.pas 74 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694
  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. hcodegen,temp_gen,pass_2,
  50. cpubase,cpuasm,
  51. nmem,nld,
  52. cgai386,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(procdefinition.rettype.def.size);
  429. funcretref.base:=procinfo^.framepointer;
  430. end
  431. else
  432. gettempofsizereference(procdefinition.rettype.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 have 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. if (lexlevel>=normal_function_level) and assigned(tprocdef(procdefinition).parast) and
  797. ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
  798. begin
  799. { if we call a nested function in a method, we must }
  800. { push also SELF! }
  801. { THAT'S NOT TRUE, we have to load ESI via frame pointer }
  802. { access }
  803. {
  804. begin
  805. loadesi:=false;
  806. emit_reg(A_PUSH,S_L,R_ESI);
  807. end;
  808. }
  809. if lexlevel=(tprocdef(procdefinition).parast.symtablelevel) then
  810. begin
  811. new(r);
  812. reset_reference(r^);
  813. r^.offset:=procinfo^.framepointer_offset;
  814. r^.base:=procinfo^.framepointer;
  815. emit_ref(A_PUSH,S_L,r)
  816. end
  817. { this is only true if the difference is one !!
  818. but it cannot be more !! }
  819. else if (lexlevel=tprocdef(procdefinition).parast.symtablelevel-1) then
  820. begin
  821. emit_reg(A_PUSH,S_L,procinfo^.framepointer)
  822. end
  823. else if (lexlevel>tprocdef(procdefinition).parast.symtablelevel) then
  824. begin
  825. hregister:=getregister32;
  826. new(r);
  827. reset_reference(r^);
  828. r^.offset:=procinfo^.framepointer_offset;
  829. r^.base:=procinfo^.framepointer;
  830. emit_ref_reg(A_MOV,S_L,r,hregister);
  831. for i:=(tprocdef(procdefinition).parast.symtablelevel) to lexlevel-1 do
  832. begin
  833. new(r);
  834. reset_reference(r^);
  835. {we should get the correct frame_pointer_offset at each level
  836. how can we do this !!! }
  837. r^.offset:=procinfo^.framepointer_offset;
  838. r^.base:=hregister;
  839. emit_ref_reg(A_MOV,S_L,r,hregister);
  840. end;
  841. emit_reg(A_PUSH,S_L,hregister);
  842. ungetregister32(hregister);
  843. end
  844. else
  845. internalerror(25000);
  846. end;
  847. saveregvars(regs_to_push);
  848. if (po_virtualmethod in procdefinition.procoptions) and
  849. not(no_virtual_call) then
  850. begin
  851. { static functions contain the vmt_address in ESI }
  852. { also class methods }
  853. { Here it is quite tricky because it also depends }
  854. { on the methodpointer PM }
  855. getexplicitregister32(R_ESI);
  856. if assigned(aktprocsym) then
  857. begin
  858. if (((sp_static in aktprocsym.symoptions) or
  859. (po_classmethod in aktprocsym.definition.procoptions)) and
  860. ((methodpointer=nil) or (methodpointer.nodetype=typen)))
  861. or
  862. (po_staticmethod in procdefinition.procoptions) or
  863. ((procdefinition.proctypeoption=potype_constructor) and
  864. { esi contains the vmt if we call a constructor via a class ref }
  865. assigned(methodpointer) and
  866. (methodpointer.resulttype.def.deftype=classrefdef)
  867. ) or
  868. { is_interface(tprocdef(procdefinition)._class) or }
  869. { ESI is loaded earlier }
  870. (po_classmethod in procdefinition.procoptions) then
  871. begin
  872. new(r);
  873. reset_reference(r^);
  874. r^.base:=R_ESI;
  875. end
  876. else
  877. begin
  878. new(r);
  879. reset_reference(r^);
  880. r^.base:=R_ESI;
  881. { this is one point where we need vmt_offset (PM) }
  882. r^.offset:= tprocdef(procdefinition)._class.vmt_offset;
  883. getexplicitregister32(R_EDI);
  884. emit_ref_reg(A_MOV,S_L,r,R_EDI);
  885. new(r);
  886. reset_reference(r^);
  887. r^.base:=R_EDI;
  888. end;
  889. end
  890. else
  891. { aktprocsym should be assigned, also in main program }
  892. internalerror(12345);
  893. {
  894. begin
  895. new(r);
  896. reset_reference(r^);
  897. r^.base:=R_ESI;
  898. emit_ref_reg(A_MOV,S_L,r,R_EDI);
  899. new(r);
  900. reset_reference(r^);
  901. r^.base:=R_EDI;
  902. end;
  903. }
  904. if tprocdef(procdefinition).extnumber=-1 then
  905. internalerror(44584);
  906. r^.offset:=tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber);
  907. if not(is_interface(tprocdef(procdefinition)._class)) and
  908. not(is_cppclass(tprocdef(procdefinition)._class)) then
  909. begin
  910. if (cs_check_object_ext in aktlocalswitches) then
  911. begin
  912. emit_sym(A_PUSH,S_L,
  913. newasmsymbol(tprocdef(procdefinition)._class.vmt_mangledname));
  914. emit_reg(A_PUSH,S_L,r^.base);
  915. emitcall('FPC_CHECK_OBJECT_EXT');
  916. end
  917. else if (cs_check_range in aktlocalswitches) then
  918. begin
  919. emit_reg(A_PUSH,S_L,r^.base);
  920. emitcall('FPC_CHECK_OBJECT');
  921. end;
  922. end;
  923. emit_ref(A_CALL,S_NO,r);
  924. ungetregister32(R_EDI);
  925. end
  926. else if not inlined then
  927. begin
  928. { We can call interrupts from within the smae code
  929. by just pushing the flags and CS PM }
  930. if (po_interrupt in procdefinition.procoptions) then
  931. begin
  932. emit_none(A_PUSHF,S_L);
  933. emit_reg(A_PUSH,S_L,R_CS);
  934. end;
  935. emitcall(tprocdef(procdefinition).mangledname);
  936. end
  937. else { inlined proc }
  938. { inlined code is in inlinecode }
  939. begin
  940. { set poinline again }
  941. include(procdefinition.proccalloptions,pocall_inline);
  942. { process the inlinecode }
  943. secondpass(inlinecode);
  944. { free the args }
  945. if tprocdef(procdefinition).parast.datasize>0 then
  946. ungetpersistanttemp(tprocdef(procdefinition).parast.address_fixup);
  947. end;
  948. end
  949. else
  950. { now procedure variable case }
  951. begin
  952. secondpass(right);
  953. if (po_interrupt in procdefinition.procoptions) then
  954. begin
  955. emit_none(A_PUSHF,S_L);
  956. emit_reg(A_PUSH,S_L,R_CS);
  957. end;
  958. { procedure of object? }
  959. if (po_methodpointer in procdefinition.procoptions) then
  960. begin
  961. { method pointer can't be in a register }
  962. hregister:=R_NO;
  963. { do some hacking if we call a method pointer }
  964. { which is a class member }
  965. { else ESI is overwritten ! }
  966. if (right.location.reference.base=R_ESI) or
  967. (right.location.reference.index=R_ESI) then
  968. begin
  969. del_reference(right.location.reference);
  970. getexplicitregister32(R_EDI);
  971. emit_ref_reg(A_MOV,S_L,
  972. newreference(right.location.reference),R_EDI);
  973. hregister:=R_EDI;
  974. end;
  975. { load self, but not if it's already explicitly pushed }
  976. if not(po_containsself in procdefinition.procoptions) then
  977. begin
  978. { load ESI }
  979. inc(right.location.reference.offset,4);
  980. getexplicitregister32(R_ESI);
  981. emit_ref_reg(A_MOV,S_L,
  982. newreference(right.location.reference),R_ESI);
  983. dec(right.location.reference.offset,4);
  984. { push self pointer }
  985. emit_reg(A_PUSH,S_L,R_ESI);
  986. end;
  987. saveregvars($ff);
  988. if hregister=R_NO then
  989. emit_ref(A_CALL,S_NO,newreference(right.location.reference))
  990. else
  991. begin
  992. ungetregister32(hregister);
  993. emit_reg(A_CALL,S_NO,hregister);
  994. end;
  995. del_reference(right.location.reference);
  996. end
  997. else
  998. begin
  999. saveregvars($ff);
  1000. case right.location.loc of
  1001. LOC_REGISTER,LOC_CREGISTER:
  1002. begin
  1003. emit_reg(A_CALL,S_NO,right.location.register);
  1004. ungetregister32(right.location.register);
  1005. end
  1006. else
  1007. begin
  1008. emit_ref(A_CALL,S_NO,newreference(right.location.reference));
  1009. del_reference(right.location.reference);
  1010. end;
  1011. end;
  1012. end;
  1013. end;
  1014. { this was only for normal functions
  1015. displaced here so we also get
  1016. it to work for procvars PM }
  1017. if (not inlined) and (pocall_clearstack in procdefinition.proccalloptions) then
  1018. begin
  1019. { we also add the pop_size which is included in pushedparasize }
  1020. pop_size:=0;
  1021. { better than an add on all processors }
  1022. if pushedparasize=4 then
  1023. begin
  1024. getexplicitregister32(R_EDI);
  1025. emit_reg(A_POP,S_L,R_EDI);
  1026. ungetregister32(R_EDI);
  1027. end
  1028. { the pentium has two pipes and pop reg is pairable }
  1029. { but the registers must be different! }
  1030. else if (pushedparasize=8) and
  1031. not(cs_littlesize in aktglobalswitches) and
  1032. (aktoptprocessor=ClassP5) and
  1033. (procinfo^._class=nil) then
  1034. begin
  1035. getexplicitregister32(R_EDI);
  1036. emit_reg(A_POP,S_L,R_EDI);
  1037. ungetregister32(R_EDI);
  1038. exprasmList.concat(Tairegalloc.Alloc(R_ESI));
  1039. emit_reg(A_POP,S_L,R_ESI);
  1040. exprasmList.concat(Tairegalloc.Alloc(R_ESI));
  1041. end
  1042. else if pushedparasize<>0 then
  1043. emit_const_reg(A_ADD,S_L,pushedparasize,R_ESP);
  1044. end;
  1045. if pop_esp then
  1046. emit_reg(A_POP,S_L,R_ESP);
  1047. dont_call:
  1048. pushedparasize:=oldpushedparasize;
  1049. unused:=unusedregisters;
  1050. usablereg32:=usablecount;
  1051. {$ifdef TEMPREGDEBUG}
  1052. testregisters32;
  1053. {$endif TEMPREGDEBUG}
  1054. { a constructor could be a function with boolean result }
  1055. { if calling constructor called fail we
  1056. must jump directly to quickexitlabel PM
  1057. but only if it is a call of an inherited constructor }
  1058. if (inlined or
  1059. (right=nil)) and
  1060. (procdefinition.proctypeoption=potype_constructor) and
  1061. assigned(methodpointer) and
  1062. (methodpointer.nodetype=typen) and
  1063. (aktprocsym.definition.proctypeoption=potype_constructor) then
  1064. begin
  1065. emitjmp(C_Z,faillabel);
  1066. end;
  1067. { call to AfterConstruction? }
  1068. if is_class(resulttype.def) and
  1069. (inlined or
  1070. (right=nil)) and
  1071. (procdefinition.proctypeoption=potype_constructor) and
  1072. assigned(methodpointer) and
  1073. (methodpointer.nodetype<>typen) then
  1074. begin
  1075. getlabel(constructorfailed);
  1076. emitjmp(C_Z,constructorfailed);
  1077. emit_reg(A_PUSH,S_L,R_ESI);
  1078. new(r);
  1079. reset_reference(r^);
  1080. r^.base:=R_ESI;
  1081. getexplicitregister32(R_EDI);
  1082. emit_ref_reg(A_MOV,S_L,r,R_EDI);
  1083. new(r);
  1084. reset_reference(r^);
  1085. r^.offset:=68;
  1086. r^.base:=R_EDI;
  1087. emit_ref(A_CALL,S_NO,r);
  1088. ungetregister32(R_EDI);
  1089. exprasmList.concat(Tairegalloc.Alloc(R_EAX));
  1090. emitlab(constructorfailed);
  1091. emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX);
  1092. end;
  1093. { handle function results }
  1094. { structured results are easy to handle.... }
  1095. { needed also when result_no_used !! }
  1096. if (not is_void(resulttype.def)) and ret_in_param(resulttype.def) then
  1097. begin
  1098. location.loc:=LOC_MEM;
  1099. location.reference.symbol:=nil;
  1100. location.reference:=funcretref;
  1101. end;
  1102. { we have only to handle the result if it is used, but }
  1103. { ansi/widestrings must be registered, so we can dispose them }
  1104. if (not is_void(resulttype.def)) and ((nf_return_value_used in flags) or
  1105. is_ansistring(resulttype.def) or is_widestring(resulttype.def)) then
  1106. begin
  1107. { a contructor could be a function with boolean result }
  1108. if (inlined or
  1109. (right=nil)) and
  1110. (procdefinition.proctypeoption=potype_constructor) and
  1111. { quick'n'dirty check if it is a class or an object }
  1112. (resulttype.def.deftype=orddef) then
  1113. begin
  1114. { this fails if popsize > 0 PM }
  1115. location.loc:=LOC_FLAGS;
  1116. location.resflags:=F_NE;
  1117. if extended_new then
  1118. begin
  1119. {$ifdef test_dest_loc}
  1120. if dest_loc_known and (dest_loc_tree=p) then
  1121. mov_reg_to_dest(p,S_L,R_EAX)
  1122. else
  1123. {$endif test_dest_loc}
  1124. begin
  1125. hregister:=getexplicitregister32(R_EAX);
  1126. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1127. location.register:=hregister;
  1128. end;
  1129. end;
  1130. end
  1131. { structed results are easy to handle.... }
  1132. else if ret_in_param(resulttype.def) then
  1133. begin
  1134. {location.loc:=LOC_MEM;
  1135. stringdispose(location.reference.symbol);
  1136. location.reference:=funcretref;
  1137. already done above (PM) }
  1138. end
  1139. else
  1140. begin
  1141. if (resulttype.def.deftype in [orddef,enumdef]) then
  1142. begin
  1143. location.loc:=LOC_REGISTER;
  1144. case resulttype.def.size of
  1145. 4 :
  1146. begin
  1147. {$ifdef test_dest_loc}
  1148. if dest_loc_known and (dest_loc_tree=p) then
  1149. mov_reg_to_dest(p,S_L,R_EAX)
  1150. else
  1151. {$endif test_dest_loc}
  1152. begin
  1153. hregister:=getexplicitregister32(R_EAX);
  1154. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1155. location.register:=hregister;
  1156. end;
  1157. end;
  1158. 1 :
  1159. begin
  1160. {$ifdef test_dest_loc}
  1161. if dest_loc_known and (dest_loc_tree=p) then
  1162. mov_reg_to_dest(p,S_B,R_AL)
  1163. else
  1164. {$endif test_dest_loc}
  1165. begin
  1166. hregister:=getexplicitregister32(R_EAX);
  1167. emit_reg_reg(A_MOV,S_B,R_AL,reg32toreg8(hregister));
  1168. location.register:=reg32toreg8(hregister);
  1169. end;
  1170. end;
  1171. 2 :
  1172. begin
  1173. {$ifdef test_dest_loc}
  1174. if dest_loc_known and (dest_loc_tree=p) then
  1175. mov_reg_to_dest(p,S_W,R_AX)
  1176. else
  1177. {$endif test_dest_loc}
  1178. begin
  1179. hregister:=getexplicitregister32(R_EAX);
  1180. emit_reg_reg(A_MOV,S_W,R_AX,reg32toreg16(hregister));
  1181. location.register:=reg32toreg16(hregister);
  1182. end;
  1183. end;
  1184. 8 :
  1185. begin
  1186. {$ifdef test_dest_loc}
  1187. {$error Don't know what to do here}
  1188. {$endif test_dest_loc}
  1189. if R_EDX in unused then
  1190. begin
  1191. hregister2:=getexplicitregister32(R_EDX);
  1192. hregister:=getexplicitregister32(R_EAX);
  1193. end
  1194. else
  1195. begin
  1196. hregister:=getexplicitregister32(R_EAX);
  1197. hregister2:=getexplicitregister32(R_EDX);
  1198. end;
  1199. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1200. emit_reg_reg(A_MOV,S_L,R_EDX,hregister2);
  1201. location.registerlow:=hregister;
  1202. location.registerhigh:=hregister2;
  1203. end;
  1204. else internalerror(7);
  1205. end
  1206. end
  1207. else if (resulttype.def.deftype=floatdef) then
  1208. begin
  1209. location.loc:=LOC_FPU;
  1210. inc(fpuvaroffset);
  1211. end
  1212. else if is_ansistring(resulttype.def) or
  1213. is_widestring(resulttype.def) then
  1214. begin
  1215. hregister:=getexplicitregister32(R_EAX);
  1216. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1217. if tstringdef(resulttype.def).string_typ=st_widestring then
  1218. begin
  1219. gettempwidestringreference(hr);
  1220. decrstringref(resulttype.def,hr);
  1221. end
  1222. else
  1223. begin
  1224. gettempansistringreference(hr);
  1225. decrstringref(resulttype.def,hr);
  1226. end;
  1227. emit_reg_ref(A_MOV,S_L,hregister,
  1228. newreference(hr));
  1229. ungetregister32(hregister);
  1230. location.loc:=LOC_MEM;
  1231. location.reference:=hr;
  1232. end
  1233. else
  1234. begin
  1235. location.loc:=LOC_REGISTER;
  1236. {$ifdef test_dest_loc}
  1237. if dest_loc_known and (dest_loc_tree=p) then
  1238. mov_reg_to_dest(p,S_L,R_EAX)
  1239. else
  1240. {$endif test_dest_loc}
  1241. begin
  1242. hregister:=getexplicitregister32(R_EAX);
  1243. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1244. location.register:=hregister;
  1245. end;
  1246. end;
  1247. end;
  1248. end;
  1249. { perhaps i/o check ? }
  1250. if iolabel<>nil then
  1251. begin
  1252. emit_sym(A_PUSH,S_L,iolabel);
  1253. emitcall('FPC_IOCHECK');
  1254. end;
  1255. if pop_size>0 then
  1256. emit_const_reg(A_ADD,S_L,pop_size,R_ESP);
  1257. { restore registers }
  1258. popusedregisters(pushed);
  1259. { at last, restore instance pointer (SELF) }
  1260. if loadesi then
  1261. maybe_loadself;
  1262. pp:=tbinarynode(params);
  1263. while assigned(pp) do
  1264. begin
  1265. if assigned(pp.left) then
  1266. begin
  1267. if (pp.left.location.loc in [LOC_REFERENCE,LOC_MEM]) then
  1268. ungetiftemp(pp.left.location.reference);
  1269. { process also all nodes of an array of const }
  1270. if pp.left.nodetype=arrayconstructorn then
  1271. begin
  1272. if assigned(tarrayconstructornode(pp.left).left) then
  1273. begin
  1274. hp:=pp.left;
  1275. while assigned(hp) do
  1276. begin
  1277. if (tarrayconstructornode(tunarynode(hp).left).location.loc in [LOC_REFERENCE,LOC_MEM]) then
  1278. ungetiftemp(tarrayconstructornode(hp).left.location.reference);
  1279. hp:=tbinarynode(hp).right;
  1280. end;
  1281. end;
  1282. end;
  1283. end;
  1284. pp:=tbinarynode(pp.right);
  1285. end;
  1286. if inlined then
  1287. ungetpersistanttemp(inlinecode.retoffset);
  1288. if assigned(params) then
  1289. params.free;
  1290. { from now on the result can be freed normally }
  1291. if inlined and ret_in_param(resulttype.def) then
  1292. persistanttemptonormal(funcretref.offset);
  1293. { if return value is not used }
  1294. if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then
  1295. begin
  1296. if location.loc in [LOC_MEM,LOC_REFERENCE] then
  1297. begin
  1298. { data which must be finalized ? }
  1299. if (resulttype.def.needs_inittable) then
  1300. finalize(resulttype.def,location.reference,false);
  1301. { release unused temp }
  1302. ungetiftemp(location.reference)
  1303. end
  1304. else if location.loc=LOC_FPU then
  1305. begin
  1306. { release FPU stack }
  1307. emit_reg(A_FSTP,S_NO,R_ST0);
  1308. {
  1309. dec(fpuvaroffset);
  1310. do NOT decrement as the increment before
  1311. is not called for unused results PM }
  1312. end;
  1313. end;
  1314. end;
  1315. {*****************************************************************************
  1316. TI386PROCINLINENODE
  1317. *****************************************************************************}
  1318. procedure ti386procinlinenode.pass_2;
  1319. var st : tsymtable;
  1320. oldprocsym : tprocsym;
  1321. ps, i : longint;
  1322. tmpreg: tregister;
  1323. oldprocinfo : pprocinfo;
  1324. oldinlining_procedure,
  1325. nostackframe,make_global : boolean;
  1326. inlineentrycode,inlineexitcode : TAAsmoutput;
  1327. oldexitlabel,oldexit2label,oldquickexitlabel:tasmlabel;
  1328. oldunused,oldusableregs : tregisterset;
  1329. oldc_usableregs : longint;
  1330. oldreg_pushes : regvar_longintarray;
  1331. oldregvar_loaded,
  1332. oldis_reg_var : regvar_booleanarray;
  1333. {$ifdef TEMPREGDEBUG}
  1334. oldreg_user : regvar_ptreearray;
  1335. oldreg_releaser : regvar_ptreearray;
  1336. {$endif TEMPREGDEBUG}
  1337. {$ifdef GDB}
  1338. startlabel,endlabel : tasmlabel;
  1339. pp : pchar;
  1340. mangled_length : longint;
  1341. {$endif GDB}
  1342. begin
  1343. { deallocate the registers used for the current procedure's regvars }
  1344. if assigned(aktprocsym.definition.regvarinfo) then
  1345. begin
  1346. with pregvarinfo(aktprocsym.definition.regvarinfo)^ do
  1347. for i := 1 to maxvarregs do
  1348. if assigned(regvars[i]) then
  1349. store_regvar(exprasmlist,regvars[i].reg);
  1350. oldunused := unused;
  1351. oldusableregs := usableregs;
  1352. oldc_usableregs := c_usableregs;
  1353. oldreg_pushes := reg_pushes;
  1354. oldis_reg_var := is_reg_var;
  1355. oldregvar_loaded := regvar_loaded;
  1356. {$ifdef TEMPREGDEBUG}
  1357. oldreg_user := reg_user;
  1358. oldreg_releaser := reg_releaser;
  1359. {$endif TEMPREGDEBUG}
  1360. { make sure the register allocator knows what the regvars in the }
  1361. { inlined code block are (JM) }
  1362. resetusableregisters;
  1363. clearregistercount;
  1364. cleartempgen;
  1365. if assigned(inlineprocsym.definition.regvarinfo) then
  1366. with pregvarinfo(inlineprocsym.definition.regvarinfo)^ do
  1367. for i := 1 to maxvarregs do
  1368. if assigned(regvars[i]) then
  1369. begin
  1370. case regsize(regvars[i].reg) of
  1371. S_B: tmpreg := reg8toreg32(regvars[i].reg);
  1372. S_W: tmpreg := reg16toreg32(regvars[i].reg);
  1373. S_L: tmpreg := regvars[i].reg;
  1374. end;
  1375. usableregs:=usableregs-[tmpreg];
  1376. is_reg_var[tmpreg]:=true;
  1377. dec(c_usableregs);
  1378. end;
  1379. end;
  1380. oldinlining_procedure:=inlining_procedure;
  1381. oldexitlabel:=aktexitlabel;
  1382. oldexit2label:=aktexit2label;
  1383. oldquickexitlabel:=quickexitlabel;
  1384. getlabel(aktexitlabel);
  1385. getlabel(aktexit2label);
  1386. oldprocsym:=aktprocsym;
  1387. { we're inlining a procedure }
  1388. inlining_procedure:=true;
  1389. { save old procinfo }
  1390. getmem(oldprocinfo,sizeof(tprocinfo));
  1391. move(procinfo^,oldprocinfo^,sizeof(tprocinfo));
  1392. { set the return value }
  1393. aktprocsym:=inlineprocsym;
  1394. procinfo^.returntype:=aktprocsym.definition.rettype;
  1395. procinfo^.return_offset:=retoffset;
  1396. procinfo^.para_offset:=para_offset;
  1397. { arg space has been filled by the parent secondcall }
  1398. st:=aktprocsym.definition.localst;
  1399. { set it to the same lexical level }
  1400. st.symtablelevel:=oldprocsym.definition.localst.symtablelevel;
  1401. if st.datasize>0 then
  1402. begin
  1403. st.address_fixup:=gettempofsizepersistant(st.datasize)+st.datasize;
  1404. {$ifdef extdebug}
  1405. Comment(V_debug,'local symtable is at offset '+tostr(st.address_fixup));
  1406. exprasmList.concat(Tai_asm_comment.Create(strpnew(
  1407. 'local symtable is at offset '+tostr(st.address_fixup))));
  1408. {$endif extdebug}
  1409. end;
  1410. exprasmList.concat(Tai_Marker.Create(InlineStart));
  1411. {$ifdef extdebug}
  1412. exprasmList.concat(Tai_asm_comment.Create(strpnew('Start of inlined proc')));
  1413. {$endif extdebug}
  1414. {$ifdef GDB}
  1415. if (cs_debuginfo in aktmoduleswitches) then
  1416. begin
  1417. getaddrlabel(startlabel);
  1418. getaddrlabel(endlabel);
  1419. emitlab(startlabel);
  1420. inlineprocsym.definition.localst.symtabletype:=inlinelocalsymtable;
  1421. inlineprocsym.definition.parast.symtabletype:=inlineparasymtable;
  1422. { Here we must include the para and local symtable info }
  1423. inlineprocsym.concatstabto(withdebuglist);
  1424. { set it back for safety }
  1425. inlineprocsym.definition.localst.symtabletype:=localsymtable;
  1426. inlineprocsym.definition.parast.symtabletype:=parasymtable;
  1427. mangled_length:=length(oldprocsym.definition.mangledname);
  1428. getmem(pp,mangled_length+50);
  1429. strpcopy(pp,'192,0,0,'+startlabel.name);
  1430. if (target_info.use_function_relative_addresses) then
  1431. begin
  1432. strpcopy(strend(pp),'-');
  1433. strpcopy(strend(pp),oldprocsym.definition.mangledname);
  1434. end;
  1435. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  1436. end;
  1437. {$endif GDB}
  1438. { takes care of local data initialization }
  1439. inlineentrycode:=TAAsmoutput.Create;
  1440. inlineexitcode:=TAAsmoutput.Create;
  1441. ps:=para_size;
  1442. make_global:=false; { to avoid warning }
  1443. genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
  1444. if po_assembler in aktprocsym.definition.procoptions then
  1445. inlineentrycode.insert(Tai_marker.Create(asmblockstart));
  1446. exprasmList.concatlist(inlineentrycode);
  1447. secondpass(inlinetree);
  1448. genexitcode(inlineexitcode,0,false,true);
  1449. if po_assembler in aktprocsym.definition.procoptions then
  1450. inlineexitcode.concat(Tai_marker.Create(asmblockend));
  1451. exprasmList.concatlist(inlineexitcode);
  1452. inlineentrycode.free;
  1453. inlineexitcode.free;
  1454. {$ifdef extdebug}
  1455. exprasmList.concat(Tai_asm_comment.Create(strpnew('End of inlined proc')));
  1456. {$endif extdebug}
  1457. exprasmList.concat(Tai_Marker.Create(InlineEnd));
  1458. {we can free the local data now, reset also the fixup address }
  1459. if st.datasize>0 then
  1460. begin
  1461. ungetpersistanttemp(st.address_fixup-st.datasize);
  1462. st.address_fixup:=0;
  1463. end;
  1464. { restore procinfo }
  1465. move(oldprocinfo^,procinfo^,sizeof(tprocinfo));
  1466. freemem(oldprocinfo,sizeof(tprocinfo));
  1467. {$ifdef GDB}
  1468. if (cs_debuginfo in aktmoduleswitches) then
  1469. begin
  1470. emitlab(endlabel);
  1471. strpcopy(pp,'224,0,0,'+endlabel.name);
  1472. if (target_info.use_function_relative_addresses) then
  1473. begin
  1474. strpcopy(strend(pp),'-');
  1475. strpcopy(strend(pp),oldprocsym.definition.mangledname);
  1476. end;
  1477. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  1478. freemem(pp,mangled_length+50);
  1479. end;
  1480. {$endif GDB}
  1481. { restore }
  1482. aktprocsym:=oldprocsym;
  1483. aktexitlabel:=oldexitlabel;
  1484. aktexit2label:=oldexit2label;
  1485. quickexitlabel:=oldquickexitlabel;
  1486. inlining_procedure:=oldinlining_procedure;
  1487. { reallocate the registers used for the current procedure's regvars, }
  1488. { since they may have been used and then deallocated in the inlined }
  1489. { procedure (JM) }
  1490. if assigned(aktprocsym.definition.regvarinfo) then
  1491. begin
  1492. unused := oldunused;
  1493. usableregs := oldusableregs;
  1494. c_usableregs := oldc_usableregs;
  1495. reg_pushes := oldreg_pushes;
  1496. is_reg_var := oldis_reg_var;
  1497. regvar_loaded := oldregvar_loaded;
  1498. {$ifdef TEMPREGDEBUG}
  1499. reg_user := oldreg_user;
  1500. reg_releaser := oldreg_releaser;
  1501. {$endif TEMPREGDEBUG}
  1502. end;
  1503. end;
  1504. begin
  1505. ccallparanode:=ti386callparanode;
  1506. ccallnode:=ti386callnode;
  1507. cprocinlinenode:=ti386procinlinenode;
  1508. end.
  1509. {
  1510. $Log$
  1511. Revision 1.27 2001-07-08 21:00:16 peter
  1512. * various widestring updates, it works now mostly without charset
  1513. mapping supported
  1514. Revision 1.26 2001/07/01 20:16:20 peter
  1515. * alignmentinfo record added
  1516. * -Oa argument supports more alignment settings that can be specified
  1517. per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
  1518. RECORDMAX,LOCALMIN,LOCALMAX. It is possible to set the mimimum
  1519. required alignment and the maximum usefull alignment. The final
  1520. alignment will be choosen per variable size dependent on these
  1521. settings
  1522. Revision 1.25 2001/06/04 11:48:02 peter
  1523. * better const to var checking
  1524. Revision 1.24 2001/05/19 21:22:53 peter
  1525. * function returning int64 inlining fixed
  1526. Revision 1.23 2001/05/16 15:11:42 jonas
  1527. * added missign begin..end pair (noticed by Carl)
  1528. Revision 1.22 2001/04/18 22:02:01 peter
  1529. * registration of targets and assemblers
  1530. Revision 1.21 2001/04/13 01:22:18 peter
  1531. * symtable change to classes
  1532. * range check generation and errors fixed, make cycle DEBUG=1 works
  1533. * memory leaks fixed
  1534. Revision 1.20 2001/04/02 21:20:36 peter
  1535. * resulttype rewrite
  1536. Revision 1.19 2001/03/11 22:58:51 peter
  1537. * getsym redesign, removed the globals srsym,srsymtable
  1538. Revision 1.18 2001/01/27 21:29:35 florian
  1539. * behavior -Oa optimized
  1540. Revision 1.17 2001/01/08 21:46:46 peter
  1541. * don't push high value for open array with cdecl;external;
  1542. Revision 1.16 2000/12/25 00:07:32 peter
  1543. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  1544. tlinkedlist objects)
  1545. Revision 1.15 2000/12/09 10:45:40 florian
  1546. * AfterConstructor isn't called anymore when a constructor failed
  1547. Revision 1.14 2000/12/07 17:19:46 jonas
  1548. * new constant handling: from now on, hex constants >$7fffffff are
  1549. parsed as unsigned constants (otherwise, $80000000 got sign extended
  1550. and became $ffffffff80000000), all constants in the longint range
  1551. become longints, all constants >$7fffffff and <=cardinal($ffffffff)
  1552. are cardinals and the rest are int64's.
  1553. * added lots of longint typecast to prevent range check errors in the
  1554. compiler and rtl
  1555. * type casts of symbolic ordinal constants are now preserved
  1556. * fixed bug where the original resulttype.def wasn't restored correctly
  1557. after doing a 64bit rangecheck
  1558. Revision 1.13 2000/12/05 11:44:33 jonas
  1559. + new integer regvar handling, should be much more efficient
  1560. Revision 1.12 2000/12/03 22:26:54 florian
  1561. * fixed web buzg 1275: problem with int64 functions results
  1562. Revision 1.11 2000/11/29 00:30:46 florian
  1563. * unused units removed from uses clause
  1564. * some changes for widestrings
  1565. Revision 1.10 2000/11/23 13:26:34 jonas
  1566. * fix for webbug 1066/1126
  1567. Revision 1.9 2000/11/22 15:12:06 jonas
  1568. * fixed inline-related problems (partially "merges")
  1569. Revision 1.8 2000/11/17 09:54:58 florian
  1570. * INT_CHECK_OBJECT_* isn't applied to interfaces anymore
  1571. Revision 1.7 2000/11/12 23:24:14 florian
  1572. * interfaces are basically running
  1573. Revision 1.6 2000/11/07 23:40:49 florian
  1574. + AfterConstruction and BeforeDestruction impemented
  1575. Revision 1.5 2000/11/06 23:15:01 peter
  1576. * added copyvaluepara call again
  1577. Revision 1.4 2000/11/04 14:25:23 florian
  1578. + merged Attila's changes for interfaces, not tested yet
  1579. Revision 1.3 2000/11/04 13:12:14 jonas
  1580. * check for nil pointers before calling getcopy
  1581. Revision 1.2 2000/10/31 22:02:56 peter
  1582. * symtable splitted, no real code changes
  1583. Revision 1.1 2000/10/15 09:33:31 peter
  1584. * moved n386*.pas to i386/ cpu_target dir
  1585. Revision 1.2 2000/10/14 10:14:48 peter
  1586. * moehrendorf oct 2000 rewrite
  1587. Revision 1.1 2000/10/10 17:31:56 florian
  1588. * initial revision
  1589. }