ncgutil.pas 97 KB

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