ncgutil.pas 122 KB

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