ncgutil.pas 114 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861
  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. begin
  1828. { the actual profile code can clobber some registers,
  1829. therefore if the context must be saved, do it before
  1830. the actual call to the profile code
  1831. }
  1832. if (cs_profile in current_settings.moduleswitches) and
  1833. not(po_assembler in current_procinfo.procdef.procoptions) then
  1834. begin
  1835. { non-win32 can call mcout even in main }
  1836. if not (target_info.system in [system_i386_win32,system_i386_wdosx]) or
  1837. not (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1838. begin
  1839. cg.g_profilecode(list);
  1840. end;
  1841. end;
  1842. { call startup helpers from main program }
  1843. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1844. begin
  1845. { initialize units }
  1846. cg.allocallcpuregisters(list);
  1847. if not(current_module.islibrary) then
  1848. cg.a_call_name(list,'FPC_INITIALIZEUNITS',false)
  1849. else
  1850. cg.a_call_name(list,'FPC_LIBINITIALIZEUNITS',false);
  1851. cg.deallocallcpuregisters(list);
  1852. end;
  1853. list.concat(Tai_force_line.Create);
  1854. {$ifdef OLDREGVARS}
  1855. load_regvars(list,nil);
  1856. {$endif OLDREGVARS}
  1857. end;
  1858. procedure gen_exit_code(list:TAsmList);
  1859. begin
  1860. { call __EXIT for main program }
  1861. if (not DLLsource) and
  1862. (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1863. cg.a_call_name(list,'FPC_DO_EXIT',false);
  1864. end;
  1865. {****************************************************************************
  1866. Entry/Exit
  1867. ****************************************************************************}
  1868. function has_alias_name(pd:tprocdef;const s:string):boolean;
  1869. var
  1870. item : TCmdStrListItem;
  1871. begin
  1872. result:=true;
  1873. if pd.mangledname=s then
  1874. exit;
  1875. item := TCmdStrListItem(pd.aliasnames.first);
  1876. while assigned(item) do
  1877. begin
  1878. if item.str=s then
  1879. exit;
  1880. item := TCmdStrListItem(item.next);
  1881. end;
  1882. result:=false;
  1883. end;
  1884. procedure alloc_proc_symbol(pd: tprocdef);
  1885. var
  1886. item : TCmdStrListItem;
  1887. begin
  1888. item := TCmdStrListItem(pd.aliasnames.first);
  1889. while assigned(item) do
  1890. begin
  1891. current_asmdata.DefineAsmSymbol(item.str,AB_GLOBAL,AT_FUNCTION);
  1892. item := TCmdStrListItem(item.next);
  1893. end;
  1894. end;
  1895. procedure gen_proc_symbol(list:TAsmList);
  1896. var
  1897. item,
  1898. previtem : TCmdStrListItem;
  1899. begin
  1900. previtem:=nil;
  1901. item := TCmdStrListItem(current_procinfo.procdef.aliasnames.first);
  1902. while assigned(item) do
  1903. begin
  1904. { "double link" all procedure entry symbols via .reference }
  1905. { directives on darwin, because otherwise the linker }
  1906. { sometimes strips the procedure if only on of the symbols }
  1907. { is referenced }
  1908. if assigned(previtem) and
  1909. (target_info.system in systems_darwin) then
  1910. list.concat(tai_directive.create(asd_reference,item.str));
  1911. if (cs_profile in current_settings.moduleswitches) or
  1912. (po_global in current_procinfo.procdef.procoptions) then
  1913. list.concat(Tai_symbol.createname_global(item.str,AT_FUNCTION,0))
  1914. else
  1915. list.concat(Tai_symbol.createname(item.str,AT_FUNCTION,0));
  1916. if assigned(previtem) and
  1917. (target_info.system in systems_darwin) then
  1918. list.concat(tai_directive.create(asd_reference,previtem.str));
  1919. if tf_use_function_relative_addresses in target_info.flags then
  1920. list.concat(Tai_function_name.create(item.str));
  1921. previtem:=item;
  1922. item := TCmdStrListItem(item.next);
  1923. end;
  1924. current_procinfo.procdef.procstarttai:=tai(list.last);
  1925. end;
  1926. procedure gen_proc_symbol_end(list:TAsmList);
  1927. begin
  1928. list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
  1929. current_procinfo.procdef.procendtai:=tai(list.last);
  1930. if (current_module.islibrary) then
  1931. if (current_procinfo.procdef.proctypeoption = potype_proginit) then
  1932. exportlib.setinitname(list,current_procinfo.procdef.mangledname);
  1933. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1934. begin
  1935. if (target_info.system in (systems_darwin+[system_powerpc_macos])) and
  1936. not(current_module.islibrary) then
  1937. begin
  1938. list.concat(tai_section.create(sec_code,'',4));
  1939. list.concat(tai_symbol.createname_global(
  1940. target_info.cprefix+mainaliasname,AT_FUNCTION,0));
  1941. { keep argc, argv and envp properly on the stack }
  1942. cg.a_jmp_name(list,target_info.cprefix+'FPC_SYSTEMMAIN');
  1943. end;
  1944. end;
  1945. end;
  1946. procedure gen_proc_entry_code(list:TAsmList);
  1947. var
  1948. hitemp,
  1949. lotemp : longint;
  1950. begin
  1951. { generate call frame marker for dwarf call frame info }
  1952. current_asmdata.asmcfi.start_frame(list);
  1953. { All temps are know, write offsets used for information }
  1954. if (cs_asm_source in current_settings.globalswitches) then
  1955. begin
  1956. if tg.direction>0 then
  1957. begin
  1958. lotemp:=current_procinfo.tempstart;
  1959. hitemp:=tg.lasttemp;
  1960. end
  1961. else
  1962. begin
  1963. lotemp:=tg.lasttemp;
  1964. hitemp:=current_procinfo.tempstart;
  1965. end;
  1966. list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
  1967. tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
  1968. end;
  1969. { generate target specific proc entry code }
  1970. cg.g_proc_entry(list,current_procinfo.calc_stackframe_size,(po_nostackframe in current_procinfo.procdef.procoptions));
  1971. end;
  1972. procedure gen_proc_exit_code(list:TAsmList);
  1973. var
  1974. parasize : longint;
  1975. begin
  1976. { c style clearstack does not need to remove parameters from the stack, only the
  1977. return value when it was pushed by arguments }
  1978. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1979. begin
  1980. parasize:=0;
  1981. if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption) then
  1982. inc(parasize,sizeof(pint));
  1983. end
  1984. else
  1985. parasize:=current_procinfo.para_stack_size;
  1986. { generate target specific proc exit code }
  1987. cg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
  1988. { release return registers, needed for optimizer }
  1989. if not is_void(current_procinfo.procdef.returndef) then
  1990. location_free(list,current_procinfo.procdef.funcretloc[calleeside]);
  1991. { end of frame marker for call frame info }
  1992. current_asmdata.asmcfi.end_frame(list);
  1993. end;
  1994. procedure gen_stack_check_size_para(list:TAsmList);
  1995. var
  1996. paraloc1 : tcgpara;
  1997. begin
  1998. paraloc1.init;
  1999. paramanager.getintparaloc(pocall_default,1,paraloc1);
  2000. paramanager.allocparaloc(list,paraloc1);
  2001. cg.a_param_const(list,OS_INT,current_procinfo.calc_stackframe_size,paraloc1);
  2002. paramanager.freeparaloc(list,paraloc1);
  2003. paraloc1.done;
  2004. end;
  2005. procedure gen_stack_check_call(list:TAsmList);
  2006. var
  2007. paraloc1 : tcgpara;
  2008. begin
  2009. paraloc1.init;
  2010. { Also alloc the register needed for the parameter }
  2011. paramanager.getintparaloc(pocall_default,1,paraloc1);
  2012. paramanager.allocparaloc(list,paraloc1);
  2013. paramanager.freeparaloc(list,paraloc1);
  2014. { Call the helper }
  2015. cg.allocallcpuregisters(list);
  2016. cg.a_call_name(list,'FPC_STACKCHECK',false);
  2017. cg.deallocallcpuregisters(list);
  2018. paraloc1.done;
  2019. end;
  2020. procedure gen_save_used_regs(list:TAsmList);
  2021. begin
  2022. { Pure assembler routines need to save the registers themselves }
  2023. if (po_assembler in current_procinfo.procdef.procoptions) then
  2024. exit;
  2025. { oldfpccall expects all registers to be destroyed }
  2026. if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then
  2027. cg.g_save_registers(list);
  2028. end;
  2029. procedure gen_restore_used_regs(list:TAsmList);
  2030. begin
  2031. { Pure assembler routines need to save the registers themselves }
  2032. if (po_assembler in current_procinfo.procdef.procoptions) then
  2033. exit;
  2034. { oldfpccall expects all registers to be destroyed }
  2035. if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then
  2036. cg.g_restore_registers(list);
  2037. end;
  2038. {****************************************************************************
  2039. External handling
  2040. ****************************************************************************}
  2041. procedure gen_external_stub(list:TAsmList;pd:tprocdef;const externalname:string);
  2042. begin
  2043. { add the procedure to the al_procedures }
  2044. maybe_new_object_file(list);
  2045. new_section(list,sec_code,lower(pd.mangledname),current_settings.alignment.procalign);
  2046. list.concat(Tai_align.create(current_settings.alignment.procalign));
  2047. if (po_global in pd.procoptions) then
  2048. list.concat(Tai_symbol.createname_global(pd.mangledname,AT_FUNCTION,0))
  2049. else
  2050. list.concat(Tai_symbol.createname(pd.mangledname,AT_FUNCTION,0));
  2051. cg.g_external_wrapper(list,pd,externalname);
  2052. end;
  2053. {****************************************************************************
  2054. Const Data
  2055. ****************************************************************************}
  2056. procedure insertbssdata(sym : tstaticvarsym);
  2057. var
  2058. l : aint;
  2059. varalign : shortint;
  2060. storefilepos : tfileposinfo;
  2061. list : TAsmList;
  2062. sectype : TAsmSectiontype;
  2063. begin
  2064. storefilepos:=current_filepos;
  2065. current_filepos:=sym.fileinfo;
  2066. l:=sym.getsize;
  2067. varalign:=sym.vardef.alignment;
  2068. if (varalign=0) then
  2069. varalign:=l;
  2070. if tf_section_threadvars in target_info.flags then
  2071. begin
  2072. if (vo_is_thread_var in sym.varoptions) then
  2073. begin
  2074. list:=current_asmdata.asmlists[al_threadvars];
  2075. sectype:=sec_threadvar;
  2076. end
  2077. else
  2078. begin
  2079. list:=current_asmdata.asmlists[al_globals];
  2080. sectype:=sec_bss;
  2081. end;
  2082. end
  2083. else
  2084. begin
  2085. if (vo_is_thread_var in sym.varoptions) then
  2086. begin
  2087. inc(l,sizeof(pint));
  2088. { it doesn't help to set a higher alignment, as }
  2089. { the first sizeof(pint) bytes field will offset }
  2090. { everything anyway }
  2091. varalign:=sizeof(pint);
  2092. end;
  2093. list:=current_asmdata.asmlists[al_globals];
  2094. sectype:=sec_bss;
  2095. end;
  2096. varalign:=var_align(varalign);
  2097. maybe_new_object_file(list);
  2098. new_section(list,sectype,lower(sym.mangledname),varalign);
  2099. if (sym.owner.symtabletype=globalsymtable) or
  2100. create_smartlink or
  2101. DLLSource or
  2102. (assigned(current_procinfo) and
  2103. (po_inline in current_procinfo.procdef.procoptions)) or
  2104. (vo_is_public in sym.varoptions) then
  2105. list.concat(Tai_datablock.create_global(sym.mangledname,l))
  2106. else
  2107. list.concat(Tai_datablock.create(sym.mangledname,l));
  2108. current_filepos:=storefilepos;
  2109. end;
  2110. procedure gen_alloc_symtable(list:TAsmList;st:TSymtable);
  2111. procedure setlocalloc(vs:tabstractnormalvarsym);
  2112. begin
  2113. if cs_asm_source in current_settings.globalswitches then
  2114. begin
  2115. case vs.initialloc.loc of
  2116. LOC_REFERENCE :
  2117. begin
  2118. if not assigned(vs.initialloc.reference.symbol) then
  2119. list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at '+
  2120. std_regname(vs.initialloc.reference.base)+tostr_with_plus(vs.initialloc.reference.offset))));
  2121. end;
  2122. end;
  2123. end;
  2124. vs.localloc:=vs.initialloc;
  2125. end;
  2126. var
  2127. i : longint;
  2128. sym : tsym;
  2129. vs : tabstractnormalvarsym;
  2130. isaddr : boolean;
  2131. begin
  2132. for i:=0 to st.SymList.Count-1 do
  2133. begin
  2134. sym:=tsym(st.SymList[i]);
  2135. case sym.typ of
  2136. staticvarsym :
  2137. begin
  2138. vs:=tabstractnormalvarsym(sym);
  2139. { The code in loadnode.pass_generatecode will create the
  2140. LOC_REFERENCE instead for all none register variables. This is
  2141. required because we can't store an asmsymbol in the localloc because
  2142. the asmsymbol is invalid after an unit is compiled. This gives
  2143. problems when this procedure is inlined in an other unit (PFV) }
  2144. if vs.is_regvar(false) then
  2145. begin
  2146. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
  2147. vs.initialloc.size:=def_cgsize(vs.vardef);
  2148. gen_alloc_regvar(list,vs);
  2149. setlocalloc(vs);
  2150. end;
  2151. end;
  2152. paravarsym :
  2153. begin
  2154. vs:=tabstractnormalvarsym(sym);
  2155. { Parameters passed to assembler procedures need to be kept
  2156. in the original location }
  2157. if (po_assembler in current_procinfo.procdef.procoptions) then
  2158. tparavarsym(vs).paraloc[calleeside].get_location(vs.initialloc)
  2159. else
  2160. begin
  2161. isaddr:=paramanager.push_addr_param(vs.varspez,vs.vardef,current_procinfo.procdef.proccalloption);
  2162. if isaddr then
  2163. vs.initialloc.size:=OS_ADDR
  2164. else
  2165. vs.initialloc.size:=def_cgsize(vs.vardef);
  2166. if vs.is_regvar(isaddr) then
  2167. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable]
  2168. else
  2169. begin
  2170. vs.initialloc.loc:=LOC_REFERENCE;
  2171. { Reuse the parameter location for values to are at a single location on the stack }
  2172. if paramanager.param_use_paraloc(tparavarsym(sym).paraloc[calleeside]) then
  2173. begin
  2174. reference_reset_base(vs.initialloc.reference,tparavarsym(sym).paraloc[calleeside].location^.reference.index,
  2175. tparavarsym(sym).paraloc[calleeside].location^.reference.offset);
  2176. end
  2177. else
  2178. begin
  2179. if isaddr then
  2180. tg.GetLocal(list,sizeof(pint),voidpointertype,vs.initialloc.reference)
  2181. else
  2182. tg.GetLocal(list,vs.getsize,tparavarsym(sym).paraloc[calleeside].alignment,vs.vardef,vs.initialloc.reference);
  2183. end;
  2184. end;
  2185. end;
  2186. setlocalloc(vs);
  2187. end;
  2188. localvarsym :
  2189. begin
  2190. vs:=tabstractnormalvarsym(sym);
  2191. vs.initialloc.size:=def_cgsize(vs.vardef);
  2192. if (m_delphi in current_settings.modeswitches) and
  2193. (po_assembler in current_procinfo.procdef.procoptions) and
  2194. (vo_is_funcret in vs.varoptions) and
  2195. (vs.refs=0) then
  2196. begin
  2197. { not referenced, so don't allocate. Use dummy to }
  2198. { avoid ie's later on because of LOC_INVALID }
  2199. vs.initialloc.loc:=LOC_REGISTER;
  2200. vs.initialloc.size:=OS_INT;
  2201. vs.initialloc.register:=NR_FUNCTION_RESULT_REG;
  2202. end
  2203. else if vs.is_regvar(false) then
  2204. begin
  2205. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
  2206. gen_alloc_regvar(list,vs);
  2207. end
  2208. else
  2209. begin
  2210. vs.initialloc.loc:=LOC_REFERENCE;
  2211. tg.GetLocal(list,vs.getsize,vs.vardef,vs.initialloc.reference);
  2212. end;
  2213. setlocalloc(vs);
  2214. end;
  2215. end;
  2216. end;
  2217. end;
  2218. procedure add_regvars(var rv: tusedregvars; const location: tlocation);
  2219. begin
  2220. case location.loc of
  2221. LOC_CREGISTER:
  2222. {$ifndef cpu64bitalu}
  2223. if location.size in [OS_64,OS_S64] then
  2224. begin
  2225. rv.intregvars.addnodup(getsupreg(location.register64.reglo));
  2226. rv.intregvars.addnodup(getsupreg(location.register64.reghi));
  2227. end
  2228. else
  2229. {$endif not cpu64bitalu}
  2230. rv.intregvars.addnodup(getsupreg(location.register));
  2231. LOC_CFPUREGISTER:
  2232. rv.fpuregvars.addnodup(getsupreg(location.register));
  2233. LOC_CMMREGISTER:
  2234. rv.mmregvars.addnodup(getsupreg(location.register));
  2235. end;
  2236. end;
  2237. function do_get_used_regvars(var n: tnode; arg: pointer): foreachnoderesult;
  2238. var
  2239. rv: pusedregvars absolute arg;
  2240. begin
  2241. case (n.nodetype) of
  2242. temprefn:
  2243. { We only have to synchronise a tempnode before a loop if it is }
  2244. { not created inside the loop, and only synchronise after the }
  2245. { loop if it's not destroyed inside the loop. If it's created }
  2246. { before the loop and not yet destroyed, then before the loop }
  2247. { is secondpassed tempinfo^.valid will be true, and we get the }
  2248. { correct registers. If it's not destroyed inside the loop, }
  2249. { then after the loop has been secondpassed tempinfo^.valid }
  2250. { be true and we also get the right registers. In other cases, }
  2251. { tempinfo^.valid will be false and so we do not add }
  2252. { unnecessary registers. This way, we don't have to look at }
  2253. { tempcreate and tempdestroy nodes to get this info (JM) }
  2254. if (ti_valid in ttemprefnode(n).tempinfo^.flags) then
  2255. add_regvars(rv^,ttemprefnode(n).tempinfo^.location);
  2256. loadn:
  2257. if (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
  2258. add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc);
  2259. vecn:
  2260. { range checks sometimes need the high parameter }
  2261. if (cs_check_range in current_settings.localswitches) and
  2262. (is_open_array(tvecnode(n).left.resultdef) or
  2263. is_array_of_const(tvecnode(n).left.resultdef)) and
  2264. not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  2265. add_regvars(rv^,tabstractnormalvarsym(get_high_value_sym(tparavarsym(tloadnode(tvecnode(n).left).symtableentry))).localloc)
  2266. end;
  2267. result := fen_true;
  2268. end;
  2269. procedure get_used_regvars(n: tnode; var rv: tusedregvars);
  2270. begin
  2271. foreachnodestatic(n,@do_get_used_regvars,@rv);
  2272. end;
  2273. (*
  2274. See comments at declaration of pusedregvarscommon
  2275. function do_get_used_regvars_common(var n: tnode; arg: pointer): foreachnoderesult;
  2276. var
  2277. rv: pusedregvarscommon absolute arg;
  2278. begin
  2279. if (n.nodetype = loadn) and
  2280. (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
  2281. with tabstractnormalvarsym(tloadnode(n).symtableentry).localloc do
  2282. case loc of
  2283. LOC_CREGISTER:
  2284. { if not yet encountered in this node tree }
  2285. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  2286. { but nevertheless already encountered somewhere }
  2287. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  2288. { then it's a regvar used in two or more node trees }
  2289. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  2290. LOC_CFPUREGISTER:
  2291. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  2292. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  2293. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  2294. LOC_CMMREGISTER:
  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. end;
  2299. result := fen_true;
  2300. end;
  2301. procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
  2302. begin
  2303. rv.myregvars.intregvars.clear;
  2304. rv.myregvars.fpuregvars.clear;
  2305. rv.myregvars.mmregvars.clear;
  2306. foreachnodestatic(n,@do_get_used_regvars_common,@rv);
  2307. end;
  2308. *)
  2309. procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars);
  2310. var
  2311. count: longint;
  2312. begin
  2313. for count := 1 to rv.intregvars.length do
  2314. cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.readidx(count-1),R_SUBWHOLE));
  2315. for count := 1 to rv.fpuregvars.length do
  2316. cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.readidx(count-1),R_SUBWHOLE));
  2317. for count := 1 to rv.mmregvars.length do
  2318. cg.a_reg_sync(list,newreg(R_MMREGISTER,rv.mmregvars.readidx(count-1),R_SUBWHOLE));
  2319. end;
  2320. {*****************************************************************************
  2321. SSA support
  2322. *****************************************************************************}
  2323. type
  2324. preplaceregrec = ^treplaceregrec;
  2325. treplaceregrec = record
  2326. old, new: tregister;
  2327. {$ifndef cpu64bitalu}
  2328. oldhi, newhi: tregister;
  2329. {$endif not cpu64bitalu}
  2330. ressym: tsym;
  2331. end;
  2332. function doreplace(var n: tnode; para: pointer): foreachnoderesult;
  2333. var
  2334. rr: preplaceregrec absolute para;
  2335. begin
  2336. result := fen_false;
  2337. if (nf_is_funcret in n.flags) and (fc_exit in flowcontrol) then
  2338. exit;
  2339. case n.nodetype of
  2340. loadn:
  2341. begin
  2342. if (tabstractvarsym(tloadnode(n).symtableentry).varoptions * [vo_is_dll_var, vo_is_thread_var] = []) and
  2343. not assigned(tloadnode(n).left) and
  2344. (tloadnode(n).symtableentry <> rr^.ressym) and
  2345. (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
  2346. (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register = rr^.old) then
  2347. begin
  2348. {$ifndef cpu64bitalu}
  2349. { it's possible a 64 bit location was shifted and/xor typecasted }
  2350. { in a 32 bit value, so only 1 register was left in the location }
  2351. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.size in [OS_64,OS_S64]) then
  2352. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi = rr^.oldhi) then
  2353. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi := rr^.newhi
  2354. else
  2355. exit;
  2356. {$endif not cpu64bitalu}
  2357. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register := rr^.new;
  2358. result := fen_norecurse_true;
  2359. end;
  2360. end;
  2361. temprefn:
  2362. begin
  2363. if (ti_valid in ttemprefnode(n).tempinfo^.flags) and
  2364. (ttemprefnode(n).tempinfo^.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
  2365. (ttemprefnode(n).tempinfo^.location.register = rr^.old) then
  2366. begin
  2367. {$ifndef cpu64bitalu}
  2368. { it's possible a 64 bit location was shifted and/xor typecasted }
  2369. { in a 32 bit value, so only 1 register was left in the location }
  2370. if (ttemprefnode(n).tempinfo^.location.size in [OS_64,OS_S64]) then
  2371. if (ttemprefnode(n).tempinfo^.location.register64.reghi = rr^.oldhi) then
  2372. ttemprefnode(n).tempinfo^.location.register64.reghi := rr^.newhi
  2373. else
  2374. exit;
  2375. {$endif not cpu64bitalu}
  2376. ttemprefnode(n).tempinfo^.location.register := rr^.new;
  2377. result := fen_norecurse_true;
  2378. end;
  2379. end;
  2380. { optimize the searching a bit }
  2381. derefn,addrn,
  2382. calln,inlinen,casen,
  2383. addn,subn,muln,
  2384. andn,orn,xorn,
  2385. ltn,lten,gtn,gten,equaln,unequaln,
  2386. slashn,divn,shrn,shln,notn,
  2387. inn,
  2388. asn,isn:
  2389. result := fen_norecurse_false;
  2390. end;
  2391. end;
  2392. procedure maybechangeloadnodereg(list: TAsmList; var n: tnode; reload: boolean);
  2393. var
  2394. rr: treplaceregrec;
  2395. begin
  2396. if not (n.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) or
  2397. ([fc_inflowcontrol,fc_gotolabel,fc_lefthandled] * flowcontrol <> []) then
  2398. exit;
  2399. rr.old := n.location.register;
  2400. rr.ressym := nil;
  2401. {$ifndef cpu64bitalu}
  2402. rr.oldhi := NR_NO;
  2403. {$endif not cpu64bitalu}
  2404. case n.location.loc of
  2405. LOC_CREGISTER:
  2406. begin
  2407. {$ifndef cpu64bitalu}
  2408. if (n.location.size in [OS_64,OS_S64]) then
  2409. begin
  2410. rr.oldhi := n.location.register64.reghi;
  2411. rr.new := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  2412. rr.newhi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  2413. end
  2414. else
  2415. {$endif not cpu64bitalu}
  2416. rr.new := cg.getintregister(current_asmdata.CurrAsmList,n.location.size);
  2417. end;
  2418. LOC_CFPUREGISTER:
  2419. rr.new := cg.getfpuregister(current_asmdata.CurrAsmList,n.location.size);
  2420. {$ifdef SUPPORT_MMX}
  2421. LOC_CMMXREGISTER:
  2422. rr.new := tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList);
  2423. {$endif SUPPORT_MMX}
  2424. LOC_CMMREGISTER:
  2425. rr.new := cg.getmmregister(current_asmdata.CurrAsmList,n.location.size);
  2426. else
  2427. exit;
  2428. end;
  2429. if (current_procinfo.procdef.funcretloc[calleeside].loc<>LOC_VOID) and
  2430. assigned(current_procinfo.procdef.funcretsym) and
  2431. (tabstractvarsym(current_procinfo.procdef.funcretsym).refs <> 0) then
  2432. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  2433. rr.ressym:=tsym(current_procinfo.procdef.parast.Find('self'))
  2434. else
  2435. rr.ressym:=current_procinfo.procdef.funcretsym;
  2436. if not foreachnodestatic(n,@doreplace,@rr) then
  2437. exit;
  2438. if reload then
  2439. case n.location.loc of
  2440. LOC_CREGISTER:
  2441. begin
  2442. {$ifndef cpu64bitalu}
  2443. if (n.location.size in [OS_64,OS_S64]) then
  2444. cg64.a_load64_reg_reg(list,n.location.register64,joinreg64(rr.new,rr.newhi))
  2445. else
  2446. {$endif not cpu64bitalu}
  2447. cg.a_load_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new);
  2448. end;
  2449. LOC_CFPUREGISTER:
  2450. cg.a_loadfpu_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new);
  2451. {$ifdef SUPPORT_MMX}
  2452. LOC_CMMXREGISTER:
  2453. cg.a_loadmm_reg_reg(list,OS_M64,OS_M64,n.location.register,rr.new,nil);
  2454. {$endif SUPPORT_MMX}
  2455. LOC_CMMREGISTER:
  2456. cg.a_loadmm_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new,nil);
  2457. else
  2458. internalerror(2006090920);
  2459. end;
  2460. { now that we've change the loadn/temp, also change the node result location }
  2461. {$ifndef cpu64bitalu}
  2462. if (n.location.size in [OS_64,OS_S64]) then
  2463. begin
  2464. n.location.register64.reglo := rr.new;
  2465. n.location.register64.reghi := rr.newhi;
  2466. end
  2467. else
  2468. {$endif not cpu64bitalu}
  2469. n.location.register := rr.new;
  2470. end;
  2471. procedure gen_free_symtable(list:TAsmList;st:TSymtable);
  2472. var
  2473. i : longint;
  2474. sym : tsym;
  2475. begin
  2476. for i:=0 to st.SymList.Count-1 do
  2477. begin
  2478. sym:=tsym(st.SymList[i]);
  2479. if (sym.typ in [staticvarsym,localvarsym,paravarsym]) then
  2480. begin
  2481. with tabstractnormalvarsym(sym) do
  2482. begin
  2483. { Note: We need to keep the data available in memory
  2484. for the sub procedures that can access local data
  2485. in the parent procedures }
  2486. case localloc.loc of
  2487. LOC_CREGISTER :
  2488. if (pi_has_goto in current_procinfo.flags) then
  2489. {$ifndef cpu64bitalu}
  2490. if def_cgsize(vardef) in [OS_64,OS_S64] then
  2491. begin
  2492. cg.a_reg_sync(list,localloc.register64.reglo);
  2493. cg.a_reg_sync(list,localloc.register64.reghi);
  2494. end
  2495. else
  2496. {$endif not cpu64bitalu}
  2497. cg.a_reg_sync(list,localloc.register);
  2498. LOC_CFPUREGISTER,
  2499. LOC_CMMREGISTER:
  2500. if (pi_has_goto in current_procinfo.flags) then
  2501. cg.a_reg_sync(list,localloc.register);
  2502. LOC_REFERENCE :
  2503. begin
  2504. if typ in [localvarsym,paravarsym] then
  2505. tg.Ungetlocal(list,localloc.reference);
  2506. end;
  2507. end;
  2508. end;
  2509. end;
  2510. end;
  2511. end;
  2512. procedure gen_intf_wrapper(list:TAsmList;_class:tobjectdef);
  2513. var
  2514. i,j : longint;
  2515. tmps : string;
  2516. pd : TProcdef;
  2517. ImplIntf : TImplementedInterface;
  2518. begin
  2519. for i:=0 to _class.ImplementedInterfaces.count-1 do
  2520. begin
  2521. ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]);
  2522. if (ImplIntf=ImplIntf.VtblImplIntf) and
  2523. assigned(ImplIntf.ProcDefs) then
  2524. begin
  2525. maybe_new_object_file(list);
  2526. for j:=0 to ImplIntf.ProcDefs.Count-1 do
  2527. begin
  2528. pd:=TProcdef(ImplIntf.ProcDefs[j]);
  2529. tmps:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+
  2530. ImplIntf.IntfDef.objname^+'_$_'+tostr(j)+'_$_'+pd.mangledname);
  2531. { create wrapper code }
  2532. new_section(list,sec_code,tmps,0);
  2533. cg.init_register_allocators;
  2534. cg.g_intf_wrapper(list,pd,tmps,ImplIntf.ioffset);
  2535. cg.done_register_allocators;
  2536. end;
  2537. end;
  2538. end;
  2539. end;
  2540. procedure gen_intf_wrappers(list:TAsmList;st:TSymtable);
  2541. var
  2542. i : longint;
  2543. def : tdef;
  2544. begin
  2545. for i:=0 to st.DefList.Count-1 do
  2546. begin
  2547. def:=tdef(st.DefList[i]);
  2548. if is_class(def) then
  2549. gen_intf_wrapper(list,tobjectdef(def));
  2550. end;
  2551. end;
  2552. procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister);
  2553. var
  2554. href : treference;
  2555. begin
  2556. if is_object(objdef) then
  2557. begin
  2558. case selfloc.loc of
  2559. LOC_CREFERENCE,
  2560. LOC_REFERENCE:
  2561. begin
  2562. reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset);
  2563. cg.a_loadaddr_ref_reg(list,selfloc.reference,href.base);
  2564. end;
  2565. else
  2566. internalerror(200305056);
  2567. end;
  2568. end
  2569. else
  2570. begin
  2571. case selfloc.loc of
  2572. LOC_REGISTER:
  2573. begin
  2574. {$ifdef cpu_uses_separate_address_registers}
  2575. if getregtype(left.location.register)<>R_ADDRESSREGISTER then
  2576. begin
  2577. reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset);
  2578. cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,selfloc.register,href.base);
  2579. end
  2580. else
  2581. {$endif cpu_uses_separate_address_registers}
  2582. reference_reset_base(href,selfloc.register,objdef.vmt_offset);
  2583. end;
  2584. LOC_CREGISTER,
  2585. LOC_CREFERENCE,
  2586. LOC_REFERENCE:
  2587. begin
  2588. reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset);
  2589. cg.a_load_loc_reg(list,OS_ADDR,selfloc,href.base);
  2590. end;
  2591. else
  2592. internalerror(200305057);
  2593. end;
  2594. end;
  2595. vmtreg:=cg.getaddressregister(list);
  2596. cg.g_maybe_testself(list,href.base);
  2597. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,vmtreg);
  2598. { test validity of VMT }
  2599. if not(is_interface(objdef)) and
  2600. not(is_cppclass(objdef)) then
  2601. cg.g_maybe_testvmt(list,vmtreg,objdef);
  2602. end;
  2603. function getprocalign : shortint;
  2604. begin
  2605. { gprof uses 16 byte granularity }
  2606. if (cs_profile in current_settings.moduleswitches) then
  2607. result:=16
  2608. else
  2609. result:=current_settings.alignment.procalign;
  2610. end;
  2611. procedure gen_pic_helpers(list : TAsmList);
  2612. {$ifdef i386}
  2613. var
  2614. href : treference;
  2615. {$endif i386}
  2616. begin
  2617. { if other cpus require such helpers as well, it can be solved more cleanly }
  2618. {$ifdef i386}
  2619. if current_module.requires_ebx_pic_helper then
  2620. begin
  2621. new_section(list,sec_code,'fpc_geteipasebx',0);
  2622. list.concat(tai_symbol.Createname('fpc_geteipasebx',AT_FUNCTION,getprocalign));
  2623. reference_reset(href);
  2624. href.base:=NR_ESP;
  2625. list.concat(taicpu.op_ref_reg(A_MOV,S_L,href,NR_EBX));
  2626. list.concat(taicpu.op_none(A_RET,S_NO));
  2627. end;
  2628. if current_module.requires_ecx_pic_helper then
  2629. begin
  2630. new_section(list,sec_code,'fpc_geteipasecx',0);
  2631. list.concat(tai_symbol.Createname('fpc_geteipasecx',AT_FUNCTION,getprocalign));
  2632. reference_reset(href);
  2633. href.base:=NR_ESP;
  2634. list.concat(taicpu.op_ref_reg(A_MOV,S_L,href,NR_ECX));
  2635. list.concat(taicpu.op_none(A_RET,S_NO));
  2636. end;
  2637. {$endif i386}
  2638. end;
  2639. end.