ncgutil.pas 97 KB

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