ncgutil.pas 106 KB

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