ncgutil.pas 86 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189
  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 fpcdefs.inc}
  20. interface
  21. uses
  22. node,cpuinfo,
  23. globtype,
  24. cpubase,cgbase,
  25. aasmbase,aasmtai,aasmcpu,
  26. symconst,symbase,symdef,symsym,symtype,symtable
  27. {$ifndef cpu64bit}
  28. ,cg64f32
  29. {$endif cpu64bit}
  30. ;
  31. type
  32. tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
  33. procedure firstcomplex(p : tbinarynode);
  34. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  35. // procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
  36. procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  37. procedure location_force_fpureg(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
  38. procedure location_force_mem(list:TAAsmoutput;var l:tlocation);
  39. procedure location_force_mmregscalar(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
  40. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  41. procedure gen_proc_symbol(list:Taasmoutput);
  42. procedure gen_proc_symbol_end(list:Taasmoutput);
  43. procedure gen_proc_entry_code(list:Taasmoutput);
  44. procedure gen_proc_exit_code(list:Taasmoutput);
  45. procedure gen_save_used_regs(list:TAAsmoutput);
  46. procedure gen_restore_used_regs(list:TAAsmoutput;const funcretparaloc:tparalocation);
  47. procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
  48. procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
  49. procedure gen_entry_code(list:TAAsmoutput);
  50. procedure gen_exit_code(list:TAAsmoutput);
  51. procedure gen_load_para_value(list:TAAsmoutput);
  52. procedure gen_load_return_value(list:TAAsmoutput);
  53. (*
  54. procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
  55. procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
  56. *)
  57. {#
  58. Allocate the buffers for exception management and setjmp environment.
  59. Return a pointer to these buffers, send them to the utility routine
  60. so they are registered, and then call setjmp.
  61. Then compare the result of setjmp with 0, and if not equal
  62. to zero, then jump to exceptlabel.
  63. Also store the result of setjmp to a temporary space by calling g_save_exception_reason
  64. It is to note that this routine may be called *after* the stackframe of a
  65. routine has been called, therefore on machines where the stack cannot
  66. be modified, all temps should be allocated on the heap instead of the
  67. stack.
  68. }
  69. const
  70. EXCEPT_BUF_SIZE = 3*sizeof(aint);
  71. type
  72. texceptiontemps=record
  73. jmpbuf,
  74. envbuf,
  75. reasonbuf : treference;
  76. end;
  77. procedure get_exception_temps(list:taasmoutput;var t:texceptiontemps);
  78. procedure unget_exception_temps(list:taasmoutput;const t:texceptiontemps);
  79. procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;exceptlabel:tasmlabel);
  80. procedure free_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
  81. procedure insertconstdata(sym : ttypedconstsym);
  82. procedure insertbssdata(sym : tvarsym);
  83. procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
  84. procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
  85. procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
  86. procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
  87. procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
  88. { rtti and init/final }
  89. procedure generate_rtti(p:Ttypesym);
  90. procedure generate_inittable(p:tsym);
  91. implementation
  92. uses
  93. {$ifdef Delphi}
  94. Sysutils,
  95. {$else}
  96. strings,
  97. {$endif}
  98. cutils,cclasses,
  99. globals,systems,verbose,
  100. ppu,defutil,
  101. procinfo,paramgr,fmodule,
  102. regvars,dwarf,
  103. {$ifdef GDB}
  104. gdb,
  105. {$endif GDB}
  106. pass_1,pass_2,
  107. ncon,nld,nutils,
  108. tgobj,cgutils,cgobj;
  109. {*****************************************************************************
  110. Misc Helpers
  111. *****************************************************************************}
  112. { DO NOT RELY on the fact that the tnode is not yet swaped
  113. because of inlining code PM }
  114. procedure firstcomplex(p : tbinarynode);
  115. var
  116. hp : tnode;
  117. begin
  118. { always calculate boolean AND and OR from left to right }
  119. if (p.nodetype in [orn,andn]) and
  120. is_boolean(p.left.resulttype.def) then
  121. begin
  122. if nf_swaped in p.flags then
  123. internalerror(234234);
  124. end
  125. else
  126. if (
  127. (p.location.loc=LOC_FPUREGISTER) and
  128. (p.right.registersfpu > p.left.registersfpu)
  129. ) or
  130. (
  131. (
  132. (
  133. ((p.left.registersfpu = 0) and (p.right.registersfpu = 0)) or
  134. (p.location.loc<>LOC_FPUREGISTER)
  135. ) and
  136. (p.left.registersint<p.right.registersint)
  137. )
  138. ) then
  139. begin
  140. hp:=p.left;
  141. p.left:=p.right;
  142. p.right:=hp;
  143. if nf_swaped in p.flags then
  144. exclude(p.flags,nf_swaped)
  145. else
  146. include(p.flags,nf_swaped);
  147. end;
  148. end;
  149. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  150. {
  151. produces jumps to true respectively false labels using boolean expressions
  152. depending on whether the loading of regvars is currently being
  153. synchronized manually (such as in an if-node) or automatically (most of
  154. the other cases where this procedure is called), loadregvars can be
  155. "lr_load_regvars" or "lr_dont_load_regvars"
  156. }
  157. var
  158. opsize : tcgsize;
  159. storepos : tfileposinfo;
  160. begin
  161. if nf_error in p.flags then
  162. exit;
  163. storepos:=aktfilepos;
  164. aktfilepos:=p.fileinfo;
  165. if is_boolean(p.resulttype.def) then
  166. begin
  167. {$ifdef OLDREGVARS}
  168. if loadregvars = lr_load_regvars then
  169. load_all_regvars(list);
  170. {$endif OLDREGVARS}
  171. if is_constboolnode(p) then
  172. begin
  173. if tordconstnode(p).value<>0 then
  174. cg.a_jmp_always(list,truelabel)
  175. else
  176. cg.a_jmp_always(list,falselabel)
  177. end
  178. else
  179. begin
  180. opsize:=def_cgsize(p.resulttype.def);
  181. case p.location.loc of
  182. LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
  183. begin
  184. {$ifdef OLDREGVARS}
  185. if (p.location.loc = LOC_CREGISTER) then
  186. load_regvar_reg(list,p.location.register);
  187. {$endif OLDREGVARS}
  188. cg.a_cmp_const_loc_label(list,opsize,OC_NE,
  189. 0,p.location,truelabel);
  190. { !!! should happen right after cmp (JM) }
  191. location_release(list,p.location);
  192. cg.a_jmp_always(list,falselabel);
  193. end;
  194. LOC_JUMP:
  195. ;
  196. {$ifdef cpuflags}
  197. LOC_FLAGS :
  198. begin
  199. cg.a_jmp_flags(list,p.location.resflags,
  200. truelabel);
  201. cg.a_jmp_always(list,falselabel);
  202. end;
  203. {$endif cpuflags}
  204. else
  205. begin
  206. printnode(output,p);
  207. internalerror(200308241);
  208. end;
  209. end;
  210. end;
  211. end
  212. else
  213. internalerror(200112305);
  214. aktfilepos:=storepos;
  215. end;
  216. (*
  217. This code needs fixing. It is not safe to use rgint; on the m68000 it
  218. would be rgaddr.
  219. procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
  220. begin
  221. case t.loc of
  222. LOC_REGISTER:
  223. begin
  224. { can't be a regvar, since it would be LOC_CREGISTER then }
  225. exclude(regs,getsupreg(t.register));
  226. if t.registerhigh<>NR_NO then
  227. exclude(regs,getsupreg(t.registerhigh));
  228. end;
  229. LOC_CREFERENCE,LOC_REFERENCE:
  230. begin
  231. if not(cs_regvars in aktglobalswitches) or
  232. (getsupreg(t.reference.base) in cg.rgint.usableregs) then
  233. exclude(regs,getsupreg(t.reference.base));
  234. if not(cs_regvars in aktglobalswitches) or
  235. (getsupreg(t.reference.index) in cg.rgint.usableregs) then
  236. exclude(regs,getsupreg(t.reference.index));
  237. end;
  238. end;
  239. end;
  240. *)
  241. {*****************************************************************************
  242. EXCEPTION MANAGEMENT
  243. *****************************************************************************}
  244. procedure get_exception_temps(list:taasmoutput;var t:texceptiontemps);
  245. begin
  246. tg.GetTemp(list,EXCEPT_BUF_SIZE,tt_persistent,t.envbuf);
  247. tg.GetTemp(list,JMP_BUF_SIZE,tt_persistent,t.jmpbuf);
  248. tg.GetTemp(list,sizeof(aint),tt_persistent,t.reasonbuf);
  249. end;
  250. procedure unget_exception_temps(list:taasmoutput;const t:texceptiontemps);
  251. begin
  252. tg.Ungettemp(list,t.jmpbuf);
  253. tg.ungettemp(list,t.envbuf);
  254. tg.ungettemp(list,t.reasonbuf);
  255. end;
  256. procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;exceptlabel:tasmlabel);
  257. var
  258. paraloc1,paraloc2,paraloc3 : tparalocation;
  259. begin
  260. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  261. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  262. paraloc3:=paramanager.getintparaloc(pocall_default,3);
  263. paramanager.allocparaloc(list,paraloc3);
  264. cg.a_paramaddr_ref(list,t.envbuf,paraloc3);
  265. paramanager.allocparaloc(list,paraloc2);
  266. cg.a_paramaddr_ref(list,t.jmpbuf,paraloc2);
  267. { push type of exceptionframe }
  268. paramanager.allocparaloc(list,paraloc1);
  269. cg.a_param_const(list,OS_S32,1,paraloc1);
  270. paramanager.freeparaloc(list,paraloc3);
  271. paramanager.freeparaloc(list,paraloc2);
  272. paramanager.freeparaloc(list,paraloc1);
  273. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  274. cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
  275. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  276. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  277. paramanager.allocparaloc(list,paraloc1);
  278. cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
  279. paramanager.freeparaloc(list,paraloc1);
  280. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  281. cg.a_call_name(list,'FPC_SETJMP');
  282. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  283. cg.g_exception_reason_save(list, t.reasonbuf);
  284. cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,OS_S32),exceptlabel);
  285. end;
  286. procedure free_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
  287. begin
  288. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  289. cg.a_call_name(list,'FPC_POPADDRSTACK');
  290. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  291. if not onlyfree then
  292. begin
  293. cg.g_exception_reason_load(list, t.reasonbuf);
  294. cg.a_cmp_const_reg_label(list,OS_INT,OC_EQ,a,NR_FUNCTION_RESULT_REG,endexceptlabel);
  295. end;
  296. end;
  297. {*****************************************************************************
  298. TLocation
  299. *****************************************************************************}
  300. {$ifndef cpu64bit}
  301. { 32-bit version }
  302. procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  303. var
  304. hregister,
  305. hregisterhi : tregister;
  306. hreg64 : tregister64;
  307. hl : tasmlabel;
  308. oldloc : tlocation;
  309. const_location: boolean;
  310. begin
  311. oldloc:=l;
  312. if dst_size=OS_NO then
  313. internalerror(200309144);
  314. { handle transformations to 64bit separate }
  315. if dst_size in [OS_64,OS_S64] then
  316. begin
  317. if not (l.size in [OS_64,OS_S64]) then
  318. begin
  319. { load a smaller size to OS_64 }
  320. if l.loc=LOC_REGISTER then
  321. begin
  322. hregister:=cg.makeregsize(list,l.registerlow,OS_32);
  323. cg.a_load_reg_reg(list,l.size,OS_32,l.registerlow,hregister);
  324. end
  325. else
  326. begin
  327. location_release(list,l);
  328. hregister:=cg.getintregister(list,OS_INT);
  329. end;
  330. { load value in low register }
  331. case l.loc of
  332. LOC_FLAGS :
  333. cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
  334. LOC_JUMP :
  335. begin
  336. cg.a_label(list,truelabel);
  337. cg.a_load_const_reg(list,OS_INT,1,hregister);
  338. objectlibrary.getlabel(hl);
  339. cg.a_jmp_always(list,hl);
  340. cg.a_label(list,falselabel);
  341. cg.a_load_const_reg(list,OS_INT,0,hregister);
  342. cg.a_label(list,hl);
  343. end;
  344. else
  345. cg.a_load_loc_reg(list,OS_INT,l,hregister);
  346. end;
  347. { reset hi part, take care of the signed bit of the current value }
  348. hregisterhi:=cg.getintregister(list,OS_INT);
  349. if (l.size in [OS_S8,OS_S16,OS_S32]) then
  350. begin
  351. if l.loc=LOC_CONSTANT then
  352. begin
  353. if (longint(l.value)<0) then
  354. cg.a_load_const_reg(list,OS_32,aint($ffffffff),hregisterhi)
  355. else
  356. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  357. end
  358. else
  359. begin
  360. cg.a_op_const_reg_reg(list,OP_SAR,OS_32,31,hregister,
  361. hregisterhi);
  362. end;
  363. end
  364. else
  365. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  366. location_reset(l,LOC_REGISTER,dst_size);
  367. l.registerlow:=hregister;
  368. l.registerhigh:=hregisterhi;
  369. end
  370. else
  371. begin
  372. { 64bit to 64bit }
  373. if (l.loc=LOC_REGISTER) or
  374. ((l.loc=LOC_CREGISTER) and maybeconst) then
  375. begin
  376. hregister:=l.registerlow;
  377. hregisterhi:=l.registerhigh;
  378. end
  379. else
  380. begin
  381. hregister:=cg.getintregister(list,OS_INT);
  382. hregisterhi:=cg.getintregister(list,OS_INT);
  383. location_release(list,l);
  384. end;
  385. hreg64.reglo:=hregister;
  386. hreg64.reghi:=hregisterhi;
  387. { load value in new register }
  388. cg64.a_load64_loc_reg(list,l,hreg64);
  389. location_reset(l,LOC_REGISTER,dst_size);
  390. l.registerlow:=hregister;
  391. l.registerhigh:=hregisterhi;
  392. end;
  393. end
  394. else
  395. begin
  396. {Do not bother to recycle the existing register. The register
  397. allocator eliminates unnecessary moves, so it's not needed
  398. and trying to recycle registers can cause problems because
  399. the registers changes size and may need aditional constraints.
  400. Not if it's about LOC_CREGISTER's (JM)
  401. }
  402. const_location :=
  403. (maybeconst) and
  404. (l.loc = LOC_CREGISTER) and
  405. (TCGSize2Size[l.size] = TCGSize2Size[dst_size]) and
  406. ((l.size = dst_size) or
  407. (TCGSize2Size[l.size] = TCGSize2Size[OS_INT]));
  408. if not const_location then
  409. begin
  410. location_release(list,l);
  411. hregister:=cg.getintregister(list,dst_size)
  412. end
  413. else
  414. hregister := l.register;
  415. { load value in new register }
  416. case l.loc of
  417. LOC_FLAGS :
  418. cg.g_flags2reg(list,dst_size,l.resflags,hregister);
  419. LOC_JUMP :
  420. begin
  421. cg.a_label(list,truelabel);
  422. cg.a_load_const_reg(list,dst_size,1,hregister);
  423. objectlibrary.getlabel(hl);
  424. cg.a_jmp_always(list,hl);
  425. cg.a_label(list,falselabel);
  426. cg.a_load_const_reg(list,dst_size,0,hregister);
  427. cg.a_label(list,hl);
  428. end;
  429. else
  430. begin
  431. { load_loc_reg can only handle size >= l.size, when the
  432. new size is smaller then we need to adjust the size
  433. of the orignal and maybe recalculate l.register for i386 }
  434. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  435. begin
  436. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  437. l.register:=cg.makeregsize(list,l.register,dst_size);
  438. { for big endian systems, the reference's offset must }
  439. { be increased in this case, since they have the }
  440. { MSB first in memory and e.g. byte(word_var) should }
  441. { return the second byte in this case (JM) }
  442. if (target_info.endian = ENDIAN_BIG) and
  443. (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  444. inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
  445. {$ifdef x86}
  446. l.size:=dst_size;
  447. {$endif x86}
  448. end;
  449. cg.a_load_loc_reg(list,dst_size,l,hregister);
  450. {$ifndef x86}
  451. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  452. l.size:=dst_size;
  453. {$endif not x86}
  454. end;
  455. end;
  456. if not const_location then
  457. location_reset(l,LOC_REGISTER,dst_size)
  458. else
  459. location_reset(l,LOC_CREGISTER,dst_size);
  460. l.register:=hregister;
  461. end;
  462. { Release temp when it was a reference }
  463. if oldloc.loc=LOC_REFERENCE then
  464. location_freetemp(list,oldloc);
  465. end;
  466. {$else cpu64bit}
  467. { 64-bit version }
  468. procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  469. var
  470. hregister : tregister;
  471. hl : tasmlabel;
  472. oldloc : tlocation;
  473. begin
  474. oldloc:=l;
  475. {Do not bother to recycle the existing register. The register
  476. allocator eliminates unnecessary moves, so it's not needed
  477. and trying to recycle registers can cause problems because
  478. the registers changes size and may need aditional constraints.}
  479. location_release(list,l);
  480. hregister:=cg.getintregister(list,dst_size);
  481. { load value in new register }
  482. case l.loc of
  483. LOC_FLAGS :
  484. cg.g_flags2reg(list,dst_size,l.resflags,hregister);
  485. LOC_JUMP :
  486. begin
  487. cg.a_label(list,truelabel);
  488. cg.a_load_const_reg(list,dst_size,1,hregister);
  489. objectlibrary.getlabel(hl);
  490. cg.a_jmp_always(list,hl);
  491. cg.a_label(list,falselabel);
  492. cg.a_load_const_reg(list,dst_size,0,hregister);
  493. cg.a_label(list,hl);
  494. end;
  495. else
  496. begin
  497. { load_loc_reg can only handle size >= l.size, when the
  498. new size is smaller then we need to adjust the size
  499. of the orignal and maybe recalculate l.register for i386 }
  500. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  501. begin
  502. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  503. l.register:=cg.makeregsize(list,l.register,dst_size);
  504. { for big endian systems, the reference's offset must }
  505. { be increased in this case, since they have the }
  506. { MSB first in memory and e.g. byte(word_var) should }
  507. { return the second byte in this case (JM) }
  508. if (target_info.endian = ENDIAN_BIG) and
  509. (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  510. inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
  511. {$ifdef x86}
  512. l.size:=dst_size;
  513. {$endif x86}
  514. end;
  515. cg.a_load_loc_reg(list,dst_size,l,hregister);
  516. {$ifndef x86}
  517. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  518. l.size:=dst_size;
  519. {$endif not x86}
  520. end;
  521. end;
  522. if (l.loc <> LOC_CREGISTER) or
  523. not maybeconst then
  524. location_reset(l,LOC_REGISTER,dst_size)
  525. else
  526. location_reset(l,LOC_CREGISTER,dst_size);
  527. l.register:=hregister;
  528. { Release temp when it was a reference }
  529. if oldloc.loc=LOC_REFERENCE then
  530. location_freetemp(list,oldloc);
  531. end;
  532. {$endif cpu64bit}
  533. procedure location_force_fpureg(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
  534. var
  535. reg : tregister;
  536. href : treference;
  537. begin
  538. if (l.loc<>LOC_FPUREGISTER) and
  539. ((l.loc<>LOC_CFPUREGISTER) or (not maybeconst)) then
  540. begin
  541. { if it's in an mm register, store to memory first }
  542. if (l.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
  543. begin
  544. tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
  545. cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,href,mms_movescalar);
  546. location_release(list,l);
  547. location_reset(l,LOC_REFERENCE,l.size);
  548. l.reference:=href;
  549. end;
  550. reg:=cg.getfpuregister(list,l.size);
  551. cg.a_loadfpu_loc_reg(list,l,reg);
  552. location_freetemp(list,l);
  553. location_release(list,l);
  554. location_reset(l,LOC_FPUREGISTER,l.size);
  555. l.register:=reg;
  556. end;
  557. end;
  558. procedure location_force_mmregscalar(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
  559. var
  560. reg : tregister;
  561. href : treference;
  562. begin
  563. if (l.loc<>LOC_MMREGISTER) and
  564. ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then
  565. begin
  566. { if it's in an fpu register, store to memory first }
  567. if (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
  568. begin
  569. tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
  570. cg.a_loadfpu_reg_ref(list,l.size,l.register,href);
  571. location_release(list,l);
  572. location_reset(l,LOC_REFERENCE,l.size);
  573. l.reference:=href;
  574. end;
  575. reg:=cg.getmmregister(list,l.size);
  576. cg.a_loadmm_loc_reg(list,l.size,l,reg,mms_movescalar);
  577. location_freetemp(list,l);
  578. location_release(list,l);
  579. location_reset(l,LOC_MMREGISTER,l.size);
  580. l.register:=reg;
  581. end;
  582. end;
  583. procedure location_force_mem(list:TAAsmoutput;var l:tlocation);
  584. var
  585. r : treference;
  586. begin
  587. case l.loc of
  588. LOC_FPUREGISTER,
  589. LOC_CFPUREGISTER :
  590. begin
  591. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  592. cg.a_loadfpu_reg_ref(list,l.size,l.register,r);
  593. location_release(list,l);
  594. location_reset(l,LOC_REFERENCE,l.size);
  595. l.reference:=r;
  596. end;
  597. LOC_MMREGISTER,
  598. LOC_CMMREGISTER:
  599. begin
  600. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  601. cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,r,mms_movescalar);
  602. location_release(list,l);
  603. location_reset(l,LOC_REFERENCE,l.size);
  604. l.reference:=r;
  605. end;
  606. LOC_CONSTANT,
  607. LOC_REGISTER,
  608. LOC_CREGISTER :
  609. begin
  610. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  611. {$ifndef cpu64bit}
  612. if l.size in [OS_64,OS_S64] then
  613. begin
  614. cg64.a_load64_loc_ref(list,l,r);
  615. location_release(list,l);
  616. end
  617. else
  618. {$endif cpu64bit}
  619. begin
  620. location_release(list,l);
  621. cg.a_load_loc_ref(list,l.size,l,r);
  622. end;
  623. location_reset(l,LOC_REFERENCE,l.size);
  624. l.reference:=r;
  625. end;
  626. LOC_CREFERENCE,
  627. LOC_REFERENCE : ;
  628. else
  629. internalerror(200203219);
  630. end;
  631. end;
  632. {*****************************************************************************
  633. Maybe_Save
  634. *****************************************************************************}
  635. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  636. begin
  637. {$ifdef i386}
  638. if (needed>=maxfpuregs) and
  639. (l.loc = LOC_FPUREGISTER) then
  640. begin
  641. location_force_mem(list,l);
  642. maybe_pushfpu:=true;
  643. end
  644. else
  645. maybe_pushfpu:=false;
  646. {$else i386}
  647. maybe_pushfpu:=false;
  648. {$endif i386}
  649. end;
  650. {****************************************************************************
  651. Init/Finalize Code
  652. ****************************************************************************}
  653. procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
  654. var
  655. href1,href2 : treference;
  656. list:TAAsmoutput;
  657. hsym : tvarsym;
  658. l : longint;
  659. loadref : boolean;
  660. localcopyloc : tparalocation;
  661. begin
  662. list:=taasmoutput(arg);
  663. if (tsym(p).typ=varsym) and
  664. (tvarsym(p).varspez=vs_value) and
  665. (paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
  666. begin
  667. loadref:=true;
  668. case tvarsym(p).localloc.loc of
  669. LOC_REGISTER :
  670. begin
  671. reference_reset_base(href1,tvarsym(p).localloc.register,0);
  672. loadref:=false;
  673. end;
  674. LOC_REFERENCE :
  675. reference_reset_base(href1,tvarsym(p).localloc.reference.index,
  676. tvarsym(p).localloc.reference.offset);
  677. else
  678. internalerror(200309181);
  679. end;
  680. if is_open_array(tvarsym(p).vartype.def) or
  681. is_array_of_const(tvarsym(p).vartype.def) then
  682. begin
  683. { cdecl functions don't have a high pointer so it is not possible to generate
  684. a local copy }
  685. if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  686. begin
  687. hsym:=tvarsym(tsym(p).owner.search('high'+p.name));
  688. if not assigned(hsym) then
  689. internalerror(200306061);
  690. case hsym.localloc.loc of
  691. LOC_REFERENCE :
  692. begin
  693. { this code is only executed before the code for the body and the entry/exit code is generated
  694. so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
  695. }
  696. include(current_procinfo.flags,pi_do_call);
  697. reference_reset_base(href2,hsym.localloc.reference.index,hsym.localloc.reference.offset);
  698. cg.g_copyvaluepara_openarray(list,href1,href2,tarraydef(tvarsym(p).vartype.def).elesize)
  699. end
  700. else
  701. internalerror(200309182);
  702. end;
  703. end;
  704. end
  705. else
  706. begin
  707. if tvarsym(p).localloc.loc<>LOC_REFERENCE then
  708. internalerror(200309183);
  709. { Allocate space for the local copy }
  710. l:=tvarsym(p).getvaluesize;
  711. localcopyloc.loc:=LOC_REFERENCE;
  712. localcopyloc.size:=int_cgsize(l);
  713. tg.GetLocal(list,l,tvarsym(p).vartype.def,localcopyloc.reference);
  714. { Copy data }
  715. reference_reset_base(href2,localcopyloc.reference.index,localcopyloc.reference.offset);
  716. if is_shortstring(tvarsym(p).vartype.def) then
  717. begin
  718. { this code is only executed before the code for the body and the entry/exit code is generated
  719. so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
  720. }
  721. include(current_procinfo.flags,pi_do_call);
  722. cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,loadref)
  723. end
  724. else
  725. cg.g_concatcopy(list,href1,href2,tvarsym(p).vartype.def.size,true,loadref);
  726. { update localloc of varsym }
  727. tg.Ungetlocal(list,tvarsym(p).localloc.reference);
  728. tvarsym(p).localloc:=localcopyloc;
  729. end;
  730. end;
  731. end;
  732. { generates the code for initialisation of local data }
  733. procedure initialize_data(p : tnamedindexitem;arg:pointer);
  734. var
  735. oldexprasmlist : TAAsmoutput;
  736. hp : tnode;
  737. begin
  738. if (tsym(p).typ=varsym) and
  739. (tvarsym(p).refs>0) and
  740. not(is_class(tvarsym(p).vartype.def)) and
  741. tvarsym(p).vartype.def.needs_inittable then
  742. begin
  743. oldexprasmlist:=exprasmlist;
  744. exprasmlist:=taasmoutput(arg);
  745. hp:=initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner));
  746. firstpass(hp);
  747. secondpass(hp);
  748. hp.free;
  749. exprasmlist:=oldexprasmlist;
  750. end;
  751. end;
  752. procedure finalize_sym(asmlist:taasmoutput;sym:tsym);
  753. var
  754. hp : tnode;
  755. oldexprasmlist : TAAsmoutput;
  756. begin
  757. include(current_procinfo.flags,pi_needs_implicit_finally);
  758. oldexprasmlist:=exprasmlist;
  759. exprasmlist:=asmlist;
  760. hp:=finalize_data_node(cloadnode.create(sym,sym.owner));
  761. firstpass(hp);
  762. secondpass(hp);
  763. hp.free;
  764. exprasmlist:=oldexprasmlist;
  765. end;
  766. { generates the code for finalisation of local variables }
  767. procedure finalize_local_vars(p : tnamedindexitem;arg:pointer);
  768. begin
  769. case tsym(p).typ of
  770. varsym :
  771. begin
  772. if (tvarsym(p).refs>0) and
  773. not(vo_is_funcret in tvarsym(p).varoptions) and
  774. not(is_class(tvarsym(p).vartype.def)) and
  775. tvarsym(p).vartype.def.needs_inittable then
  776. finalize_sym(taasmoutput(arg),tsym(p));
  777. end;
  778. end;
  779. end;
  780. { generates the code for finalisation of local typedconsts }
  781. procedure finalize_local_typedconst(p : tnamedindexitem;arg:pointer);
  782. var
  783. i : longint;
  784. pd : tprocdef;
  785. begin
  786. case tsym(p).typ of
  787. typedconstsym :
  788. begin
  789. if ttypedconstsym(p).is_writable and
  790. ttypedconstsym(p).typedconsttype.def.needs_inittable then
  791. finalize_sym(taasmoutput(arg),tsym(p));
  792. end;
  793. procsym :
  794. begin
  795. for i:=1 to tprocsym(p).procdef_count do
  796. begin
  797. pd:=tprocsym(p).procdef[i];
  798. if assigned(pd.localst) and
  799. (pd.localst.symtabletype<>staticsymtable) then
  800. pd.localst.foreach_static(@finalize_local_typedconst,arg);
  801. end;
  802. end;
  803. end;
  804. end;
  805. { generates the code for finalization of static symtable and
  806. all local (static) typedconsts }
  807. procedure finalize_static_data(p : tnamedindexitem;arg:pointer);
  808. var
  809. i : longint;
  810. pd : tprocdef;
  811. begin
  812. case tsym(p).typ of
  813. varsym :
  814. begin
  815. if (tvarsym(p).refs>0) and
  816. not(vo_is_funcret in tvarsym(p).varoptions) and
  817. not(is_class(tvarsym(p).vartype.def)) and
  818. tvarsym(p).vartype.def.needs_inittable then
  819. finalize_sym(taasmoutput(arg),tsym(p));
  820. end;
  821. typedconstsym :
  822. begin
  823. if ttypedconstsym(p).is_writable and
  824. ttypedconstsym(p).typedconsttype.def.needs_inittable then
  825. finalize_sym(taasmoutput(arg),tsym(p));
  826. end;
  827. procsym :
  828. begin
  829. for i:=1 to tprocsym(p).procdef_count do
  830. begin
  831. pd:=tprocsym(p).procdef[i];
  832. if assigned(pd.localst) and
  833. (pd.localst.symtabletype<>staticsymtable) then
  834. pd.localst.foreach_static(@finalize_local_typedconst,arg);
  835. end;
  836. end;
  837. end;
  838. end;
  839. { generates the code for incrementing the reference count of parameters and
  840. initialize out parameters }
  841. procedure init_paras(p : tnamedindexitem;arg:pointer);
  842. var
  843. href : treference;
  844. tmpreg : tregister;
  845. list:TAAsmoutput;
  846. begin
  847. list:=taasmoutput(arg);
  848. if (tsym(p).typ=varsym) and
  849. not is_class(tvarsym(p).vartype.def) and
  850. tvarsym(p).vartype.def.needs_inittable then
  851. begin
  852. case tvarsym(p).varspez of
  853. vs_value :
  854. begin
  855. if tvarsym(p).localloc.loc<>LOC_REFERENCE then
  856. internalerror(200309187);
  857. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  858. cg.g_incrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
  859. end;
  860. vs_out :
  861. begin
  862. case tvarsym(p).localloc.loc of
  863. LOC_REFERENCE :
  864. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  865. else
  866. internalerror(2003091810);
  867. end;
  868. tmpreg:=cg.getaddressregister(list);
  869. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,tmpreg);
  870. reference_reset_base(href,tmpreg,0);
  871. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  872. cg.ungetregister(list,tmpreg);
  873. end;
  874. end;
  875. end;
  876. end;
  877. { generates the code for decrementing the reference count of parameters }
  878. procedure final_paras(p : tnamedindexitem;arg:pointer);
  879. var
  880. href : treference;
  881. list:TAAsmoutput;
  882. begin
  883. list:=taasmoutput(arg);
  884. if (tsym(p).typ=varsym) and
  885. not is_class(tvarsym(p).vartype.def) and
  886. tvarsym(p).vartype.def.needs_inittable then
  887. begin
  888. if (tvarsym(p).varspez=vs_value) then
  889. begin
  890. include(current_procinfo.flags,pi_needs_implicit_finally);
  891. if tvarsym(p).localloc.loc<>LOC_REFERENCE then
  892. internalerror(200309188);
  893. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  894. cg.g_decrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
  895. end;
  896. end
  897. else if (tsym(p).typ=varsym) and
  898. (tvarsym(p).varspez=vs_value) and
  899. (is_open_array(tvarsym(p).vartype.def) or
  900. is_array_of_const(tvarsym(p).vartype.def)) then
  901. begin
  902. { cdecl functions don't have a high pointer so it is not possible to generate
  903. a local copy }
  904. if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  905. begin
  906. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  907. cg.g_releasevaluepara_openarray(list,href);
  908. end;
  909. end;
  910. end;
  911. { Initialize temp ansi/widestrings,interfaces }
  912. procedure inittempvariables(list:taasmoutput);
  913. var
  914. hp : ptemprecord;
  915. href : treference;
  916. begin
  917. hp:=tg.templist;
  918. while assigned(hp) do
  919. begin
  920. if assigned(hp^.def) and
  921. hp^.def.needs_inittable then
  922. begin
  923. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  924. cg.g_initialize(list,hp^.def,href,false);
  925. end;
  926. hp:=hp^.next;
  927. end;
  928. end;
  929. procedure finalizetempvariables(list:taasmoutput);
  930. var
  931. hp : ptemprecord;
  932. href : treference;
  933. begin
  934. hp:=tg.templist;
  935. while assigned(hp) do
  936. begin
  937. if assigned(hp^.def) and
  938. hp^.def.needs_inittable then
  939. begin
  940. include(current_procinfo.flags,pi_needs_implicit_finally);
  941. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  942. cg.g_finalize(list,hp^.def,href,false);
  943. end;
  944. hp:=hp^.next;
  945. end;
  946. end;
  947. procedure gen_load_return_value(list:TAAsmoutput);
  948. var
  949. ressym : tvarsym;
  950. resloc : tlocation;
  951. hreg : tregister;
  952. resultloc : tparalocation;
  953. begin
  954. resultloc:=current_procinfo.procdef.funcret_paraloc[calleeside];
  955. { Is the loading needed? }
  956. if is_void(current_procinfo.procdef.rettype.def) or
  957. (
  958. (po_assembler in current_procinfo.procdef.procoptions) and
  959. (not(assigned(current_procinfo.procdef.funcretsym)) or
  960. (tvarsym(current_procinfo.procdef.funcretsym).refs=0))
  961. ) then
  962. exit;
  963. { constructors return self }
  964. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  965. ressym:=tvarsym(current_procinfo.procdef.parast.search('self'))
  966. else
  967. ressym := tvarsym(current_procinfo.procdef.funcretsym);
  968. if (ressym.refs>0) then
  969. begin
  970. case ressym.localloc.loc of
  971. LOC_FPUREGISTER:
  972. begin
  973. location_reset(resloc,LOC_CFPUREGISTER,resultloc.size);
  974. resloc.register:=ressym.localloc.register;
  975. end;
  976. LOC_REGISTER:
  977. begin
  978. location_reset(resloc,LOC_CREGISTER,resultloc.size);
  979. resloc.register:=ressym.localloc.register;
  980. end;
  981. LOC_MMREGISTER:
  982. begin
  983. location_reset(resloc,LOC_CMMREGISTER,resultloc.size);
  984. resloc.register:=ressym.localloc.register;
  985. end;
  986. LOC_REFERENCE:
  987. begin
  988. location_reset(resloc,LOC_REFERENCE,resultloc.size);
  989. reference_reset_base(resloc.reference,ressym.localloc.reference.index,ressym.localloc.reference.offset);
  990. end;
  991. else
  992. internalerror(200309184);
  993. end;
  994. { Here, we return the function result. In most architectures, the value is
  995. passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
  996. function returns in a register and the caller receives it in an other one }
  997. case resultloc.loc of
  998. LOC_REGISTER:
  999. begin
  1000. {$ifndef cpu64bit}
  1001. if resloc.size in [OS_64,OS_S64] then
  1002. begin
  1003. cg.getexplicitregister(list,NR_FUNCTION_RETURN64_LOW_REG);
  1004. cg.getexplicitregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
  1005. cg.ungetregister(list,NR_FUNCTION_RETURN64_LOW_REG);
  1006. cg.ungetregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
  1007. // for the optimizer
  1008. cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_LOW_REG);
  1009. cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
  1010. cg64.a_load64_loc_reg(list,resloc,joinreg64(NR_FUNCTION_RETURN64_LOW_REG,
  1011. NR_FUNCTION_RETURN64_HIGH_REG));
  1012. end
  1013. else
  1014. {$endif cpu64bit}
  1015. begin
  1016. cg.getexplicitregister(list,resultloc.register);
  1017. hreg:=cg.makeregsize(list,resultloc.register,resloc.size);
  1018. cg.ungetregister(list,hreg);
  1019. // for the optimizer
  1020. cg.a_reg_alloc(list,resultloc.register);
  1021. cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
  1022. end;
  1023. end;
  1024. LOC_FPUREGISTER:
  1025. begin
  1026. cg.a_loadfpu_loc_reg(list,resloc,resultloc.register);
  1027. end;
  1028. LOC_MMREGISTER:
  1029. begin
  1030. cg.a_loadmm_loc_reg(list,resloc.size,resloc,resultloc.register,mms_movescalar);
  1031. end;
  1032. LOC_INVALID,
  1033. LOC_REFERENCE:
  1034. ;
  1035. else
  1036. internalerror(200405025);
  1037. end;
  1038. end;
  1039. end;
  1040. procedure gen_load_para_value(list:TAAsmoutput);
  1041. var
  1042. hp : tparaitem;
  1043. href : treference;
  1044. gotregvarparas : boolean;
  1045. begin
  1046. { Store register parameters in reference or in register variable }
  1047. if assigned(current_procinfo.procdef.parast) and
  1048. not (po_assembler in current_procinfo.procdef.procoptions) then
  1049. begin
  1050. { move register parameters which aren't regable into memory }
  1051. { we do this before init_paras because that one calls routines which may overwrite these }
  1052. { registers and it also expects the values to be in memory }
  1053. hp:=tparaitem(current_procinfo.procdef.para.first);
  1054. gotregvarparas := false;
  1055. while assigned(hp) do
  1056. begin
  1057. case tvarsym(hp.parasym).localloc.loc of
  1058. LOC_REGISTER,
  1059. LOC_MMREGISTER,
  1060. LOC_FPUREGISTER:
  1061. begin
  1062. gotregvarparas := true;
  1063. { cg.a_load_param_reg will first allocate and then deallocate paraloc }
  1064. { register (if the parameter resides in a register) and then allocate }
  1065. { the regvar (which is currently not allocated) }
  1066. cg.a_loadany_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.register,mms_movescalar);
  1067. end;
  1068. LOC_REFERENCE :
  1069. begin
  1070. if hp.paraloc[calleeside].loc<>LOC_REFERENCE then
  1071. begin
  1072. if getregtype(hp.paraloc[calleeside].register)=R_INTREGISTER then
  1073. begin
  1074. if getsupreg(hp.paraloc[calleeside].register)<first_int_imreg then
  1075. begin
  1076. {$ifndef cpu64bit}
  1077. if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
  1078. begin
  1079. cg.getexplicitregister(list,hp.paraloc[calleeside].registerlow);
  1080. cg.getexplicitregister(list,hp.paraloc[calleeside].registerhigh);
  1081. end
  1082. else
  1083. {$endif cpu64bit}
  1084. cg.getexplicitregister(list,hp.paraloc[calleeside].register);
  1085. end;
  1086. { Release parameter register }
  1087. {$ifndef cpu64bit}
  1088. if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
  1089. begin
  1090. cg.ungetregister(list,hp.paraloc[calleeside].registerlow);
  1091. cg.ungetregister(list,hp.paraloc[calleeside].registerhigh);
  1092. end
  1093. else
  1094. {$endif cpu64bit}
  1095. cg.ungetregister(list,hp.paraloc[calleeside].register);
  1096. end;
  1097. reference_reset_base(href,tvarsym(hp.parasym).localloc.reference.index,tvarsym(hp.parasym).localloc.reference.offset);
  1098. cg.a_loadany_param_ref(list,hp.paraloc[calleeside],href,mms_movescalar);
  1099. end;
  1100. end;
  1101. else
  1102. internalerror(200309185);
  1103. end;
  1104. hp:=tparaitem(hp.next);
  1105. end;
  1106. if gotregvarparas then
  1107. begin
  1108. { deallocate all register variables again }
  1109. hp:=tparaitem(current_procinfo.procdef.para.first);
  1110. while assigned(hp) do
  1111. begin
  1112. if (tvarsym(hp.parasym).localloc.loc=LOC_REGISTER) then
  1113. cg.ungetregister(list,tvarsym(hp.parasym).localloc.register);
  1114. hp:=tparaitem(hp.next);
  1115. end;
  1116. end;
  1117. end;
  1118. { generate copies of call by value parameters, must be done before
  1119. the initialization and body is parsed because the refcounts are
  1120. incremented using the local copies }
  1121. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1122. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1123. end;
  1124. procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
  1125. begin
  1126. { initialize local data like ansistrings }
  1127. case current_procinfo.procdef.proctypeoption of
  1128. potype_unitinit:
  1129. begin
  1130. { this is also used for initialization of variables in a
  1131. program which does not have a globalsymtable }
  1132. if assigned(current_module.globalsymtable) then
  1133. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1134. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1135. end;
  1136. { units have seperate code for initilization and finalization }
  1137. potype_unitfinalize: ;
  1138. { program init/final is generated in separate procedure }
  1139. potype_proginit: ;
  1140. else
  1141. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1142. end;
  1143. { initialisizes temp. ansi/wide string data }
  1144. inittempvariables(list);
  1145. { initialize ansi/widesstring para's }
  1146. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1147. {$ifdef OLDREGVARS}
  1148. load_regvars(list,nil);
  1149. {$endif OLDREGVARS}
  1150. end;
  1151. procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
  1152. begin
  1153. {$ifdef OLDREGVARS}
  1154. cleanup_regvars(list);
  1155. {$endif OLDREGVARS}
  1156. { finalize temporary data }
  1157. finalizetempvariables(list);
  1158. { finalize local data like ansistrings}
  1159. case current_procinfo.procdef.proctypeoption of
  1160. potype_unitfinalize:
  1161. begin
  1162. { this is also used for initialization of variables in a
  1163. program which does not have a globalsymtable }
  1164. if assigned(current_module.globalsymtable) then
  1165. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_static_data,list);
  1166. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_static_data,list);
  1167. end;
  1168. { units/progs have separate code for initialization and finalization }
  1169. potype_unitinit: ;
  1170. { program init/final is generated in separate procedure }
  1171. potype_proginit: ;
  1172. else
  1173. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_local_vars,list);
  1174. end;
  1175. { finalize paras data }
  1176. if assigned(current_procinfo.procdef.parast) then
  1177. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1178. end;
  1179. procedure gen_entry_code(list:TAAsmoutput);
  1180. var
  1181. href : treference;
  1182. paraloc1,
  1183. paraloc2 : tparalocation;
  1184. hp : tused_unit;
  1185. begin
  1186. { the actual profile code can clobber some registers,
  1187. therefore if the context must be saved, do it before
  1188. the actual call to the profile code
  1189. }
  1190. if (cs_profile in aktmoduleswitches) and
  1191. not(po_assembler in current_procinfo.procdef.procoptions) then
  1192. begin
  1193. { non-win32 can call mcout even in main }
  1194. if not (target_info.system in [system_i386_win32,system_i386_wdosx]) or
  1195. not (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1196. begin
  1197. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1198. cg.g_profilecode(list);
  1199. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1200. end;
  1201. end;
  1202. { call startup helpers from main program }
  1203. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1204. begin
  1205. { initialize profiling for win32 }
  1206. if (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1207. (cs_profile in aktmoduleswitches) then
  1208. begin
  1209. reference_reset_symbol(href,objectlibrary.newasmsymbol('etext',AB_EXTERNAL,AT_DATA),0);
  1210. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1211. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1212. paramanager.allocparaloc(list,paraloc2);
  1213. cg.a_paramaddr_ref(list,href,paraloc2);
  1214. reference_reset_symbol(href,objectlibrary.newasmsymbol('__image_base__',AB_EXTERNAL,AT_DATA),0);
  1215. paramanager.allocparaloc(list,paraloc1);
  1216. cg.a_paramaddr_ref(list,href,paraloc1);
  1217. paramanager.freeparaloc(list,paraloc2);
  1218. paramanager.freeparaloc(list,paraloc1);
  1219. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1220. cg.a_call_name(list,'_monstartup');
  1221. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1222. end;
  1223. { initialize units }
  1224. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1225. cg.a_call_name(list,'FPC_INITIALIZEUNITS');
  1226. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1227. {$ifdef GDB}
  1228. if (cs_debuginfo in aktmoduleswitches) then
  1229. begin
  1230. { include reference to all debuginfo sections of used units }
  1231. hp:=tused_unit(usedunits.first);
  1232. while assigned(hp) do
  1233. begin
  1234. If (hp.u.flags and uf_has_debuginfo)=uf_has_debuginfo then
  1235. current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0));
  1236. hp:=tused_unit(hp.next);
  1237. end;
  1238. { include reference to debuginfo for this program }
  1239. current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
  1240. end;
  1241. {$endif GDB}
  1242. end;
  1243. {$ifdef GDB}
  1244. if (cs_debuginfo in aktmoduleswitches) then
  1245. list.concat(Tai_force_line.Create);
  1246. {$endif GDB}
  1247. {$ifdef OLDREGVARS}
  1248. load_regvars(list,nil);
  1249. {$endif OLDREGVARS}
  1250. end;
  1251. procedure gen_exit_code(list:TAAsmoutput);
  1252. begin
  1253. { call __EXIT for main program }
  1254. if (not DLLsource) and
  1255. (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1256. cg.a_call_name(list,'FPC_DO_EXIT');
  1257. end;
  1258. {****************************************************************************
  1259. Entry/Exit
  1260. ****************************************************************************}
  1261. procedure gen_proc_symbol(list:Taasmoutput);
  1262. var
  1263. hs : string;
  1264. begin
  1265. { add symbol entry point as well as debug information }
  1266. { will be inserted in front of the rest of this list. }
  1267. { Insert alignment and assembler names }
  1268. { Align, gprof uses 16 byte granularity }
  1269. if (cs_profile in aktmoduleswitches) then
  1270. list.concat(Tai_align.create(16))
  1271. else
  1272. list.concat(Tai_align.create(aktalignment.procalign));
  1273. {$ifdef GDB}
  1274. if (cs_debuginfo in aktmoduleswitches) then
  1275. begin
  1276. if (po_public in current_procinfo.procdef.procoptions) then
  1277. Tprocsym(current_procinfo.procdef.procsym).is_global:=true;
  1278. current_procinfo.procdef.concatstabto(list);
  1279. Tprocsym(current_procinfo.procdef.procsym).isstabwritten:=true;
  1280. end;
  1281. {$endif GDB}
  1282. repeat
  1283. hs:=current_procinfo.procdef.aliasnames.getfirst;
  1284. if hs='' then
  1285. break;
  1286. {$ifdef GDB}
  1287. if (cs_debuginfo in aktmoduleswitches) and
  1288. target_info.use_function_relative_addresses then
  1289. list.concat(Tai_stab_function_name.create(strpnew(hs)));
  1290. {$endif GDB}
  1291. if (cs_profile in aktmoduleswitches) or
  1292. (po_public in current_procinfo.procdef.procoptions) then
  1293. list.concat(Tai_symbol.createname_global(hs,AT_FUNCTION,0))
  1294. else
  1295. list.concat(Tai_symbol.createname(hs,AT_FUNCTION,0));
  1296. until false;
  1297. end;
  1298. procedure gen_proc_symbol_end(list:Taasmoutput);
  1299. {$ifdef GDB}
  1300. var
  1301. stabsendlabel : tasmlabel;
  1302. mangled_length : longint;
  1303. p : pchar;
  1304. {$endif GDB}
  1305. begin
  1306. list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
  1307. {$ifdef GDB}
  1308. if (cs_debuginfo in aktmoduleswitches) then
  1309. begin
  1310. objectlibrary.getlabel(stabsendlabel);
  1311. cg.a_label(list,stabsendlabel);
  1312. { define calling EBP as pseudo local var PM }
  1313. { this enables test if the function is a local one !! }
  1314. {if assigned(current_procinfo.parent) and
  1315. (current_procinfo.procdef.parast.symtablelevel>normal_function_level) then
  1316. list.concat(Tai_stabs.Create(strpnew(
  1317. '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
  1318. tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.parent_framepointer_offset)))); }
  1319. if assigned(current_procinfo.procdef.funcretsym) and
  1320. (tvarsym(current_procinfo.procdef.funcretsym).refs>0) then
  1321. begin
  1322. if tvarsym(current_procinfo.procdef.funcretsym).localloc.loc=LOC_REFERENCE then
  1323. begin
  1324. {$warning Need to add gdb support for ret in param register calling}
  1325. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1326. begin
  1327. list.concat(Tai_stabs.Create(strpnew(
  1328. '"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1329. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1330. if (m_result in aktmodeswitches) then
  1331. list.concat(Tai_stabs.Create(strpnew(
  1332. '"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1333. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))))
  1334. end
  1335. else
  1336. begin
  1337. list.concat(Tai_stabs.Create(strpnew(
  1338. '"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1339. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1340. if (m_result in aktmodeswitches) then
  1341. list.concat(Tai_stabs.Create(strpnew(
  1342. '"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1343. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1344. end;
  1345. end;
  1346. end;
  1347. mangled_length:=length(current_procinfo.procdef.mangledname);
  1348. getmem(p,2*mangled_length+50);
  1349. strpcopy(p,'192,0,0,');
  1350. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1351. if (target_info.use_function_relative_addresses) then
  1352. begin
  1353. strpcopy(strend(p),'-');
  1354. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1355. end;
  1356. list.concat(Tai_stabn.Create(strnew(p)));
  1357. {List.concat(Tai_stabn.Create(strpnew('192,0,0,'
  1358. +current_procinfo.procdef.mangledname))));
  1359. p[0]:='2';p[1]:='2';p[2]:='4';
  1360. strpcopy(strend(p),'_end');}
  1361. strpcopy(p,'224,0,0,'+stabsendlabel.name);
  1362. if (target_info.use_function_relative_addresses) then
  1363. begin
  1364. strpcopy(strend(p),'-');
  1365. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1366. end;
  1367. list.concatlist(withdebuglist);
  1368. list.concat(Tai_stabn.Create(strnew(p)));
  1369. { strpnew('224,0,0,'
  1370. +current_procinfo.procdef.mangledname+'_end'))));}
  1371. freemem(p,2*mangled_length+50);
  1372. end;
  1373. {$endif GDB}
  1374. end;
  1375. procedure gen_proc_entry_code(list:Taasmoutput);
  1376. var
  1377. hitemp,
  1378. lotemp,
  1379. stackframe : longint;
  1380. check : boolean;
  1381. paraloc1 : tparalocation;
  1382. href : treference;
  1383. begin
  1384. { generate call frame marker for dwarf call frame info }
  1385. dwarfcfi.start_frame(list);
  1386. { allocate temp for saving the argument used when
  1387. stack checking uses a register for pushing the stackframe size }
  1388. check:=(cs_check_stack in aktlocalswitches) and (current_procinfo.procdef.proctypeoption<>potype_proginit);
  1389. if check then
  1390. begin
  1391. { Allocate tempspace to store register parameter than
  1392. is destroyed when calling stackchecking code }
  1393. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1394. if paraloc1.loc=LOC_REGISTER then
  1395. tg.GetTemp(list,sizeof(aint),tt_normal,href);
  1396. end;
  1397. { Calculate size of stackframe }
  1398. stackframe:=current_procinfo.calc_stackframe_size;
  1399. { All temps are know, write offsets used for information }
  1400. if (cs_asm_source in aktglobalswitches) then
  1401. begin
  1402. if tg.direction>0 then
  1403. begin
  1404. lotemp:=current_procinfo.tempstart;
  1405. hitemp:=tg.lasttemp;
  1406. end
  1407. else
  1408. begin
  1409. lotemp:=tg.lasttemp;
  1410. hitemp:=current_procinfo.tempstart;
  1411. end;
  1412. list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
  1413. tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
  1414. end;
  1415. { generate target specific proc entry code }
  1416. cg.g_proc_entry(list,stackframe,(po_nostackframe in current_procinfo.procdef.procoptions));
  1417. { Add stack checking code? }
  1418. if check then
  1419. begin
  1420. { The tempspace to store original register is already
  1421. allocated above before the stackframe size is calculated. }
  1422. if paraloc1.loc=LOC_REGISTER then
  1423. cg.a_load_reg_ref(list,OS_INT,OS_INT,paraloc1.register,href);
  1424. paramanager.allocparaloc(list,paraloc1);
  1425. cg.a_param_const(list,OS_INT,stackframe,paraloc1);
  1426. paramanager.freeparaloc(list,paraloc1);
  1427. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1428. cg.a_call_name(list,'FPC_STACKCHECK');
  1429. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1430. if paraloc1.loc=LOC_REGISTER then
  1431. begin
  1432. cg.a_load_ref_reg(list,OS_INT,OS_INT,href,paraloc1.register);
  1433. tg.UnGetTemp(list,href);
  1434. end;
  1435. end;
  1436. end;
  1437. procedure gen_proc_exit_code(list:Taasmoutput);
  1438. var
  1439. parasize : longint;
  1440. begin
  1441. { c style clearstack does not need to remove parameters from the stack, only the
  1442. return value when it was pushed by arguments }
  1443. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1444. begin
  1445. parasize:=0;
  1446. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1447. inc(parasize,sizeof(aint));
  1448. end
  1449. else
  1450. parasize:=current_procinfo.para_stack_size;
  1451. { generate target specific proc exit code }
  1452. cg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
  1453. { release return registers, needed for optimizer }
  1454. if current_procinfo.procdef.funcret_paraloc[calleeside].loc<>LOC_INVALID then
  1455. paramanager.freeparaloc(list,
  1456. current_procinfo.procdef.funcret_paraloc[calleeside]);
  1457. { end of frame marker for call frame info }
  1458. dwarfcfi.end_frame(list);
  1459. end;
  1460. procedure gen_save_used_regs(list:TAAsmoutput);
  1461. begin
  1462. { Pure assembler routines need to save the registers themselves }
  1463. if (po_assembler in current_procinfo.procdef.procoptions) then
  1464. exit;
  1465. { for the save all registers we can simply use a pusha,popa which
  1466. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1467. if (po_saveregisters in current_procinfo.procdef.procoptions) then
  1468. cg.g_save_all_registers(list)
  1469. else
  1470. if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
  1471. cg.g_save_standard_registers(list);
  1472. end;
  1473. procedure gen_restore_used_regs(list:TAAsmoutput;const funcretparaloc:tparalocation);
  1474. begin
  1475. { Pure assembler routines need to save the registers themselves }
  1476. if (po_assembler in current_procinfo.procdef.procoptions) then
  1477. exit;
  1478. { for the save all registers we can simply use a pusha,popa which
  1479. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1480. if (po_saveregisters in current_procinfo.procdef.procoptions) then
  1481. cg.g_restore_all_registers(list,funcretparaloc)
  1482. else
  1483. if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
  1484. cg.g_restore_standard_registers(list);
  1485. end;
  1486. {****************************************************************************
  1487. Inlining
  1488. ****************************************************************************}
  1489. (*
  1490. procedure load_inlined_return_value(list:TAAsmoutput);
  1491. var
  1492. ressym: tvarsym;
  1493. resloc: tlocation;
  1494. r,r2 : tregister;
  1495. begin
  1496. if not is_void(current_procinfo.procdef.rettype.def) then
  1497. begin
  1498. ressym := tvarsym(current_procinfo.procdef.funcretsym);
  1499. if ressym.reg.enum <> R_NO then
  1500. begin
  1501. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1502. location_reset(resloc,LOC_CREGISTER,OS_ADDR)
  1503. else
  1504. if ressym.vartype.def.deftype = floatdef then
  1505. location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procinfo.procdef.rettype.def))
  1506. else
  1507. location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
  1508. resloc.register := ressym.reg;
  1509. end
  1510. else
  1511. begin
  1512. location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
  1513. reference_reset_base(resloc.reference,current_procinfo.framepointer,tvarsym(current_procinfo.procdef.funcretsym).adjusted_address);
  1514. end;
  1515. { Here, we return the function result. In most architectures, the value is
  1516. passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
  1517. function returns in a register and the caller receives it in an other one }
  1518. case current_procinfo.procdef.rettype.def.deftype of
  1519. orddef,
  1520. enumdef :
  1521. begin
  1522. {$ifndef cpu64bit}
  1523. if resloc.size in [OS_64,OS_S64] then
  1524. begin
  1525. r:=cg.getregisterint(list,OS_INT);
  1526. r2:=cg.getregisterint(list,OS_INT);
  1527. cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
  1528. end
  1529. else
  1530. {$endif cpu64bit}
  1531. begin
  1532. r:=cg.getregisterint(list,resloc.size);
  1533. cg.a_load_loc_reg(list,resloc.size,resloc,r);
  1534. end;
  1535. end;
  1536. floatdef :
  1537. begin
  1538. {$ifdef cpufpemu}
  1539. if cs_fp_emulation in aktmoduleswitches then
  1540. r.enum := FUNCTION_RETURN_REG
  1541. else
  1542. {$endif cpufpemu}
  1543. r.enum:=FPU_RESULT_REG;
  1544. cg.a_loadfpu_loc_reg(list,resloc,r);
  1545. end;
  1546. else
  1547. begin
  1548. if not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1549. begin
  1550. {$ifndef cpu64bit}
  1551. { Win32 can return records in EAX:EDX }
  1552. if resloc.size in [OS_64,OS_S64] then
  1553. begin
  1554. r:=cg.getregisterint(list,OS_INT);
  1555. r2:=cg.getregisterint(list,OS_INT);
  1556. cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
  1557. end
  1558. else
  1559. {$endif cpu64bit}
  1560. begin
  1561. r:=cg.getregisterint(list,resloc.size);
  1562. cg.a_load_loc_reg(list,resloc.size,resloc,r);
  1563. end;
  1564. end
  1565. end;
  1566. end;
  1567. end;
  1568. end;
  1569. procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
  1570. begin
  1571. { initialize return value }
  1572. initretvalue(list);
  1573. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1574. { initialisizes temp. ansi/wide string data }
  1575. inittempvariables(list);
  1576. { initialize ansi/widesstring para's }
  1577. if assigned(current_procinfo.procdef.parast) then
  1578. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1579. { generate copies of call by value parameters }
  1580. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1581. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1582. load_regvars(list,nil);
  1583. end;
  1584. procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
  1585. var
  1586. usesacc,
  1587. usesacchi,
  1588. usesfpu : boolean;
  1589. begin
  1590. if aktexitlabel.is_used then
  1591. cg.a_label(list,aktexitlabel);
  1592. cleanup_regvars(list);
  1593. { finalize temporary data }
  1594. finalizetempvariables(list);
  1595. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1596. { finalize paras data }
  1597. if assigned(current_procinfo.procdef.parast) then
  1598. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1599. { handle return value, this is not done for assembler routines when
  1600. they didn't reference the result variable }
  1601. if not(po_assembler in current_procinfo.procdef.procoptions) or
  1602. (assigned(current_procinfo.procdef.funcretsym) and
  1603. (tvarsym(current_procinfo.procdef.funcretsym).refcount>1)) then
  1604. begin
  1605. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  1606. internalerror(200305263);
  1607. // load_inlined_return_value(list);
  1608. load_return_value(list,usesacc,usesacchi,usesfpu)
  1609. end;
  1610. cleanup_regvars(list);
  1611. end;
  1612. *)
  1613. {****************************************************************************
  1614. Const Data
  1615. ****************************************************************************}
  1616. procedure insertconstdata(sym : ttypedconstsym);
  1617. { this does not affect the local stack space, since all
  1618. typed constansts and initialized variables are always
  1619. put in the .data / .rodata section
  1620. }
  1621. var
  1622. storefilepos : tfileposinfo;
  1623. curconstsegment : taasmoutput;
  1624. l : longint;
  1625. begin
  1626. storefilepos:=aktfilepos;
  1627. aktfilepos:=sym.fileinfo;
  1628. if sym.is_writable then
  1629. curconstsegment:=datasegment
  1630. else
  1631. curconstsegment:=consts;
  1632. l:=sym.getsize;
  1633. { insert cut for smartlinking or alignment }
  1634. maybe_new_object_file(curconstSegment);
  1635. new_section(curconstSegment,sec_rodata,lower(sym.mangledname),const_align(l));
  1636. if (sym.owner.symtabletype=globalsymtable) or
  1637. maybe_smartlink_symbol or
  1638. (assigned(current_procinfo) and
  1639. (current_procinfo.procdef.proccalloption=pocall_inline)) or
  1640. DLLSource then
  1641. curconstSegment.concat(Tai_symbol.Createname_global(sym.mangledname,AT_DATA,l))
  1642. else
  1643. curconstSegment.concat(Tai_symbol.Createname(sym.mangledname,AT_DATA,l));
  1644. aktfilepos:=storefilepos;
  1645. end;
  1646. procedure insertbssdata(sym : tvarsym);
  1647. var
  1648. l,varalign : longint;
  1649. storefilepos : tfileposinfo;
  1650. begin
  1651. storefilepos:=aktfilepos;
  1652. aktfilepos:=sym.fileinfo;
  1653. l:=sym.getvaluesize;
  1654. if (vo_is_thread_var in sym.varoptions) then
  1655. inc(l,sizeof(aint));
  1656. varalign:=var_align(l);
  1657. maybe_new_object_file(bssSegment);
  1658. new_section(bssSegment,sec_bss,lower(sym.mangledname),varalign);
  1659. if (sym.owner.symtabletype=globalsymtable) or
  1660. maybe_smartlink_symbol or
  1661. DLLSource or
  1662. (assigned(current_procinfo) and
  1663. (current_procinfo.procdef.proccalloption=pocall_inline)) or
  1664. (vo_is_exported in sym.varoptions) or
  1665. (vo_is_C_var in sym.varoptions) then
  1666. bssSegment.concat(Tai_datablock.Create_global(sym.mangledname,l))
  1667. else
  1668. bssSegment.concat(Tai_datablock.Create(sym.mangledname,l));
  1669. aktfilepos:=storefilepos;
  1670. end;
  1671. procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
  1672. var
  1673. sym : tsym;
  1674. begin
  1675. sym:=tsym(st.symindex.first);
  1676. while assigned(sym) do
  1677. begin
  1678. { Only allocate space for referenced locals }
  1679. if (sym.typ=varsym) and
  1680. (tvarsym(sym).refs>0) then
  1681. begin
  1682. with tvarsym(sym) do
  1683. begin
  1684. {$warning TODO Add support for register variables}
  1685. localloc.loc:=LOC_REFERENCE;
  1686. tg.GetLocal(list,getvaluesize,vartype.def,localloc.reference);
  1687. if cs_asm_source in aktglobalswitches then
  1688. list.concat(Tai_comment.Create(strpnew('Local '+realname+' located at '+
  1689. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1690. end;
  1691. end;
  1692. sym:=tsym(sym.indexnext);
  1693. end;
  1694. end;
  1695. procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
  1696. var
  1697. sym : tsym;
  1698. begin
  1699. sym:=tsym(st.symindex.first);
  1700. while assigned(sym) do
  1701. begin
  1702. if (sym.typ=varsym) and
  1703. (tvarsym(sym).refs>0) then
  1704. begin
  1705. with tvarsym(sym) do
  1706. begin
  1707. { Note: We need to keep the data available in memory
  1708. for the sub procedures that can access local data
  1709. in the parent procedures }
  1710. case localloc.loc of
  1711. LOC_REFERENCE :
  1712. tg.Ungetlocal(list,localloc.reference);
  1713. LOC_REGISTER :
  1714. begin
  1715. {$ifndef cpu64bit}
  1716. if localloc.size in [OS_64,OS_S64] then
  1717. begin
  1718. cg.ungetregister(list,localloc.registerlow);
  1719. cg.ungetregister(list,localloc.registerhigh);
  1720. end
  1721. else
  1722. {$endif cpu64bit}
  1723. cg.ungetregister(list,localloc.register);
  1724. end;
  1725. end;
  1726. end;
  1727. end;
  1728. sym:=tsym(sym.indexnext);
  1729. end;
  1730. end;
  1731. procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
  1732. var
  1733. sym : tsym;
  1734. begin
  1735. sym:=tsym(st.symindex.first);
  1736. while assigned(sym) do
  1737. begin
  1738. if sym.typ=varsym then
  1739. begin
  1740. with tvarsym(sym) do
  1741. begin
  1742. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1743. begin
  1744. case paraitem.paraloc[calleeside].loc of
  1745. LOC_MMREGISTER,
  1746. LOC_FPUREGISTER,
  1747. LOC_REGISTER:
  1748. begin
  1749. (*
  1750. if paraitem.paraloc[calleeside].register=NR_NO then
  1751. begin
  1752. paraitem.paraloc[calleeside].loc:=LOC_REGISTER;
  1753. paraitem.paraloc[calleeside].size:=paraitem.paraloc[calleeside].size;
  1754. {$ifndef cpu64bit}
  1755. if paraitem.paraloc[calleeside].size in [OS_64,OS_S64] then
  1756. begin
  1757. paraitem.paraloc[calleeside].registerlow:=cg.getregisterint(list,OS_32);
  1758. paraitem.paraloc[calleeside].registerhigh:=cg.getregisterint(list,OS_32);
  1759. end
  1760. else
  1761. {$endif cpu64bit}
  1762. paraitem.paraloc[calleeside].register:=cg.getregisterint(list,localloc.size);
  1763. end;
  1764. *)
  1765. (*
  1766. {$warning TODO Allocate register paras}
  1767. localloc.loc:=LOC_REGISTER;
  1768. localloc.size:=paraitem.paraloc[calleeside].size;
  1769. {$ifndef cpu64bit}
  1770. if localloc.size in [OS_64,OS_S64] then
  1771. begin
  1772. localloc.registerlow:=cg.getregisterint(list,OS_32);
  1773. localloc.registerhigh:=cg.getregisterint(list,OS_32);
  1774. end
  1775. else
  1776. {$endif cpu64bit}
  1777. localloc.register:=cg.getregisterint(list,localloc.size);
  1778. *)
  1779. localloc.loc:=LOC_REFERENCE;
  1780. localloc.size:=paraitem.paraloc[calleeside].size;
  1781. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1782. end;
  1783. {$ifdef powerpc}
  1784. LOC_REFERENCE:
  1785. begin
  1786. localloc.loc := LOC_REFERENCE;
  1787. localloc.size:=paraitem.paraloc[calleeside].size;
  1788. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1789. end;
  1790. {$endif powerpc}
  1791. else
  1792. localloc:=paraitem.paraloc[calleeside];
  1793. end;
  1794. end
  1795. else
  1796. localloc:=paraitem.paraloc[calleeside];
  1797. if cs_asm_source in aktglobalswitches then
  1798. case localloc.loc of
  1799. LOC_REFERENCE :
  1800. begin
  1801. list.concat(Tai_comment.Create(strpnew('Para '+realname+' located at '+
  1802. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1803. end;
  1804. end;
  1805. end;
  1806. end;
  1807. sym:=tsym(sym.indexnext);
  1808. end;
  1809. end;
  1810. procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
  1811. var
  1812. sym : tsym;
  1813. begin
  1814. if (po_assembler in current_procinfo.procdef.procoptions) then
  1815. exit;
  1816. sym:=tsym(st.symindex.first);
  1817. while assigned(sym) do
  1818. begin
  1819. if sym.typ=varsym then
  1820. begin
  1821. with tvarsym(sym) do
  1822. begin
  1823. { for localloc <> LOC_REFERENCE, we need regvar support inside inlined procedures }
  1824. localloc.loc:=LOC_REFERENCE;
  1825. localloc.size:=int_cgsize(paramanager.push_size(varspez,vartype.def,pocall_inline));
  1826. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1827. case paraitem.paraloc[calleeside].loc of
  1828. LOC_FPUREGISTER:
  1829. begin
  1830. paraitem.paraloc[calleeside].register := cg.getfpuregister(list,paraitem.paraloc[calleeside].size);
  1831. paraitem.paraloc[callerside] := paraitem.paraloc[calleeside];
  1832. end;
  1833. LOC_REGISTER:
  1834. begin
  1835. paraitem.paraloc[calleeside].register := cg.getintregister(list,paraitem.paraloc[calleeside].size);
  1836. paraitem.paraloc[callerside] := paraitem.paraloc[calleeside];
  1837. end;
  1838. LOC_MMREGISTER:
  1839. begin
  1840. paraitem.paraloc[calleeside].register := cg.getmmregister(list,paraitem.paraloc[calleeside].size);
  1841. paraitem.paraloc[callerside] := paraitem.paraloc[calleeside];
  1842. end;
  1843. LOC_REFERENCE:
  1844. begin
  1845. paraitem.paraloc[calleeside] := localloc;
  1846. paraitem.paraloc[callerside] := localloc;
  1847. end;
  1848. end;
  1849. if cs_asm_source in aktglobalswitches then
  1850. begin
  1851. case localloc.loc of
  1852. LOC_REFERENCE :
  1853. list.concat(Tai_comment.Create(strpnew('Para '+realname+' allocated at '+
  1854. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1855. end;
  1856. end;
  1857. end;
  1858. end;
  1859. sym:=tsym(sym.indexnext);
  1860. end;
  1861. end;
  1862. procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
  1863. var
  1864. sym : tsym;
  1865. begin
  1866. sym:=tsym(st.symindex.first);
  1867. while assigned(sym) do
  1868. begin
  1869. if sym.typ=varsym then
  1870. begin
  1871. with tvarsym(sym) do
  1872. begin
  1873. { Note: We need to keep the data available in memory
  1874. for the sub procedures that can access local data
  1875. in the parent procedures }
  1876. case localloc.loc of
  1877. LOC_REFERENCE :
  1878. tg.UngetLocal(list,localloc.reference);
  1879. LOC_REGISTER :
  1880. begin
  1881. if localloc.register<>paraitem.paraloc[calleeside].register then
  1882. begin
  1883. {$ifndef cpu64bit}
  1884. if localloc.size in [OS_64,OS_S64] then
  1885. begin
  1886. cg.ungetregister(list,localloc.registerlow);
  1887. cg.ungetregister(list,localloc.registerhigh);
  1888. end
  1889. else
  1890. {$endif cpu64bit}
  1891. cg.ungetregister(list,localloc.register);
  1892. end;
  1893. end;
  1894. end;
  1895. end;
  1896. end;
  1897. sym:=tsym(sym.indexnext);
  1898. end;
  1899. end;
  1900. { persistent rtti generation }
  1901. procedure generate_rtti(p:Ttypesym);
  1902. var
  1903. rsym : trttisym;
  1904. def : tstoreddef;
  1905. begin
  1906. { rtti can only be generated for classes that are always typesyms }
  1907. def:=tstoreddef(ttypesym(p).restype.def);
  1908. { there is an error, skip rtti info }
  1909. if (def.deftype=errordef) or (Errorcount>0) then
  1910. exit;
  1911. { only create rtti once for each definition }
  1912. if not(df_has_rttitable in def.defoptions) then
  1913. begin
  1914. { definition should be in the same symtable as the symbol }
  1915. if p.owner<>def.owner then
  1916. internalerror(200108262);
  1917. { create rttisym }
  1918. rsym:=trttisym.create(p.name,fullrtti);
  1919. p.owner.insert(rsym);
  1920. { register rttisym in definition }
  1921. include(def.defoptions,df_has_rttitable);
  1922. def.rttitablesym:=rsym;
  1923. { write rtti data }
  1924. def.write_child_rtti_data(fullrtti);
  1925. maybe_new_object_file(rttilist);
  1926. new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
  1927. rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0));
  1928. def.write_rtti_data(fullrtti);
  1929. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  1930. end;
  1931. end;
  1932. { persistent init table generation }
  1933. procedure generate_inittable(p:tsym);
  1934. var
  1935. rsym : trttisym;
  1936. def : tstoreddef;
  1937. begin
  1938. { anonymous types are also allowed for records that can be varsym }
  1939. case p.typ of
  1940. typesym :
  1941. def:=tstoreddef(ttypesym(p).restype.def);
  1942. varsym :
  1943. def:=tstoreddef(tvarsym(p).vartype.def);
  1944. else
  1945. internalerror(200108263);
  1946. end;
  1947. { only create inittable once for each definition }
  1948. if not(df_has_inittable in def.defoptions) then
  1949. begin
  1950. { definition should be in the same symtable as the symbol }
  1951. if p.owner<>def.owner then
  1952. internalerror(200108264);
  1953. { create rttisym }
  1954. rsym:=trttisym.create(p.name,initrtti);
  1955. p.owner.insert(rsym);
  1956. { register rttisym in definition }
  1957. include(def.defoptions,df_has_inittable);
  1958. def.inittablesym:=rsym;
  1959. { write inittable data }
  1960. def.write_child_rtti_data(initrtti);
  1961. maybe_new_object_file(rttilist);
  1962. new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
  1963. rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0));
  1964. def.write_rtti_data(initrtti);
  1965. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  1966. end;
  1967. end;
  1968. end.
  1969. {
  1970. $Log$
  1971. Revision 1.214 2004-09-13 20:30:05 peter
  1972. * finalize all (also procedure local) typedconst at unit finalization
  1973. Revision 1.213 2004/08/23 11:00:06 michael
  1974. + Patch from Peter to fix debuginfo in constructor.
  1975. Revision 1.212 2004/07/17 13:14:17 jonas
  1976. * don't finalize typed consts (fixes bug3212, but causes memory leak;
  1977. they should be finalized at the end of the module)
  1978. Revision 1.211 2004/07/09 23:41:04 jonas
  1979. * support register parameters for inlined procedures + some inline
  1980. cleanups
  1981. Revision 1.210 2004/07/04 12:24:59 jonas
  1982. * fixed one regvar problem, but regvars are still broken since the dwarf
  1983. merge...
  1984. Revision 1.209 2004/06/29 20:57:21 peter
  1985. * fixed size of exceptbuf
  1986. Revision 1.208 2004/06/20 08:55:29 florian
  1987. * logs truncated
  1988. Revision 1.207 2004/06/16 20:07:08 florian
  1989. * dwarf branch merged
  1990. Revision 1.206 2004/06/01 20:39:33 jonas
  1991. * fixed bug regarding parameters on the ppc (they were allocated twice
  1992. under some circumstances and not at all in others)
  1993. Revision 1.205 2004/05/30 21:41:15 jonas
  1994. * more regvar optimizations in location_force_reg
  1995. Revision 1.204 2004/05/30 21:18:22 jonas
  1996. * some optimizations and associated fixes for better regvar code
  1997. Revision 1.203 2004/05/28 21:14:13 peter
  1998. * first load para's to temps before calling entry code (profile
  1999. }