ncgutil.pas 92 KB

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