ncgutil.pas 100 KB

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