cg386cal.pas 69 KB

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