ncgutil.pas 95 KB

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