ncgutil.pas 65 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Helper routines for all code generators
  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. unit ncgutil;
  19. {$i defines.inc}
  20. interface
  21. uses
  22. node,
  23. cginfo,cpubase,aasm,
  24. rgobj;
  25. type
  26. tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
  27. tmaybesave = record
  28. saved : boolean;
  29. ref : treference;
  30. end;
  31. procedure firstcomplex(p : tbinarynode);
  32. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  33. procedure remove_non_regvars_from_loc(const t: tlocation; var regs: tregisterset);
  34. procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  35. procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
  36. procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
  37. procedure maybe_restore(list:taasmoutput;var l:tlocation;const s:tmaybesave);
  38. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  39. procedure push_value_para(p:tnode;inlined,is_cdecl:boolean;
  40. para_offset:longint;alignment : longint);
  41. procedure genentrycode(list : TAAsmoutput;
  42. make_global:boolean;
  43. stackframe:longint;
  44. var parasize:longint;var nostackframe:boolean;
  45. inlined : boolean);
  46. procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe,inlined:boolean);
  47. procedure genimplicitunitinit(list : TAAsmoutput);
  48. procedure genimplicitunitfinal(list : TAAsmoutput);
  49. implementation
  50. uses
  51. {$ifdef Delphi}
  52. Sysutils,
  53. {$else}
  54. strings,
  55. {$endif}
  56. cutils,cclasses,globtype,globals,systems,verbose,
  57. symbase,symconst,symtype,symsym,symdef,symtable,types,
  58. fmodule,
  59. cgbase,regvars,tainst,cpuasm,
  60. {$ifdef GDB}
  61. gdb,
  62. {$endif GDB}
  63. ncon,
  64. tgobj,cpuinfo,cgobj,cgcpu,cg64f32;
  65. {*****************************************************************************
  66. Misc Helpers
  67. *****************************************************************************}
  68. { DO NOT RELY on the fact that the tnode is not yet swaped
  69. because of inlining code PM }
  70. procedure firstcomplex(p : tbinarynode);
  71. var
  72. hp : tnode;
  73. begin
  74. { always calculate boolean AND and OR from left to right }
  75. if (p.nodetype in [orn,andn]) and
  76. (p.left.resulttype.def.deftype=orddef) and
  77. (torddef(p.left.resulttype.def).typ in [bool8bit,bool16bit,bool32bit]) then
  78. begin
  79. { p.swaped:=false}
  80. if nf_swaped in p.flags then
  81. internalerror(234234);
  82. end
  83. else
  84. if (((p.location.loc=LOC_FPUREGISTER) and
  85. (p.right.registersfpu > p.left.registersfpu)) or
  86. ((((p.left.registersfpu = 0) and
  87. (p.right.registersfpu = 0)) or
  88. (p.location.loc<>LOC_FPUREGISTER)) and
  89. (p.left.registers32<p.right.registers32))) and
  90. { the following check is appropriate, because all }
  91. { 4 registers are rarely used and it is thereby }
  92. { achieved that the extra code is being dropped }
  93. { by exchanging not commutative operators }
  94. (p.right.registers32<=c_countusableregsint) then
  95. begin
  96. hp:=p.left;
  97. p.left:=p.right;
  98. p.right:=hp;
  99. if nf_swaped in p.flags then
  100. exclude(p.flags,nf_swaped)
  101. else
  102. include(p.flags,nf_swaped);
  103. end;
  104. end;
  105. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  106. {
  107. produces jumps to true respectively false labels using boolean expressions
  108. depending on whether the loading of regvars is currently being
  109. synchronized manually (such as in an if-node) or automatically (most of
  110. the other cases where this procedure is called), loadregvars can be
  111. "lr_load_regvars" or "lr_dont_load_regvars"
  112. }
  113. var
  114. opsize : tcgsize;
  115. storepos : tfileposinfo;
  116. begin
  117. if nf_error in p.flags then
  118. exit;
  119. storepos:=aktfilepos;
  120. aktfilepos:=p.fileinfo;
  121. if is_boolean(p.resulttype.def) then
  122. begin
  123. if loadregvars = lr_load_regvars then
  124. load_all_regvars(list);
  125. if is_constboolnode(p) then
  126. begin
  127. if tordconstnode(p).value<>0 then
  128. cg.a_jmp_always(list,truelabel)
  129. else
  130. cg.a_jmp_always(list,falselabel)
  131. end
  132. else
  133. begin
  134. opsize:=def_cgsize(p.resulttype.def);
  135. case p.location.loc of
  136. LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
  137. begin
  138. if (p.location.loc = LOC_CREGISTER) then
  139. load_regvar_reg(list,p.location.register);
  140. cg.a_cmp_const_loc_label(list,opsize,OC_NE,
  141. 0,p.location,truelabel);
  142. { !!! should happen right after cmp (JM) }
  143. location_release(list,p.location);
  144. cg.a_jmp_always(list,falselabel);
  145. end;
  146. LOC_FLAGS :
  147. begin
  148. cg.a_jmp_flags(list,p.location.resflags,
  149. truelabel);
  150. cg.a_jmp_always(list,falselabel);
  151. end;
  152. end;
  153. end;
  154. end
  155. else
  156. internalerror(200112305);
  157. aktfilepos:=storepos;
  158. end;
  159. procedure remove_non_regvars_from_loc(const t: tlocation; var regs: tregisterset);
  160. begin
  161. case t.loc of
  162. LOC_REGISTER:
  163. begin
  164. { can't be a regvar, since it would be LOC_CREGISTER then }
  165. exclude(regs,t.register);
  166. if t.registerhigh <> R_NO then
  167. exclude(regs,t.registerhigh);
  168. end;
  169. LOC_CREFERENCE,LOC_REFERENCE:
  170. begin
  171. if not(cs_regalloc in aktglobalswitches) or
  172. (t.reference.base in rg.usableregsint) then
  173. exclude(regs,t.reference.base);
  174. if not(cs_regalloc in aktglobalswitches) or
  175. (t.reference.index in rg.usableregsint) then
  176. exclude(regs,t.reference.index);
  177. end;
  178. end;
  179. end;
  180. {*****************************************************************************
  181. TLocation
  182. *****************************************************************************}
  183. { 32-bit version }
  184. procedure location_force_reg32(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  185. var
  186. hregister,
  187. hregisterhi : tregister;
  188. hl : tasmlabel;
  189. begin
  190. { handle transformations to 64bit separate }
  191. if dst_size in [OS_64,OS_S64] then
  192. begin
  193. if not (l.size in [OS_64,OS_S64]) then
  194. begin
  195. { load a smaller size to OS_64 }
  196. if l.loc=LOC_REGISTER then
  197. hregister:=rg.makeregsize(l.registerlow,OS_INT)
  198. else
  199. hregister:=rg.getregisterint(list);
  200. { load value in low register }
  201. case l.loc of
  202. LOC_FLAGS :
  203. cg.g_flags2reg(list,l.resflags,hregister);
  204. LOC_JUMP :
  205. begin
  206. cg.a_label(list,truelabel);
  207. cg.a_load_const_reg(list,OS_INT,1,hregister);
  208. getlabel(hl);
  209. cg.a_jmp_always(list,hl);
  210. cg.a_label(list,falselabel);
  211. cg.a_load_const_reg(list,OS_INT,0,hregister);
  212. cg.a_label(list,hl);
  213. end;
  214. else
  215. cg.a_load_loc_reg(list,l,hregister);
  216. end;
  217. { reset hi part, take care of the signed bit of the current value }
  218. hregisterhi:=rg.getregisterint(list);
  219. if (dst_size=OS_S64) and
  220. (l.size in [OS_S8,OS_S16,OS_S32]) then
  221. begin
  222. if l.loc=LOC_CONSTANT then
  223. begin
  224. if (longint(l.value)<0) then
  225. cg.a_load_const_reg(list,OS_32,$ffffffff,hregisterhi)
  226. else
  227. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  228. end
  229. else
  230. begin
  231. cg.a_load_reg_reg(list,OS_32,hregister,hregisterhi);
  232. cg.a_op_const_reg(list,OP_SAR,31,hregisterhi);
  233. end;
  234. end
  235. else
  236. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  237. location_reset(l,LOC_REGISTER,dst_size);
  238. l.registerlow:=hregister;
  239. l.registerhigh:=hregisterhi;
  240. end
  241. else
  242. begin
  243. { 64bit to 64bit }
  244. if (l.loc=LOC_REGISTER) or
  245. ((l.loc=LOC_CREGISTER) and maybeconst) then
  246. begin
  247. hregister:=l.registerlow;
  248. hregisterhi:=l.registerhigh;
  249. end
  250. else
  251. begin
  252. hregister:=rg.getregisterint(list);
  253. hregisterhi:=rg.getregisterint(list);
  254. end;
  255. { load value in new register }
  256. tcg64f32(cg).a_load64_loc_reg(list,l,hregister,hregisterhi);
  257. location_reset(l,LOC_REGISTER,dst_size);
  258. l.registerlow:=hregister;
  259. l.registerhigh:=hregisterhi;
  260. end;
  261. end
  262. else
  263. begin
  264. { transformations to 32bit or smaller }
  265. if l.loc=LOC_REGISTER then
  266. begin
  267. { if the previous was 64bit release the high register }
  268. if l.size in [OS_64,OS_S64] then
  269. begin
  270. rg.ungetregisterint(list,l.registerhigh);
  271. l.registerhigh:=R_NO;
  272. end;
  273. hregister:=l.register;
  274. end
  275. else
  276. begin
  277. { get new register }
  278. if (l.loc=LOC_CREGISTER) and
  279. maybeconst and
  280. (TCGSize2Size[dst_size]=TCGSize2Size[l.size]) then
  281. hregister:=l.register
  282. else
  283. hregister:=rg.getregisterint(list);
  284. end;
  285. hregister:=rg.makeregsize(hregister,dst_size);
  286. { load value in new register }
  287. case l.loc of
  288. LOC_FLAGS :
  289. cg.g_flags2reg(list,l.resflags,hregister);
  290. LOC_JUMP :
  291. begin
  292. cg.a_label(list,truelabel);
  293. cg.a_load_const_reg(list,dst_size,1,hregister);
  294. getlabel(hl);
  295. cg.a_jmp_always(list,hl);
  296. cg.a_label(list,falselabel);
  297. cg.a_load_const_reg(list,dst_size,0,hregister);
  298. cg.a_label(list,hl);
  299. end;
  300. else
  301. begin
  302. { load_loc_reg can only handle size >= l.size, when the
  303. new size is smaller then we need to adjust the size
  304. of the orignal and maybe recalculate l.register for i386 }
  305. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  306. begin
  307. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  308. l.register:=rg.makeregsize(l.register,dst_size);
  309. l.size:=dst_size;
  310. end;
  311. cg.a_load_loc_reg(list,l,hregister);
  312. end;
  313. end;
  314. location_reset(l,LOC_REGISTER,dst_size);
  315. l.register:=hregister;
  316. end;
  317. end;
  318. { 64-bit version }
  319. procedure location_force_reg64(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  320. var
  321. hregister : tregister;
  322. hl : tasmlabel;
  323. begin
  324. { handle transformations to 64bit separate }
  325. if dst_size in [OS_64,OS_S64] then
  326. begin
  327. { load a smaller size to OS_64 }
  328. if l.loc=LOC_REGISTER then
  329. hregister:=rg.makeregsize(l.register,OS_INT)
  330. else
  331. hregister:=rg.getregisterint(list);
  332. { load value in low register }
  333. case l.loc of
  334. LOC_FLAGS :
  335. cg.g_flags2reg(list,l.resflags,hregister);
  336. LOC_JUMP :
  337. begin
  338. cg.a_label(list,truelabel);
  339. cg.a_load_const_reg(list,OS_INT,1,hregister);
  340. getlabel(hl);
  341. cg.a_jmp_always(list,hl);
  342. cg.a_label(list,falselabel);
  343. cg.a_load_const_reg(list,OS_INT,0,hregister);
  344. cg.a_label(list,hl);
  345. end;
  346. else
  347. cg.a_load_loc_reg(list,l,hregister);
  348. end;
  349. location_reset(l,LOC_REGISTER,dst_size);
  350. l.register:=hregister;
  351. end
  352. else
  353. begin
  354. { transformations to 32bit or smaller }
  355. if l.loc=LOC_REGISTER then
  356. begin
  357. hregister:=l.register;
  358. end
  359. else
  360. begin
  361. { get new register }
  362. if (l.loc=LOC_CREGISTER) and
  363. maybeconst and
  364. (TCGSize2Size[dst_size]=TCGSize2Size[l.size]) then
  365. hregister:=l.register
  366. else
  367. hregister:=rg.getregisterint(list);
  368. end;
  369. hregister:=rg.makeregsize(hregister,dst_size);
  370. { load value in new register }
  371. case l.loc of
  372. LOC_FLAGS :
  373. cg.g_flags2reg(list,l.resflags,hregister);
  374. LOC_JUMP :
  375. begin
  376. cg.a_label(list,truelabel);
  377. cg.a_load_const_reg(list,dst_size,1,hregister);
  378. getlabel(hl);
  379. cg.a_jmp_always(list,hl);
  380. cg.a_label(list,falselabel);
  381. cg.a_load_const_reg(list,dst_size,0,hregister);
  382. cg.a_label(list,hl);
  383. end;
  384. else
  385. begin
  386. { load_loc_reg can only handle size >= l.size, when the
  387. new size is smaller then we need to adjust the size
  388. of the orignal and maybe recalculate l.register for i386 }
  389. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  390. begin
  391. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  392. l.register:=rg.makeregsize(l.register,dst_size);
  393. l.size:=dst_size;
  394. end;
  395. cg.a_load_loc_reg(list,l,hregister);
  396. end;
  397. end;
  398. location_reset(l,LOC_REGISTER,dst_size);
  399. l.register:=hregister;
  400. end;
  401. end;
  402. procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  403. begin
  404. { release previous location before demanding a new register }
  405. if (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  406. begin
  407. location_freetemp(list,l);
  408. location_release(list,l);
  409. end;
  410. if sizeof(aword) < 8 then
  411. location_force_reg32(list, l, dst_size, maybeconst)
  412. else
  413. location_force_reg64(list, l, dst_size, maybeconst);
  414. end;
  415. procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
  416. var
  417. r : treference;
  418. begin
  419. case l.loc of
  420. LOC_FPUREGISTER,
  421. LOC_CFPUREGISTER :
  422. begin
  423. tg.gettempofsizereference(list,TCGSize2Size[l.size],r);
  424. cg.a_loadfpu_reg_ref(list,l.size,l.register,r);
  425. location_reset(l,LOC_REFERENCE,l.size);
  426. l.reference:=r;
  427. end;
  428. LOC_CONSTANT,
  429. LOC_REGISTER,
  430. LOC_CREGISTER :
  431. begin
  432. tg.gettempofsizereference(list,TCGSize2Size[l.size],r);
  433. if l.size in [OS_64,OS_S64] then
  434. tcg64f32(cg).a_load64_loc_ref(list,l,r)
  435. else
  436. cg.a_load_loc_ref(list,l,r);
  437. location_reset(l,LOC_REFERENCE,l.size);
  438. l.reference:=r;
  439. end;
  440. LOC_CREFERENCE,
  441. LOC_REFERENCE : ;
  442. else
  443. internalerror(200203219);
  444. end;
  445. end;
  446. {*****************************************************************************
  447. Maybe_Save
  448. *****************************************************************************}
  449. procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
  450. begin
  451. s.saved:=false;
  452. if l.loc=LOC_CREGISTER then
  453. begin
  454. s.saved:=true;
  455. exit;
  456. end;
  457. if needed>rg.countunusedregsint then
  458. begin
  459. case l.loc of
  460. LOC_REGISTER :
  461. begin
  462. if l.size in [OS_64,OS_S64] then
  463. begin
  464. tg.gettempofsizereference(exprasmlist,8,s.ref);
  465. tcg64f32(cg).a_load64_reg_ref(exprasmlist,l.registerlow,l.registerhigh,s.ref);
  466. end
  467. else
  468. begin
  469. tg.gettempofsizereference(exprasmlist,TCGSize2Size[l.size],s.ref);
  470. cg.a_load_reg_ref(exprasmlist,l.size,l.register,s.ref);
  471. end;
  472. location_release(exprasmlist,l);
  473. s.saved:=true;
  474. end;
  475. LOC_REFERENCE,
  476. LOC_CREFERENCE :
  477. begin
  478. if ((l.reference.base<>R_NO) or
  479. (l.reference.index<>R_NO)) then
  480. begin
  481. { load address into a single base register }
  482. cg.a_loadaddr_ref_reg(list,l.reference,l.reference.base);
  483. { save base register }
  484. tg.gettempofsizereference(exprasmlist,TCGSize2Size[OS_ADDR],s.ref);
  485. cg.a_load_reg_ref(exprasmlist,OS_ADDR,l.reference.base,s.ref);
  486. { release }
  487. location_release(exprasmlist,l);
  488. s.saved:=true;
  489. end;
  490. end;
  491. end;
  492. end;
  493. end;
  494. procedure maybe_restore(list:taasmoutput;var l:tlocation;const s:tmaybesave);
  495. begin
  496. if not s.saved then
  497. exit;
  498. if l.loc=LOC_CREGISTER then
  499. begin
  500. load_regvar_reg(list,l.register);
  501. exit;
  502. end;
  503. case l.loc of
  504. LOC_REGISTER :
  505. begin
  506. if l.size in [OS_64,OS_S64] then
  507. begin
  508. l.registerlow:=rg.getregisterint(exprasmlist);
  509. l.registerhigh:=rg.getregisterint(exprasmlist);
  510. tcg64f32(cg).a_load64_ref_reg(exprasmlist,s.ref,l.registerlow,l.registerhigh);
  511. end
  512. else
  513. begin
  514. l.register:=rg.getregisterint(exprasmlist);
  515. cg.a_load_ref_reg(exprasmlist,OS_INT,s.ref,l.register);
  516. end;
  517. end;
  518. LOC_CREFERENCE,
  519. LOC_REFERENCE :
  520. begin
  521. reference_reset(l.reference);
  522. l.reference.base:=rg.getaddressregister(exprasmlist);
  523. cg.a_load_ref_reg(exprasmlist,OS_ADDR,s.ref,l.reference.base);
  524. end;
  525. end;
  526. tg.ungetiftemp(exprasmlist,s.ref);
  527. end;
  528. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  529. begin
  530. if needed>=maxfpuregs then
  531. begin
  532. if l.loc = LOC_FPUREGISTER then
  533. begin
  534. location_force_mem(list,l);
  535. maybe_pushfpu:=true;
  536. end
  537. else
  538. maybe_pushfpu:=false;
  539. end
  540. else
  541. maybe_pushfpu:=false;
  542. end;
  543. {*****************************************************************************
  544. Push Value Para
  545. *****************************************************************************}
  546. procedure push_value_para(p:tnode;inlined,is_cdecl:boolean;
  547. para_offset:longint;alignment : longint);
  548. var
  549. tempreference : treference;
  550. href : treference;
  551. hreg : tregister;
  552. sizetopush,
  553. size : longint;
  554. cgsize : tcgsize;
  555. begin
  556. { Move flags and jump in register to make it less complex }
  557. if p.location.loc in [LOC_FLAGS,LOC_JUMP] then
  558. location_force_reg(exprasmlist,p.location,def_cgsize(p.resulttype.def),false);
  559. { Handle Floating point types differently }
  560. if p.resulttype.def.deftype=floatdef then
  561. begin
  562. case p.location.loc of
  563. LOC_FPUREGISTER,
  564. LOC_CFPUREGISTER:
  565. begin
  566. size:=align(tfloatdef(p.resulttype.def).size,alignment);
  567. inc(pushedparasize,size);
  568. if not inlined then
  569. cg.a_op_const_reg(exprasmlist,OP_SUB,size,STACK_POINTER_REG);
  570. {$ifdef GDB}
  571. if (cs_debuginfo in aktmoduleswitches) and
  572. (exprasmList.first=exprasmList.last) then
  573. exprasmList.concat(Tai_force_line.Create);
  574. {$endif GDB}
  575. { this is the easiest case for inlined !! }
  576. if inlined then
  577. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize)
  578. else
  579. reference_reset_base(href,stack_pointer_reg,0);
  580. cg.a_loadfpu_reg_ref(exprasmlist,
  581. def_cgsize(p.resulttype.def),p.location.register,href);
  582. end;
  583. LOC_REFERENCE,
  584. LOC_CREFERENCE :
  585. begin
  586. sizetopush:=align(p.resulttype.def.size,alignment);
  587. tempreference:=p.location.reference;
  588. inc(tempreference.offset,sizetopush);
  589. while (sizetopush>0) do
  590. begin
  591. if sizetopush>=4 then
  592. begin
  593. cgsize:=OS_32;
  594. inc(pushedparasize,4);
  595. dec(tempreference.offset,4);
  596. dec(sizetopush,4);
  597. end
  598. else
  599. begin
  600. cgsize:=OS_16;
  601. inc(pushedparasize,2);
  602. dec(tempreference.offset,2);
  603. dec(sizetopush,2);
  604. end;
  605. if inlined then
  606. begin
  607. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  608. cg.a_load_ref_ref(exprasmlist,cgsize,tempreference,href);
  609. end
  610. else
  611. cg.a_param_ref(exprasmlist,cgsize,tempreference,-1);
  612. end;
  613. end;
  614. else
  615. internalerror(200204243);
  616. end;
  617. end
  618. else
  619. begin
  620. { call by value open array ? }
  621. if is_cdecl and
  622. push_addr_param(p.resulttype.def) then
  623. begin
  624. if not (p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  625. internalerror(200204241);
  626. { push on stack }
  627. size:=align(p.resulttype.def.size,alignment);
  628. inc(pushedparasize,size);
  629. cg.a_op_const_reg(exprasmlist,OP_SUB,size,STACK_POINTER_REG);
  630. reference_reset_base(href,STACK_POINTER_REG,0);
  631. cg.g_concatcopy(exprasmlist,p.location.reference,href,size,false,false);
  632. end
  633. else
  634. begin
  635. case p.location.loc of
  636. LOC_CONSTANT,
  637. LOC_REGISTER,
  638. LOC_CREGISTER,
  639. LOC_REFERENCE,
  640. LOC_CREFERENCE :
  641. begin
  642. cgsize:=def_cgsize(p.resulttype.def);
  643. if cgsize in [OS_64,OS_S64] then
  644. begin
  645. inc(pushedparasize,8);
  646. if inlined then
  647. begin
  648. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  649. tcg64f32(cg).a_load64_loc_ref(exprasmlist,p.location,href);
  650. end
  651. else
  652. tcg64f32(cg).a_param64_loc(exprasmlist,p.location,-1);
  653. end
  654. else
  655. begin
  656. case cgsize of
  657. OS_8,OS_S8 :
  658. begin
  659. if alignment=4 then
  660. cgsize:=OS_32
  661. else
  662. cgsize:=OS_16;
  663. end;
  664. OS_16,OS_S16 :
  665. begin
  666. if alignment=4 then
  667. cgsize:=OS_32;
  668. end;
  669. end;
  670. { update register to use to match alignment }
  671. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  672. begin
  673. hreg:=p.location.register;
  674. p.location.register:=rg.makeregsize(p.location.register,cgsize);
  675. end;
  676. inc(pushedparasize,alignment);
  677. if inlined then
  678. begin
  679. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  680. cg.a_load_loc_ref(exprasmlist,p.location,href);
  681. end
  682. else
  683. cg.a_param_loc(exprasmlist,p.location,-1);
  684. { restore old register }
  685. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  686. p.location.register:=hreg;
  687. end;
  688. location_release(exprasmlist,p.location);
  689. end;
  690. {$ifdef SUPPORT_MMX}
  691. LOC_MMXREGISTER,
  692. LOC_CMMXREGISTER:
  693. begin
  694. inc(pushedparasize,8);
  695. if inlined then
  696. begin
  697. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  698. cg.a_loadmm_reg_ref(exprasmlist,p.location.register,href);
  699. end
  700. else
  701. cg.a_parammm_reg(exprasmlist,p.location.register);
  702. end;
  703. {$endif SUPPORT_MMX}
  704. else
  705. internalerror(200204241);
  706. end;
  707. end;
  708. end;
  709. end;
  710. {****************************************************************************
  711. Entry/Exit Code
  712. ****************************************************************************}
  713. procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
  714. var
  715. href1,href2 : treference;
  716. list : taasmoutput;
  717. begin
  718. list:=taasmoutput(arg);
  719. if (tsym(p).typ=varsym) and
  720. (tvarsym(p).varspez=vs_value) and
  721. (push_addr_param(tvarsym(p).vartype.def)) then
  722. begin
  723. reference_reset_base(href1,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
  724. if is_open_array(tvarsym(p).vartype.def) or
  725. is_array_of_const(tvarsym(p).vartype.def) then
  726. cg.g_copyvaluepara_openarray(list,href1,tarraydef(tvarsym(p).vartype.def).elesize)
  727. else
  728. begin
  729. reference_reset_base(href2,procinfo^.framepointer,-tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup);
  730. if is_shortstring(tvarsym(p).vartype.def) then
  731. cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,true)
  732. else
  733. cg.g_concatcopy(list,href1,href2,tvarsym(p).vartype.def.size,true,true);
  734. end;
  735. end;
  736. end;
  737. procedure initialize_threadvar(p : tnamedindexitem;arg:pointer);
  738. var
  739. href : treference;
  740. list : taasmoutput;
  741. begin
  742. list:=taasmoutput(arg);
  743. if (tsym(p).typ=varsym) and
  744. (vo_is_thread_var in tvarsym(p).varoptions) then
  745. begin
  746. cg.a_param_const(list,OS_INT,tvarsym(p).getsize,2);
  747. reference_reset_symbol(href,newasmsymbol(tvarsym(p).mangledname),0);
  748. cg.a_paramaddr_ref(list,href,2);
  749. rg.saveregvars(list,all_registers);
  750. cg.a_call_name(list,'FPC_INIT_THREADVAR');
  751. end;
  752. end;
  753. { generates the code for initialisation of local data }
  754. procedure initialize_data(p : tnamedindexitem;arg:pointer);
  755. var
  756. href : treference;
  757. list : taasmoutput;
  758. begin
  759. list:=taasmoutput(arg);
  760. if (tsym(p).typ=varsym) and
  761. assigned(tvarsym(p).vartype.def) and
  762. not(is_class(tvarsym(p).vartype.def)) and
  763. tvarsym(p).vartype.def.needs_inittable then
  764. begin
  765. if assigned(procinfo) then
  766. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  767. if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
  768. reference_reset_base(href,procinfo^.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
  769. else
  770. reference_reset_symbol(href,newasmsymbol(tvarsym(p).mangledname),0);
  771. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  772. end;
  773. end;
  774. { generates the code for finalisation of local data }
  775. procedure finalize_data(p : tnamedindexitem;arg:pointer);
  776. var
  777. href : treference;
  778. list : taasmoutput;
  779. begin
  780. list:=taasmoutput(arg);
  781. if (tsym(p).typ=varsym) and
  782. assigned(tvarsym(p).vartype.def) and
  783. not(is_class(tvarsym(p).vartype.def)) and
  784. tvarsym(p).vartype.def.needs_inittable then
  785. begin
  786. if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
  787. reference_reset_base(href,procinfo^.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
  788. else
  789. reference_reset_symbol(href,newasmsymbol(tvarsym(p).mangledname),0);
  790. cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
  791. end;
  792. end;
  793. { generates the code for incrementing the reference count of parameters and
  794. initialize out parameters }
  795. procedure init_paras(p : tnamedindexitem;arg:pointer);
  796. var
  797. href : treference;
  798. tmpreg : tregister;
  799. list : taasmoutput;
  800. begin
  801. list:=taasmoutput(arg);
  802. if (tsym(p).typ=varsym) and
  803. not is_class(tvarsym(p).vartype.def) and
  804. tvarsym(p).vartype.def.needs_inittable then
  805. begin
  806. case tvarsym(p).varspez of
  807. vs_value :
  808. begin
  809. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  810. if assigned(tvarsym(p).localvarsym) then
  811. reference_reset_base(href,procinfo^.framepointer,
  812. -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
  813. else
  814. reference_reset_base(href,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
  815. cg.g_incrrefcount(list,tvarsym(p).vartype.def,href);
  816. end;
  817. vs_out :
  818. begin
  819. reference_reset_base(href,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
  820. tmpreg:=cg.get_scratch_reg(list);
  821. cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
  822. reference_reset_base(href,tmpreg,0);
  823. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  824. end;
  825. end;
  826. end;
  827. end;
  828. { generates the code for decrementing the reference count of parameters }
  829. procedure final_paras(p : tnamedindexitem;arg:pointer);
  830. var
  831. href : treference;
  832. list : taasmoutput;
  833. begin
  834. list:=taasmoutput(arg);
  835. if (tsym(p).typ=varsym) and
  836. not is_class(tvarsym(p).vartype.def) and
  837. tvarsym(p).vartype.def.needs_inittable then
  838. begin
  839. if (tvarsym(p).varspez=vs_value) then
  840. begin
  841. if assigned(tvarsym(p).localvarsym) then
  842. reference_reset_base(href,procinfo^.framepointer,
  843. -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
  844. else
  845. reference_reset_base(href,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
  846. cg.g_decrrefcount(list,tvarsym(p).vartype.def,href);
  847. end;
  848. end;
  849. end;
  850. { Initialize temp ansi/widestrings,interfaces }
  851. procedure inittempvariables(list:taasmoutput);
  852. var
  853. hp : ptemprecord;
  854. href : treference;
  855. begin
  856. hp:=tg.templist;
  857. while assigned(hp) do
  858. begin
  859. if hp^.temptype in [tt_ansistring,tt_freeansistring,
  860. tt_widestring,tt_freewidestring,
  861. tt_interfacecom] then
  862. begin
  863. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  864. reference_reset_base(href,procinfo^.framepointer,hp^.pos);
  865. cg.a_load_const_ref(list,OS_ADDR,0,href);
  866. end;
  867. hp:=hp^.next;
  868. end;
  869. end;
  870. procedure finalizetempvariables(list:taasmoutput);
  871. var
  872. hp : ptemprecord;
  873. href : treference;
  874. begin
  875. hp:=tg.templist;
  876. while assigned(hp) do
  877. begin
  878. case hp^.temptype of
  879. tt_ansistring,
  880. tt_freeansistring :
  881. begin
  882. reference_reset_base(href,procinfo^.framepointer,hp^.pos);
  883. cg.a_paramaddr_ref(list,href,1);
  884. cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
  885. end;
  886. tt_widestring,
  887. tt_freewidestring :
  888. begin
  889. reference_reset_base(href,procinfo^.framepointer,hp^.pos);
  890. cg.a_paramaddr_ref(list,href,1);
  891. cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
  892. end;
  893. tt_interfacecom :
  894. begin
  895. reference_reset_base(href,procinfo^.framepointer,hp^.pos);
  896. cg.a_paramaddr_ref(list,href,1);
  897. cg.a_call_name(list,'FPC_INTF_DECR_REF');
  898. end;
  899. end;
  900. hp:=hp^.next;
  901. end;
  902. end;
  903. procedure handle_return_value(list:TAAsmoutput; inlined : boolean;var uses_acc,uses_acchi : boolean);
  904. var
  905. href : treference;
  906. hreg : tregister;
  907. cgsize : TCGSize;
  908. begin
  909. if not is_void(aktprocdef.rettype.def) then
  910. begin
  911. if (tfuncretsym(aktprocdef.funcretsym).funcretstate<>vs_assigned) and
  912. (not inlined) then
  913. CGMessage(sym_w_function_result_not_set);
  914. reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
  915. cgsize:=def_cgsize(aktprocdef.rettype.def);
  916. case aktprocdef.rettype.def.deftype of
  917. orddef,
  918. enumdef :
  919. begin
  920. uses_acc:=true;
  921. cg.a_reg_alloc(list,accumulator);
  922. if cgsize in [OS_64,OS_S64] then
  923. begin
  924. uses_acchi:=true;
  925. cg.a_reg_alloc(list,accumulatorhigh);
  926. tcg64f32(cg).a_load64_ref_reg(list,href,accumulator,accumulatorhigh);
  927. end
  928. else
  929. begin
  930. hreg:=rg.makeregsize(accumulator,cgsize);
  931. cg.a_load_ref_reg(list,cgsize,href,hreg);
  932. end;
  933. end;
  934. floatdef :
  935. begin
  936. cg.a_loadfpu_ref_reg(list,cgsize,href,fpuresultreg);
  937. end;
  938. else
  939. begin
  940. if ret_in_acc(aktprocdef.rettype.def) then
  941. begin
  942. uses_acc:=true;
  943. cg.a_reg_alloc(list,accumulator);
  944. cg.a_load_ref_reg(list,cgsize,href,accumulator);
  945. end
  946. end;
  947. end;
  948. end;
  949. end;
  950. procedure handle_fast_exit_return_value(list:TAAsmoutput);
  951. var
  952. href : treference;
  953. hreg : tregister;
  954. cgsize : TCGSize;
  955. begin
  956. if not is_void(aktprocdef.rettype.def) then
  957. begin
  958. reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
  959. cgsize:=def_cgsize(aktprocdef.rettype.def);
  960. case aktprocdef.rettype.def.deftype of
  961. orddef,
  962. enumdef :
  963. begin
  964. if cgsize in [OS_64,OS_S64] then
  965. tcg64f32(cg).a_load64_reg_ref(list,accumulator,accumulatorhigh,href)
  966. else
  967. begin
  968. hreg:=rg.makeregsize(accumulator,cgsize);
  969. cg.a_load_reg_ref(list,cgsize,hreg,href);
  970. end;
  971. end;
  972. floatdef :
  973. begin
  974. cg.a_loadfpu_reg_ref(list,cgsize,fpuresultreg,href);
  975. end;
  976. else
  977. begin
  978. if ret_in_acc(aktprocdef.rettype.def) then
  979. cg.a_load_reg_ref(list,cgsize,accumulator,href);
  980. end;
  981. end;
  982. end;
  983. end;
  984. procedure genentrycode(list : TAAsmoutput;
  985. make_global:boolean;
  986. stackframe:longint;
  987. var parasize:longint;var nostackframe:boolean;
  988. inlined : boolean);
  989. var
  990. hs : string;
  991. href : treference;
  992. p : tsymtable;
  993. tempbuf : treference;
  994. tmpreg : tregister;
  995. begin
  996. { Insert alignment and assembler names }
  997. if not inlined then
  998. begin
  999. { Align, gprof uses 16 byte granularity }
  1000. if (cs_profile in aktmoduleswitches) then
  1001. list.concat(Tai_align.Create_op(16,$90))
  1002. else
  1003. list.concat(Tai_align.Create(aktalignment.procalign));
  1004. if (cs_profile in aktmoduleswitches) or
  1005. (aktprocdef.owner.symtabletype=globalsymtable) or
  1006. (assigned(procinfo^._class) and (procinfo^._class.owner.symtabletype=globalsymtable)) then
  1007. make_global:=true;
  1008. if make_global or ((procinfo^.flags and pi_is_global) <> 0) then
  1009. aktprocsym.is_global := True;
  1010. {$ifdef GDB}
  1011. if (cs_debuginfo in aktmoduleswitches) then
  1012. begin
  1013. aktprocdef.concatstabto(list);
  1014. aktprocsym.isstabwritten:=true;
  1015. end;
  1016. {$endif GDB}
  1017. repeat
  1018. hs:=aktprocdef.aliasnames.getfirst;
  1019. if hs='' then
  1020. break;
  1021. {$ifdef GDB}
  1022. if (cs_debuginfo in aktmoduleswitches) and
  1023. target_info.use_function_relative_addresses then
  1024. list.concat(Tai_stab_function_name.Create(strpnew(hs)));
  1025. {$endif GDB}
  1026. if make_global then
  1027. list.concat(Tai_symbol.Createname_global(hs,0))
  1028. else
  1029. list.concat(Tai_symbol.Createname(hs,0));
  1030. until false;
  1031. { omit stack frame ? }
  1032. if (procinfo^.framepointer=STACK_POINTER_REG) then
  1033. begin
  1034. CGMessage(cg_d_stackframe_omited);
  1035. nostackframe:=true;
  1036. if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
  1037. parasize:=0
  1038. else
  1039. parasize:=aktprocdef.parast.datasize+procinfo^.para_offset-4;
  1040. if stackframe<>0 then
  1041. cg.a_op_const_reg(list,OP_SUB,stackframe,procinfo^.framepointer);
  1042. end
  1043. else
  1044. begin
  1045. nostackframe:=false;
  1046. if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
  1047. parasize:=0
  1048. else
  1049. parasize:=aktprocdef.parast.datasize+procinfo^.para_offset-target_info.first_parm_offset;
  1050. if (po_interrupt in aktprocdef.procoptions) then
  1051. cg.g_interrupt_stackframe_entry(list);
  1052. cg.g_stackframe_entry(list,stackframe);
  1053. if (cs_check_stack in aktlocalswitches) then
  1054. cg.g_stackcheck(list,stackframe);
  1055. end;
  1056. if (cs_profile in aktmoduleswitches) and
  1057. not(po_assembler in aktprocdef.procoptions) then
  1058. cg.g_profilecode(list);
  1059. end;
  1060. { for the save all registers we can simply use a pusha,popa which
  1061. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1062. if (po_saveregisters in aktprocdef.procoptions) then
  1063. cg.g_save_all_registers(list)
  1064. else
  1065. { should we save edi,esi,ebx like C ? }
  1066. if (po_savestdregs in aktprocdef.procoptions) then
  1067. cg.g_save_standard_registers(list);
  1068. { a constructor needs a help procedure }
  1069. if (aktprocdef.proctypeoption=potype_constructor) then
  1070. cg.g_call_constructor_helper(list);
  1071. { don't load ESI, does the caller }
  1072. { we must do it for local function }
  1073. { that can be called from a foreach_static }
  1074. { of another object than self !! PM }
  1075. if assigned(procinfo^._class) and { !!!!! shouldn't we load ESI always? }
  1076. (lexlevel>normal_function_level) then
  1077. cg.g_maybe_loadself(list);
  1078. { When message method contains self as a parameter,
  1079. we must load it into ESI }
  1080. If (po_containsself in aktprocdef.procoptions) then
  1081. begin
  1082. list.concat(Tairegalloc.Alloc(self_pointer_reg));
  1083. reference_reset_base(href,procinfo^.framepointer,procinfo^.selfpointer_offset);
  1084. cg.a_load_ref_reg(list,OS_ADDR,href,self_pointer_reg);
  1085. end;
  1086. { initialize return value }
  1087. if (not is_void(aktprocdef.rettype.def)) and
  1088. (aktprocdef.rettype.def.needs_inittable) then
  1089. begin
  1090. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  1091. reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
  1092. cg.g_initialize(list,aktprocdef.rettype.def,href,ret_in_param(aktprocdef.rettype.def));
  1093. end;
  1094. { initialisize local data like ansistrings }
  1095. case aktprocdef.proctypeoption of
  1096. potype_unitinit:
  1097. begin
  1098. { using current_module.globalsymtable is hopefully }
  1099. { more robust than symtablestack and symtablestack.next }
  1100. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1101. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1102. end;
  1103. { units have seperate code for initilization and finalization }
  1104. potype_unitfinalize: ;
  1105. else
  1106. aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1107. end;
  1108. { initialisizes temp. ansi/wide string data }
  1109. inittempvariables(list);
  1110. { generate copies of call by value parameters }
  1111. if not(po_assembler in aktprocdef.procoptions) and
  1112. not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_palmossyscall,pocall_system]) then
  1113. aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1114. if assigned( aktprocdef.parast) then
  1115. aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1116. if (not inlined) then
  1117. begin
  1118. { call startup helpers from main program }
  1119. if (aktprocdef.proctypeoption=potype_proginit) then
  1120. begin
  1121. { initialize profiling for win32 }
  1122. if (target_info.target in [target_I386_WIN32,target_I386_wdosx]) and
  1123. (cs_profile in aktmoduleswitches) then
  1124. cg.a_call_name(list,'__monstartup');
  1125. { add local threadvars in units (only if needed because not all platforms
  1126. have threadvar support) }
  1127. if have_local_threadvars then
  1128. cg.a_call_name(list,'FPC_INITIALIZELOCALTHREADVARS');
  1129. { add global threadvars }
  1130. p:=symtablestack;
  1131. while assigned(p) do
  1132. begin
  1133. p.foreach_static({$ifndef TP}@{$endif}initialize_threadvar,list);
  1134. p:=p.next;
  1135. end;
  1136. { initialize units }
  1137. cg.a_call_name(list,'FPC_INITIALIZEUNITS');
  1138. end;
  1139. { do we need an exception frame because of ansi/widestrings/interfaces ? }
  1140. if ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
  1141. { but it's useless in init/final code of units }
  1142. not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
  1143. begin
  1144. include(rg.usedinproc,accumulator);
  1145. { allocate exception frame buffer }
  1146. cg.a_op_const_reg(list,OP_SUB,36,STACK_POINTER_REG);
  1147. tmpreg:=rg.getaddressregister(list);
  1148. cg.a_load_reg_reg(list,OS_ADDR,STACK_POINTER_REG,tmpreg);
  1149. reference_reset_base(tempbuf,tmpreg,0);
  1150. cg.g_push_exception(list,tempbuf,1,aktexitlabel);
  1151. reference_release(list,tempbuf);
  1152. { probably we've to reload self here }
  1153. cg.g_maybe_loadself(list);
  1154. end;
  1155. {$ifdef GDB}
  1156. if (cs_debuginfo in aktmoduleswitches) then
  1157. list.concat(Tai_force_line.Create);
  1158. {$endif GDB}
  1159. end;
  1160. if inlined then
  1161. load_regvars(list,nil);
  1162. end;
  1163. procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe,inlined:boolean);
  1164. var
  1165. {$ifdef GDB}
  1166. stabsendlabel : tasmlabel;
  1167. mangled_length : longint;
  1168. p : pchar;
  1169. st : string[2];
  1170. {$endif GDB}
  1171. okexitlabel,
  1172. noreraiselabel,nodestroycall : tasmlabel;
  1173. tmpreg : tregister;
  1174. href : treference;
  1175. usesacc,
  1176. usesacchi,
  1177. usesself : boolean;
  1178. pd : tprocdef;
  1179. begin
  1180. if aktexit2label.is_used and
  1181. ((procinfo^.flags and (pi_needs_implicit_finally or pi_uses_exceptions)) <> 0) then
  1182. begin
  1183. cg.a_jmp_always(list,aktexitlabel);
  1184. cg.a_label(list,aktexit2label);
  1185. handle_fast_exit_return_value(list);
  1186. end;
  1187. if aktexitlabel.is_used then
  1188. list.concat(Tai_label.Create(aktexitlabel));
  1189. cleanup_regvars(list);
  1190. { call the destructor help procedure }
  1191. if (aktprocdef.proctypeoption=potype_destructor) and
  1192. assigned(procinfo^._class) then
  1193. cg.g_call_destructor_helper(list);
  1194. { finalize temporary data }
  1195. finalizetempvariables(list);
  1196. { finalize local data like ansistrings}
  1197. case aktprocdef.proctypeoption of
  1198. potype_unitfinalize:
  1199. begin
  1200. { using current_module.globalsymtable is hopefully }
  1201. { more robust than symtablestack and symtablestack.next }
  1202. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1203. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1204. end;
  1205. { units have seperate code for initialization and finalization }
  1206. potype_unitinit: ;
  1207. else
  1208. aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1209. end;
  1210. { finalize paras data }
  1211. if assigned(aktprocdef.parast) then
  1212. aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1213. { do we need to handle exceptions because of ansi/widestrings ? }
  1214. if not inlined and
  1215. ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
  1216. { but it's useless in init/final code of units }
  1217. not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
  1218. begin
  1219. { the exception helper routines modify all registers }
  1220. aktprocdef.usedregisters:=all_registers;
  1221. getlabel(noreraiselabel);
  1222. cg.g_pop_exception(list,noreraiselabel);
  1223. if (aktprocdef.proctypeoption=potype_constructor) then
  1224. begin
  1225. if assigned(procinfo^._class) then
  1226. begin
  1227. pd:=procinfo^._class.searchdestructor;
  1228. if assigned(pd) then
  1229. begin
  1230. getlabel(nodestroycall);
  1231. reference_reset_base(href,procinfo^.framepointer,procinfo^.selfpointer_offset);
  1232. cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nodestroycall);
  1233. if is_class(procinfo^._class) then
  1234. begin
  1235. cg.a_param_const(list,OS_INT,1,2);
  1236. cg.a_param_reg(list,OS_ADDR,self_pointer_reg,1);
  1237. end
  1238. else if is_object(procinfo^._class) then
  1239. begin
  1240. cg.a_param_reg(list,OS_ADDR,self_pointer_reg,2);
  1241. reference_reset_symbol(href,newasmsymbol(procinfo^._class.vmt_mangledname),0);
  1242. cg.a_paramaddr_ref(list,href,1);
  1243. end
  1244. else
  1245. Internalerror(200006164);
  1246. if (po_virtualmethod in pd.procoptions) then
  1247. begin
  1248. reference_reset_base(href,self_pointer_reg,0);
  1249. tmpreg:=cg.get_scratch_reg(list);
  1250. cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
  1251. reference_reset_base(href,tmpreg,procinfo^._class.vmtmethodoffset(pd.extnumber));
  1252. cg.free_scratch_reg(list,tmpreg);
  1253. cg.a_call_ref(list,href);
  1254. end
  1255. else
  1256. cg.a_call_name(list,pd.mangledname);
  1257. { not necessary because the result is never assigned in the
  1258. case of an exception (FK) }
  1259. cg.a_label(list,nodestroycall);
  1260. end;
  1261. end
  1262. end
  1263. else
  1264. begin
  1265. { no constructor }
  1266. { must be the return value finalized before reraising the exception? }
  1267. if (not is_void(aktprocdef.rettype.def)) and
  1268. (aktprocdef.rettype.def.needs_inittable) and
  1269. ((aktprocdef.rettype.def.deftype<>objectdef) or
  1270. not is_class(aktprocdef.rettype.def)) then
  1271. begin
  1272. reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
  1273. cg.g_finalize(list,aktprocdef.rettype.def,href,ret_in_param(aktprocdef.rettype.def));
  1274. end;
  1275. end;
  1276. cg.a_call_name(list,'FPC_RERAISE');
  1277. cg.a_label(list,noreraiselabel);
  1278. end;
  1279. { call __EXIT for main program }
  1280. if (not DLLsource) and
  1281. (not inlined) and
  1282. (aktprocdef.proctypeoption=potype_proginit) then
  1283. cg.a_call_name(list,'FPC_DO_EXIT');
  1284. { handle return value, this is not done for assembler routines when
  1285. they didn't reference the result variable }
  1286. usesacc:=false;
  1287. usesacchi:=false;
  1288. usesself:=false;
  1289. if not(po_assembler in aktprocdef.procoptions) or
  1290. (assigned(aktprocdef.funcretsym) and
  1291. (tfuncretsym(aktprocdef.funcretsym).refcount>1)) then
  1292. begin
  1293. if (aktprocdef.proctypeoption<>potype_constructor) then
  1294. handle_return_value(list,inlined,usesacc,usesacchi)
  1295. else
  1296. begin
  1297. { successful constructor deletes the zero flag }
  1298. { and returns self in eax }
  1299. { eax must be set to zero if the allocation failed !!! }
  1300. getlabel(okexitlabel);
  1301. cg.a_jmp_always(list,okexitlabel);
  1302. cg.a_label(list,faillabel);
  1303. cg.g_call_fail_helper(list);
  1304. cg.a_label(list,okexitlabel);
  1305. { for classes this is done after the call to }
  1306. { AfterConstruction }
  1307. if is_object(procinfo^._class) then
  1308. begin
  1309. cg.a_reg_alloc(list,accumulator);
  1310. cg.a_load_reg_reg(list,OS_ADDR,self_pointer_reg,accumulator);
  1311. usesacc:=true;
  1312. end;
  1313. {$ifdef i386}
  1314. list.concat(taicpu.op_reg_reg(A_TEST,S_L,R_ESI,R_ESI));
  1315. {$else}
  1316. {$warning constructor returns in flags for i386}
  1317. {$endif i386}
  1318. usesself:=true;
  1319. end;
  1320. end;
  1321. if aktexit2label.is_used and not aktexit2label.is_set then
  1322. cg.a_label(list,aktexit2label);
  1323. {$ifdef GDB}
  1324. if ((cs_debuginfo in aktmoduleswitches) and not inlined) then
  1325. begin
  1326. getlabel(stabsendlabel);
  1327. cg.a_label(list,stabsendlabel);
  1328. end;
  1329. {$endif GDB}
  1330. { for the save all registers we can simply use a pusha,popa which
  1331. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1332. if (po_saveregisters in aktprocdef.procoptions) then
  1333. cg.g_restore_all_registers(list,usesself,usesacc,usesacchi)
  1334. else
  1335. { should we restore edi ? }
  1336. if (po_savestdregs in aktprocdef.procoptions) then
  1337. cg.g_restore_standard_registers(list);
  1338. { remove stackframe }
  1339. if not inlined then
  1340. begin
  1341. if (not nostackframe) then
  1342. cg.g_restore_frame_pointer(list)
  1343. else
  1344. if (tg.gettempsize<>0) then
  1345. cg.a_op_const_reg(list,OP_ADD,tg.gettempsize,STACK_POINTER_REG);
  1346. end;
  1347. { at last, the return is generated }
  1348. if not inlined then
  1349. begin
  1350. if (po_interrupt in aktprocdef.procoptions) then
  1351. cg.g_interrupt_stackframe_exit(list,usesself,usesacc,usesacchi)
  1352. else
  1353. cg.g_return_from_proc(list,parasize);
  1354. end;
  1355. if not inlined then
  1356. list.concat(Tai_symbol_end.Createname(aktprocdef.mangledname));
  1357. {$ifdef GDB}
  1358. if (cs_debuginfo in aktmoduleswitches) and not inlined then
  1359. begin
  1360. if assigned(procinfo^._class) then
  1361. if (not assigned(procinfo^.parent) or
  1362. not assigned(procinfo^.parent^._class)) then
  1363. begin
  1364. if (po_classmethod in aktprocdef.procoptions) or
  1365. ((po_virtualmethod in aktprocdef.procoptions) and
  1366. (potype_constructor=aktprocdef.proctypeoption)) or
  1367. (po_staticmethod in aktprocdef.procoptions) then
  1368. begin
  1369. list.concat(Tai_stabs.Create(strpnew(
  1370. '"pvmt:p'+tstoreddef(pvmttype.def).numberstring+'",'+
  1371. tostr(N_tsym)+',0,0,'+tostr(procinfo^.selfpointer_offset))));
  1372. end
  1373. else
  1374. begin
  1375. if not(is_class(procinfo^._class)) then
  1376. st:='v'
  1377. else
  1378. st:='p';
  1379. list.concat(Tai_stabs.Create(strpnew(
  1380. '"$t:'+st+procinfo^._class.numberstring+'",'+
  1381. tostr(N_tsym)+',0,0,'+tostr(procinfo^.selfpointer_offset))));
  1382. end;
  1383. end
  1384. else
  1385. begin
  1386. if not is_class(procinfo^._class) then
  1387. st:='*'
  1388. else
  1389. st:='';
  1390. list.concat(Tai_stabs.Create(strpnew(
  1391. '"$t:r'+st+procinfo^._class.numberstring+'",'+
  1392. tostr(N_RSYM)+',0,0,'+tostr(GDB_i386index[SELF_POINTER_REG]))));
  1393. end;
  1394. { define calling EBP as pseudo local var PM }
  1395. { this enables test if the function is a local one !! }
  1396. if assigned(procinfo^.parent) and (lexlevel>normal_function_level) then
  1397. list.concat(Tai_stabs.Create(strpnew(
  1398. '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
  1399. tostr(N_LSYM)+',0,0,'+tostr(procinfo^.framepointer_offset))));
  1400. if (not is_void(aktprocdef.rettype.def)) then
  1401. begin
  1402. if ret_in_param(aktprocdef.rettype.def) then
  1403. list.concat(Tai_stabs.Create(strpnew(
  1404. '"'+aktprocsym.name+':X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
  1405. tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))))
  1406. else
  1407. list.concat(Tai_stabs.Create(strpnew(
  1408. '"'+aktprocsym.name+':X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
  1409. tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))));
  1410. if (m_result in aktmodeswitches) then
  1411. if ret_in_param(aktprocdef.rettype.def) then
  1412. list.concat(Tai_stabs.Create(strpnew(
  1413. '"RESULT:X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
  1414. tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))))
  1415. else
  1416. list.concat(Tai_stabs.Create(strpnew(
  1417. '"RESULT:X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
  1418. tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))));
  1419. end;
  1420. mangled_length:=length(aktprocdef.mangledname);
  1421. getmem(p,2*mangled_length+50);
  1422. strpcopy(p,'192,0,0,');
  1423. strpcopy(strend(p),aktprocdef.mangledname);
  1424. if (target_info.use_function_relative_addresses) then
  1425. begin
  1426. strpcopy(strend(p),'-');
  1427. strpcopy(strend(p),aktprocdef.mangledname);
  1428. end;
  1429. list.concat(Tai_stabn.Create(strnew(p)));
  1430. {List.concat(Tai_stabn.Create(strpnew('192,0,0,'
  1431. +aktprocdef.mangledname))));
  1432. p[0]:='2';p[1]:='2';p[2]:='4';
  1433. strpcopy(strend(p),'_end');}
  1434. strpcopy(p,'224,0,0,'+stabsendlabel.name);
  1435. if (target_info.use_function_relative_addresses) then
  1436. begin
  1437. strpcopy(strend(p),'-');
  1438. strpcopy(strend(p),aktprocdef.mangledname);
  1439. end;
  1440. list.concatlist(withdebuglist);
  1441. list.concat(Tai_stabn.Create(strnew(p)));
  1442. { strpnew('224,0,0,'
  1443. +aktprocdef.mangledname+'_end'))));}
  1444. freemem(p,2*mangled_length+50);
  1445. end;
  1446. {$endif GDB}
  1447. if inlined then
  1448. cleanup_regvars(list);
  1449. end;
  1450. procedure genimplicitunitinit(list : TAAsmoutput);
  1451. begin
  1452. { using current_module.globalsymtable is hopefully }
  1453. { more robust than symtablestack and symtablestack.next }
  1454. tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
  1455. tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
  1456. list.insert(Tai_symbol.Createname_global('INIT$$'+current_module.modulename^,0));
  1457. list.insert(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_init',0));
  1458. {$ifdef GDB}
  1459. if (cs_debuginfo in aktmoduleswitches) and
  1460. target_info.use_function_relative_addresses then
  1461. list.insert(Tai_stab_function_name.Create(strpnew('INIT$$'+current_module.modulename^)));
  1462. {$endif GDB}
  1463. cg.g_return_from_proc(list,0);
  1464. end;
  1465. procedure genimplicitunitfinal(list : TAAsmoutput);
  1466. begin
  1467. { using current_module.globalsymtable is hopefully }
  1468. { more robust than symtablestack and symtablestack.next }
  1469. tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
  1470. tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
  1471. list.insert(Tai_symbol.Createname_global('FINALIZE$$'+current_module.modulename^,0));
  1472. list.insert(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_finalize',0));
  1473. {$ifdef GDB}
  1474. if (cs_debuginfo in aktmoduleswitches) and
  1475. target_info.use_function_relative_addresses then
  1476. list.insert(Tai_stab_function_name.Create(strpnew('FINALIZE$$'+current_module.modulename^)));
  1477. {$endif GDB}
  1478. cg.g_return_from_proc(list,0);
  1479. end;
  1480. end.
  1481. {
  1482. $Log$
  1483. Revision 1.14 2002-05-14 19:34:42 peter
  1484. * removed old logs and updated copyright year
  1485. Revision 1.13 2002/05/13 19:54:37 peter
  1486. * removed n386ld and n386util units
  1487. * maybe_save/maybe_restore added instead of the old maybe_push
  1488. Revision 1.12 2002/05/12 19:58:36 carl
  1489. * some small portability fixes
  1490. Revision 1.11 2002/05/12 16:53:07 peter
  1491. * moved entry and exitcode to ncgutil and cgobj
  1492. * foreach gets extra argument for passing local data to the
  1493. iterator function
  1494. * -CR checks also class typecasts at runtime by changing them
  1495. into as
  1496. * fixed compiler to cycle with the -CR option
  1497. * fixed stabs with elf writer, finally the global variables can
  1498. be watched
  1499. * removed a lot of routines from cga unit and replaced them by
  1500. calls to cgobj
  1501. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1502. u32bit then the other is typecasted also to u32bit without giving
  1503. a rangecheck warning/error.
  1504. * fixed pascal calling method with reversing also the high tree in
  1505. the parast, detected by tcalcst3 test
  1506. Revision 1.10 2002/04/21 19:02:03 peter
  1507. * removed newn and disposen nodes, the code is now directly
  1508. inlined from pexpr
  1509. * -an option that will write the secondpass nodes to the .s file, this
  1510. requires EXTDEBUG define to actually write the info
  1511. * fixed various internal errors and crashes due recent code changes
  1512. Revision 1.9 2002/04/21 15:24:38 carl
  1513. + a_jmp_cond -> a_jmp_always (a_jmp_cond is NOT portable)
  1514. + changeregsize -> rg.makeregsize
  1515. Revision 1.8 2002/04/19 15:39:34 peter
  1516. * removed some more routines from cga
  1517. * moved location_force_reg/mem to ncgutil
  1518. * moved arrayconstructnode secondpass to ncgld
  1519. Revision 1.7 2002/04/15 18:58:47 carl
  1520. + target_info.size_of_pointer -> pointer_Size
  1521. Revision 1.6 2002/04/06 18:10:42 jonas
  1522. * several powerpc-related additions and fixes
  1523. Revision 1.5 2002/04/04 19:05:57 peter
  1524. * removed unused units
  1525. * use tlocation.size in cg.a_*loc*() routines
  1526. Revision 1.4 2002/04/02 17:11:28 peter
  1527. * tlocation,treference update
  1528. * LOC_CONSTANT added for better constant handling
  1529. * secondadd splitted in multiple routines
  1530. * location_force_reg added for loading a location to a register
  1531. of a specified size
  1532. * secondassignment parses now first the right and then the left node
  1533. (this is compatible with Kylix). This saves a lot of push/pop especially
  1534. with string operations
  1535. * adapted some routines to use the new cg methods
  1536. Revision 1.3 2002/03/31 20:26:34 jonas
  1537. + a_loadfpu_* and a_loadmm_* methods in tcg
  1538. * register allocation is now handled by a class and is mostly processor
  1539. independent (+rgobj.pas and i386/rgcpu.pas)
  1540. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  1541. * some small improvements and fixes to the optimizer
  1542. * some register allocation fixes
  1543. * some fpuvaroffset fixes in the unary minus node
  1544. * push/popusedregisters is now called rg.save/restoreusedregisters and
  1545. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  1546. also better optimizable)
  1547. * fixed and optimized register saving/restoring for new/dispose nodes
  1548. * LOC_FPU locations now also require their "register" field to be set to
  1549. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  1550. - list field removed of the tnode class because it's not used currently
  1551. and can cause hard-to-find bugs
  1552. Revision 1.2 2002/03/04 19:10:11 peter
  1553. * removed compiler warnings
  1554. }