ncgutil.pas 94 KB

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