ncgutil.pas 84 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132
  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. case ressym.localloc.loc of
  944. LOC_FPUREGISTER:
  945. begin
  946. location_reset(restmploc,LOC_CFPUREGISTER,funcretloc^.size);
  947. restmploc.register:=ressym.localloc.register;
  948. end;
  949. LOC_REGISTER:
  950. begin
  951. location_reset(restmploc,LOC_CREGISTER,funcretloc^.size);
  952. restmploc.register:=ressym.localloc.register;
  953. end;
  954. LOC_MMREGISTER:
  955. begin
  956. location_reset(restmploc,LOC_CMMREGISTER,funcretloc^.size);
  957. restmploc.register:=ressym.localloc.register;
  958. end;
  959. LOC_REFERENCE:
  960. begin
  961. location_reset(restmploc,LOC_REFERENCE,funcretloc^.size);
  962. restmploc.reference:=ressym.localloc.reference;
  963. end;
  964. else
  965. internalerror(200309184);
  966. end;
  967. { Here, we return the function result. In most architectures, the value is
  968. passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
  969. function returns in a register and the caller receives it in an other one }
  970. case funcretloc^.loc of
  971. LOC_REGISTER:
  972. begin
  973. {$ifndef cpu64bit}
  974. if current_procinfo.procdef.funcret_paraloc[calleeside].size in [OS_64,OS_S64] then
  975. begin
  976. current_procinfo.procdef.funcret_paraloc[calleeside].get_location(resloc);
  977. if resloc.loc<>LOC_REGISTER then
  978. internalerror(200409141);
  979. { Load low and high register separate to generate better register
  980. allocation info }
  981. if getsupreg(resloc.registerlow)<first_int_imreg then
  982. begin
  983. cg.getcpuregister(list,resloc.registerlow);
  984. cg.ungetcpuregister(list,resloc.registerlow);
  985. // for the optimizer
  986. cg.a_reg_alloc(list,resloc.registerlow);
  987. end;
  988. case restmploc.loc of
  989. LOC_REFERENCE :
  990. begin
  991. href:=restmploc.reference;
  992. if target_info.endian=ENDIAN_BIG then
  993. inc(href.offset,4);
  994. cg.a_load_ref_reg(list,OS_32,OS_32,href,resloc.registerlow);
  995. end;
  996. LOC_REGISTER :
  997. cg.a_load_reg_reg(list,OS_32,OS_32,restmploc.registerlow,resloc.registerlow);
  998. else
  999. internalerror(200409201);
  1000. end;
  1001. if getsupreg(resloc.registerhigh)<first_int_imreg then
  1002. begin
  1003. cg.getcpuregister(list,resloc.registerhigh);
  1004. cg.ungetcpuregister(list,resloc.registerhigh);
  1005. // for the optimizer
  1006. cg.a_reg_alloc(list,resloc.registerhigh);
  1007. end;
  1008. case restmploc.loc of
  1009. LOC_REFERENCE :
  1010. begin
  1011. href:=restmploc.reference;
  1012. if target_info.endian=ENDIAN_LITTLE then
  1013. inc(href.offset,4);
  1014. cg.a_load_ref_reg(list,OS_32,OS_32,href,resloc.registerhigh);
  1015. end;
  1016. LOC_REGISTER :
  1017. cg.a_load_reg_reg(list,OS_32,OS_32,restmploc.registerhigh,resloc.registerhigh);
  1018. else
  1019. internalerror(200409201);
  1020. end;
  1021. end
  1022. else
  1023. {$endif cpu64bit}
  1024. begin
  1025. hreg:=cg.makeregsize(list,funcretloc^.register,restmploc.size);
  1026. if getsupreg(funcretloc^.register)<first_int_imreg then
  1027. begin
  1028. cg.getcpuregister(list,funcretloc^.register);
  1029. cg.ungetcpuregister(list,hreg);
  1030. // for the optimizer
  1031. cg.a_reg_alloc(list,funcretloc^.register);
  1032. end;
  1033. cg.a_load_loc_reg(list,restmploc.size,restmploc,hreg);
  1034. end;
  1035. end;
  1036. LOC_FPUREGISTER:
  1037. begin
  1038. if getsupreg(funcretloc^.register)<first_fpu_imreg then
  1039. begin
  1040. cg.getcpuregister(list,funcretloc^.register);
  1041. cg.ungetcpuregister(list,funcretloc^.register);
  1042. end;
  1043. cg.a_loadfpu_loc_reg(list,restmploc,funcretloc^.register);
  1044. end;
  1045. LOC_MMREGISTER:
  1046. begin
  1047. if getsupreg(funcretloc^.register)<first_mm_imreg then
  1048. begin
  1049. cg.getcpuregister(list,funcretloc^.register);
  1050. cg.ungetcpuregister(list,funcretloc^.register);
  1051. end;
  1052. cg.a_loadmm_loc_reg(list,restmploc.size,restmploc,funcretloc^.register,mms_movescalar);
  1053. end;
  1054. LOC_INVALID,
  1055. LOC_REFERENCE:
  1056. ;
  1057. else
  1058. internalerror(200405025);
  1059. end;
  1060. end;
  1061. end;
  1062. procedure gen_load_para_value(list:TAAsmoutput);
  1063. var
  1064. hp : tparaitem;
  1065. gotregvarparas : boolean;
  1066. hiparaloc,
  1067. paraloc : pcgparalocation;
  1068. begin
  1069. { Store register parameters in reference or in register variable }
  1070. if assigned(current_procinfo.procdef.parast) and
  1071. not (po_assembler in current_procinfo.procdef.procoptions) then
  1072. begin
  1073. { move register parameters which aren't regable into memory }
  1074. { we do this before init_paras because that one calls routines which may overwrite these }
  1075. { registers and it also expects the values to be in memory }
  1076. hp:=tparaitem(current_procinfo.procdef.para.first);
  1077. gotregvarparas := false;
  1078. while assigned(hp) do
  1079. begin
  1080. paraloc:=hp.paraloc[calleeside].location;
  1081. if not assigned(paraloc) then
  1082. internalerror(200408203);
  1083. hiparaloc:=paraloc^.next;
  1084. case tvarsym(hp.parasym).localloc.loc of
  1085. LOC_REGISTER,
  1086. LOC_MMREGISTER,
  1087. LOC_FPUREGISTER:
  1088. begin
  1089. gotregvarparas := true;
  1090. { cg.a_load_param_reg will first allocate and then deallocate paraloc }
  1091. { register (if the parameter resides in a register) and then allocate }
  1092. { the regvar (which is currently not allocated) }
  1093. cg.a_loadany_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.register,mms_movescalar);
  1094. end;
  1095. LOC_REFERENCE :
  1096. begin
  1097. if paraloc^.loc<>LOC_REFERENCE then
  1098. begin
  1099. if getregtype(paraloc^.register)=R_INTREGISTER then
  1100. begin
  1101. { Release parameter register }
  1102. if getsupreg(paraloc^.register)<first_int_imreg then
  1103. begin
  1104. {$ifndef cpu64bit}
  1105. if assigned(hiparaloc) then
  1106. begin
  1107. cg.getcpuregister(list,hiparaloc^.register);
  1108. cg.ungetcpuregister(list,hiparaloc^.register);
  1109. end;
  1110. {$endif cpu64bit}
  1111. cg.getcpuregister(list,paraloc^.register);
  1112. cg.ungetcpuregister(list,paraloc^.register);
  1113. end;
  1114. end;
  1115. cg.a_loadany_param_ref(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.reference,mms_movescalar);
  1116. end;
  1117. end;
  1118. else
  1119. internalerror(200309185);
  1120. end;
  1121. hp:=tparaitem(hp.next);
  1122. end;
  1123. end;
  1124. { generate copies of call by value parameters, must be done before
  1125. the initialization and body is parsed because the refcounts are
  1126. incremented using the local copies }
  1127. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1128. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1129. end;
  1130. procedure gen_initialize_code(list:TAAsmoutput);
  1131. begin
  1132. { initialize local data like ansistrings }
  1133. case current_procinfo.procdef.proctypeoption of
  1134. potype_unitinit:
  1135. begin
  1136. { this is also used for initialization of variables in a
  1137. program which does not have a globalsymtable }
  1138. if assigned(current_module.globalsymtable) then
  1139. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1140. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1141. end;
  1142. { units have seperate code for initilization and finalization }
  1143. potype_unitfinalize: ;
  1144. { program init/final is generated in separate procedure }
  1145. potype_proginit: ;
  1146. else
  1147. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1148. end;
  1149. { initialisizes temp. ansi/wide string data }
  1150. inittempvariables(list);
  1151. { initialize ansi/widesstring para's }
  1152. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1153. {$ifdef OLDREGVARS}
  1154. load_regvars(list,nil);
  1155. {$endif OLDREGVARS}
  1156. end;
  1157. procedure gen_finalize_code(list:TAAsmoutput);
  1158. begin
  1159. {$ifdef OLDREGVARS}
  1160. cleanup_regvars(list);
  1161. {$endif OLDREGVARS}
  1162. { finalize temporary data }
  1163. finalizetempvariables(list);
  1164. { finalize local data like ansistrings}
  1165. case current_procinfo.procdef.proctypeoption of
  1166. potype_unitfinalize:
  1167. begin
  1168. { this is also used for initialization of variables in a
  1169. program which does not have a globalsymtable }
  1170. if assigned(current_module.globalsymtable) then
  1171. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_static_data,list);
  1172. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_static_data,list);
  1173. end;
  1174. { units/progs have separate code for initialization and finalization }
  1175. potype_unitinit: ;
  1176. { program init/final is generated in separate procedure }
  1177. potype_proginit: ;
  1178. else
  1179. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_local_vars,list);
  1180. end;
  1181. { finalize paras data }
  1182. if assigned(current_procinfo.procdef.parast) then
  1183. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1184. end;
  1185. procedure gen_entry_code(list:TAAsmoutput);
  1186. var
  1187. href : treference;
  1188. paraloc1,
  1189. paraloc2 : tcgpara;
  1190. hp : tused_unit;
  1191. begin
  1192. paraloc1.init;
  1193. paraloc2.init;
  1194. { the actual profile code can clobber some registers,
  1195. therefore if the context must be saved, do it before
  1196. the actual call to the profile code
  1197. }
  1198. if (cs_profile in aktmoduleswitches) and
  1199. not(po_assembler in current_procinfo.procdef.procoptions) then
  1200. begin
  1201. { non-win32 can call mcout even in main }
  1202. if not (target_info.system in [system_i386_win32,system_i386_wdosx]) or
  1203. not (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1204. begin
  1205. cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1206. cg.g_profilecode(list);
  1207. cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1208. end;
  1209. end;
  1210. { call startup helpers from main program }
  1211. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1212. begin
  1213. { initialize profiling for win32 }
  1214. if (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1215. (cs_profile in aktmoduleswitches) then
  1216. begin
  1217. reference_reset_symbol(href,objectlibrary.newasmsymbol('etext',AB_EXTERNAL,AT_DATA),0);
  1218. paramanager.getintparaloc(pocall_default,1,paraloc1);
  1219. paramanager.getintparaloc(pocall_default,2,paraloc2);
  1220. paramanager.allocparaloc(list,paraloc2);
  1221. cg.a_paramaddr_ref(list,href,paraloc2);
  1222. reference_reset_symbol(href,objectlibrary.newasmsymbol('__image_base__',AB_EXTERNAL,AT_DATA),0);
  1223. paramanager.allocparaloc(list,paraloc1);
  1224. cg.a_paramaddr_ref(list,href,paraloc1);
  1225. paramanager.freeparaloc(list,paraloc2);
  1226. paramanager.freeparaloc(list,paraloc1);
  1227. cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1228. cg.a_call_name(list,'_monstartup');
  1229. cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1230. end;
  1231. { initialize units }
  1232. cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1233. cg.a_call_name(list,'FPC_INITIALIZEUNITS');
  1234. cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1235. {$ifdef GDB}
  1236. if (cs_debuginfo in aktmoduleswitches) then
  1237. begin
  1238. { include reference to all debuginfo sections of used units }
  1239. hp:=tused_unit(usedunits.first);
  1240. while assigned(hp) do
  1241. begin
  1242. If (hp.u.flags and uf_has_debuginfo)=uf_has_debuginfo then
  1243. current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0));
  1244. hp:=tused_unit(hp.next);
  1245. end;
  1246. { include reference to debuginfo for this program }
  1247. current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
  1248. end;
  1249. {$endif GDB}
  1250. end;
  1251. {$ifdef GDB}
  1252. if (cs_debuginfo in aktmoduleswitches) then
  1253. list.concat(Tai_force_line.Create);
  1254. {$endif GDB}
  1255. {$ifdef OLDREGVARS}
  1256. load_regvars(list,nil);
  1257. {$endif OLDREGVARS}
  1258. paraloc1.done;
  1259. paraloc2.done;
  1260. end;
  1261. procedure gen_exit_code(list:TAAsmoutput);
  1262. begin
  1263. { call __EXIT for main program }
  1264. if (not DLLsource) and
  1265. (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1266. cg.a_call_name(list,'FPC_DO_EXIT');
  1267. end;
  1268. {****************************************************************************
  1269. Entry/Exit
  1270. ****************************************************************************}
  1271. procedure gen_proc_symbol(list:Taasmoutput);
  1272. var
  1273. hs : string;
  1274. begin
  1275. { add symbol entry point as well as debug information }
  1276. { will be inserted in front of the rest of this list. }
  1277. { Insert alignment and assembler names }
  1278. { Align, gprof uses 16 byte granularity }
  1279. if (cs_profile in aktmoduleswitches) then
  1280. list.concat(Tai_align.create(16))
  1281. else
  1282. list.concat(Tai_align.create(aktalignment.procalign));
  1283. {$ifdef GDB}
  1284. if (cs_debuginfo in aktmoduleswitches) then
  1285. begin
  1286. if (po_public in current_procinfo.procdef.procoptions) then
  1287. Tprocsym(current_procinfo.procdef.procsym).is_global:=true;
  1288. current_procinfo.procdef.concatstabto(list);
  1289. Tprocsym(current_procinfo.procdef.procsym).isstabwritten:=true;
  1290. end;
  1291. {$endif GDB}
  1292. repeat
  1293. hs:=current_procinfo.procdef.aliasnames.getfirst;
  1294. if hs='' then
  1295. break;
  1296. {$ifdef GDB}
  1297. if (cs_debuginfo in aktmoduleswitches) and
  1298. target_info.use_function_relative_addresses then
  1299. list.concat(Tai_stab_function_name.create(strpnew(hs)));
  1300. {$endif GDB}
  1301. if (cs_profile in aktmoduleswitches) or
  1302. (po_public in current_procinfo.procdef.procoptions) then
  1303. list.concat(Tai_symbol.createname_global(hs,AT_FUNCTION,0))
  1304. else
  1305. list.concat(Tai_symbol.createname(hs,AT_FUNCTION,0));
  1306. until false;
  1307. end;
  1308. procedure gen_proc_symbol_end(list:Taasmoutput);
  1309. {$ifdef GDB}
  1310. var
  1311. stabsendlabel : tasmlabel;
  1312. mangled_length : longint;
  1313. p : pchar;
  1314. {$endif GDB}
  1315. begin
  1316. list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
  1317. {$ifdef GDB}
  1318. if (cs_debuginfo in aktmoduleswitches) then
  1319. begin
  1320. objectlibrary.getlabel(stabsendlabel);
  1321. cg.a_label(list,stabsendlabel);
  1322. { define calling EBP as pseudo local var PM }
  1323. { this enables test if the function is a local one !! }
  1324. {if assigned(current_procinfo.parent) and
  1325. (current_procinfo.procdef.parast.symtablelevel>normal_function_level) then
  1326. list.concat(Tai_stabs.Create(strpnew(
  1327. '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
  1328. tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.parent_framepointer_offset)))); }
  1329. if assigned(current_procinfo.procdef.funcretsym) and
  1330. (tvarsym(current_procinfo.procdef.funcretsym).refs>0) then
  1331. begin
  1332. if tvarsym(current_procinfo.procdef.funcretsym).localloc.loc=LOC_REFERENCE then
  1333. begin
  1334. {$warning Need to add gdb support for ret in param register calling}
  1335. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  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. else
  1346. begin
  1347. list.concat(Tai_stabs.Create(strpnew(
  1348. '"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1349. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1350. if (m_result in aktmodeswitches) then
  1351. list.concat(Tai_stabs.Create(strpnew(
  1352. '"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1353. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1354. end;
  1355. end;
  1356. end;
  1357. mangled_length:=length(current_procinfo.procdef.mangledname);
  1358. getmem(p,2*mangled_length+50);
  1359. strpcopy(p,'192,0,0,');
  1360. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1361. if (target_info.use_function_relative_addresses) then
  1362. begin
  1363. strpcopy(strend(p),'-');
  1364. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1365. end;
  1366. list.concat(Tai_stabn.Create(strnew(p)));
  1367. {List.concat(Tai_stabn.Create(strpnew('192,0,0,'
  1368. +current_procinfo.procdef.mangledname))));
  1369. p[0]:='2';p[1]:='2';p[2]:='4';
  1370. strpcopy(strend(p),'_end');}
  1371. strpcopy(p,'224,0,0,'+stabsendlabel.name);
  1372. if (target_info.use_function_relative_addresses) then
  1373. begin
  1374. strpcopy(strend(p),'-');
  1375. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1376. end;
  1377. list.concatlist(withdebuglist);
  1378. list.concat(Tai_stabn.Create(strnew(p)));
  1379. { strpnew('224,0,0,'
  1380. +current_procinfo.procdef.mangledname+'_end'))));}
  1381. freemem(p,2*mangled_length+50);
  1382. end;
  1383. {$endif GDB}
  1384. end;
  1385. procedure gen_proc_entry_code(list:Taasmoutput);
  1386. var
  1387. hitemp,
  1388. lotemp,
  1389. stackframe : longint;
  1390. check : boolean;
  1391. paraloc1 : tcgpara;
  1392. href : treference;
  1393. begin
  1394. paraloc1.init;
  1395. { generate call frame marker for dwarf call frame info }
  1396. dwarfcfi.start_frame(list);
  1397. { allocate temp for saving the argument used when
  1398. stack checking uses a register for pushing the stackframe size }
  1399. check:=(cs_check_stack in aktlocalswitches) and (current_procinfo.procdef.proctypeoption<>potype_proginit);
  1400. if check then
  1401. begin
  1402. { Allocate tempspace to store register parameter than
  1403. is destroyed when calling stackchecking code }
  1404. paramanager.getintparaloc(pocall_default,1,paraloc1);
  1405. if paraloc1.location^.loc=LOC_REGISTER then
  1406. tg.GetTemp(list,sizeof(aint),tt_normal,href);
  1407. end;
  1408. { Calculate size of stackframe }
  1409. stackframe:=current_procinfo.calc_stackframe_size;
  1410. { All temps are know, write offsets used for information }
  1411. if (cs_asm_source in aktglobalswitches) then
  1412. begin
  1413. if tg.direction>0 then
  1414. begin
  1415. lotemp:=current_procinfo.tempstart;
  1416. hitemp:=tg.lasttemp;
  1417. end
  1418. else
  1419. begin
  1420. lotemp:=tg.lasttemp;
  1421. hitemp:=current_procinfo.tempstart;
  1422. end;
  1423. list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
  1424. tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
  1425. end;
  1426. { generate target specific proc entry code }
  1427. cg.g_proc_entry(list,stackframe,(po_nostackframe in current_procinfo.procdef.procoptions));
  1428. { Add stack checking code? }
  1429. if check then
  1430. begin
  1431. { The tempspace to store original register is already
  1432. allocated above before the stackframe size is calculated. }
  1433. if paraloc1.location^.loc=LOC_REGISTER then
  1434. cg.a_load_reg_ref(list,OS_INT,OS_INT,paraloc1.location^.register,href);
  1435. paramanager.allocparaloc(list,paraloc1);
  1436. cg.a_param_const(list,OS_INT,stackframe,paraloc1);
  1437. paramanager.freeparaloc(list,paraloc1);
  1438. cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1439. cg.a_call_name(list,'FPC_STACKCHECK');
  1440. cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1441. if paraloc1.location^.loc=LOC_REGISTER then
  1442. begin
  1443. cg.a_load_ref_reg(list,OS_INT,OS_INT,href,paraloc1.location^.register);
  1444. tg.UnGetTemp(list,href);
  1445. end;
  1446. end;
  1447. paraloc1.done;
  1448. end;
  1449. procedure gen_proc_exit_code(list:Taasmoutput);
  1450. var
  1451. parasize : longint;
  1452. begin
  1453. { c style clearstack does not need to remove parameters from the stack, only the
  1454. return value when it was pushed by arguments }
  1455. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1456. begin
  1457. parasize:=0;
  1458. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1459. inc(parasize,sizeof(aint));
  1460. end
  1461. else
  1462. parasize:=current_procinfo.para_stack_size;
  1463. { generate target specific proc exit code }
  1464. cg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
  1465. { release return registers, needed for optimizer }
  1466. paramanager.freeparaloc(list,current_procinfo.procdef.funcret_paraloc[calleeside]);
  1467. { end of frame marker for call frame info }
  1468. dwarfcfi.end_frame(list);
  1469. end;
  1470. procedure gen_save_used_regs(list:TAAsmoutput);
  1471. begin
  1472. { Pure assembler routines need to save the registers themselves }
  1473. if (po_assembler in current_procinfo.procdef.procoptions) then
  1474. exit;
  1475. { for the save all registers we can simply use a pusha,popa which
  1476. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1477. if (po_saveregisters in current_procinfo.procdef.procoptions) then
  1478. cg.g_save_all_registers(list)
  1479. else
  1480. if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
  1481. cg.g_save_standard_registers(list);
  1482. end;
  1483. procedure gen_restore_used_regs(list:TAAsmoutput;const funcretparaloc:tcgpara);
  1484. begin
  1485. { Pure assembler routines need to save the registers themselves }
  1486. if (po_assembler in current_procinfo.procdef.procoptions) then
  1487. exit;
  1488. { for the save all registers we can simply use a pusha,popa which
  1489. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1490. if (po_saveregisters in current_procinfo.procdef.procoptions) then
  1491. cg.g_restore_all_registers(list,funcretparaloc)
  1492. else
  1493. if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
  1494. cg.g_restore_standard_registers(list);
  1495. end;
  1496. {****************************************************************************
  1497. Const Data
  1498. ****************************************************************************}
  1499. procedure insertconstdata(sym : ttypedconstsym);
  1500. { this does not affect the local stack space, since all
  1501. typed constansts and initialized variables are always
  1502. put in the .data / .rodata section
  1503. }
  1504. var
  1505. storefilepos : tfileposinfo;
  1506. curconstsegment : taasmoutput;
  1507. l : longint;
  1508. begin
  1509. storefilepos:=aktfilepos;
  1510. aktfilepos:=sym.fileinfo;
  1511. if sym.is_writable then
  1512. curconstsegment:=datasegment
  1513. else
  1514. curconstsegment:=consts;
  1515. l:=sym.getsize;
  1516. { insert cut for smartlinking or alignment }
  1517. maybe_new_object_file(curconstSegment);
  1518. new_section(curconstSegment,sec_rodata,lower(sym.mangledname),const_align(l));
  1519. if (sym.owner.symtabletype=globalsymtable) or
  1520. maybe_smartlink_symbol or
  1521. (assigned(current_procinfo) and
  1522. (current_procinfo.procdef.proccalloption=pocall_inline)) or
  1523. DLLSource then
  1524. curconstSegment.concat(Tai_symbol.Createname_global(sym.mangledname,AT_DATA,l))
  1525. else
  1526. curconstSegment.concat(Tai_symbol.Createname(sym.mangledname,AT_DATA,l));
  1527. aktfilepos:=storefilepos;
  1528. end;
  1529. procedure insertbssdata(sym : tvarsym);
  1530. var
  1531. l,varalign : longint;
  1532. storefilepos : tfileposinfo;
  1533. begin
  1534. storefilepos:=aktfilepos;
  1535. aktfilepos:=sym.fileinfo;
  1536. l:=sym.getvaluesize;
  1537. if (vo_is_thread_var in sym.varoptions) then
  1538. inc(l,sizeof(aint));
  1539. varalign:=var_align(l);
  1540. maybe_new_object_file(bssSegment);
  1541. new_section(bssSegment,sec_bss,lower(sym.mangledname),varalign);
  1542. if (sym.owner.symtabletype=globalsymtable) or
  1543. maybe_smartlink_symbol or
  1544. DLLSource or
  1545. (assigned(current_procinfo) and
  1546. (current_procinfo.procdef.proccalloption=pocall_inline)) or
  1547. (vo_is_exported in sym.varoptions) or
  1548. (vo_is_C_var in sym.varoptions) then
  1549. bssSegment.concat(Tai_datablock.Create_global(sym.mangledname,l))
  1550. else
  1551. bssSegment.concat(Tai_datablock.Create(sym.mangledname,l));
  1552. aktfilepos:=storefilepos;
  1553. end;
  1554. procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
  1555. var
  1556. sym : tsym;
  1557. begin
  1558. sym:=tsym(st.symindex.first);
  1559. while assigned(sym) do
  1560. begin
  1561. { Only allocate space for referenced locals }
  1562. if (sym.typ=varsym) and
  1563. (tvarsym(sym).refs>0) then
  1564. begin
  1565. with tvarsym(sym) do
  1566. begin
  1567. {$warning TODO Add support for register variables}
  1568. localloc.loc:=LOC_REFERENCE;
  1569. tg.GetLocal(list,getvaluesize,vartype.def,localloc.reference);
  1570. if cs_asm_source in aktglobalswitches then
  1571. list.concat(Tai_comment.Create(strpnew('Local '+realname+' located at '+
  1572. std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
  1573. end;
  1574. end;
  1575. sym:=tsym(sym.indexnext);
  1576. end;
  1577. end;
  1578. procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
  1579. var
  1580. sym : tsym;
  1581. begin
  1582. sym:=tsym(st.symindex.first);
  1583. while assigned(sym) do
  1584. begin
  1585. if (sym.typ=varsym) and
  1586. (tvarsym(sym).refs>0) then
  1587. begin
  1588. with tvarsym(sym) do
  1589. begin
  1590. { Note: We need to keep the data available in memory
  1591. for the sub procedures that can access local data
  1592. in the parent procedures }
  1593. case localloc.loc of
  1594. LOC_REFERENCE :
  1595. tg.Ungetlocal(list,localloc.reference);
  1596. end;
  1597. end;
  1598. end;
  1599. sym:=tsym(sym.indexnext);
  1600. end;
  1601. end;
  1602. procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
  1603. var
  1604. sym : tsym;
  1605. begin
  1606. sym:=tsym(st.symindex.first);
  1607. while assigned(sym) do
  1608. begin
  1609. if sym.typ=varsym then
  1610. begin
  1611. with tvarsym(sym) do
  1612. begin
  1613. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1614. begin
  1615. case paraitem.paraloc[calleeside].location^.loc of
  1616. LOC_MMREGISTER,
  1617. LOC_FPUREGISTER,
  1618. LOC_REGISTER:
  1619. begin
  1620. (*
  1621. if paraitem.paraloc[calleeside].register=NR_NO then
  1622. begin
  1623. paraitem.paraloc[calleeside].loc:=LOC_REGISTER;
  1624. paraitem.paraloc[calleeside].size:=paraitem.paraloc[calleeside].size;
  1625. {$ifndef cpu64bit}
  1626. if paraitem.paraloc[calleeside].size in [OS_64,OS_S64] then
  1627. begin
  1628. paraitem.paraloc[calleeside].registerlow:=cg.getregisterint(list,OS_32);
  1629. paraitem.paraloc[calleeside].registerhigh:=cg.getregisterint(list,OS_32);
  1630. end
  1631. else
  1632. {$endif cpu64bit}
  1633. paraitem.paraloc[calleeside].register:=cg.getregisterint(list,localloc.size);
  1634. end;
  1635. *)
  1636. (*
  1637. {$warning TODO Allocate register paras}
  1638. localloc.loc:=LOC_REGISTER;
  1639. localloc.size:=paraitem.paraloc[calleeside].size;
  1640. {$ifndef cpu64bit}
  1641. if localloc.size in [OS_64,OS_S64] then
  1642. begin
  1643. localloc.registerlow:=cg.getregisterint(list,OS_32);
  1644. localloc.registerhigh:=cg.getregisterint(list,OS_32);
  1645. end
  1646. else
  1647. {$endif cpu64bit}
  1648. localloc.register:=cg.getregisterint(list,localloc.size);
  1649. *)
  1650. localloc.loc:=LOC_REFERENCE;
  1651. localloc.size:=paraitem.paraloc[calleeside].size;
  1652. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1653. end;
  1654. {$ifdef powerpc}
  1655. LOC_REFERENCE:
  1656. begin
  1657. localloc.loc := LOC_REFERENCE;
  1658. localloc.size:=paraitem.paraloc[calleeside].size;
  1659. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1660. end;
  1661. {$endif powerpc}
  1662. else
  1663. paraitem.paraloc[calleeside].get_location(localloc);
  1664. end;
  1665. end
  1666. else
  1667. paraitem.paraloc[calleeside].get_location(localloc);
  1668. if cs_asm_source in aktglobalswitches then
  1669. case localloc.loc of
  1670. LOC_REFERENCE :
  1671. begin
  1672. list.concat(Tai_comment.Create(strpnew('Para '+realname+' located at '+
  1673. std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
  1674. end;
  1675. end;
  1676. end;
  1677. end;
  1678. sym:=tsym(sym.indexnext);
  1679. end;
  1680. end;
  1681. procedure gen_alloc_inline_parast(list:TAAsmoutput;pd:tprocdef);
  1682. var
  1683. sym : tsym;
  1684. calleeparaloc,
  1685. callerparaloc : pcgparalocation;
  1686. begin
  1687. if (po_assembler in pd.procoptions) then
  1688. exit;
  1689. sym:=tsym(pd.parast.symindex.first);
  1690. while assigned(sym) do
  1691. begin
  1692. if sym.typ=varsym then
  1693. begin
  1694. with tvarsym(sym) do
  1695. begin
  1696. { for localloc <> LOC_REFERENCE, we need regvar support inside inlined procedures }
  1697. localloc.loc:=LOC_REFERENCE;
  1698. localloc.size:=int_cgsize(paramanager.push_size(varspez,vartype.def,pocall_inline));
  1699. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1700. calleeparaloc:=paraitem.paraloc[calleeside].location;
  1701. callerparaloc:=paraitem.paraloc[callerside].location;
  1702. while assigned(calleeparaloc) do
  1703. begin
  1704. if not assigned(callerparaloc) then
  1705. internalerror(200408281);
  1706. if calleeparaloc^.loc<>callerparaloc^.loc then
  1707. internalerror(200408282);
  1708. case calleeparaloc^.loc of
  1709. LOC_FPUREGISTER:
  1710. begin
  1711. calleeparaloc^.register:=cg.getfpuregister(list,calleeparaloc^.size);
  1712. callerparaloc^.register:=calleeparaloc^.register;
  1713. end;
  1714. LOC_REGISTER:
  1715. begin
  1716. calleeparaloc^.register:=cg.getintregister(list,calleeparaloc^.size);
  1717. callerparaloc^.register:=calleeparaloc^.register;
  1718. end;
  1719. LOC_MMREGISTER:
  1720. begin
  1721. calleeparaloc^.register:=cg.getmmregister(list,calleeparaloc^.size);
  1722. callerparaloc^.register:=calleeparaloc^.register;
  1723. end;
  1724. LOC_REFERENCE:
  1725. begin
  1726. calleeparaloc^.reference.offset := localloc.reference.offset;
  1727. calleeparaloc^.reference.index := localloc.reference.base;
  1728. callerparaloc^.reference.offset := localloc.reference.offset;
  1729. callerparaloc^.reference.index := localloc.reference.base;
  1730. end;
  1731. end;
  1732. calleeparaloc:=calleeparaloc^.next;
  1733. callerparaloc:=callerparaloc^.next;
  1734. end;
  1735. if cs_asm_source in aktglobalswitches then
  1736. begin
  1737. case localloc.loc of
  1738. LOC_REFERENCE :
  1739. list.concat(Tai_comment.Create(strpnew('Para '+realname+' allocated at '+
  1740. std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
  1741. end;
  1742. end;
  1743. end;
  1744. end;
  1745. sym:=tsym(sym.indexnext);
  1746. end;
  1747. end;
  1748. procedure gen_alloc_inline_funcret(list:TAAsmoutput;pd:tprocdef);
  1749. var
  1750. sym : tsym;
  1751. calleeparaloc,
  1752. callerparaloc : pcgparalocation;
  1753. begin
  1754. if not assigned(pd.funcretsym) or
  1755. (po_assembler in pd.procoptions) then
  1756. exit;
  1757. { for localloc <> LOC_REFERENCE, we need regvar support inside inlined procedures }
  1758. with tvarsym(pd.funcretsym) do
  1759. begin
  1760. localloc.loc:=LOC_REFERENCE;
  1761. localloc.size:=int_cgsize(paramanager.push_size(varspez,vartype.def,pocall_inline));
  1762. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1763. calleeparaloc:=pd.funcret_paraloc[calleeside].location;
  1764. callerparaloc:=pd.funcret_paraloc[callerside].location;
  1765. while assigned(calleeparaloc) do
  1766. begin
  1767. if not assigned(callerparaloc) then
  1768. internalerror(200408281);
  1769. if calleeparaloc^.loc<>callerparaloc^.loc then
  1770. internalerror(200408282);
  1771. case calleeparaloc^.loc of
  1772. LOC_FPUREGISTER:
  1773. begin
  1774. calleeparaloc^.register:=cg.getfpuregister(list,calleeparaloc^.size);
  1775. callerparaloc^.register:=calleeparaloc^.register;
  1776. end;
  1777. LOC_REGISTER:
  1778. begin
  1779. calleeparaloc^.register:=cg.getintregister(list,calleeparaloc^.size);
  1780. callerparaloc^.register:=calleeparaloc^.register;
  1781. end;
  1782. LOC_MMREGISTER:
  1783. begin
  1784. calleeparaloc^.register:=cg.getmmregister(list,calleeparaloc^.size);
  1785. callerparaloc^.register:=calleeparaloc^.register;
  1786. end;
  1787. LOC_REFERENCE:
  1788. begin
  1789. calleeparaloc^.reference.offset := localloc.reference.offset;
  1790. calleeparaloc^.reference.index := localloc.reference.base;
  1791. callerparaloc^.reference.offset := localloc.reference.offset;
  1792. callerparaloc^.reference.index := localloc.reference.base;
  1793. end;
  1794. end;
  1795. calleeparaloc:=calleeparaloc^.next;
  1796. callerparaloc:=callerparaloc^.next;
  1797. end;
  1798. if cs_asm_source in aktglobalswitches then
  1799. begin
  1800. case localloc.loc of
  1801. LOC_REFERENCE :
  1802. list.concat(Tai_comment.Create(strpnew('Funcret '+realname+' allocated at '+
  1803. std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
  1804. end;
  1805. end;
  1806. end;
  1807. end;
  1808. procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
  1809. var
  1810. sym : tsym;
  1811. begin
  1812. sym:=tsym(st.symindex.first);
  1813. while assigned(sym) do
  1814. begin
  1815. if sym.typ=varsym then
  1816. begin
  1817. with tvarsym(sym) do
  1818. begin
  1819. { Note: We need to keep the data available in memory
  1820. for the sub procedures that can access local data
  1821. in the parent procedures }
  1822. case localloc.loc of
  1823. LOC_REFERENCE :
  1824. tg.UngetLocal(list,localloc.reference);
  1825. end;
  1826. end;
  1827. end;
  1828. sym:=tsym(sym.indexnext);
  1829. end;
  1830. end;
  1831. { persistent rtti generation }
  1832. procedure generate_rtti(p:Ttypesym);
  1833. var
  1834. rsym : trttisym;
  1835. def : tstoreddef;
  1836. begin
  1837. { rtti can only be generated for classes that are always typesyms }
  1838. def:=tstoreddef(ttypesym(p).restype.def);
  1839. { there is an error, skip rtti info }
  1840. if (def.deftype=errordef) or (Errorcount>0) then
  1841. exit;
  1842. { only create rtti once for each definition }
  1843. if not(df_has_rttitable in def.defoptions) then
  1844. begin
  1845. { definition should be in the same symtable as the symbol }
  1846. if p.owner<>def.owner then
  1847. internalerror(200108262);
  1848. { create rttisym }
  1849. rsym:=trttisym.create(p.name,fullrtti);
  1850. p.owner.insert(rsym);
  1851. { register rttisym in definition }
  1852. include(def.defoptions,df_has_rttitable);
  1853. def.rttitablesym:=rsym;
  1854. { write rtti data }
  1855. def.write_child_rtti_data(fullrtti);
  1856. maybe_new_object_file(rttilist);
  1857. new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
  1858. rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0));
  1859. def.write_rtti_data(fullrtti);
  1860. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  1861. end;
  1862. end;
  1863. { persistent init table generation }
  1864. procedure generate_inittable(p:tsym);
  1865. var
  1866. rsym : trttisym;
  1867. def : tstoreddef;
  1868. begin
  1869. { anonymous types are also allowed for records that can be varsym }
  1870. case p.typ of
  1871. typesym :
  1872. def:=tstoreddef(ttypesym(p).restype.def);
  1873. varsym :
  1874. def:=tstoreddef(tvarsym(p).vartype.def);
  1875. else
  1876. internalerror(200108263);
  1877. end;
  1878. { only create inittable once for each definition }
  1879. if not(df_has_inittable in def.defoptions) then
  1880. begin
  1881. { definition should be in the same symtable as the symbol }
  1882. if p.owner<>def.owner then
  1883. internalerror(200108264);
  1884. { create rttisym }
  1885. rsym:=trttisym.create(p.name,initrtti);
  1886. p.owner.insert(rsym);
  1887. { register rttisym in definition }
  1888. include(def.defoptions,df_has_inittable);
  1889. def.inittablesym:=rsym;
  1890. { write inittable data }
  1891. def.write_child_rtti_data(initrtti);
  1892. maybe_new_object_file(rttilist);
  1893. new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
  1894. rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0));
  1895. def.write_rtti_data(initrtti);
  1896. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  1897. end;
  1898. end;
  1899. end.
  1900. {
  1901. $Log$
  1902. Revision 1.217 2004-09-25 14:23:54 peter
  1903. * ungetregister is now only used for cpuregisters, renamed to
  1904. ungetcpuregister
  1905. * renamed (get|unget)explicitregister(s) to ..cpuregister
  1906. * removed location-release/reference_release
  1907. Revision 1.216 2004/09/21 17:25:12 peter
  1908. * paraloc branch merged
  1909. Revision 1.215 2004/09/14 16:33:46 peter
  1910. * release localsymtables when module is compiled
  1911. Revision 1.214 2004/09/13 20:30:05 peter
  1912. * finalize all (also procedure local) typedconst at unit finalization
  1913. Revision 1.213.4.3 2004/09/20 20:46:34 peter
  1914. * register allocation optimized for 64bit loading of parameters
  1915. and return values
  1916. Revision 1.213.4.2 2004/09/17 17:19:26 peter
  1917. * fixed 64 bit unaryminus for sparc
  1918. * fixed 64 bit inlining
  1919. * signness of not operation
  1920. Revision 1.213.4.1 2004/08/31 20:43:06 peter
  1921. * paraloc patch
  1922. Revision 1.213 2004/08/23 11:00:06 michael
  1923. + Patch from Peter to fix debuginfo in constructor.
  1924. Revision 1.212 2004/07/17 13:14:17 jonas
  1925. * don't finalize typed consts (fixes bug3212, but causes memory leak;
  1926. they should be finalized at the end of the module)
  1927. Revision 1.211 2004/07/09 23:41:04 jonas
  1928. * support register parameters for inlined procedures + some inline
  1929. cleanups
  1930. Revision 1.210 2004/07/04 12:24:59 jonas
  1931. * fixed one regvar problem, but regvars are still broken since the dwarf
  1932. merge...
  1933. Revision 1.209 2004/06/29 20:57:21 peter
  1934. * fixed size of exceptbuf
  1935. Revision 1.208 2004/06/20 08:55:29 florian
  1936. * logs truncated
  1937. Revision 1.207 2004/06/16 20:07:08 florian
  1938. * dwarf branch merged
  1939. Revision 1.206 2004/06/01 20:39:33 jonas
  1940. * fixed bug regarding parameters on the ppc (they were allocated twice
  1941. under some circumstances and not at all in others)
  1942. Revision 1.205 2004/05/30 21:41:15 jonas
  1943. * more regvar optimizations in location_force_reg
  1944. Revision 1.204 2004/05/30 21:18:22 jonas
  1945. * some optimizations and associated fixes for better regvar code
  1946. Revision 1.203 2004/05/28 21:14:13 peter
  1947. * first load para's to temps before calling entry code (profile
  1948. }