ncgutil.pas 114 KB

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