ncgutil.pas 117 KB

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