ncgutil.pas 95 KB

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