ncgutil.pas 106 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738
  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 : tstaticvarsym);
  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_swapped 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_swapped in p.flags then
  209. exclude(p.flags,nf_swapped)
  210. else
  211. include(p.flags,nf_swapped);
  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 (aword(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=staticvarsym) then
  925. begin
  926. { Static variables can have the initialloc only set to LOC_CxREGISTER
  927. or LOC_INVALID, for explaination see gen_alloc_symtable (PFV) }
  928. case tstaticvarsym(p).initialloc.loc of
  929. LOC_CREGISTER :
  930. begin
  931. {$ifndef cpu64bit}
  932. if (tstaticvarsym(p).initialloc.size in [OS_64,OS_S64]) then
  933. cg64.a_load64_const_reg(TAsmList(arg),0,tstaticvarsym(p).initialloc.register64)
  934. else
  935. {$endif not cpu64bit}
  936. cg.a_load_const_reg(TAsmList(arg),reg_cgsize(tstaticvarsym(p).initialloc.register),0,
  937. tstaticvarsym(p).initialloc.register);
  938. end;
  939. LOC_CMMREGISTER :
  940. { clear the whole register }
  941. cg.a_opmm_reg_reg(TAsmList(arg),OP_XOR,reg_cgsize(tstaticvarsym(p).initialloc.register),
  942. tstaticvarsym(p).initialloc.register,
  943. tstaticvarsym(p).initialloc.register,
  944. nil);
  945. LOC_CFPUREGISTER :
  946. ;
  947. LOC_INVALID :
  948. ;
  949. else
  950. internalerror(200410124);
  951. end;
  952. end;
  953. end;
  954. { generates the code for initialisation of local data }
  955. procedure initialize_data(p:TObject;arg:pointer);
  956. var
  957. OldAsmList : TAsmList;
  958. hp : tnode;
  959. begin
  960. if (tsym(p).typ in [staticvarsym,localvarsym]) and
  961. (tabstractvarsym(p).refs>0) and
  962. not(vo_is_typed_const in tabstractvarsym(p).varoptions) and
  963. not(vo_is_external in tabstractvarsym(p).varoptions) and
  964. not(is_class(tabstractvarsym(p).vardef)) and
  965. tabstractvarsym(p).vardef.needs_inittable then
  966. begin
  967. OldAsmList:=current_asmdata.CurrAsmList;
  968. current_asmdata.CurrAsmList:=TAsmList(arg);
  969. hp:=initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner));
  970. firstpass(hp);
  971. secondpass(hp);
  972. hp.free;
  973. current_asmdata.CurrAsmList:=OldAsmList;
  974. end;
  975. end;
  976. procedure finalize_sym(asmlist:TAsmList;sym:tsym);
  977. var
  978. hp : tnode;
  979. OldAsmList : TAsmList;
  980. begin
  981. include(current_procinfo.flags,pi_needs_implicit_finally);
  982. OldAsmList:=current_asmdata.CurrAsmList;
  983. current_asmdata.CurrAsmList:=asmlist;
  984. hp:=finalize_data_node(cloadnode.create(sym,sym.owner));
  985. firstpass(hp);
  986. secondpass(hp);
  987. hp.free;
  988. current_asmdata.CurrAsmList:=OldAsmList;
  989. end;
  990. { generates the code for finalisation of local variables }
  991. procedure finalize_local_vars(p:TObject;arg:pointer);
  992. begin
  993. if (tsym(p).typ=localvarsym) and
  994. (tlocalvarsym(p).refs>0) and
  995. not(vo_is_external in tlocalvarsym(p).varoptions) and
  996. not(vo_is_funcret in tlocalvarsym(p).varoptions) and
  997. not(is_class(tlocalvarsym(p).vardef)) and
  998. tlocalvarsym(p).vardef.needs_inittable then
  999. finalize_sym(TAsmList(arg),tsym(p));
  1000. end;
  1001. { generates the code for finalization of static symtable and
  1002. all local (static) typed consts }
  1003. procedure finalize_static_data(p:TObject;arg:pointer);
  1004. var
  1005. i : longint;
  1006. pd : tprocdef;
  1007. begin
  1008. case tsym(p).typ of
  1009. staticvarsym :
  1010. begin
  1011. if (tstaticvarsym(p).refs>0) and
  1012. (tstaticvarsym(p).varspez<>vs_const) and
  1013. not(vo_is_funcret in tstaticvarsym(p).varoptions) and
  1014. not(vo_is_external in tstaticvarsym(p).varoptions) and
  1015. not(is_class(tstaticvarsym(p).vardef)) and
  1016. tstaticvarsym(p).vardef.needs_inittable then
  1017. finalize_sym(TAsmList(arg),tsym(p));
  1018. end;
  1019. procsym :
  1020. begin
  1021. for i:=0 to tprocsym(p).ProcdefList.Count-1 do
  1022. begin
  1023. pd:=tprocdef(tprocsym(p).ProcdefList[i]);
  1024. if assigned(pd.localst) and
  1025. (pd.procsym=tprocsym(p)) and
  1026. (pd.localst.symtabletype<>staticsymtable) then
  1027. pd.localst.SymList.ForEachCall(@finalize_static_data,arg);
  1028. end;
  1029. end;
  1030. end;
  1031. end;
  1032. { generates the code for incrementing the reference count of parameters and
  1033. initialize out parameters }
  1034. procedure init_paras(p:TObject;arg:pointer);
  1035. var
  1036. href : treference;
  1037. tmpreg : tregister;
  1038. list : TAsmList;
  1039. needs_inittable: boolean;
  1040. begin
  1041. list:=TAsmList(arg);
  1042. if (tsym(p).typ=paravarsym) then
  1043. begin
  1044. needs_inittable :=
  1045. not is_class_or_interface(tparavarsym(p).vardef) and
  1046. tparavarsym(p).vardef.needs_inittable;
  1047. case tparavarsym(p).varspez of
  1048. vs_value :
  1049. if needs_inittable then
  1050. begin
  1051. location_get_data_ref(list,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef));
  1052. cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
  1053. end;
  1054. vs_out :
  1055. begin
  1056. if (needs_inittable) or
  1057. (localvartrashing <> -1) then
  1058. begin
  1059. tmpreg:=cg.getaddressregister(list);
  1060. cg.a_load_loc_reg(list,OS_ADDR,tparavarsym(p).initialloc,tmpreg);
  1061. reference_reset_base(href,tmpreg,0);
  1062. if (localvartrashing <> -1) and
  1063. { needs separate implementation to trash open arrays }
  1064. { since their size is only known at run time }
  1065. not is_special_array(tparavarsym(p).vardef) then
  1066. trash_reference(list,href,tparavarsym(p).vardef.size);
  1067. if needs_inittable then
  1068. cg.g_initialize(list,tparavarsym(p).vardef,href);
  1069. end;
  1070. end;
  1071. else if (localvartrashing <> -1) and
  1072. ([vo_is_funcret,vo_is_hidden_para] * tparavarsym(p).varoptions = [vo_is_funcret,vo_is_hidden_para]) then
  1073. begin
  1074. tmpreg:=cg.getaddressregister(list);
  1075. cg.a_load_loc_reg(list,OS_ADDR,tparavarsym(p).initialloc,tmpreg);
  1076. reference_reset_base(href,tmpreg,0);
  1077. { may be an open string, even if is_open_string() returns }
  1078. { false for some helpers in the system unit }
  1079. if not is_shortstring(tparavarsym(p).vardef) then
  1080. trash_reference(list,href,tparavarsym(p).vardef.size)
  1081. else
  1082. { an open string has at least size 2 }
  1083. trash_reference(list,href,2);
  1084. end
  1085. end;
  1086. end;
  1087. end;
  1088. { generates the code for decrementing the reference count of parameters }
  1089. procedure final_paras(p:TObject;arg:pointer);
  1090. var
  1091. list : TAsmList;
  1092. href : treference;
  1093. begin
  1094. if not(tsym(p).typ=paravarsym) then
  1095. exit;
  1096. list:=TAsmList(arg);
  1097. if not is_class_or_interface(tparavarsym(p).vardef) and
  1098. tparavarsym(p).vardef.needs_inittable then
  1099. begin
  1100. if (tparavarsym(p).varspez=vs_value) then
  1101. begin
  1102. include(current_procinfo.flags,pi_needs_implicit_finally);
  1103. location_get_data_ref(list,tparavarsym(p).localloc,href,is_open_array(tparavarsym(p).vardef));
  1104. cg.g_decrrefcount(list,tparavarsym(p).vardef,href);
  1105. end;
  1106. end
  1107. else
  1108. if (tparavarsym(p).varspez=vs_value) and
  1109. (is_open_array(tparavarsym(p).vardef) or
  1110. is_array_of_const(tparavarsym(p).vardef)) then
  1111. begin
  1112. { cdecl functions don't have a high pointer so it is not possible to generate
  1113. a local copy }
  1114. if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  1115. cg.g_releasevaluepara_openarray(list,tparavarsym(p).localloc);
  1116. end;
  1117. end;
  1118. { Initialize temp ansi/widestrings,interfaces }
  1119. procedure inittempvariables(list:TAsmList);
  1120. var
  1121. hp : ptemprecord;
  1122. href : treference;
  1123. begin
  1124. hp:=tg.templist;
  1125. while assigned(hp) do
  1126. begin
  1127. if assigned(hp^.def) and
  1128. hp^.def.needs_inittable then
  1129. begin
  1130. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  1131. cg.g_initialize(list,hp^.def,href);
  1132. end;
  1133. hp:=hp^.next;
  1134. end;
  1135. end;
  1136. procedure finalizetempvariables(list:TAsmList);
  1137. var
  1138. hp : ptemprecord;
  1139. href : treference;
  1140. begin
  1141. hp:=tg.templist;
  1142. while assigned(hp) do
  1143. begin
  1144. if assigned(hp^.def) and
  1145. hp^.def.needs_inittable then
  1146. begin
  1147. include(current_procinfo.flags,pi_needs_implicit_finally);
  1148. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  1149. cg.g_finalize(list,hp^.def,href);
  1150. end;
  1151. hp:=hp^.next;
  1152. end;
  1153. end;
  1154. procedure gen_load_return_value(list:TAsmList);
  1155. var
  1156. {$ifndef cpu64bit}
  1157. href : treference;
  1158. {$endif cpu64bit}
  1159. ressym : tabstractnormalvarsym;
  1160. resloc,
  1161. restmploc : tlocation;
  1162. hreg : tregister;
  1163. funcretloc : tlocation;
  1164. begin
  1165. { Is the loading needed? }
  1166. if (current_procinfo.procdef.funcretloc[calleeside].loc=LOC_VOID) or
  1167. (
  1168. (po_assembler in current_procinfo.procdef.procoptions) and
  1169. (not(assigned(current_procinfo.procdef.funcretsym)) or
  1170. (tabstractvarsym(current_procinfo.procdef.funcretsym).refs=0))
  1171. ) then
  1172. exit;
  1173. funcretloc:=current_procinfo.procdef.funcretloc[calleeside];
  1174. { constructors return self }
  1175. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  1176. ressym:=tabstractnormalvarsym(current_procinfo.procdef.parast.Find('self'))
  1177. else
  1178. ressym:=tabstractnormalvarsym(current_procinfo.procdef.funcretsym);
  1179. if (ressym.refs>0) then
  1180. begin
  1181. {$ifdef OLDREGVARS}
  1182. case ressym.localloc.loc of
  1183. LOC_CFPUREGISTER,
  1184. LOC_FPUREGISTER:
  1185. begin
  1186. location_reset(restmploc,LOC_CFPUREGISTER,funcretloc^.size);
  1187. restmploc.register:=ressym.localloc.register;
  1188. end;
  1189. LOC_CREGISTER,
  1190. LOC_REGISTER:
  1191. begin
  1192. location_reset(restmploc,LOC_CREGISTER,funcretloc^.size);
  1193. restmploc.register:=ressym.localloc.register;
  1194. end;
  1195. LOC_MMREGISTER:
  1196. begin
  1197. location_reset(restmploc,LOC_CMMREGISTER,funcretloc^.size);
  1198. restmploc.register:=ressym.localloc.register;
  1199. end;
  1200. LOC_REFERENCE:
  1201. begin
  1202. location_reset(restmploc,LOC_REFERENCE,funcretloc^.size);
  1203. restmploc.reference:=ressym.localloc.reference;
  1204. end;
  1205. else
  1206. internalerror(200309184);
  1207. end;
  1208. {$else}
  1209. restmploc:=ressym.localloc;
  1210. {$endif}
  1211. { Here, we return the function result. In most architectures, the value is
  1212. passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
  1213. function returns in a register and the caller receives it in an other one }
  1214. case funcretloc.loc of
  1215. LOC_REGISTER:
  1216. begin
  1217. {$ifndef cpu64bit}
  1218. if current_procinfo.procdef.funcretloc[calleeside].size in [OS_64,OS_S64] then
  1219. begin
  1220. resloc:=current_procinfo.procdef.funcretloc[calleeside];
  1221. if resloc.loc<>LOC_REGISTER then
  1222. internalerror(200409141);
  1223. { Load low and high register separate to generate better register
  1224. allocation info }
  1225. if getsupreg(resloc.register64.reglo)<first_int_imreg then
  1226. begin
  1227. cg.getcpuregister(list,resloc.register64.reglo);
  1228. end;
  1229. case restmploc.loc of
  1230. LOC_REFERENCE :
  1231. begin
  1232. href:=restmploc.reference;
  1233. if target_info.endian=ENDIAN_BIG then
  1234. inc(href.offset,4);
  1235. cg.a_load_ref_reg(list,OS_32,OS_32,href,resloc.register64.reglo);
  1236. end;
  1237. LOC_CREGISTER :
  1238. cg.a_load_reg_reg(list,OS_32,OS_32,restmploc.register64.reglo,resloc.register64.reglo);
  1239. else
  1240. internalerror(200409203);
  1241. end;
  1242. if getsupreg(resloc.register64.reghi)<first_int_imreg then
  1243. begin
  1244. cg.getcpuregister(list,resloc.register64.reghi);
  1245. end;
  1246. case restmploc.loc of
  1247. LOC_REFERENCE :
  1248. begin
  1249. href:=restmploc.reference;
  1250. if target_info.endian=ENDIAN_LITTLE then
  1251. inc(href.offset,4);
  1252. cg.a_load_ref_reg(list,OS_32,OS_32,href,resloc.register64.reghi);
  1253. end;
  1254. LOC_CREGISTER :
  1255. cg.a_load_reg_reg(list,OS_32,OS_32,restmploc.register64.reghi,resloc.register64.reghi);
  1256. else
  1257. internalerror(200409204);
  1258. end;
  1259. end
  1260. else
  1261. {$endif cpu64bit}
  1262. begin
  1263. hreg:=cg.makeregsize(list,funcretloc.register,funcretloc.size);
  1264. if getsupreg(funcretloc.register)<first_int_imreg then
  1265. begin
  1266. cg.getcpuregister(list,funcretloc.register);
  1267. end;
  1268. { it could be that a structure is passed in memory but the function is expected to
  1269. return a pointer to this memory }
  1270. if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption) then
  1271. cg.a_load_loc_reg(list,OS_ADDR,restmploc,hreg)
  1272. else
  1273. cg.a_load_loc_reg(list,restmploc.size,restmploc,hreg);
  1274. end;
  1275. end;
  1276. LOC_FPUREGISTER:
  1277. begin
  1278. if getsupreg(funcretloc.register)<first_fpu_imreg then
  1279. begin
  1280. cg.getcpuregister(list,funcretloc.register);
  1281. end;
  1282. { we can't do direct moves between fpu and mm registers }
  1283. if restmploc.loc in [LOC_MMREGISTER,LOC_CMMREGISTER] then
  1284. location_force_fpureg(list,restmploc,false);
  1285. cg.a_loadfpu_loc_reg(list,restmploc,funcretloc.register);
  1286. end;
  1287. LOC_MMREGISTER:
  1288. begin
  1289. if getsupreg(funcretloc.register)<first_mm_imreg then
  1290. begin
  1291. cg.getcpuregister(list,funcretloc.register);
  1292. end;
  1293. cg.a_loadmm_loc_reg(list,restmploc.size,restmploc,funcretloc.register,mms_movescalar);
  1294. end;
  1295. LOC_INVALID,
  1296. LOC_REFERENCE:
  1297. ;
  1298. else
  1299. internalerror(200405025);
  1300. end;
  1301. end
  1302. {$ifdef x86}
  1303. else
  1304. begin
  1305. { the caller will pop a value off the cpu stack }
  1306. if (funcretloc.loc = LOC_FPUREGISTER) then
  1307. list.concat(taicpu.op_none(A_FLDZ));
  1308. end;
  1309. {$endif x86}
  1310. end;
  1311. procedure gen_alloc_regvar(list:TAsmList;sym: tabstractnormalvarsym);
  1312. begin
  1313. case sym.initialloc.loc of
  1314. LOC_CREGISTER:
  1315. begin
  1316. {$ifndef cpu64bit}
  1317. if sym.initialloc.size in [OS_64,OS_S64] then
  1318. begin
  1319. sym.initialloc.register64.reglo:=cg.getintregister(list,OS_32);
  1320. sym.initialloc.register64.reghi:=cg.getintregister(list,OS_32);
  1321. end
  1322. else
  1323. {$endif cpu64bit}
  1324. sym.initialloc.register:=cg.getintregister(list,sym.initialloc.size);
  1325. end;
  1326. LOC_CFPUREGISTER:
  1327. begin
  1328. sym.initialloc.register:=cg.getfpuregister(list,sym.initialloc.size);
  1329. end;
  1330. LOC_CMMREGISTER:
  1331. begin
  1332. sym.initialloc.register:=cg.getmmregister(list,sym.initialloc.size);
  1333. end;
  1334. end;
  1335. if (pi_has_goto in current_procinfo.flags) then
  1336. begin
  1337. { Allocate register already, to prevent first allocation to be
  1338. inside a loop }
  1339. {$ifndef cpu64bit}
  1340. if sym.initialloc.size in [OS_64,OS_S64] then
  1341. begin
  1342. cg.a_reg_sync(list,sym.initialloc.register64.reglo);
  1343. cg.a_reg_sync(list,sym.initialloc.register64.reghi);
  1344. end
  1345. else
  1346. {$endif cpu64bit}
  1347. cg.a_reg_sync(list,sym.initialloc.register);
  1348. end;
  1349. sym.localloc:=sym.initialloc;
  1350. end;
  1351. procedure gen_load_para_value(list:TAsmList);
  1352. procedure get_para(const paraloc:TCGParaLocation);
  1353. begin
  1354. case paraloc.loc of
  1355. LOC_REGISTER :
  1356. begin
  1357. if getsupreg(paraloc.register)<first_int_imreg then
  1358. cg.getcpuregister(list,paraloc.register);
  1359. end;
  1360. LOC_MMREGISTER :
  1361. begin
  1362. if getsupreg(paraloc.register)<first_mm_imreg then
  1363. cg.getcpuregister(list,paraloc.register);
  1364. end;
  1365. LOC_FPUREGISTER :
  1366. begin
  1367. if getsupreg(paraloc.register)<first_fpu_imreg then
  1368. cg.getcpuregister(list,paraloc.register);
  1369. end;
  1370. end;
  1371. end;
  1372. procedure unget_para(const paraloc:TCGParaLocation);
  1373. begin
  1374. case paraloc.loc of
  1375. LOC_REGISTER :
  1376. begin
  1377. if getsupreg(paraloc.register)<first_int_imreg then
  1378. cg.ungetcpuregister(list,paraloc.register);
  1379. end;
  1380. LOC_MMREGISTER :
  1381. begin
  1382. if getsupreg(paraloc.register)<first_mm_imreg then
  1383. cg.ungetcpuregister(list,paraloc.register);
  1384. end;
  1385. LOC_FPUREGISTER :
  1386. begin
  1387. if getsupreg(paraloc.register)<first_fpu_imreg then
  1388. cg.ungetcpuregister(list,paraloc.register);
  1389. end;
  1390. end;
  1391. end;
  1392. procedure gen_load_ref(const paraloc:TCGParaLocation;const ref:treference;sizeleft:aint);
  1393. var
  1394. href : treference;
  1395. begin
  1396. case paraloc.loc of
  1397. LOC_REGISTER :
  1398. begin
  1399. {$IFDEF POWERPC64}
  1400. if (paraloc.shiftval <> 0) then
  1401. cg.a_op_const_reg_reg(list, OP_SHL, OS_INT, paraloc.shiftval, paraloc.register, paraloc.register);
  1402. {$ENDIF POWERPC64}
  1403. cg.a_load_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref);
  1404. end;
  1405. LOC_MMREGISTER :
  1406. cg.a_loadmm_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref,mms_movescalar);
  1407. LOC_FPUREGISTER :
  1408. cg.a_loadfpu_reg_ref(list,paraloc.size,paraloc.register,ref);
  1409. LOC_REFERENCE :
  1410. begin
  1411. reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset);
  1412. { use concatcopy, because it can also be a float which fails when
  1413. load_ref_ref is used. Don't copy data when the references are equal }
  1414. if not((href.base=ref.base) and (href.offset=ref.offset)) then
  1415. cg.g_concatcopy(list,href,ref,sizeleft);
  1416. end;
  1417. else
  1418. internalerror(2002081302);
  1419. end;
  1420. end;
  1421. procedure gen_load_reg(const paraloc:TCGParaLocation;reg:tregister);
  1422. var
  1423. href : treference;
  1424. begin
  1425. case paraloc.loc of
  1426. LOC_REGISTER :
  1427. cg.a_load_reg_reg(list,paraloc.size,paraloc.size,paraloc.register,reg);
  1428. LOC_MMREGISTER :
  1429. cg.a_loadmm_reg_reg(list,paraloc.size,paraloc.size,paraloc.register,reg,mms_movescalar);
  1430. LOC_FPUREGISTER :
  1431. cg.a_loadfpu_reg_reg(list,paraloc.size,paraloc.register,reg);
  1432. LOC_REFERENCE :
  1433. begin
  1434. reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset);
  1435. case getregtype(reg) of
  1436. R_INTREGISTER :
  1437. cg.a_load_ref_reg(list,paraloc.size,paraloc.size,href,reg);
  1438. R_FPUREGISTER :
  1439. cg.a_loadfpu_ref_reg(list,paraloc.size,href,reg);
  1440. R_MMREGISTER :
  1441. cg.a_loadmm_ref_reg(list,paraloc.size,paraloc.size,href,reg,mms_movescalar);
  1442. else
  1443. internalerror(2004101012);
  1444. end;
  1445. end;
  1446. else
  1447. internalerror(2002081302);
  1448. end;
  1449. end;
  1450. var
  1451. i : longint;
  1452. currpara : tparavarsym;
  1453. paraloc : pcgparalocation;
  1454. href : treference;
  1455. sizeleft : aint;
  1456. {$if defined(sparc) or defined(arm)}
  1457. tempref : treference;
  1458. {$endif sparc}
  1459. begin
  1460. if (po_assembler in current_procinfo.procdef.procoptions) then
  1461. exit;
  1462. { Allocate registers used by parameters }
  1463. for i:=0 to current_procinfo.procdef.paras.count-1 do
  1464. begin
  1465. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  1466. paraloc:=currpara.paraloc[calleeside].location;
  1467. while assigned(paraloc) do
  1468. begin
  1469. if paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER] then
  1470. get_para(paraloc^);
  1471. paraloc:=paraloc^.next;
  1472. end;
  1473. end;
  1474. { Copy parameters to local references/registers }
  1475. for i:=0 to current_procinfo.procdef.paras.count-1 do
  1476. begin
  1477. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  1478. paraloc:=currpara.paraloc[calleeside].location;
  1479. { skip e.g. empty records }
  1480. if not assigned(paraloc) then
  1481. internalerror(200408203);
  1482. if (paraloc^.loc = LOC_VOID) then
  1483. continue;
  1484. case currpara.initialloc.loc of
  1485. LOC_REFERENCE :
  1486. begin
  1487. { If the parameter location is reused we don't need to copy
  1488. anything }
  1489. if not paramanager.param_use_paraloc(currpara.paraloc[calleeside]) then
  1490. begin
  1491. href:=currpara.initialloc.reference;
  1492. sizeleft:=currpara.paraloc[calleeside].intsize;
  1493. while assigned(paraloc) do
  1494. begin
  1495. if (paraloc^.size=OS_NO) then
  1496. begin
  1497. { Can only be a reference that contains the rest
  1498. of the parameter }
  1499. if (paraloc^.loc<>LOC_REFERENCE) or
  1500. assigned(paraloc^.next) then
  1501. internalerror(2005013010);
  1502. gen_load_ref(paraloc^,href,sizeleft);
  1503. inc(href.offset,sizeleft);
  1504. sizeleft:=0;
  1505. end
  1506. else
  1507. begin
  1508. gen_load_ref(paraloc^,href,tcgsize2size[paraloc^.size]);
  1509. inc(href.offset,TCGSize2Size[paraloc^.size]);
  1510. dec(sizeleft,TCGSize2Size[paraloc^.size]);
  1511. end;
  1512. unget_para(paraloc^);
  1513. paraloc:=paraloc^.next;
  1514. end;
  1515. end;
  1516. end;
  1517. LOC_CREGISTER :
  1518. begin
  1519. {$ifndef cpu64bit}
  1520. if (currpara.paraloc[calleeside].size in [OS_64,OS_S64]) and
  1521. is_64bit(currpara.vardef) then
  1522. begin
  1523. case paraloc^.loc of
  1524. LOC_REGISTER:
  1525. begin
  1526. if not assigned(paraloc^.next) then
  1527. internalerror(200410104);
  1528. if (target_info.endian=ENDIAN_BIG) then
  1529. begin
  1530. { paraloc^ -> high
  1531. paraloc^.next -> low }
  1532. unget_para(paraloc^);
  1533. gen_alloc_regvar(list,currpara);
  1534. gen_load_reg(paraloc^,currpara.initialloc.register64.reghi);
  1535. unget_para(paraloc^.next^);
  1536. gen_load_reg(paraloc^.next^,currpara.initialloc.register64.reglo);
  1537. end
  1538. else
  1539. begin
  1540. { paraloc^ -> low
  1541. paraloc^.next -> high }
  1542. unget_para(paraloc^);
  1543. gen_alloc_regvar(list,currpara);
  1544. gen_load_reg(paraloc^,currpara.initialloc.register64.reglo);
  1545. unget_para(paraloc^.next^);
  1546. gen_load_reg(paraloc^.next^,currpara.initialloc.register64.reghi);
  1547. end;
  1548. end;
  1549. LOC_REFERENCE:
  1550. begin
  1551. gen_alloc_regvar(list,currpara);
  1552. reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset);
  1553. cg64.a_load64_ref_reg(list,href,currpara.initialloc.register64);
  1554. unget_para(paraloc^);
  1555. end;
  1556. else
  1557. internalerror(2005101501);
  1558. end
  1559. end
  1560. else
  1561. {$endif cpu64bit}
  1562. begin
  1563. if assigned(paraloc^.next) then
  1564. internalerror(200410105);
  1565. unget_para(paraloc^);
  1566. gen_alloc_regvar(list,currpara);
  1567. gen_load_reg(paraloc^,currpara.initialloc.register);
  1568. end;
  1569. end;
  1570. LOC_CFPUREGISTER :
  1571. begin
  1572. {$if defined(sparc) or defined(arm)}
  1573. { Arm and Sparc passes floats in int registers, when loading to fpu register
  1574. we need a temp }
  1575. sizeleft := TCGSize2Size[currpara.initialloc.size];
  1576. tg.GetTemp(list,sizeleft,tt_normal,tempref);
  1577. href:=tempref;
  1578. while assigned(paraloc) do
  1579. begin
  1580. unget_para(paraloc^);
  1581. gen_load_ref(paraloc^,href,sizeleft);
  1582. inc(href.offset,TCGSize2Size[paraloc^.size]);
  1583. dec(sizeleft,TCGSize2Size[paraloc^.size]);
  1584. paraloc:=paraloc^.next;
  1585. end;
  1586. gen_alloc_regvar(list,currpara);
  1587. cg.a_loadfpu_ref_reg(list,currpara.initialloc.size,tempref,currpara.initialloc.register);
  1588. tg.UnGetTemp(list,tempref);
  1589. {$else sparc}
  1590. unget_para(paraloc^);
  1591. gen_alloc_regvar(list,currpara);
  1592. gen_load_reg(paraloc^,currpara.initialloc.register);
  1593. if assigned(paraloc^.next) then
  1594. internalerror(200410109);
  1595. {$endif sparc}
  1596. end;
  1597. LOC_CMMREGISTER :
  1598. begin
  1599. unget_para(paraloc^);
  1600. gen_alloc_regvar(list,currpara);
  1601. gen_load_reg(paraloc^,currpara.initialloc.register);
  1602. { data could come in two memory locations, for now
  1603. we simply ignore the sanity check (FK)
  1604. if assigned(paraloc^.next) then
  1605. internalerror(200410108);
  1606. }
  1607. end;
  1608. end;
  1609. end;
  1610. { generate copies of call by value parameters, must be done before
  1611. the initialization and body is parsed because the refcounts are
  1612. incremented using the local copies }
  1613. current_procinfo.procdef.parast.SymList.ForEachCall(@copyvalueparas,list);
  1614. {$ifdef powerpc}
  1615. { unget the register that contains the stack pointer before the procedure entry, }
  1616. { which is used to access the parameters in their original callee-side location }
  1617. if (tppcprocinfo(current_procinfo).needs_frame_pointer) then
  1618. cg.a_reg_dealloc(list,NR_R12);
  1619. {$endif powerpc}
  1620. {$ifdef powerpc64}
  1621. { unget the register that contains the stack pointer before the procedure entry, }
  1622. { which is used to access the parameters in their original callee-side location }
  1623. if (tppcprocinfo(current_procinfo).needs_frame_pointer) then
  1624. cg.a_reg_dealloc(list, NR_OLD_STACK_POINTER_REG);
  1625. {$endif powerpc64}
  1626. end;
  1627. procedure gen_initialize_code(list:TAsmList);
  1628. begin
  1629. { initialize local data like ansistrings }
  1630. case current_procinfo.procdef.proctypeoption of
  1631. potype_unitinit:
  1632. begin
  1633. { this is also used for initialization of variables in a
  1634. program which does not have a globalsymtable }
  1635. if assigned(current_module.globalsymtable) then
  1636. TSymtable(current_module.globalsymtable).SymList.ForEachCall(@initialize_data,list);
  1637. TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_data,list);
  1638. TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list);
  1639. end;
  1640. { units have seperate code for initilization and finalization }
  1641. potype_unitfinalize: ;
  1642. { program init/final is generated in separate procedure }
  1643. potype_proginit:
  1644. begin
  1645. TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list);
  1646. end;
  1647. else
  1648. begin
  1649. if (localvartrashing <> -1) and
  1650. not(po_assembler in current_procinfo.procdef.procoptions) then
  1651. current_procinfo.procdef.localst.SymList.ForEachCall(@trash_variable,list);
  1652. current_procinfo.procdef.localst.SymList.ForEachCall(@initialize_data,list);
  1653. end;
  1654. end;
  1655. { initialisizes temp. ansi/wide string data }
  1656. inittempvariables(list);
  1657. { initialize ansi/widesstring para's }
  1658. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1659. current_procinfo.procdef.parast.SymList.ForEachCall(@init_paras,list);
  1660. {$ifdef OLDREGVARS}
  1661. load_regvars(list,nil);
  1662. {$endif OLDREGVARS}
  1663. end;
  1664. procedure gen_finalize_code(list:TAsmList);
  1665. begin
  1666. {$ifdef OLDREGVARS}
  1667. cleanup_regvars(list);
  1668. {$endif OLDREGVARS}
  1669. { finalize temporary data }
  1670. finalizetempvariables(list);
  1671. { finalize local data like ansistrings}
  1672. case current_procinfo.procdef.proctypeoption of
  1673. potype_unitfinalize:
  1674. begin
  1675. { this is also used for initialization of variables in a
  1676. program which does not have a globalsymtable }
  1677. if assigned(current_module.globalsymtable) then
  1678. TSymtable(current_module.globalsymtable).SymList.ForEachCall(@finalize_static_data,list);
  1679. TSymtable(current_module.localsymtable).SymList.ForEachCall(@finalize_static_data,list);
  1680. end;
  1681. { units/progs have separate code for initialization and finalization }
  1682. potype_unitinit: ;
  1683. { program init/final is generated in separate procedure }
  1684. potype_proginit: ;
  1685. else
  1686. current_procinfo.procdef.localst.SymList.ForEachCall(@finalize_local_vars,list);
  1687. end;
  1688. { finalize paras data }
  1689. if assigned(current_procinfo.procdef.parast) and
  1690. not(po_assembler in current_procinfo.procdef.procoptions) then
  1691. current_procinfo.procdef.parast.SymList.ForEachCall(@final_paras,list);
  1692. end;
  1693. procedure gen_entry_code(list:TAsmList);
  1694. var
  1695. paraloc1,
  1696. paraloc2 : tcgpara;
  1697. begin
  1698. paraloc1.init;
  1699. paraloc2.init;
  1700. { the actual profile code can clobber some registers,
  1701. therefore if the context must be saved, do it before
  1702. the actual call to the profile code
  1703. }
  1704. if (cs_profile in current_settings.moduleswitches) and
  1705. not(po_assembler in current_procinfo.procdef.procoptions) then
  1706. begin
  1707. { non-win32 can call mcout even in main }
  1708. if not (target_info.system in [system_i386_win32,system_i386_wdosx]) or
  1709. not (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1710. begin
  1711. cg.g_profilecode(list);
  1712. end;
  1713. end;
  1714. { call startup helpers from main program }
  1715. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1716. begin
  1717. { initialize units }
  1718. cg.allocallcpuregisters(list);
  1719. cg.a_call_name(list,'FPC_INITIALIZEUNITS');
  1720. cg.deallocallcpuregisters(list);
  1721. end;
  1722. list.concat(Tai_force_line.Create);
  1723. {$ifdef OLDREGVARS}
  1724. load_regvars(list,nil);
  1725. {$endif OLDREGVARS}
  1726. paraloc1.done;
  1727. paraloc2.done;
  1728. end;
  1729. procedure gen_exit_code(list:TAsmList);
  1730. begin
  1731. { call __EXIT for main program }
  1732. if (not DLLsource) and
  1733. (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1734. cg.a_call_name(list,'FPC_DO_EXIT');
  1735. end;
  1736. {****************************************************************************
  1737. Entry/Exit
  1738. ****************************************************************************}
  1739. procedure alloc_proc_symbol(pd: tprocdef);
  1740. var
  1741. item: tstringlistitem;
  1742. begin
  1743. item := tstringlistitem(pd.aliasnames.first);
  1744. while assigned(item) do
  1745. begin
  1746. current_asmdata.DefineAsmSymbol(item.str,AB_GLOBAL,AT_FUNCTION);
  1747. item := tstringlistitem(item.next);
  1748. end;
  1749. end;
  1750. procedure gen_proc_symbol(list:TAsmList);
  1751. var
  1752. hs : string;
  1753. begin
  1754. repeat
  1755. hs:=current_procinfo.procdef.aliasnames.getfirst;
  1756. if hs='' then
  1757. break;
  1758. if (cs_profile in current_settings.moduleswitches) or
  1759. (po_global in current_procinfo.procdef.procoptions) then
  1760. list.concat(Tai_symbol.createname_global(hs,AT_FUNCTION,0))
  1761. else
  1762. list.concat(Tai_symbol.createname(hs,AT_FUNCTION,0));
  1763. if tf_use_function_relative_addresses in target_info.flags then
  1764. list.concat(Tai_function_name.create(hs));
  1765. until false;
  1766. current_procinfo.procdef.procstarttai:=tai(list.last);
  1767. end;
  1768. procedure gen_proc_symbol_end(list:TAsmList);
  1769. begin
  1770. list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
  1771. current_procinfo.procdef.procendtai:=tai(list.last);
  1772. { finalisation marker for Mac OS X }
  1773. if (target_info.system in [system_powerpc_darwin,system_i386_darwin]) and
  1774. (current_module.islibrary) and
  1775. (((current_module.flags and uf_finalize)<>0) or
  1776. (current_procinfo.procdef.proctypeoption = potype_proginit)) then
  1777. begin
  1778. if (current_procinfo.procdef.proctypeoption = potype_proginit) then
  1779. list.concat(tai_directive.create(asd_mod_init_func,''))
  1780. else
  1781. list.concat(tai_directive.create(asd_mod_term_func,''));
  1782. list.concat(tai_align.create(4));
  1783. list.concat(Tai_const.Createname(current_procinfo.procdef.mangledname,0));
  1784. end;
  1785. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1786. begin
  1787. if (target_info.system in [system_powerpc_darwin,system_i386_darwin,system_powerpc_macos]) and
  1788. not(current_module.islibrary) then
  1789. begin
  1790. list.concat(tai_section.create(sec_code,'',4));
  1791. list.concat(tai_symbol.createname_global(
  1792. target_info.cprefix+mainaliasname,AT_FUNCTION,0));
  1793. { keep argc, argv and envp properly on the stack }
  1794. cg.a_jmp_name(list,target_info.cprefix+'FPC_SYSTEMMAIN');
  1795. end;
  1796. end;
  1797. end;
  1798. procedure gen_proc_entry_code(list:TAsmList);
  1799. var
  1800. hitemp,
  1801. lotemp : longint;
  1802. begin
  1803. { generate call frame marker for dwarf call frame info }
  1804. current_asmdata.asmcfi.start_frame(list);
  1805. { All temps are know, write offsets used for information }
  1806. if (cs_asm_source in current_settings.globalswitches) then
  1807. begin
  1808. if tg.direction>0 then
  1809. begin
  1810. lotemp:=current_procinfo.tempstart;
  1811. hitemp:=tg.lasttemp;
  1812. end
  1813. else
  1814. begin
  1815. lotemp:=tg.lasttemp;
  1816. hitemp:=current_procinfo.tempstart;
  1817. end;
  1818. list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
  1819. tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
  1820. end;
  1821. { generate target specific proc entry code }
  1822. cg.g_proc_entry(list,current_procinfo.calc_stackframe_size,(po_nostackframe in current_procinfo.procdef.procoptions));
  1823. end;
  1824. procedure gen_proc_exit_code(list:TAsmList);
  1825. var
  1826. parasize : longint;
  1827. begin
  1828. { c style clearstack does not need to remove parameters from the stack, only the
  1829. return value when it was pushed by arguments }
  1830. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1831. begin
  1832. parasize:=0;
  1833. if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption) then
  1834. inc(parasize,sizeof(aint));
  1835. end
  1836. else
  1837. parasize:=current_procinfo.para_stack_size;
  1838. { generate target specific proc exit code }
  1839. cg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
  1840. { release return registers, needed for optimizer }
  1841. if not is_void(current_procinfo.procdef.returndef) then
  1842. location_free(list,current_procinfo.procdef.funcretloc[calleeside]);
  1843. { end of frame marker for call frame info }
  1844. current_asmdata.asmcfi.end_frame(list);
  1845. end;
  1846. procedure gen_stack_check_size_para(list:TAsmList);
  1847. var
  1848. paraloc1 : tcgpara;
  1849. begin
  1850. paraloc1.init;
  1851. paramanager.getintparaloc(pocall_default,1,paraloc1);
  1852. paramanager.allocparaloc(list,paraloc1);
  1853. cg.a_param_const(list,OS_INT,current_procinfo.calc_stackframe_size,paraloc1);
  1854. paramanager.freeparaloc(list,paraloc1);
  1855. paraloc1.done;
  1856. end;
  1857. procedure gen_stack_check_call(list:TAsmList);
  1858. var
  1859. paraloc1 : tcgpara;
  1860. begin
  1861. paraloc1.init;
  1862. { Also alloc the register needed for the parameter }
  1863. paramanager.getintparaloc(pocall_default,1,paraloc1);
  1864. paramanager.allocparaloc(list,paraloc1);
  1865. paramanager.freeparaloc(list,paraloc1);
  1866. { Call the helper }
  1867. cg.allocallcpuregisters(list);
  1868. cg.a_call_name(list,'FPC_STACKCHECK');
  1869. cg.deallocallcpuregisters(list);
  1870. paraloc1.done;
  1871. end;
  1872. procedure gen_save_used_regs(list:TAsmList);
  1873. begin
  1874. { Pure assembler routines need to save the registers themselves }
  1875. if (po_assembler in current_procinfo.procdef.procoptions) then
  1876. exit;
  1877. { oldfpccall expects all registers to be destroyed }
  1878. if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then
  1879. cg.g_save_standard_registers(list);
  1880. end;
  1881. procedure gen_restore_used_regs(list:TAsmList);
  1882. begin
  1883. { Pure assembler routines need to save the registers themselves }
  1884. if (po_assembler in current_procinfo.procdef.procoptions) then
  1885. exit;
  1886. { oldfpccall expects all registers to be destroyed }
  1887. if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then
  1888. cg.g_restore_standard_registers(list);
  1889. end;
  1890. procedure gen_got_load(list : TAsmList);
  1891. begin
  1892. { if loading got is necessary for more cpus, it can be moved
  1893. to the cg }
  1894. {$ifdef i386}
  1895. { allocate PIC register }
  1896. if (cs_create_pic in current_settings.moduleswitches) and
  1897. (tf_pic_uses_got in target_info.flags) and
  1898. (pi_needs_got in current_procinfo.flags) and
  1899. not(po_kylixlocal in current_procinfo.procdef.procoptions) then
  1900. begin
  1901. current_module.requires_ebx_pic_helper:=true;
  1902. cg.a_call_name_static(list,'fpc_geteipasebx');
  1903. list.concat(taicpu.op_sym_ofs_reg(A_ADD,S_L,current_asmdata.RefAsmSymbol('_GLOBAL_OFFSET_TABLE_'),0,NR_PIC_OFFSET_REG));
  1904. list.concat(tai_regalloc.alloc(NR_PIC_OFFSET_REG,nil));
  1905. { ecx could be used in leave procedures }
  1906. current_procinfo.got:=NR_EBX;
  1907. end;
  1908. {$endif i386}
  1909. end;
  1910. {****************************************************************************
  1911. External handling
  1912. ****************************************************************************}
  1913. procedure gen_external_stub(list:TAsmList;pd:tprocdef;const externalname:string);
  1914. var
  1915. ref : treference;
  1916. sym : tasmsymbol;
  1917. begin
  1918. { add the procedure to the al_procedures }
  1919. maybe_new_object_file(list);
  1920. new_section(list,sec_code,lower(pd.mangledname),current_settings.alignment.procalign);
  1921. list.concat(Tai_align.create(current_settings.alignment.procalign));
  1922. if (po_global in pd.procoptions) then
  1923. list.concat(Tai_symbol.createname_global(pd.mangledname,AT_FUNCTION,0))
  1924. else
  1925. list.concat(Tai_symbol.createname(pd.mangledname,AT_FUNCTION,0));
  1926. {$ifdef x86}
  1927. { fix this for other CPUs as well }
  1928. sym:=current_asmdata.RefAsmSymbol(externalname);
  1929. reference_reset_symbol(ref,sym,0);
  1930. { create pic'ed? }
  1931. if cs_create_pic in current_settings.moduleswitches then
  1932. begin
  1933. { it could be that we're called from a procedure not having the
  1934. got loaded
  1935. }
  1936. gen_got_load(list);
  1937. ref.refaddr:=addr_pic;
  1938. end
  1939. else
  1940. ref.refaddr:=addr_full;
  1941. list.concat(taicpu.op_ref(A_JMP,S_NO,ref));
  1942. {$else x86}
  1943. cg.a_jmp_name(list,externalname);
  1944. {$endif x86}
  1945. end;
  1946. {****************************************************************************
  1947. Const Data
  1948. ****************************************************************************}
  1949. procedure insertbssdata(sym : tstaticvarsym);
  1950. var
  1951. l : aint;
  1952. varalign : shortint;
  1953. storefilepos : tfileposinfo;
  1954. list : TAsmList;
  1955. sectype : TAsmSectiontype;
  1956. begin
  1957. storefilepos:=current_filepos;
  1958. current_filepos:=sym.fileinfo;
  1959. l:=sym.getsize;
  1960. if tf_section_threadvars in target_info.flags then
  1961. begin
  1962. if (vo_is_thread_var in sym.varoptions) then
  1963. begin
  1964. list:=current_asmdata.asmlists[al_threadvars];
  1965. sectype:=sec_threadvar;
  1966. end
  1967. else
  1968. begin
  1969. list:=current_asmdata.asmlists[al_globals];
  1970. sectype:=sec_bss;
  1971. end;
  1972. end
  1973. else
  1974. begin
  1975. if (vo_is_thread_var in sym.varoptions) then
  1976. inc(l,sizeof(aint));
  1977. list:=current_asmdata.asmlists[al_globals];
  1978. sectype:=sec_bss;
  1979. end;
  1980. varalign:=var_align(size_2_align(l));
  1981. maybe_new_object_file(list);
  1982. new_section(list,sectype,lower(sym.mangledname),varalign);
  1983. if (sym.owner.symtabletype=globalsymtable) or
  1984. maybe_smartlink_symbol or
  1985. DLLSource or
  1986. (assigned(current_procinfo) and
  1987. (po_inline in current_procinfo.procdef.procoptions)) or
  1988. (vo_is_public in sym.varoptions) then
  1989. list.concat(Tai_datablock.create_global(sym.mangledname,l))
  1990. else
  1991. list.concat(Tai_datablock.create(sym.mangledname,l));
  1992. current_filepos:=storefilepos;
  1993. end;
  1994. procedure gen_alloc_symtable(list:TAsmList;st:TSymtable);
  1995. procedure setlocalloc(vs:tabstractnormalvarsym);
  1996. begin
  1997. if cs_asm_source in current_settings.globalswitches then
  1998. begin
  1999. case vs.initialloc.loc of
  2000. LOC_REFERENCE :
  2001. begin
  2002. if not assigned(vs.initialloc.reference.symbol) then
  2003. list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at '+
  2004. std_regname(vs.initialloc.reference.base)+tostr_with_plus(vs.initialloc.reference.offset))));
  2005. end;
  2006. end;
  2007. end;
  2008. vs.localloc:=vs.initialloc;
  2009. end;
  2010. var
  2011. i : longint;
  2012. sym : tsym;
  2013. vs : tabstractnormalvarsym;
  2014. isaddr : boolean;
  2015. begin
  2016. for i:=0 to st.SymList.Count-1 do
  2017. begin
  2018. sym:=tsym(st.SymList[i]);
  2019. case sym.typ of
  2020. staticvarsym :
  2021. begin
  2022. vs:=tabstractnormalvarsym(sym);
  2023. { The code in laodnode.pass_generatecode will create the
  2024. LOC_REFERENCE instead for all none register variables. This is
  2025. required because we can't store an asmsymbol in the localloc because
  2026. the asmsymbol is invalid after an unit is compiled. This gives
  2027. problems when this procedure is inlined in an other unit (PFV) }
  2028. if vs.is_regvar(false) then
  2029. begin
  2030. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
  2031. vs.initialloc.size:=def_cgsize(vs.vardef);
  2032. gen_alloc_regvar(list,vs);
  2033. setlocalloc(vs);
  2034. end;
  2035. end;
  2036. paravarsym :
  2037. begin
  2038. vs:=tabstractnormalvarsym(sym);
  2039. { Parameters passed to assembler procedures need to be kept
  2040. in the original location }
  2041. if (po_assembler in current_procinfo.procdef.procoptions) then
  2042. tparavarsym(vs).paraloc[calleeside].get_location(vs.initialloc)
  2043. else
  2044. begin
  2045. isaddr:=paramanager.push_addr_param(vs.varspez,vs.vardef,current_procinfo.procdef.proccalloption);
  2046. if isaddr then
  2047. vs.initialloc.size:=OS_ADDR
  2048. else
  2049. vs.initialloc.size:=def_cgsize(vs.vardef);
  2050. if vs.is_regvar(isaddr) then
  2051. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable]
  2052. else
  2053. begin
  2054. vs.initialloc.loc:=LOC_REFERENCE;
  2055. { Reuse the parameter location for values to are at a single location on the stack }
  2056. if paramanager.param_use_paraloc(tparavarsym(sym).paraloc[calleeside]) then
  2057. begin
  2058. reference_reset_base(vs.initialloc.reference,tparavarsym(sym).paraloc[calleeside].location^.reference.index,
  2059. tparavarsym(sym).paraloc[calleeside].location^.reference.offset);
  2060. end
  2061. else
  2062. begin
  2063. if isaddr then
  2064. tg.GetLocal(list,sizeof(aint),voidpointertype,vs.initialloc.reference)
  2065. else
  2066. tg.GetLocal(list,vs.getsize,tparavarsym(sym).paraloc[calleeside].alignment,vs.vardef,vs.initialloc.reference);
  2067. end;
  2068. end;
  2069. end;
  2070. setlocalloc(vs);
  2071. end;
  2072. localvarsym :
  2073. begin
  2074. vs:=tabstractnormalvarsym(sym);
  2075. vs.initialloc.size:=def_cgsize(vs.vardef);
  2076. if vs.is_regvar(false) then
  2077. begin
  2078. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
  2079. gen_alloc_regvar(list,vs);
  2080. end
  2081. else
  2082. begin
  2083. vs.initialloc.loc:=LOC_REFERENCE;
  2084. tg.GetLocal(list,vs.getsize,vs.vardef,vs.initialloc.reference);
  2085. end;
  2086. setlocalloc(vs);
  2087. end;
  2088. end;
  2089. end;
  2090. end;
  2091. procedure add_regvars(var rv: tusedregvars; const location: tlocation);
  2092. begin
  2093. case location.loc of
  2094. LOC_CREGISTER:
  2095. {$ifndef cpu64bit}
  2096. if location.size in [OS_64,OS_S64] then
  2097. begin
  2098. rv.intregvars.addnodup(getsupreg(location.register64.reglo));
  2099. rv.intregvars.addnodup(getsupreg(location.register64.reghi));
  2100. end
  2101. else
  2102. {$endif cpu64bit}
  2103. rv.intregvars.addnodup(getsupreg(location.register));
  2104. LOC_CFPUREGISTER:
  2105. rv.fpuregvars.addnodup(getsupreg(location.register));
  2106. LOC_CMMREGISTER:
  2107. rv.mmregvars.addnodup(getsupreg(location.register));
  2108. end;
  2109. end;
  2110. function do_get_used_regvars(var n: tnode; arg: pointer): foreachnoderesult;
  2111. var
  2112. rv: pusedregvars absolute arg;
  2113. begin
  2114. case (n.nodetype) of
  2115. temprefn:
  2116. { We only have to synchronise a tempnode before a loop if it is }
  2117. { not created inside the loop, and only synchronise after the }
  2118. { loop if it's not destroyed inside the loop. If it's created }
  2119. { before the loop and not yet destroyed, then before the loop }
  2120. { is secondpassed tempinfo^.valid will be true, and we get the }
  2121. { correct registers. If it's not destroyed inside the loop, }
  2122. { then after the loop has been secondpassed tempinfo^.valid }
  2123. { be true and we also get the right registers. In other cases, }
  2124. { tempinfo^.valid will be false and so we do not add }
  2125. { unnecessary registers. This way, we don't have to look at }
  2126. { tempcreate and tempdestroy nodes to get this info (JM) }
  2127. if (ttemprefnode(n).tempinfo^.valid) then
  2128. add_regvars(rv^,ttemprefnode(n).tempinfo^.location);
  2129. loadn:
  2130. if (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
  2131. add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc);
  2132. vecn:
  2133. { range checks sometimes need the high parameter }
  2134. if (cs_check_range in current_settings.localswitches) and
  2135. (is_open_array(tvecnode(n).left.resultdef) or
  2136. is_array_of_const(tvecnode(n).left.resultdef)) and
  2137. not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  2138. add_regvars(rv^,tabstractnormalvarsym(get_high_value_sym(tparavarsym(tloadnode(tvecnode(n).left).symtableentry))).localloc)
  2139. end;
  2140. result := fen_true;
  2141. end;
  2142. procedure get_used_regvars(n: tnode; var rv: tusedregvars);
  2143. begin
  2144. foreachnodestatic(n,@do_get_used_regvars,@rv);
  2145. end;
  2146. (*
  2147. See comments at declaration of pusedregvarscommon
  2148. function do_get_used_regvars_common(var n: tnode; arg: pointer): foreachnoderesult;
  2149. var
  2150. rv: pusedregvarscommon absolute arg;
  2151. begin
  2152. if (n.nodetype = loadn) and
  2153. (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
  2154. with tabstractnormalvarsym(tloadnode(n).symtableentry).localloc do
  2155. case loc of
  2156. LOC_CREGISTER:
  2157. { if not yet encountered in this node tree }
  2158. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  2159. { but nevertheless already encountered somewhere }
  2160. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  2161. { then it's a regvar used in two or more node trees }
  2162. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  2163. LOC_CFPUREGISTER:
  2164. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  2165. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  2166. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  2167. LOC_CMMREGISTER:
  2168. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  2169. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  2170. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  2171. end;
  2172. result := fen_true;
  2173. end;
  2174. procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
  2175. begin
  2176. rv.myregvars.intregvars.clear;
  2177. rv.myregvars.fpuregvars.clear;
  2178. rv.myregvars.mmregvars.clear;
  2179. foreachnodestatic(n,@do_get_used_regvars_common,@rv);
  2180. end;
  2181. *)
  2182. procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars);
  2183. var
  2184. count: longint;
  2185. begin
  2186. for count := 1 to rv.intregvars.length do
  2187. cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.readidx(count-1),R_SUBWHOLE));
  2188. for count := 1 to rv.fpuregvars.length do
  2189. cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.readidx(count-1),R_SUBWHOLE));
  2190. for count := 1 to rv.mmregvars.length do
  2191. cg.a_reg_sync(list,newreg(R_MMREGISTER,rv.mmregvars.readidx(count-1),R_SUBWHOLE));
  2192. end;
  2193. {*****************************************************************************
  2194. SSA support
  2195. *****************************************************************************}
  2196. type
  2197. preplaceregrec = ^treplaceregrec;
  2198. treplaceregrec = record
  2199. old, new: tregister;
  2200. {$ifndef cpu64bit}
  2201. oldhi, newhi: tregister;
  2202. {$endif cpu64bit}
  2203. ressym: tsym;
  2204. end;
  2205. function doreplace(var n: tnode; para: pointer): foreachnoderesult;
  2206. var
  2207. rr: preplaceregrec absolute para;
  2208. begin
  2209. result := fen_false;
  2210. case n.nodetype of
  2211. loadn:
  2212. begin
  2213. if (tabstractvarsym(tloadnode(n).symtableentry).varoptions * [vo_is_dll_var, vo_is_thread_var] = []) and
  2214. not assigned(tloadnode(n).left) and
  2215. (((tloadnode(n).symtableentry <> rr^.ressym) and
  2216. not(vo_is_funcret in tabstractvarsym(tloadnode(n).symtableentry).varoptions)) or
  2217. not(fc_exit in flowcontrol)) and
  2218. (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
  2219. (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register = rr^.old) then
  2220. begin
  2221. {$ifndef cpu64bit}
  2222. { it's possible a 64 bit location was shifted and/xor typecasted }
  2223. { in a 32 bit value, so only 1 register was left in the location }
  2224. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.size in [OS_64,OS_S64]) then
  2225. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi = rr^.oldhi) then
  2226. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi := rr^.newhi
  2227. else
  2228. exit;
  2229. {$endif cpu64bit}
  2230. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register := rr^.new;
  2231. result := fen_norecurse_true;
  2232. end;
  2233. end;
  2234. temprefn:
  2235. begin
  2236. if (ttemprefnode(n).tempinfo^.valid) and
  2237. (ttemprefnode(n).tempinfo^.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
  2238. (ttemprefnode(n).tempinfo^.location.register = rr^.old) then
  2239. begin
  2240. {$ifndef cpu64bit}
  2241. { it's possible a 64 bit location was shifted and/xor typecasted }
  2242. { in a 32 bit value, so only 1 register was left in the location }
  2243. if (ttemprefnode(n).tempinfo^.location.size in [OS_64,OS_S64]) then
  2244. if (ttemprefnode(n).tempinfo^.location.register64.reghi = rr^.oldhi) then
  2245. ttemprefnode(n).tempinfo^.location.register64.reghi := rr^.newhi
  2246. else
  2247. exit;
  2248. {$endif cpu64bit}
  2249. ttemprefnode(n).tempinfo^.location.register := rr^.new;
  2250. result := fen_norecurse_true;
  2251. end;
  2252. end;
  2253. { optimize the searching a bit }
  2254. derefn,addrn,
  2255. calln,inlinen,casen,
  2256. addn,subn,muln,
  2257. andn,orn,xorn,
  2258. ltn,lten,gtn,gten,equaln,unequaln,
  2259. slashn,divn,shrn,shln,notn,
  2260. inn,
  2261. asn,isn:
  2262. result := fen_norecurse_false;
  2263. end;
  2264. end;
  2265. procedure maybechangeloadnodereg(list: TAsmList; var n: tnode; reload: boolean);
  2266. var
  2267. rr: treplaceregrec;
  2268. begin
  2269. if not (n.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) or
  2270. ([fc_inflowcontrol,fc_gotolabel] * flowcontrol <> []) then
  2271. exit;
  2272. rr.old := n.location.register;
  2273. rr.ressym := nil;
  2274. {$ifndef cpu64bit}
  2275. rr.oldhi := NR_NO;
  2276. {$endif cpu64bit}
  2277. case n.location.loc of
  2278. LOC_CREGISTER:
  2279. begin
  2280. {$ifndef cpu64bit}
  2281. if (n.location.size in [OS_64,OS_S64]) then
  2282. begin
  2283. rr.oldhi := n.location.register64.reghi;
  2284. rr.new := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  2285. rr.newhi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  2286. end
  2287. else
  2288. {$endif cpu64bit}
  2289. rr.new := cg.getintregister(current_asmdata.CurrAsmList,n.location.size);
  2290. end;
  2291. LOC_CFPUREGISTER:
  2292. rr.new := cg.getfpuregister(current_asmdata.CurrAsmList,n.location.size);
  2293. {$ifdef SUPPORT_MMX}
  2294. LOC_CMMXREGISTER:
  2295. rr.new := tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList);
  2296. {$endif SUPPORT_MMX}
  2297. LOC_CMMREGISTER:
  2298. rr.new := cg.getmmregister(current_asmdata.CurrAsmList,n.location.size);
  2299. else
  2300. exit;
  2301. end;
  2302. if (current_procinfo.procdef.funcretloc[calleeside].loc<>LOC_VOID) and
  2303. assigned(current_procinfo.procdef.funcretsym) and
  2304. (tabstractvarsym(current_procinfo.procdef.funcretsym).refs <> 0) then
  2305. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  2306. rr.ressym:=tsym(current_procinfo.procdef.parast.Find('self'))
  2307. else
  2308. rr.ressym:=current_procinfo.procdef.funcretsym;
  2309. if not foreachnodestatic(n,@doreplace,@rr) then
  2310. exit;
  2311. if reload then
  2312. case n.location.loc of
  2313. LOC_CREGISTER:
  2314. begin
  2315. {$ifndef cpu64bit}
  2316. if (n.location.size in [OS_64,OS_S64]) then
  2317. cg64.a_load64_reg_reg(list,n.location.register64,joinreg64(rr.new,rr.newhi))
  2318. else
  2319. {$endif cpu64bit}
  2320. cg.a_load_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new);
  2321. end;
  2322. LOC_CFPUREGISTER:
  2323. cg.a_loadfpu_reg_reg(list,n.location.size,n.location.register,rr.new);
  2324. {$ifdef SUPPORT_MMX}
  2325. LOC_CMMXREGISTER:
  2326. cg.a_loadmm_reg_reg(list,OS_M64,OS_M64,n.location.register,rr.new,nil);
  2327. {$endif SUPPORT_MMX}
  2328. LOC_CMMREGISTER:
  2329. cg.a_loadmm_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new,nil);
  2330. else
  2331. internalerror(2006090920);
  2332. end;
  2333. { now that we've change the loadn/temp, also change the node result location }
  2334. {$ifndef cpu64bit}
  2335. if (n.location.size in [OS_64,OS_S64]) then
  2336. begin
  2337. n.location.register64.reglo := rr.new;
  2338. n.location.register64.reghi := rr.newhi;
  2339. end
  2340. else
  2341. {$endif cpu64bit}
  2342. n.location.register := rr.new;
  2343. end;
  2344. procedure gen_free_symtable(list:TAsmList;st:TSymtable);
  2345. var
  2346. i : longint;
  2347. sym : tsym;
  2348. begin
  2349. for i:=0 to st.SymList.Count-1 do
  2350. begin
  2351. sym:=tsym(st.SymList[i]);
  2352. if (sym.typ in [staticvarsym,localvarsym,paravarsym]) then
  2353. begin
  2354. with tabstractnormalvarsym(sym) do
  2355. begin
  2356. { Note: We need to keep the data available in memory
  2357. for the sub procedures that can access local data
  2358. in the parent procedures }
  2359. case localloc.loc of
  2360. LOC_CREGISTER :
  2361. {$ifndef cpu64bit}
  2362. if (pi_has_goto in current_procinfo.flags) then
  2363. if def_cgsize(vardef) in [OS_64,OS_S64] then
  2364. begin
  2365. cg.a_reg_sync(list,localloc.register64.reglo);
  2366. cg.a_reg_sync(list,localloc.register64.reghi);
  2367. end
  2368. else
  2369. {$endif cpu64bit}
  2370. cg.a_reg_sync(list,localloc.register);
  2371. LOC_CFPUREGISTER,
  2372. LOC_CMMREGISTER:
  2373. if (pi_has_goto in current_procinfo.flags) then
  2374. cg.a_reg_sync(list,localloc.register);
  2375. LOC_REFERENCE :
  2376. begin
  2377. if typ in [localvarsym,paravarsym] then
  2378. tg.Ungetlocal(list,localloc.reference);
  2379. end;
  2380. end;
  2381. end;
  2382. end;
  2383. end;
  2384. end;
  2385. procedure gen_intf_wrapper(list:TAsmList;_class:tobjectdef);
  2386. var
  2387. i,j : longint;
  2388. tmps : string;
  2389. pd : TProcdef;
  2390. ImplIntf : TImplementedInterface;
  2391. begin
  2392. for i:=0 to _class.ImplementedInterfaces.count-1 do
  2393. begin
  2394. ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]);
  2395. if (ImplIntf=ImplIntf.VtblImplIntf) and
  2396. assigned(ImplIntf.ProcDefs) then
  2397. begin
  2398. for j:=0 to ImplIntf.ProcDefs.Count-1 do
  2399. begin
  2400. pd:=TProcdef(ImplIntf.ProcDefs[j]);
  2401. tmps:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+
  2402. ImplIntf.IntfDef.objname^+'_$_'+tostr(j)+'_$_'+pd.mangledname);
  2403. { create wrapper code }
  2404. new_section(list,sec_code,tmps,0);
  2405. cg.init_register_allocators;
  2406. cg.g_intf_wrapper(list,pd,tmps,ImplIntf.ioffset);
  2407. cg.done_register_allocators;
  2408. end;
  2409. end;
  2410. end;
  2411. end;
  2412. procedure gen_intf_wrappers(list:TAsmList;st:TSymtable);
  2413. var
  2414. i : longint;
  2415. def : tdef;
  2416. begin
  2417. for i:=0 to st.DefList.Count-1 do
  2418. begin
  2419. def:=tdef(st.DefList[i]);
  2420. if is_class(def) then
  2421. gen_intf_wrapper(list,tobjectdef(def));
  2422. end;
  2423. end;
  2424. procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister);
  2425. var
  2426. href : treference;
  2427. begin
  2428. if is_object(objdef) then
  2429. begin
  2430. case selfloc.loc of
  2431. LOC_CREFERENCE,
  2432. LOC_REFERENCE:
  2433. begin
  2434. reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset);
  2435. cg.a_loadaddr_ref_reg(list,selfloc.reference,href.base);
  2436. end;
  2437. else
  2438. internalerror(200305056);
  2439. end;
  2440. end
  2441. else
  2442. begin
  2443. case selfloc.loc of
  2444. LOC_REGISTER:
  2445. begin
  2446. {$ifdef cpu_uses_separate_address_registers}
  2447. if getregtype(left.location.register)<>R_ADDRESSREGISTER then
  2448. begin
  2449. reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset);
  2450. cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,selfloc.register,href.base);
  2451. end
  2452. else
  2453. {$endif cpu_uses_separate_address_registers}
  2454. reference_reset_base(href,selfloc.register,objdef.vmt_offset);
  2455. end;
  2456. LOC_CREGISTER,
  2457. LOC_CREFERENCE,
  2458. LOC_REFERENCE:
  2459. begin
  2460. reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset);
  2461. cg.a_load_loc_reg(list,OS_ADDR,selfloc,href.base);
  2462. end;
  2463. else
  2464. internalerror(200305057);
  2465. end;
  2466. end;
  2467. vmtreg:=cg.getaddressregister(list);
  2468. cg.g_maybe_testself(list,href.base);
  2469. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,vmtreg);
  2470. { test validity of VMT }
  2471. if not(is_interface(objdef)) and
  2472. not(is_cppclass(objdef)) then
  2473. cg.g_maybe_testvmt(list,vmtreg,objdef);
  2474. end;
  2475. function getprocalign : shortint;
  2476. begin
  2477. { gprof uses 16 byte granularity }
  2478. if (cs_profile in current_settings.moduleswitches) then
  2479. result:=16
  2480. else
  2481. result:=current_settings.alignment.procalign;
  2482. end;
  2483. procedure gen_pic_helpers(list : TAsmList);
  2484. var
  2485. href : treference;
  2486. begin
  2487. { if other cpus require such helpers as well, it can be solved more cleaner }
  2488. {$ifdef i386}
  2489. if current_module.requires_ebx_pic_helper then
  2490. begin
  2491. new_section(list,sec_code,'fpc_geteipasebx',0);
  2492. list.concat(tai_symbol.Createname('fpc_geteipasebx',AT_FUNCTION,getprocalign));
  2493. reference_reset(href);
  2494. href.base:=NR_ESP;
  2495. list.concat(taicpu.op_ref_reg(A_MOV,S_L,href,NR_EBX));
  2496. list.concat(taicpu.op_none(A_RET,S_NO));
  2497. end;
  2498. if current_module.requires_ecx_pic_helper then
  2499. begin
  2500. new_section(list,sec_code,'fpc_geteipasecx',0);
  2501. list.concat(tai_symbol.Createname('fpc_geteipasecx',AT_FUNCTION,getprocalign));
  2502. reference_reset(href);
  2503. href.base:=NR_ESP;
  2504. list.concat(taicpu.op_ref_reg(A_MOV,S_L,href,NR_ECX));
  2505. list.concat(taicpu.op_none(A_RET,S_NO));
  2506. end;
  2507. {$endif i386}
  2508. end;
  2509. end.