ncgutil.pas 86 KB

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