ncgutil.pas 109 KB

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