ncgutil.pas 88 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141
  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_fpureg(list:TAsmList;var l: tlocation;maybeconst:boolean);
  50. procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;maybeconst:boolean);
  51. procedure location_force_mmreg(list:TAsmList;var l: tlocation;maybeconst:boolean);
  52. procedure location_allocate_register(list:TAsmList;out l: tlocation;def: tdef;constant: boolean);
  53. { loads a cgpara into a tlocation; assumes that loc.loc is already
  54. initialised }
  55. procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
  56. { allocate registers for a tlocation; assumes that loc.loc is already
  57. set to LOC_CREGISTER/LOC_CFPUREGISTER/... }
  58. procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation);
  59. procedure register_maybe_adjust_setbase(list: TAsmList; var l: tlocation; setbase: aint);
  60. function has_alias_name(pd:tprocdef;const s:string):boolean;
  61. procedure alloc_proc_symbol(pd: tprocdef);
  62. procedure gen_proc_symbol(list:TAsmList);
  63. procedure gen_proc_entry_code(list:TAsmList);
  64. procedure gen_proc_exit_code(list:TAsmList);
  65. procedure gen_stack_check_size_para(list:TAsmList);
  66. procedure gen_stack_check_call(list:TAsmList);
  67. procedure gen_save_used_regs(list:TAsmList);
  68. procedure gen_restore_used_regs(list:TAsmList);
  69. procedure gen_load_para_value(list:TAsmList);
  70. procedure gen_external_stub(list:TAsmList;pd:tprocdef;const externalname:string);
  71. procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister);
  72. procedure get_used_regvars(n: tnode; var rv: tusedregvars);
  73. { adds the regvars used in n and its children to rv.allregvars,
  74. those which were already in rv.allregvars to rv.commonregvars and
  75. uses rv.myregvars as scratch (so that two uses of the same regvar
  76. in a single tree to make it appear in commonregvars). Useful to
  77. find out which regvars are used in two different node trees
  78. (e.g. in the "else" and "then" path, or in various case blocks }
  79. // procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
  80. procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars);
  81. { if the result of n is a LOC_C(..)REGISTER, try to find the corresponding
  82. loadn and change its location to a new register (= SSA). In case reload
  83. is true, transfer the old to the new register }
  84. procedure maybechangeloadnodereg(list: TAsmList; var n: tnode; reload: boolean);
  85. { Allocate the buffers for exception management and setjmp environment.
  86. Return a pointer to these buffers, send them to the utility routine
  87. so they are registered, and then call setjmp.
  88. Then compare the result of setjmp with 0, and if not equal
  89. to zero, then jump to exceptlabel.
  90. Also store the result of setjmp to a temporary space by calling g_save_exception_reason
  91. It is to note that this routine may be called *after* the stackframe of a
  92. routine has been called, therefore on machines where the stack cannot
  93. be modified, all temps should be allocated on the heap instead of the
  94. stack. }
  95. const
  96. EXCEPT_BUF_SIZE = 3*sizeof(pint);
  97. type
  98. texceptiontemps=record
  99. jmpbuf,
  100. envbuf,
  101. reasonbuf : treference;
  102. end;
  103. procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
  104. procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps);
  105. procedure new_exception(list:TAsmList;const t:texceptiontemps;exceptlabel:tasmlabel);
  106. procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
  107. procedure gen_alloc_symtable(list:TAsmList;pd:tprocdef;st:TSymtable);
  108. procedure gen_free_symtable(list:TAsmList;st:TSymtable);
  109. procedure location_free(list: TAsmList; const location : TLocation);
  110. function getprocalign : shortint;
  111. procedure gen_fpc_dummy(list : TAsmList);
  112. implementation
  113. uses
  114. version,
  115. cutils,cclasses,
  116. globals,systems,verbose,export,
  117. ppu,defutil,
  118. procinfo,paramgr,fmodule,
  119. regvars,dbgbase,
  120. pass_1,pass_2,
  121. nbas,ncon,nld,nmem,nutils,ngenutil,
  122. tgobj,cgobj,cgcpu,hlcgobj,hlcgcpu
  123. {$ifdef powerpc}
  124. , cpupi
  125. {$endif}
  126. {$ifdef powerpc64}
  127. , cpupi
  128. {$endif}
  129. {$ifdef SUPPORT_MMX}
  130. , cgx86
  131. {$endif SUPPORT_MMX}
  132. ;
  133. {*****************************************************************************
  134. Misc Helpers
  135. *****************************************************************************}
  136. {$if first_mm_imreg = 0}
  137. {$WARN 4044 OFF} { Comparison might be always false ... }
  138. {$endif}
  139. procedure location_free(list: TAsmList; const location : TLocation);
  140. begin
  141. case location.loc of
  142. LOC_VOID:
  143. ;
  144. LOC_REGISTER,
  145. LOC_CREGISTER:
  146. begin
  147. {$ifdef cpu64bitalu}
  148. { x86-64 system v abi:
  149. structs with up to 16 bytes are returned in registers }
  150. if location.size in [OS_128,OS_S128] then
  151. begin
  152. if getsupreg(location.register)<first_int_imreg then
  153. cg.ungetcpuregister(list,location.register);
  154. if getsupreg(location.registerhi)<first_int_imreg then
  155. cg.ungetcpuregister(list,location.registerhi);
  156. end
  157. {$else cpu64bitalu}
  158. if location.size in [OS_64,OS_S64] then
  159. begin
  160. if getsupreg(location.register64.reglo)<first_int_imreg then
  161. cg.ungetcpuregister(list,location.register64.reglo);
  162. if getsupreg(location.register64.reghi)<first_int_imreg then
  163. cg.ungetcpuregister(list,location.register64.reghi);
  164. end
  165. {$endif cpu64bitalu}
  166. else
  167. if getsupreg(location.register)<first_int_imreg then
  168. cg.ungetcpuregister(list,location.register);
  169. end;
  170. LOC_FPUREGISTER,
  171. LOC_CFPUREGISTER:
  172. begin
  173. if getsupreg(location.register)<first_fpu_imreg then
  174. cg.ungetcpuregister(list,location.register);
  175. end;
  176. LOC_MMREGISTER,
  177. LOC_CMMREGISTER :
  178. begin
  179. if getsupreg(location.register)<first_mm_imreg then
  180. cg.ungetcpuregister(list,location.register);
  181. end;
  182. LOC_REFERENCE,
  183. LOC_CREFERENCE :
  184. begin
  185. if paramanager.use_fixed_stack then
  186. location_freetemp(list,location);
  187. end;
  188. else
  189. internalerror(2004110211);
  190. end;
  191. end;
  192. procedure firstcomplex(p : tbinarynode);
  193. var
  194. fcl, fcr: longint;
  195. ncl, ncr: longint;
  196. begin
  197. { always calculate boolean AND and OR from left to right }
  198. if (p.nodetype in [orn,andn]) and
  199. is_boolean(p.left.resultdef) then
  200. begin
  201. if nf_swapped in p.flags then
  202. internalerror(200709253);
  203. end
  204. else
  205. begin
  206. fcl:=node_resources_fpu(p.left);
  207. fcr:=node_resources_fpu(p.right);
  208. ncl:=node_complexity(p.left);
  209. ncr:=node_complexity(p.right);
  210. { We swap left and right if
  211. a) right needs more floating point registers than left, and
  212. left needs more than 0 floating point registers (if it
  213. doesn't need any, swapping won't change the floating
  214. point register pressure)
  215. b) both left and right need an equal amount of floating
  216. point registers or right needs no floating point registers,
  217. and in addition right has a higher complexity than left
  218. (+- needs more integer registers, but not necessarily)
  219. }
  220. if ((fcr>fcl) and
  221. (fcl>0)) or
  222. (((fcr=fcl) or
  223. (fcr=0)) and
  224. (ncr>ncl)) then
  225. p.swapleftright
  226. end;
  227. end;
  228. procedure maketojumpbool(list:TAsmList; p : tnode; loadregvars: tloadregvars);
  229. {
  230. produces jumps to true respectively false labels using boolean expressions
  231. depending on whether the loading of regvars is currently being
  232. synchronized manually (such as in an if-node) or automatically (most of
  233. the other cases where this procedure is called), loadregvars can be
  234. "lr_load_regvars" or "lr_dont_load_regvars"
  235. }
  236. var
  237. opsize : tcgsize;
  238. storepos : tfileposinfo;
  239. tmpreg : tregister;
  240. begin
  241. if nf_error in p.flags then
  242. exit;
  243. storepos:=current_filepos;
  244. current_filepos:=p.fileinfo;
  245. if is_boolean(p.resultdef) then
  246. begin
  247. {$ifdef OLDREGVARS}
  248. if loadregvars = lr_load_regvars then
  249. load_all_regvars(list);
  250. {$endif OLDREGVARS}
  251. if is_constboolnode(p) then
  252. begin
  253. if Tordconstnode(p).value.uvalue<>0 then
  254. cg.a_jmp_always(list,current_procinfo.CurrTrueLabel)
  255. else
  256. cg.a_jmp_always(list,current_procinfo.CurrFalseLabel)
  257. end
  258. else
  259. begin
  260. opsize:=def_cgsize(p.resultdef);
  261. case p.location.loc of
  262. LOC_SUBSETREG,LOC_CSUBSETREG,
  263. LOC_SUBSETREF,LOC_CSUBSETREF:
  264. begin
  265. tmpreg := cg.getintregister(list,OS_INT);
  266. hlcg.a_load_loc_reg(list,p.resultdef,osuinttype,p.location,tmpreg);
  267. cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,tmpreg,current_procinfo.CurrTrueLabel);
  268. cg.a_jmp_always(list,current_procinfo.CurrFalseLabel);
  269. end;
  270. LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
  271. begin
  272. {$ifdef cpu64bitalu}
  273. if opsize in [OS_128,OS_S128] then
  274. begin
  275. hlcg.location_force_reg(list,p.location,p.resultdef,hlcg.tcgsize2orddef(opsize),true);
  276. tmpreg:=cg.getintregister(list,OS_64);
  277. cg.a_op_reg_reg_reg(list,OP_OR,OS_64,p.location.register128.reglo,p.location.register128.reghi,tmpreg);
  278. location_reset(p.location,LOC_REGISTER,OS_64);
  279. p.location.register:=tmpreg;
  280. opsize:=OS_64;
  281. end;
  282. {$else cpu64bitalu}
  283. if opsize in [OS_64,OS_S64] then
  284. begin
  285. hlcg.location_force_reg(list,p.location,p.resultdef,hlcg.tcgsize2orddef(opsize),true);
  286. tmpreg:=cg.getintregister(list,OS_32);
  287. cg.a_op_reg_reg_reg(list,OP_OR,OS_32,p.location.register64.reglo,p.location.register64.reghi,tmpreg);
  288. location_reset(p.location,LOC_REGISTER,OS_32);
  289. p.location.register:=tmpreg;
  290. opsize:=OS_32;
  291. end;
  292. {$endif cpu64bitalu}
  293. cg.a_cmp_const_loc_label(list,opsize,OC_NE,0,p.location,current_procinfo.CurrTrueLabel);
  294. cg.a_jmp_always(list,current_procinfo.CurrFalseLabel);
  295. end;
  296. LOC_JUMP:
  297. ;
  298. {$ifdef cpuflags}
  299. LOC_FLAGS :
  300. begin
  301. cg.a_jmp_flags(list,p.location.resflags,current_procinfo.CurrTrueLabel);
  302. cg.a_reg_dealloc(list,NR_DEFAULTFLAGS);
  303. cg.a_jmp_always(list,current_procinfo.CurrFalseLabel);
  304. end;
  305. {$endif cpuflags}
  306. else
  307. begin
  308. printnode(output,p);
  309. internalerror(200308241);
  310. end;
  311. end;
  312. end;
  313. end
  314. else
  315. internalerror(200112305);
  316. current_filepos:=storepos;
  317. end;
  318. (*
  319. This code needs fixing. It is not safe to use rgint; on the m68000 it
  320. would be rgaddr.
  321. procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
  322. begin
  323. case t.loc of
  324. LOC_REGISTER:
  325. begin
  326. { can't be a regvar, since it would be LOC_CREGISTER then }
  327. exclude(regs,getsupreg(t.register));
  328. if t.register64.reghi<>NR_NO then
  329. exclude(regs,getsupreg(t.register64.reghi));
  330. end;
  331. LOC_CREFERENCE,LOC_REFERENCE:
  332. begin
  333. if not(cs_opt_regvar in current_settings.optimizerswitches) or
  334. (getsupreg(t.reference.base) in cg.rgint.usableregs) then
  335. exclude(regs,getsupreg(t.reference.base));
  336. if not(cs_opt_regvar in current_settings.optimizerswitches) or
  337. (getsupreg(t.reference.index) in cg.rgint.usableregs) then
  338. exclude(regs,getsupreg(t.reference.index));
  339. end;
  340. end;
  341. end;
  342. *)
  343. {*****************************************************************************
  344. EXCEPTION MANAGEMENT
  345. *****************************************************************************}
  346. procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
  347. begin
  348. get_jumpbuf_size;
  349. tg.GetTemp(list,EXCEPT_BUF_SIZE,sizeof(pint),tt_persistent,t.envbuf);
  350. tg.GetTemp(list,jmp_buf_size,jmp_buf_align,tt_persistent,t.jmpbuf);
  351. tg.GetTemp(list,sizeof(pint),sizeof(pint),tt_persistent,t.reasonbuf);
  352. end;
  353. procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps);
  354. begin
  355. tg.Ungettemp(list,t.jmpbuf);
  356. tg.ungettemp(list,t.envbuf);
  357. tg.ungettemp(list,t.reasonbuf);
  358. end;
  359. procedure new_exception(list:TAsmList;const t:texceptiontemps;exceptlabel:tasmlabel);
  360. const
  361. {$ifdef cpu16bitaddr}
  362. pushexceptaddr_frametype_cgsize = OS_S16;
  363. setjmp_result_cgsize = OS_S16;
  364. {$else cpu16bitaddr}
  365. pushexceptaddr_frametype_cgsize = OS_S32;
  366. setjmp_result_cgsize = OS_S32;
  367. {$endif cpu16bitaddr}
  368. var
  369. paraloc1,paraloc2,paraloc3 : tcgpara;
  370. pd: tprocdef;
  371. begin
  372. pd:=search_system_proc('fpc_pushexceptaddr');
  373. paraloc1.init;
  374. paraloc2.init;
  375. paraloc3.init;
  376. paramanager.getintparaloc(pd,1,paraloc1);
  377. paramanager.getintparaloc(pd,2,paraloc2);
  378. paramanager.getintparaloc(pd,3,paraloc3);
  379. if pd.is_pushleftright then
  380. begin
  381. { push type of exceptionframe }
  382. cg.a_load_const_cgpara(list,pushexceptaddr_frametype_cgsize,1,paraloc1);
  383. cg.a_loadaddr_ref_cgpara(list,t.jmpbuf,paraloc2);
  384. cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc3);
  385. end
  386. else
  387. begin
  388. cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc3);
  389. cg.a_loadaddr_ref_cgpara(list,t.jmpbuf,paraloc2);
  390. { push type of exceptionframe }
  391. cg.a_load_const_cgpara(list,pushexceptaddr_frametype_cgsize,1,paraloc1);
  392. end;
  393. paramanager.freecgpara(list,paraloc3);
  394. paramanager.freecgpara(list,paraloc2);
  395. paramanager.freecgpara(list,paraloc1);
  396. cg.allocallcpuregisters(list);
  397. cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);
  398. cg.deallocallcpuregisters(list);
  399. pd:=search_system_proc('fpc_setjmp');
  400. paramanager.getintparaloc(pd,1,paraloc1);
  401. cg.a_load_reg_cgpara(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
  402. paramanager.freecgpara(list,paraloc1);
  403. cg.allocallcpuregisters(list);
  404. cg.a_call_name(list,'FPC_SETJMP',false);
  405. cg.deallocallcpuregisters(list);
  406. cg.alloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]);
  407. cg.g_exception_reason_save(list, t.reasonbuf);
  408. cg.a_cmp_const_reg_label(list,setjmp_result_cgsize,OC_NE,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,setjmp_result_cgsize),exceptlabel);
  409. cg.dealloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]);
  410. paraloc1.done;
  411. paraloc2.done;
  412. paraloc3.done;
  413. end;
  414. procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
  415. begin
  416. cg.allocallcpuregisters(list);
  417. cg.a_call_name(list,'FPC_POPADDRSTACK',false);
  418. cg.deallocallcpuregisters(list);
  419. if not onlyfree then
  420. begin
  421. { g_exception_reason_load already allocates NR_FUNCTION_RESULT_REG }
  422. cg.g_exception_reason_load(list, t.reasonbuf);
  423. cg.a_cmp_const_reg_label(list,OS_INT,OC_EQ,a,NR_FUNCTION_RESULT_REG,endexceptlabel);
  424. cg.a_reg_dealloc(list,NR_FUNCTION_RESULT_REG);
  425. end;
  426. end;
  427. {*****************************************************************************
  428. TLocation
  429. *****************************************************************************}
  430. procedure location_force_fpureg(list:TAsmList;var l: tlocation;maybeconst:boolean);
  431. var
  432. reg : tregister;
  433. href : treference;
  434. begin
  435. if (l.loc<>LOC_FPUREGISTER) and
  436. ((l.loc<>LOC_CFPUREGISTER) or (not maybeconst)) then
  437. begin
  438. { if it's in an mm register, store to memory first }
  439. if (l.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
  440. begin
  441. tg.GetTemp(list,tcgsize2size[l.size],tcgsize2size[l.size],tt_normal,href);
  442. cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,href,mms_movescalar);
  443. location_reset_ref(l,LOC_REFERENCE,l.size,0);
  444. l.reference:=href;
  445. end;
  446. reg:=cg.getfpuregister(list,l.size);
  447. cg.a_loadfpu_loc_reg(list,l.size,l,reg);
  448. location_freetemp(list,l);
  449. location_reset(l,LOC_FPUREGISTER,l.size);
  450. l.register:=reg;
  451. end;
  452. end;
  453. procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;maybeconst:boolean);
  454. var
  455. reg : tregister;
  456. href : treference;
  457. newsize : tcgsize;
  458. begin
  459. if (l.loc<>LOC_MMREGISTER) and
  460. ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then
  461. begin
  462. { if it's in an fpu register, store to memory first }
  463. if (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
  464. begin
  465. tg.GetTemp(list,tcgsize2size[l.size],tcgsize2size[l.size],tt_normal,href);
  466. cg.a_loadfpu_reg_ref(list,l.size,l.size,l.register,href);
  467. location_reset_ref(l,LOC_REFERENCE,l.size,0);
  468. l.reference:=href;
  469. end;
  470. {$ifndef cpu64bitalu}
  471. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) and
  472. (l.size in [OS_64,OS_S64]) then
  473. begin
  474. reg:=cg.getmmregister(list,OS_F64);
  475. cg64.a_loadmm_intreg64_reg(list,OS_F64,l.register64,reg);
  476. l.size:=OS_F64
  477. end
  478. else
  479. {$endif not cpu64bitalu}
  480. begin
  481. { on ARM, CFP values may be located in integer registers,
  482. and its second_int_to_real() also uses this routine to
  483. force integer (memory) values in an mmregister }
  484. if (l.size in [OS_32,OS_S32]) then
  485. newsize:=OS_F32
  486. else if (l.size in [OS_64,OS_S64]) then
  487. newsize:=OS_F64
  488. else
  489. newsize:=l.size;
  490. reg:=cg.getmmregister(list,newsize);
  491. hlcg.a_loadmm_loc_reg(list,l.size,newsize,l,reg,mms_movescalar);
  492. l.size:=newsize;
  493. end;
  494. location_freetemp(list,l);
  495. location_reset(l,LOC_MMREGISTER,l.size);
  496. l.register:=reg;
  497. end;
  498. end;
  499. procedure register_maybe_adjust_setbase(list: TAsmList; var l: tlocation; setbase: aint);
  500. var
  501. tmpreg: tregister;
  502. begin
  503. if (setbase<>0) then
  504. begin
  505. if not(l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  506. internalerror(2007091502);
  507. { subtract the setbase }
  508. case l.loc of
  509. LOC_CREGISTER:
  510. begin
  511. tmpreg := cg.getintregister(list,l.size);
  512. cg.a_op_const_reg_reg(list,OP_SUB,l.size,setbase,l.register,tmpreg);
  513. l.loc:=LOC_REGISTER;
  514. l.register:=tmpreg;
  515. end;
  516. LOC_REGISTER:
  517. begin
  518. cg.a_op_const_reg(list,OP_SUB,l.size,setbase,l.register);
  519. end;
  520. end;
  521. end;
  522. end;
  523. procedure location_force_mmreg(list:TAsmList;var l: tlocation;maybeconst:boolean);
  524. var
  525. reg : tregister;
  526. begin
  527. if (l.loc<>LOC_MMREGISTER) and
  528. ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then
  529. begin
  530. reg:=cg.getmmregister(list,OS_VECTOR);
  531. hlcg.a_loadmm_loc_reg(list,l.size,OS_VECTOR,l,reg,nil);
  532. location_freetemp(list,l);
  533. location_reset(l,LOC_MMREGISTER,OS_VECTOR);
  534. l.register:=reg;
  535. end;
  536. end;
  537. procedure location_allocate_register(list: TAsmList;out l: tlocation;def: tdef;constant: boolean);
  538. begin
  539. l.size:=def_cgsize(def);
  540. if (def.typ=floatdef) and
  541. not(cs_fp_emulation in current_settings.moduleswitches) then
  542. begin
  543. if use_vectorfpu(def) then
  544. begin
  545. if constant then
  546. location_reset(l,LOC_CMMREGISTER,l.size)
  547. else
  548. location_reset(l,LOC_MMREGISTER,l.size);
  549. l.register:=cg.getmmregister(list,l.size);
  550. end
  551. else
  552. begin
  553. if constant then
  554. location_reset(l,LOC_CFPUREGISTER,l.size)
  555. else
  556. location_reset(l,LOC_FPUREGISTER,l.size);
  557. l.register:=cg.getfpuregister(list,l.size);
  558. end;
  559. end
  560. else
  561. begin
  562. if constant then
  563. location_reset(l,LOC_CREGISTER,l.size)
  564. else
  565. location_reset(l,LOC_REGISTER,l.size);
  566. {$ifdef cpu64bitalu}
  567. if l.size in [OS_128,OS_S128,OS_F128] then
  568. begin
  569. l.register128.reglo:=cg.getintregister(list,OS_64);
  570. l.register128.reghi:=cg.getintregister(list,OS_64);
  571. end
  572. else
  573. {$else cpu64bitalu}
  574. if l.size in [OS_64,OS_S64,OS_F64] then
  575. begin
  576. l.register64.reglo:=cg.getintregister(list,OS_32);
  577. l.register64.reghi:=cg.getintregister(list,OS_32);
  578. end
  579. else
  580. {$endif cpu64bitalu}
  581. { Note: for withs of records (and maybe objects, classes, etc.) an
  582. address register could be set here, but that is later
  583. changed to an intregister neverthless when in the
  584. tcgassignmentnode maybechangeloadnodereg is called for the
  585. temporary node; so the workaround for now is to fix the
  586. symptoms... }
  587. l.register:=cg.getintregister(list,l.size);
  588. end;
  589. end;
  590. {****************************************************************************
  591. Init/Finalize Code
  592. ****************************************************************************}
  593. procedure copyvalueparas(p:TObject;arg:pointer);
  594. var
  595. href : treference;
  596. hreg : tregister;
  597. list : TAsmList;
  598. hsym : tparavarsym;
  599. l : longint;
  600. localcopyloc : tlocation;
  601. sizedef : tdef;
  602. begin
  603. list:=TAsmList(arg);
  604. if (tsym(p).typ=paravarsym) and
  605. (tparavarsym(p).varspez=vs_value) and
  606. (paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
  607. begin
  608. { we have no idea about the alignment at the caller side }
  609. hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
  610. if is_open_array(tparavarsym(p).vardef) or
  611. is_array_of_const(tparavarsym(p).vardef) then
  612. begin
  613. { cdecl functions don't have a high pointer so it is not possible to generate
  614. a local copy }
  615. if not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then
  616. begin
  617. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  618. if not assigned(hsym) then
  619. internalerror(200306061);
  620. hreg:=cg.getaddressregister(list);
  621. if not is_packed_array(tparavarsym(p).vardef) then
  622. hlcg.g_copyvaluepara_openarray(list,href,hsym.initialloc,tarraydef(tparavarsym(p).vardef),hreg)
  623. else
  624. internalerror(2006080401);
  625. // cg.g_copyvaluepara_packedopenarray(list,href,hsym.intialloc,tarraydef(tparavarsym(p).vardef).elepackedbitsize,hreg);
  626. sizedef:=getpointerdef(tparavarsym(p).vardef);
  627. hlcg.a_load_reg_loc(list,sizedef,sizedef,hreg,tparavarsym(p).initialloc);
  628. end;
  629. end
  630. else
  631. begin
  632. { Allocate space for the local copy }
  633. l:=tparavarsym(p).getsize;
  634. localcopyloc.loc:=LOC_REFERENCE;
  635. localcopyloc.size:=int_cgsize(l);
  636. tg.GetLocal(list,l,tparavarsym(p).vardef,localcopyloc.reference);
  637. { Copy data }
  638. if is_shortstring(tparavarsym(p).vardef) then
  639. begin
  640. { this code is only executed before the code for the body and the entry/exit code is generated
  641. so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
  642. }
  643. include(current_procinfo.flags,pi_do_call);
  644. hlcg.g_copyshortstring(list,href,localcopyloc.reference,tstringdef(tparavarsym(p).vardef));
  645. end
  646. else if tparavarsym(p).vardef.typ = variantdef then
  647. begin
  648. { this code is only executed before the code for the body and the entry/exit code is generated
  649. so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
  650. }
  651. include(current_procinfo.flags,pi_do_call);
  652. hlcg.g_copyvariant(list,href,localcopyloc.reference,tvariantdef(tparavarsym(p).vardef))
  653. end
  654. else
  655. begin
  656. { pass proper alignment info }
  657. localcopyloc.reference.alignment:=tparavarsym(p).vardef.alignment;
  658. cg.g_concatcopy(list,href,localcopyloc.reference,tparavarsym(p).vardef.size);
  659. end;
  660. { update localloc of varsym }
  661. tg.Ungetlocal(list,tparavarsym(p).localloc.reference);
  662. tparavarsym(p).localloc:=localcopyloc;
  663. tparavarsym(p).initialloc:=localcopyloc;
  664. end;
  665. end;
  666. end;
  667. { generates the code for incrementing the reference count of parameters and
  668. initialize out parameters }
  669. procedure init_paras(p:TObject;arg:pointer);
  670. var
  671. href : treference;
  672. hsym : tparavarsym;
  673. eldef : tdef;
  674. list : TAsmList;
  675. needs_inittable : boolean;
  676. begin
  677. list:=TAsmList(arg);
  678. if (tsym(p).typ=paravarsym) then
  679. begin
  680. needs_inittable:=is_managed_type(tparavarsym(p).vardef);
  681. if not needs_inittable then
  682. exit;
  683. case tparavarsym(p).varspez of
  684. vs_value :
  685. begin
  686. { variants are already handled by the call to fpc_variant_copy_overwrite if
  687. they are passed by reference }
  688. if not((tparavarsym(p).vardef.typ=variantdef) and
  689. paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
  690. begin
  691. hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint));
  692. if is_open_array(tparavarsym(p).vardef) then
  693. begin
  694. { open arrays do not contain correct element count in their rtti,
  695. the actual count must be passed separately. }
  696. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  697. eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
  698. if not assigned(hsym) then
  699. internalerror(201003031);
  700. hlcg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'fpc_addref_array');
  701. end
  702. else
  703. hlcg.g_incrrefcount(list,tparavarsym(p).vardef,href);
  704. end;
  705. end;
  706. vs_out :
  707. begin
  708. { we have no idea about the alignment at the callee side,
  709. and the user also cannot specify "unaligned" here, so
  710. assume worst case }
  711. hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
  712. if is_open_array(tparavarsym(p).vardef) then
  713. begin
  714. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  715. eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
  716. if not assigned(hsym) then
  717. internalerror(201103033);
  718. hlcg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'fpc_initialize_array');
  719. end
  720. else
  721. hlcg.g_initialize(list,tparavarsym(p).vardef,href);
  722. end;
  723. end;
  724. end;
  725. end;
  726. procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation);
  727. begin
  728. case loc.loc of
  729. LOC_CREGISTER:
  730. begin
  731. {$ifdef cpu64bitalu}
  732. if loc.size in [OS_128,OS_S128] then
  733. begin
  734. loc.register128.reglo:=cg.getintregister(list,OS_64);
  735. loc.register128.reghi:=cg.getintregister(list,OS_64);
  736. end
  737. else
  738. {$else cpu64bitalu}
  739. if loc.size in [OS_64,OS_S64] then
  740. begin
  741. loc.register64.reglo:=cg.getintregister(list,OS_32);
  742. loc.register64.reghi:=cg.getintregister(list,OS_32);
  743. end
  744. else
  745. {$endif cpu64bitalu}
  746. loc.register:=cg.getintregister(list,loc.size);
  747. end;
  748. LOC_CFPUREGISTER:
  749. begin
  750. loc.register:=cg.getfpuregister(list,loc.size);
  751. end;
  752. LOC_CMMREGISTER:
  753. begin
  754. loc.register:=cg.getmmregister(list,loc.size);
  755. end;
  756. end;
  757. end;
  758. procedure gen_alloc_regvar(list:TAsmList;sym: tabstractnormalvarsym; allocreg: boolean);
  759. begin
  760. if allocreg then
  761. gen_alloc_regloc(list,sym.initialloc);
  762. if (pi_has_label in current_procinfo.flags) then
  763. begin
  764. { Allocate register already, to prevent first allocation to be
  765. inside a loop }
  766. {$ifdef cpu64bitalu}
  767. if sym.initialloc.size in [OS_128,OS_S128] then
  768. begin
  769. cg.a_reg_sync(list,sym.initialloc.register128.reglo);
  770. cg.a_reg_sync(list,sym.initialloc.register128.reghi);
  771. end
  772. else
  773. {$else cpu64bitalu}
  774. if sym.initialloc.size in [OS_64,OS_S64] then
  775. begin
  776. cg.a_reg_sync(list,sym.initialloc.register64.reglo);
  777. cg.a_reg_sync(list,sym.initialloc.register64.reghi);
  778. end
  779. else
  780. {$endif cpu64bitalu}
  781. cg.a_reg_sync(list,sym.initialloc.register);
  782. end;
  783. sym.localloc:=sym.initialloc;
  784. end;
  785. procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
  786. procedure unget_para(const paraloc:TCGParaLocation);
  787. begin
  788. case paraloc.loc of
  789. LOC_REGISTER :
  790. begin
  791. if getsupreg(paraloc.register)<first_int_imreg then
  792. cg.ungetcpuregister(list,paraloc.register);
  793. end;
  794. LOC_MMREGISTER :
  795. begin
  796. if getsupreg(paraloc.register)<first_mm_imreg then
  797. cg.ungetcpuregister(list,paraloc.register);
  798. end;
  799. LOC_FPUREGISTER :
  800. begin
  801. if getsupreg(paraloc.register)<first_fpu_imreg then
  802. cg.ungetcpuregister(list,paraloc.register);
  803. end;
  804. end;
  805. end;
  806. var
  807. paraloc : pcgparalocation;
  808. href : treference;
  809. sizeleft : aint;
  810. {$if defined(sparc) or defined(arm) or defined(mips)}
  811. tempref : treference;
  812. {$endif defined(sparc) or defined(arm) or defined(mips)}
  813. {$ifdef mips}
  814. tmpreg : tregister;
  815. {$endif mips}
  816. {$ifndef cpu64bitalu}
  817. tempreg : tregister;
  818. reg64 : tregister64;
  819. {$endif not cpu64bitalu}
  820. begin
  821. paraloc:=para.location;
  822. if not assigned(paraloc) then
  823. internalerror(200408203);
  824. { skip e.g. empty records }
  825. if (paraloc^.loc = LOC_VOID) then
  826. exit;
  827. case destloc.loc of
  828. LOC_REFERENCE :
  829. begin
  830. { If the parameter location is reused we don't need to copy
  831. anything }
  832. if not reusepara then
  833. begin
  834. href:=destloc.reference;
  835. sizeleft:=para.intsize;
  836. while assigned(paraloc) do
  837. begin
  838. if (paraloc^.size=OS_NO) then
  839. begin
  840. { Can only be a reference that contains the rest
  841. of the parameter }
  842. if (paraloc^.loc<>LOC_REFERENCE) or
  843. assigned(paraloc^.next) then
  844. internalerror(2005013010);
  845. cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
  846. inc(href.offset,sizeleft);
  847. sizeleft:=0;
  848. end
  849. else
  850. begin
  851. cg.a_load_cgparaloc_ref(list,paraloc^,href,tcgsize2size[paraloc^.size],destloc.reference.alignment);
  852. inc(href.offset,TCGSize2Size[paraloc^.size]);
  853. dec(sizeleft,TCGSize2Size[paraloc^.size]);
  854. end;
  855. unget_para(paraloc^);
  856. paraloc:=paraloc^.next;
  857. end;
  858. end;
  859. end;
  860. LOC_REGISTER,
  861. LOC_CREGISTER :
  862. begin
  863. {$ifdef cpu64bitalu}
  864. if (para.size in [OS_128,OS_S128,OS_F128]) and
  865. ({ in case of fpu emulation, or abi's that pass fpu values
  866. via integer registers }
  867. (vardef.typ=floatdef) or
  868. is_methodpointer(vardef) or
  869. is_record(vardef)) then
  870. begin
  871. case paraloc^.loc of
  872. LOC_REGISTER:
  873. begin
  874. if not assigned(paraloc^.next) then
  875. internalerror(200410104);
  876. if (target_info.endian=ENDIAN_BIG) then
  877. begin
  878. { paraloc^ -> high
  879. paraloc^.next -> low }
  880. unget_para(paraloc^);
  881. gen_alloc_regloc(list,destloc);
  882. { reg->reg, alignment is irrelevant }
  883. cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reghi,8);
  884. unget_para(paraloc^.next^);
  885. cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reglo,8);
  886. end
  887. else
  888. begin
  889. { paraloc^ -> low
  890. paraloc^.next -> high }
  891. unget_para(paraloc^);
  892. gen_alloc_regloc(list,destloc);
  893. cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reglo,8);
  894. unget_para(paraloc^.next^);
  895. cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reghi,8);
  896. end;
  897. end;
  898. LOC_REFERENCE:
  899. begin
  900. gen_alloc_regloc(list,destloc);
  901. reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,para.alignment);
  902. cg128.a_load128_ref_reg(list,href,destloc.register128);
  903. unget_para(paraloc^);
  904. end;
  905. else
  906. internalerror(2012090607);
  907. end
  908. end
  909. else
  910. {$else cpu64bitalu}
  911. if (para.size in [OS_64,OS_S64,OS_F64]) and
  912. (is_64bit(vardef) or
  913. { in case of fpu emulation, or abi's that pass fpu values
  914. via integer registers }
  915. (vardef.typ=floatdef) or
  916. is_methodpointer(vardef) or
  917. is_record(vardef)) then
  918. begin
  919. case paraloc^.loc of
  920. LOC_REGISTER:
  921. begin
  922. if not assigned(paraloc^.next) then
  923. internalerror(200410104);
  924. if (target_info.endian=ENDIAN_BIG) then
  925. begin
  926. { paraloc^ -> high
  927. paraloc^.next -> low }
  928. unget_para(paraloc^);
  929. gen_alloc_regloc(list,destloc);
  930. { reg->reg, alignment is irrelevant }
  931. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reghi,4);
  932. unget_para(paraloc^.next^);
  933. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reglo,4);
  934. end
  935. else
  936. begin
  937. { paraloc^ -> low
  938. paraloc^.next -> high }
  939. unget_para(paraloc^);
  940. gen_alloc_regloc(list,destloc);
  941. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reglo,4);
  942. unget_para(paraloc^.next^);
  943. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reghi,4);
  944. end;
  945. end;
  946. LOC_REFERENCE:
  947. begin
  948. gen_alloc_regloc(list,destloc);
  949. reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,para.alignment);
  950. cg64.a_load64_ref_reg(list,href,destloc.register64);
  951. unget_para(paraloc^);
  952. end;
  953. else
  954. internalerror(2005101501);
  955. end
  956. end
  957. else
  958. {$endif cpu64bitalu}
  959. begin
  960. if assigned(paraloc^.next) then
  961. begin
  962. if (destloc.size in [OS_PAIR,OS_SPAIR]) and
  963. (para.Size in [OS_PAIR,OS_SPAIR]) then
  964. begin
  965. unget_para(paraloc^);
  966. gen_alloc_regloc(list,destloc);
  967. cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^,destloc.register,sizeof(aint));
  968. unget_para(paraloc^.Next^);
  969. gen_alloc_regloc(list,destloc);
  970. {$if defined(cpu16bitalu) or defined(cpu8bitalu)}
  971. cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,GetNextReg(destloc.register),sizeof(aint));
  972. {$else}
  973. cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,destloc.registerhi,sizeof(aint));
  974. {$endif}
  975. end
  976. else
  977. internalerror(200410105);
  978. end
  979. else
  980. begin
  981. unget_para(paraloc^);
  982. gen_alloc_regloc(list,destloc);
  983. cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,sizeof(aint));
  984. end;
  985. end;
  986. end;
  987. LOC_FPUREGISTER,
  988. LOC_CFPUREGISTER :
  989. begin
  990. {$ifdef mips}
  991. if (destloc.size = paraloc^.Size) and
  992. (paraloc^.Loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
  993. begin
  994. unget_para(paraloc^);
  995. gen_alloc_regloc(list,destloc);
  996. cg.a_loadfpu_reg_reg(list,paraloc^.Size, destloc.size, paraloc^.register, destloc.register);
  997. end
  998. else if (destloc.size = OS_F32) and
  999. (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then
  1000. begin
  1001. gen_alloc_regloc(list,destloc);
  1002. unget_para(paraloc^);
  1003. list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,destloc.register));
  1004. end
  1005. { TODO: Produces invalid code, needs fixing together with regalloc setup. }
  1006. {
  1007. else if (destloc.size = OS_F64) and
  1008. (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) and
  1009. (paraloc^.next^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then
  1010. begin
  1011. gen_alloc_regloc(list,destloc);
  1012. tmpreg:=destloc.register;
  1013. unget_para(paraloc^);
  1014. list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,tmpreg));
  1015. setsupreg(tmpreg,getsupreg(tmpreg)+1);
  1016. unget_para(paraloc^.next^);
  1017. list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.Next^.register,tmpreg));
  1018. end
  1019. }
  1020. else
  1021. begin
  1022. sizeleft := TCGSize2Size[destloc.size];
  1023. tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref);
  1024. href:=tempref;
  1025. while assigned(paraloc) do
  1026. begin
  1027. unget_para(paraloc^);
  1028. cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
  1029. inc(href.offset,TCGSize2Size[paraloc^.size]);
  1030. dec(sizeleft,TCGSize2Size[paraloc^.size]);
  1031. paraloc:=paraloc^.next;
  1032. end;
  1033. gen_alloc_regloc(list,destloc);
  1034. cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register);
  1035. tg.UnGetTemp(list,tempref);
  1036. end;
  1037. {$else mips}
  1038. {$if defined(sparc) or defined(arm)}
  1039. { Arm and Sparc passes floats in int registers, when loading to fpu register
  1040. we need a temp }
  1041. sizeleft := TCGSize2Size[destloc.size];
  1042. tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref);
  1043. href:=tempref;
  1044. while assigned(paraloc) do
  1045. begin
  1046. unget_para(paraloc^);
  1047. cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment);
  1048. inc(href.offset,TCGSize2Size[paraloc^.size]);
  1049. dec(sizeleft,TCGSize2Size[paraloc^.size]);
  1050. paraloc:=paraloc^.next;
  1051. end;
  1052. gen_alloc_regloc(list,destloc);
  1053. cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register);
  1054. tg.UnGetTemp(list,tempref);
  1055. {$else defined(sparc) or defined(arm)}
  1056. unget_para(paraloc^);
  1057. gen_alloc_regloc(list,destloc);
  1058. { from register to register -> alignment is irrelevant }
  1059. cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0);
  1060. if assigned(paraloc^.next) then
  1061. internalerror(200410109);
  1062. {$endif defined(sparc) or defined(arm)}
  1063. {$endif mips}
  1064. end;
  1065. LOC_MMREGISTER,
  1066. LOC_CMMREGISTER :
  1067. begin
  1068. {$ifndef cpu64bitalu}
  1069. { ARM vfp floats are passed in integer registers }
  1070. if (para.size=OS_F64) and
  1071. (paraloc^.size in [OS_32,OS_S32]) and
  1072. use_vectorfpu(vardef) then
  1073. begin
  1074. { we need 2x32bit reg }
  1075. if not assigned(paraloc^.next) or
  1076. assigned(paraloc^.next^.next) then
  1077. internalerror(2009112421);
  1078. unget_para(paraloc^.next^);
  1079. case paraloc^.next^.loc of
  1080. LOC_REGISTER:
  1081. tempreg:=paraloc^.next^.register;
  1082. LOC_REFERENCE:
  1083. begin
  1084. tempreg:=cg.getintregister(list,OS_32);
  1085. cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,tempreg,4);
  1086. end;
  1087. else
  1088. internalerror(2012051301);
  1089. end;
  1090. { don't free before the above, because then the getintregister
  1091. could reallocate this register and overwrite it }
  1092. unget_para(paraloc^);
  1093. gen_alloc_regloc(list,destloc);
  1094. if (target_info.endian=endian_big) then
  1095. { paraloc^ -> high
  1096. paraloc^.next -> low }
  1097. reg64:=joinreg64(tempreg,paraloc^.register)
  1098. else
  1099. reg64:=joinreg64(paraloc^.register,tempreg);
  1100. cg64.a_loadmm_intreg64_reg(list,OS_F64,reg64,destloc.register);
  1101. end
  1102. else
  1103. {$endif not cpu64bitalu}
  1104. begin
  1105. unget_para(paraloc^);
  1106. gen_alloc_regloc(list,destloc);
  1107. { from register to register -> alignment is irrelevant }
  1108. cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0);
  1109. { data could come in two memory locations, for now
  1110. we simply ignore the sanity check (FK)
  1111. if assigned(paraloc^.next) then
  1112. internalerror(200410108);
  1113. }
  1114. end;
  1115. end;
  1116. else
  1117. internalerror(2010052903);
  1118. end;
  1119. end;
  1120. procedure gen_load_para_value(list:TAsmList);
  1121. procedure get_para(const paraloc:TCGParaLocation);
  1122. begin
  1123. case paraloc.loc of
  1124. LOC_REGISTER :
  1125. begin
  1126. if getsupreg(paraloc.register)<first_int_imreg then
  1127. cg.getcpuregister(list,paraloc.register);
  1128. end;
  1129. LOC_MMREGISTER :
  1130. begin
  1131. if getsupreg(paraloc.register)<first_mm_imreg then
  1132. cg.getcpuregister(list,paraloc.register);
  1133. end;
  1134. LOC_FPUREGISTER :
  1135. begin
  1136. if getsupreg(paraloc.register)<first_fpu_imreg then
  1137. cg.getcpuregister(list,paraloc.register);
  1138. end;
  1139. end;
  1140. end;
  1141. var
  1142. i : longint;
  1143. currpara : tparavarsym;
  1144. paraloc : pcgparalocation;
  1145. begin
  1146. if (po_assembler in current_procinfo.procdef.procoptions) or
  1147. { exceptfilters have a single hidden 'parentfp' parameter, which
  1148. is handled by tcg.g_proc_entry. }
  1149. (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
  1150. exit;
  1151. { Allocate registers used by parameters }
  1152. for i:=0 to current_procinfo.procdef.paras.count-1 do
  1153. begin
  1154. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  1155. paraloc:=currpara.paraloc[calleeside].location;
  1156. while assigned(paraloc) do
  1157. begin
  1158. if paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER] then
  1159. get_para(paraloc^);
  1160. paraloc:=paraloc^.next;
  1161. end;
  1162. end;
  1163. { Copy parameters to local references/registers }
  1164. for i:=0 to current_procinfo.procdef.paras.count-1 do
  1165. begin
  1166. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  1167. gen_load_cgpara_loc(list,currpara.vardef,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside]));
  1168. { gen_load_cgpara_loc() already allocated the initialloc
  1169. -> don't allocate again }
  1170. if currpara.initialloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER] then
  1171. gen_alloc_regvar(list,currpara,false);
  1172. end;
  1173. { generate copies of call by value parameters, must be done before
  1174. the initialization and body is parsed because the refcounts are
  1175. incremented using the local copies }
  1176. current_procinfo.procdef.parast.SymList.ForEachCall(@copyvalueparas,list);
  1177. {$ifdef powerpc}
  1178. { unget the register that contains the stack pointer before the procedure entry, }
  1179. { which is used to access the parameters in their original callee-side location }
  1180. if (tppcprocinfo(current_procinfo).needs_frame_pointer) then
  1181. cg.a_reg_dealloc(list,NR_R12);
  1182. {$endif powerpc}
  1183. {$ifdef powerpc64}
  1184. { unget the register that contains the stack pointer before the procedure entry, }
  1185. { which is used to access the parameters in their original callee-side location }
  1186. if (tppcprocinfo(current_procinfo).needs_frame_pointer) then
  1187. cg.a_reg_dealloc(list, NR_OLD_STACK_POINTER_REG);
  1188. {$endif powerpc64}
  1189. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1190. begin
  1191. { initialize refcounted paras, and trash others. Needed here
  1192. instead of in gen_initialize_code, because when a reference is
  1193. intialised or trashed while the pointer to that reference is kept
  1194. in a regvar, we add a register move and that one again has to
  1195. come after the parameter loading code as far as the register
  1196. allocator is concerned }
  1197. current_procinfo.procdef.parast.SymList.ForEachCall(@init_paras,list);
  1198. end;
  1199. end;
  1200. {****************************************************************************
  1201. Entry/Exit
  1202. ****************************************************************************}
  1203. function has_alias_name(pd:tprocdef;const s:string):boolean;
  1204. var
  1205. item : TCmdStrListItem;
  1206. begin
  1207. result:=true;
  1208. if pd.mangledname=s then
  1209. exit;
  1210. item := TCmdStrListItem(pd.aliasnames.first);
  1211. while assigned(item) do
  1212. begin
  1213. if item.str=s then
  1214. exit;
  1215. item := TCmdStrListItem(item.next);
  1216. end;
  1217. result:=false;
  1218. end;
  1219. procedure alloc_proc_symbol(pd: tprocdef);
  1220. var
  1221. item : TCmdStrListItem;
  1222. begin
  1223. item := TCmdStrListItem(pd.aliasnames.first);
  1224. while assigned(item) do
  1225. begin
  1226. current_asmdata.DefineAsmSymbol(item.str,AB_GLOBAL,AT_FUNCTION);
  1227. item := TCmdStrListItem(item.next);
  1228. end;
  1229. end;
  1230. procedure gen_proc_symbol(list:TAsmList);
  1231. var
  1232. item,
  1233. previtem : TCmdStrListItem;
  1234. begin
  1235. previtem:=nil;
  1236. item := TCmdStrListItem(current_procinfo.procdef.aliasnames.first);
  1237. while assigned(item) do
  1238. begin
  1239. {$ifdef arm}
  1240. if current_settings.cputype in cpu_thumb2+cpu_thumb then
  1241. list.concat(tai_thumb_func.create);
  1242. {$endif arm}
  1243. { "double link" all procedure entry symbols via .reference }
  1244. { directives on darwin, because otherwise the linker }
  1245. { sometimes strips the procedure if only on of the symbols }
  1246. { is referenced }
  1247. if assigned(previtem) and
  1248. (target_info.system in systems_darwin) then
  1249. list.concat(tai_directive.create(asd_reference,item.str));
  1250. if (cs_profile in current_settings.moduleswitches) or
  1251. (po_global in current_procinfo.procdef.procoptions) then
  1252. list.concat(Tai_symbol.createname_global(item.str,AT_FUNCTION,0))
  1253. else
  1254. list.concat(Tai_symbol.createname(item.str,AT_FUNCTION,0));
  1255. if assigned(previtem) and
  1256. (target_info.system in systems_darwin) then
  1257. list.concat(tai_directive.create(asd_reference,previtem.str));
  1258. if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
  1259. list.concat(Tai_function_name.create(item.str));
  1260. previtem:=item;
  1261. item := TCmdStrListItem(item.next);
  1262. end;
  1263. current_procinfo.procdef.procstarttai:=tai(list.last);
  1264. end;
  1265. procedure gen_proc_entry_code(list:TAsmList);
  1266. var
  1267. hitemp,
  1268. lotemp, stack_frame_size : longint;
  1269. begin
  1270. { generate call frame marker for dwarf call frame info }
  1271. current_asmdata.asmcfi.start_frame(list);
  1272. { All temps are know, write offsets used for information }
  1273. if (cs_asm_source in current_settings.globalswitches) then
  1274. begin
  1275. if tg.direction>0 then
  1276. begin
  1277. lotemp:=current_procinfo.tempstart;
  1278. hitemp:=tg.lasttemp;
  1279. end
  1280. else
  1281. begin
  1282. lotemp:=tg.lasttemp;
  1283. hitemp:=current_procinfo.tempstart;
  1284. end;
  1285. list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
  1286. tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
  1287. end;
  1288. { generate target specific proc entry code }
  1289. stack_frame_size := current_procinfo.calc_stackframe_size;
  1290. if (stack_frame_size <> 0) and
  1291. (po_nostackframe in current_procinfo.procdef.procoptions) then
  1292. message1(parser_e_nostackframe_with_locals,tostr(stack_frame_size));
  1293. hlcg.g_proc_entry(list,stack_frame_size,(po_nostackframe in current_procinfo.procdef.procoptions));
  1294. end;
  1295. procedure gen_proc_exit_code(list:TAsmList);
  1296. var
  1297. parasize : longint;
  1298. begin
  1299. { c style clearstack does not need to remove parameters from the stack, only the
  1300. return value when it was pushed by arguments }
  1301. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1302. begin
  1303. parasize:=0;
  1304. if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
  1305. inc(parasize,sizeof(pint));
  1306. end
  1307. else
  1308. begin
  1309. parasize:=current_procinfo.para_stack_size;
  1310. { the parent frame pointer para has to be removed by the caller in
  1311. case of Delphi-style parent frame pointer passing }
  1312. if not paramanager.use_fixed_stack and
  1313. (po_delphi_nested_cc in current_procinfo.procdef.procoptions) then
  1314. dec(parasize,sizeof(pint));
  1315. end;
  1316. { generate target specific proc exit code }
  1317. hlcg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
  1318. { release return registers, needed for optimizer }
  1319. if not is_void(current_procinfo.procdef.returndef) then
  1320. paramanager.freecgpara(list,current_procinfo.procdef.funcretloc[calleeside]);
  1321. { end of frame marker for call frame info }
  1322. current_asmdata.asmcfi.end_frame(list);
  1323. end;
  1324. procedure gen_stack_check_size_para(list:TAsmList);
  1325. var
  1326. paraloc1 : tcgpara;
  1327. pd : tprocdef;
  1328. begin
  1329. pd:=search_system_proc('fpc_stackcheck');
  1330. paraloc1.init;
  1331. paramanager.getintparaloc(pd,1,paraloc1);
  1332. cg.a_load_const_cgpara(list,OS_INT,current_procinfo.calc_stackframe_size,paraloc1);
  1333. paramanager.freecgpara(list,paraloc1);
  1334. paraloc1.done;
  1335. end;
  1336. procedure gen_stack_check_call(list:TAsmList);
  1337. var
  1338. paraloc1 : tcgpara;
  1339. pd : tprocdef;
  1340. begin
  1341. pd:=search_system_proc('fpc_stackcheck');
  1342. paraloc1.init;
  1343. { Also alloc the register needed for the parameter }
  1344. paramanager.getintparaloc(pd,1,paraloc1);
  1345. paramanager.freecgpara(list,paraloc1);
  1346. { Call the helper }
  1347. cg.allocallcpuregisters(list);
  1348. cg.a_call_name(list,'FPC_STACKCHECK',false);
  1349. cg.deallocallcpuregisters(list);
  1350. paraloc1.done;
  1351. end;
  1352. procedure gen_save_used_regs(list:TAsmList);
  1353. begin
  1354. { Pure assembler routines need to save the registers themselves }
  1355. if (po_assembler in current_procinfo.procdef.procoptions) then
  1356. exit;
  1357. { oldfpccall expects all registers to be destroyed }
  1358. if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then
  1359. cg.g_save_registers(list);
  1360. end;
  1361. procedure gen_restore_used_regs(list:TAsmList);
  1362. begin
  1363. { Pure assembler routines need to save the registers themselves }
  1364. if (po_assembler in current_procinfo.procdef.procoptions) then
  1365. exit;
  1366. { oldfpccall expects all registers to be destroyed }
  1367. if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then
  1368. cg.g_restore_registers(list);
  1369. end;
  1370. {****************************************************************************
  1371. External handling
  1372. ****************************************************************************}
  1373. procedure gen_external_stub(list:TAsmList;pd:tprocdef;const externalname:string);
  1374. begin
  1375. create_hlcodegen;
  1376. { add the procedure to the al_procedures }
  1377. maybe_new_object_file(list);
  1378. new_section(list,sec_code,lower(pd.mangledname),current_settings.alignment.procalign);
  1379. list.concat(Tai_align.create(current_settings.alignment.procalign));
  1380. if (po_global in pd.procoptions) then
  1381. list.concat(Tai_symbol.createname_global(pd.mangledname,AT_FUNCTION,0))
  1382. else
  1383. list.concat(Tai_symbol.createname(pd.mangledname,AT_FUNCTION,0));
  1384. cg.g_external_wrapper(list,pd,externalname);
  1385. destroy_hlcodegen;
  1386. end;
  1387. {****************************************************************************
  1388. Const Data
  1389. ****************************************************************************}
  1390. procedure gen_alloc_symtable(list:TAsmList;pd:tprocdef;st:TSymtable);
  1391. procedure setlocalloc(vs:tabstractnormalvarsym);
  1392. begin
  1393. if cs_asm_source in current_settings.globalswitches then
  1394. begin
  1395. case vs.initialloc.loc of
  1396. LOC_REFERENCE :
  1397. begin
  1398. if not assigned(vs.initialloc.reference.symbol) then
  1399. list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at '+
  1400. std_regname(vs.initialloc.reference.base)+tostr_with_plus(vs.initialloc.reference.offset))));
  1401. end;
  1402. end;
  1403. end;
  1404. vs.localloc:=vs.initialloc;
  1405. FillChar(vs.currentregloc,sizeof(vs.currentregloc),0);
  1406. end;
  1407. var
  1408. i : longint;
  1409. sym : tsym;
  1410. vs : tabstractnormalvarsym;
  1411. isaddr : boolean;
  1412. begin
  1413. for i:=0 to st.SymList.Count-1 do
  1414. begin
  1415. sym:=tsym(st.SymList[i]);
  1416. case sym.typ of
  1417. staticvarsym :
  1418. begin
  1419. vs:=tabstractnormalvarsym(sym);
  1420. { The code in loadnode.pass_generatecode will create the
  1421. LOC_REFERENCE instead for all none register variables. This is
  1422. required because we can't store an asmsymbol in the localloc because
  1423. the asmsymbol is invalid after an unit is compiled. This gives
  1424. problems when this procedure is inlined in another unit (PFV) }
  1425. if vs.is_regvar(false) then
  1426. begin
  1427. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
  1428. vs.initialloc.size:=def_cgsize(vs.vardef);
  1429. gen_alloc_regvar(list,vs,true);
  1430. setlocalloc(vs);
  1431. end;
  1432. end;
  1433. paravarsym :
  1434. begin
  1435. vs:=tabstractnormalvarsym(sym);
  1436. { Parameters passed to assembler procedures need to be kept
  1437. in the original location }
  1438. if (po_assembler in current_procinfo.procdef.procoptions) then
  1439. tparavarsym(vs).paraloc[calleeside].get_location(vs.initialloc)
  1440. { exception filters receive their frame pointer as a parameter }
  1441. else if (current_procinfo.procdef.proctypeoption=potype_exceptfilter) and
  1442. (vo_is_parentfp in vs.varoptions) then
  1443. begin
  1444. location_reset(vs.initialloc,LOC_REGISTER,OS_ADDR);
  1445. vs.initialloc.register:=NR_FRAME_POINTER_REG;
  1446. end
  1447. else
  1448. begin
  1449. isaddr:=paramanager.push_addr_param(vs.varspez,vs.vardef,current_procinfo.procdef.proccalloption);
  1450. if isaddr then
  1451. vs.initialloc.size:=OS_ADDR
  1452. else
  1453. vs.initialloc.size:=def_cgsize(vs.vardef);
  1454. if vs.is_regvar(isaddr) then
  1455. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable]
  1456. else
  1457. begin
  1458. vs.initialloc.loc:=LOC_REFERENCE;
  1459. { Reuse the parameter location for values to are at a single location on the stack }
  1460. if paramanager.param_use_paraloc(tparavarsym(sym).paraloc[calleeside]) then
  1461. begin
  1462. reference_reset_base(vs.initialloc.reference,tparavarsym(sym).paraloc[calleeside].location^.reference.index,
  1463. tparavarsym(sym).paraloc[calleeside].location^.reference.offset,tparavarsym(sym).paraloc[calleeside].alignment);
  1464. end
  1465. else
  1466. begin
  1467. if isaddr then
  1468. tg.GetLocal(list,sizeof(pint),voidpointertype,vs.initialloc.reference)
  1469. else
  1470. tg.GetLocal(list,vs.getsize,tparavarsym(sym).paraloc[calleeside].alignment,vs.vardef,vs.initialloc.reference);
  1471. end;
  1472. end;
  1473. end;
  1474. setlocalloc(vs);
  1475. end;
  1476. localvarsym :
  1477. begin
  1478. vs:=tabstractnormalvarsym(sym);
  1479. vs.initialloc.size:=def_cgsize(vs.vardef);
  1480. if ([po_assembler,po_nostackframe] * current_procinfo.procdef.procoptions = [po_assembler,po_nostackframe]) and
  1481. (vo_is_funcret in vs.varoptions) then
  1482. begin
  1483. paramanager.create_funcretloc_info(pd,calleeside);
  1484. if assigned(pd.funcretloc[calleeside].location^.next) then
  1485. begin
  1486. { can't replace references to "result" with a complex
  1487. location expression inside assembler code }
  1488. location_reset(vs.initialloc,LOC_INVALID,OS_NO);
  1489. end
  1490. else
  1491. pd.funcretloc[calleeside].get_location(vs.initialloc);
  1492. end
  1493. else if (m_delphi in current_settings.modeswitches) and
  1494. (po_assembler in current_procinfo.procdef.procoptions) and
  1495. (vo_is_funcret in vs.varoptions) and
  1496. (vs.refs=0) then
  1497. begin
  1498. { not referenced, so don't allocate. Use dummy to }
  1499. { avoid ie's later on because of LOC_INVALID }
  1500. vs.initialloc.loc:=LOC_REGISTER;
  1501. vs.initialloc.size:=OS_INT;
  1502. vs.initialloc.register:=NR_FUNCTION_RESULT_REG;
  1503. end
  1504. else if vs.is_regvar(false) then
  1505. begin
  1506. vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
  1507. gen_alloc_regvar(list,vs,true);
  1508. end
  1509. else
  1510. begin
  1511. vs.initialloc.loc:=LOC_REFERENCE;
  1512. tg.GetLocal(list,vs.getsize,vs.vardef,vs.initialloc.reference);
  1513. end;
  1514. setlocalloc(vs);
  1515. end;
  1516. end;
  1517. end;
  1518. end;
  1519. procedure add_regvars(var rv: tusedregvars; const location: tlocation);
  1520. begin
  1521. case location.loc of
  1522. LOC_CREGISTER:
  1523. {$ifdef cpu64bitalu}
  1524. if location.size in [OS_128,OS_S128] then
  1525. begin
  1526. rv.intregvars.addnodup(getsupreg(location.register128.reglo));
  1527. rv.intregvars.addnodup(getsupreg(location.register128.reghi));
  1528. end
  1529. else
  1530. {$else cpu64bitalu}
  1531. if location.size in [OS_64,OS_S64] then
  1532. begin
  1533. rv.intregvars.addnodup(getsupreg(location.register64.reglo));
  1534. rv.intregvars.addnodup(getsupreg(location.register64.reghi));
  1535. end
  1536. else
  1537. {$endif cpu64bitalu}
  1538. rv.intregvars.addnodup(getsupreg(location.register));
  1539. LOC_CFPUREGISTER:
  1540. rv.fpuregvars.addnodup(getsupreg(location.register));
  1541. LOC_CMMREGISTER:
  1542. rv.mmregvars.addnodup(getsupreg(location.register));
  1543. end;
  1544. end;
  1545. function do_get_used_regvars(var n: tnode; arg: pointer): foreachnoderesult;
  1546. var
  1547. rv: pusedregvars absolute arg;
  1548. begin
  1549. case (n.nodetype) of
  1550. temprefn:
  1551. { We only have to synchronise a tempnode before a loop if it is }
  1552. { not created inside the loop, and only synchronise after the }
  1553. { loop if it's not destroyed inside the loop. If it's created }
  1554. { before the loop and not yet destroyed, then before the loop }
  1555. { is secondpassed tempinfo^.valid will be true, and we get the }
  1556. { correct registers. If it's not destroyed inside the loop, }
  1557. { then after the loop has been secondpassed tempinfo^.valid }
  1558. { be true and we also get the right registers. In other cases, }
  1559. { tempinfo^.valid will be false and so we do not add }
  1560. { unnecessary registers. This way, we don't have to look at }
  1561. { tempcreate and tempdestroy nodes to get this info (JM) }
  1562. if (ti_valid in ttemprefnode(n).tempinfo^.flags) then
  1563. add_regvars(rv^,ttemprefnode(n).tempinfo^.location);
  1564. loadn:
  1565. if (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
  1566. add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc);
  1567. vecn:
  1568. { range checks sometimes need the high parameter }
  1569. if (cs_check_range in current_settings.localswitches) and
  1570. (is_open_array(tvecnode(n).left.resultdef) or
  1571. is_array_of_const(tvecnode(n).left.resultdef)) and
  1572. not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then
  1573. add_regvars(rv^,tabstractnormalvarsym(get_high_value_sym(tparavarsym(tloadnode(tvecnode(n).left).symtableentry))).localloc)
  1574. end;
  1575. result := fen_true;
  1576. end;
  1577. procedure get_used_regvars(n: tnode; var rv: tusedregvars);
  1578. begin
  1579. foreachnodestatic(n,@do_get_used_regvars,@rv);
  1580. end;
  1581. (*
  1582. See comments at declaration of pusedregvarscommon
  1583. function do_get_used_regvars_common(var n: tnode; arg: pointer): foreachnoderesult;
  1584. var
  1585. rv: pusedregvarscommon absolute arg;
  1586. begin
  1587. if (n.nodetype = loadn) and
  1588. (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
  1589. with tabstractnormalvarsym(tloadnode(n).symtableentry).localloc do
  1590. case loc of
  1591. LOC_CREGISTER:
  1592. { if not yet encountered in this node tree }
  1593. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  1594. { but nevertheless already encountered somewhere }
  1595. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  1596. { then it's a regvar used in two or more node trees }
  1597. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  1598. LOC_CFPUREGISTER:
  1599. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  1600. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  1601. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  1602. LOC_CMMREGISTER:
  1603. if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
  1604. not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
  1605. rv^.commonregvars.intregvars.addnodup(getsupreg(register));
  1606. end;
  1607. result := fen_true;
  1608. end;
  1609. procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
  1610. begin
  1611. rv.myregvars.intregvars.clear;
  1612. rv.myregvars.fpuregvars.clear;
  1613. rv.myregvars.mmregvars.clear;
  1614. foreachnodestatic(n,@do_get_used_regvars_common,@rv);
  1615. end;
  1616. *)
  1617. procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars);
  1618. var
  1619. count: longint;
  1620. begin
  1621. for count := 1 to rv.intregvars.length do
  1622. cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.readidx(count-1),R_SUBWHOLE));
  1623. for count := 1 to rv.fpuregvars.length do
  1624. cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.readidx(count-1),R_SUBWHOLE));
  1625. for count := 1 to rv.mmregvars.length do
  1626. cg.a_reg_sync(list,newreg(R_MMREGISTER,rv.mmregvars.readidx(count-1),R_SUBWHOLE));
  1627. end;
  1628. {*****************************************************************************
  1629. SSA support
  1630. *****************************************************************************}
  1631. type
  1632. preplaceregrec = ^treplaceregrec;
  1633. treplaceregrec = record
  1634. old, new: tregister;
  1635. oldhi, newhi: tregister;
  1636. ressym: tsym;
  1637. { moved sym }
  1638. sym : tabstractnormalvarsym;
  1639. end;
  1640. function doreplace(var n: tnode; para: pointer): foreachnoderesult;
  1641. var
  1642. rr: preplaceregrec absolute para;
  1643. begin
  1644. result := fen_false;
  1645. if (nf_is_funcret in n.flags) and (fc_exit in flowcontrol) then
  1646. exit;
  1647. case n.nodetype of
  1648. loadn:
  1649. begin
  1650. if (tloadnode(n).symtableentry.typ in [localvarsym,paravarsym,staticvarsym]) and
  1651. (tabstractvarsym(tloadnode(n).symtableentry).varoptions * [vo_is_dll_var, vo_is_thread_var] = []) and
  1652. not assigned(tloadnode(n).left) and
  1653. ((tloadnode(n).symtableentry <> rr^.ressym) or
  1654. not(fc_exit in flowcontrol)
  1655. ) and
  1656. (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
  1657. (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register = rr^.old) then
  1658. begin
  1659. {$ifdef cpu64bitalu}
  1660. { it's possible a 128 bit location was shifted and/xor typecasted }
  1661. { in a 64 bit value, so only 1 register was left in the location }
  1662. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.size in [OS_128,OS_S128]) then
  1663. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register128.reghi = rr^.oldhi) then
  1664. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register128.reghi := rr^.newhi
  1665. else
  1666. exit;
  1667. {$else cpu64bitalu}
  1668. { it's possible a 64 bit location was shifted and/xor typecasted }
  1669. { in a 32 bit value, so only 1 register was left in the location }
  1670. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.size in [OS_64,OS_S64]) then
  1671. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi = rr^.oldhi) then
  1672. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi := rr^.newhi
  1673. else
  1674. exit;
  1675. {$endif cpu64bitalu}
  1676. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register := rr^.new;
  1677. rr^.sym := tabstractnormalvarsym(tloadnode(n).symtableentry);
  1678. result := fen_norecurse_true;
  1679. end;
  1680. end;
  1681. temprefn:
  1682. begin
  1683. if (ti_valid in ttemprefnode(n).tempinfo^.flags) and
  1684. (ttemprefnode(n).tempinfo^.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
  1685. (ttemprefnode(n).tempinfo^.location.register = rr^.old) then
  1686. begin
  1687. {$ifdef cpu64bitalu}
  1688. { it's possible a 128 bit location was shifted and/xor typecasted }
  1689. { in a 64 bit value, so only 1 register was left in the location }
  1690. if (ttemprefnode(n).tempinfo^.location.size in [OS_128,OS_S128]) then
  1691. if (ttemprefnode(n).tempinfo^.location.register128.reghi = rr^.oldhi) then
  1692. ttemprefnode(n).tempinfo^.location.register128.reghi := rr^.newhi
  1693. else
  1694. exit;
  1695. {$else cpu64bitalu}
  1696. { it's possible a 64 bit location was shifted and/xor typecasted }
  1697. { in a 32 bit value, so only 1 register was left in the location }
  1698. if (ttemprefnode(n).tempinfo^.location.size in [OS_64,OS_S64]) then
  1699. if (ttemprefnode(n).tempinfo^.location.register64.reghi = rr^.oldhi) then
  1700. ttemprefnode(n).tempinfo^.location.register64.reghi := rr^.newhi
  1701. else
  1702. exit;
  1703. {$endif cpu64bitalu}
  1704. ttemprefnode(n).tempinfo^.location.register := rr^.new;
  1705. result := fen_norecurse_true;
  1706. end;
  1707. end;
  1708. { optimize the searching a bit }
  1709. derefn,addrn,
  1710. calln,inlinen,casen,
  1711. addn,subn,muln,
  1712. andn,orn,xorn,
  1713. ltn,lten,gtn,gten,equaln,unequaln,
  1714. slashn,divn,shrn,shln,notn,
  1715. inn,
  1716. asn,isn:
  1717. result := fen_norecurse_false;
  1718. end;
  1719. end;
  1720. procedure maybechangeloadnodereg(list: TAsmList; var n: tnode; reload: boolean);
  1721. var
  1722. rr: treplaceregrec;
  1723. varloc : tai_varloc;
  1724. begin
  1725. {$ifdef jvm}
  1726. exit;
  1727. {$endif}
  1728. if not (n.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) or
  1729. ([fc_inflowcontrol,fc_gotolabel,fc_lefthandled] * flowcontrol <> []) then
  1730. exit;
  1731. rr.old := n.location.register;
  1732. rr.ressym := nil;
  1733. rr.sym := nil;
  1734. rr.oldhi := NR_NO;
  1735. case n.location.loc of
  1736. LOC_CREGISTER:
  1737. begin
  1738. {$ifdef cpu64bitalu}
  1739. if (n.location.size in [OS_128,OS_S128]) then
  1740. begin
  1741. rr.oldhi := n.location.register128.reghi;
  1742. rr.new := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  1743. rr.newhi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  1744. end
  1745. else
  1746. {$else cpu64bitalu}
  1747. if (n.location.size in [OS_64,OS_S64]) then
  1748. begin
  1749. rr.oldhi := n.location.register64.reghi;
  1750. rr.new := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  1751. rr.newhi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  1752. end
  1753. else
  1754. {$endif cpu64bitalu}
  1755. rr.new := cg.getintregister(current_asmdata.CurrAsmList,n.location.size);
  1756. end;
  1757. LOC_CFPUREGISTER:
  1758. rr.new := cg.getfpuregister(current_asmdata.CurrAsmList,n.location.size);
  1759. {$ifdef SUPPORT_MMX}
  1760. LOC_CMMXREGISTER:
  1761. rr.new := tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList);
  1762. {$endif SUPPORT_MMX}
  1763. LOC_CMMREGISTER:
  1764. rr.new := cg.getmmregister(current_asmdata.CurrAsmList,n.location.size);
  1765. else
  1766. exit;
  1767. end;
  1768. if not is_void(current_procinfo.procdef.returndef) and
  1769. assigned(current_procinfo.procdef.funcretsym) and
  1770. (tabstractvarsym(current_procinfo.procdef.funcretsym).refs <> 0) then
  1771. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  1772. rr.ressym:=tsym(current_procinfo.procdef.parast.Find('self'))
  1773. else
  1774. rr.ressym:=current_procinfo.procdef.funcretsym;
  1775. if not foreachnodestatic(n,@doreplace,@rr) then
  1776. exit;
  1777. if reload then
  1778. case n.location.loc of
  1779. LOC_CREGISTER:
  1780. begin
  1781. {$ifdef cpu64bitalu}
  1782. if (n.location.size in [OS_128,OS_S128]) then
  1783. cg128.a_load128_reg_reg(list,n.location.register128,joinreg128(rr.new,rr.newhi))
  1784. else
  1785. {$else cpu64bitalu}
  1786. if (n.location.size in [OS_64,OS_S64]) then
  1787. cg64.a_load64_reg_reg(list,n.location.register64,joinreg64(rr.new,rr.newhi))
  1788. else
  1789. {$endif cpu64bitalu}
  1790. cg.a_load_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new);
  1791. end;
  1792. LOC_CFPUREGISTER:
  1793. cg.a_loadfpu_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new);
  1794. {$ifdef SUPPORT_MMX}
  1795. LOC_CMMXREGISTER:
  1796. cg.a_loadmm_reg_reg(list,OS_M64,OS_M64,n.location.register,rr.new,nil);
  1797. {$endif SUPPORT_MMX}
  1798. LOC_CMMREGISTER:
  1799. cg.a_loadmm_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new,nil);
  1800. else
  1801. internalerror(2006090920);
  1802. end;
  1803. { now that we've change the loadn/temp, also change the node result location }
  1804. {$ifdef cpu64bitalu}
  1805. if (n.location.size in [OS_128,OS_S128]) then
  1806. begin
  1807. n.location.register128.reglo := rr.new;
  1808. n.location.register128.reghi := rr.newhi;
  1809. if assigned(rr.sym) and
  1810. ((rr.sym.currentregloc.register<>rr.new) or
  1811. (rr.sym.currentregloc.registerhi<>rr.newhi)) then
  1812. begin
  1813. varloc:=tai_varloc.create128(rr.sym,rr.new,rr.newhi);
  1814. varloc.oldlocation:=rr.sym.currentregloc.register;
  1815. varloc.oldlocationhi:=rr.sym.currentregloc.registerhi;
  1816. rr.sym.currentregloc.register:=rr.new;
  1817. rr.sym.currentregloc.registerHI:=rr.newhi;
  1818. list.concat(varloc);
  1819. end;
  1820. end
  1821. else
  1822. {$else cpu64bitalu}
  1823. if (n.location.size in [OS_64,OS_S64]) then
  1824. begin
  1825. n.location.register64.reglo := rr.new;
  1826. n.location.register64.reghi := rr.newhi;
  1827. if assigned(rr.sym) and
  1828. ((rr.sym.currentregloc.register<>rr.new) or
  1829. (rr.sym.currentregloc.registerhi<>rr.newhi)) then
  1830. begin
  1831. varloc:=tai_varloc.create64(rr.sym,rr.new,rr.newhi);
  1832. varloc.oldlocation:=rr.sym.currentregloc.register;
  1833. varloc.oldlocationhi:=rr.sym.currentregloc.registerhi;
  1834. rr.sym.currentregloc.register:=rr.new;
  1835. rr.sym.currentregloc.registerHI:=rr.newhi;
  1836. list.concat(varloc);
  1837. end;
  1838. end
  1839. else
  1840. {$endif cpu64bitalu}
  1841. begin
  1842. n.location.register := rr.new;
  1843. if assigned(rr.sym) and (rr.sym.currentregloc.register<>rr.new) then
  1844. begin
  1845. varloc:=tai_varloc.create(rr.sym,rr.new);
  1846. varloc.oldlocation:=rr.sym.currentregloc.register;
  1847. rr.sym.currentregloc.register:=rr.new;
  1848. list.concat(varloc);
  1849. end;
  1850. end;
  1851. end;
  1852. procedure gen_free_symtable(list:TAsmList;st:TSymtable);
  1853. var
  1854. i : longint;
  1855. sym : tsym;
  1856. begin
  1857. for i:=0 to st.SymList.Count-1 do
  1858. begin
  1859. sym:=tsym(st.SymList[i]);
  1860. if (sym.typ in [staticvarsym,localvarsym,paravarsym]) then
  1861. begin
  1862. with tabstractnormalvarsym(sym) do
  1863. begin
  1864. { Note: We need to keep the data available in memory
  1865. for the sub procedures that can access local data
  1866. in the parent procedures }
  1867. case localloc.loc of
  1868. LOC_CREGISTER :
  1869. if (pi_has_label in current_procinfo.flags) then
  1870. {$ifdef cpu64bitalu}
  1871. if def_cgsize(vardef) in [OS_128,OS_S128] then
  1872. begin
  1873. cg.a_reg_sync(list,localloc.register128.reglo);
  1874. cg.a_reg_sync(list,localloc.register128.reghi);
  1875. end
  1876. else
  1877. {$else cpu64bitalu}
  1878. if def_cgsize(vardef) in [OS_64,OS_S64] then
  1879. begin
  1880. cg.a_reg_sync(list,localloc.register64.reglo);
  1881. cg.a_reg_sync(list,localloc.register64.reghi);
  1882. end
  1883. else
  1884. {$endif cpu64bitalu}
  1885. cg.a_reg_sync(list,localloc.register);
  1886. LOC_CFPUREGISTER,
  1887. LOC_CMMREGISTER:
  1888. if (pi_has_label in current_procinfo.flags) then
  1889. cg.a_reg_sync(list,localloc.register);
  1890. LOC_REFERENCE :
  1891. begin
  1892. if typ in [localvarsym,paravarsym] then
  1893. tg.Ungetlocal(list,localloc.reference);
  1894. end;
  1895. end;
  1896. end;
  1897. end;
  1898. end;
  1899. end;
  1900. procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister);
  1901. var
  1902. href : treference;
  1903. selfdef: tdef;
  1904. begin
  1905. if is_object(objdef) then
  1906. begin
  1907. case selfloc.loc of
  1908. LOC_CREFERENCE,
  1909. LOC_REFERENCE:
  1910. begin
  1911. reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset,sizeof(pint));
  1912. cg.a_loadaddr_ref_reg(list,selfloc.reference,href.base);
  1913. selfdef:=getpointerdef(objdef);
  1914. end;
  1915. else
  1916. internalerror(200305056);
  1917. end;
  1918. end
  1919. else
  1920. { This is also valid for Objective-C classes: vmt_offset is 0 there,
  1921. and the first "field" of an Objective-C class instance is a pointer
  1922. to its "meta-class". }
  1923. begin
  1924. selfdef:=objdef;
  1925. case selfloc.loc of
  1926. LOC_REGISTER:
  1927. begin
  1928. {$ifdef cpu_uses_separate_address_registers}
  1929. if getregtype(left.location.register)<>R_ADDRESSREGISTER then
  1930. begin
  1931. reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset,sizeof(pint));
  1932. cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,selfloc.register,href.base);
  1933. end
  1934. else
  1935. {$endif cpu_uses_separate_address_registers}
  1936. reference_reset_base(href,selfloc.register,objdef.vmt_offset,sizeof(pint));
  1937. end;
  1938. LOC_CONSTANT,
  1939. LOC_CREGISTER,
  1940. LOC_CREFERENCE,
  1941. LOC_REFERENCE,
  1942. LOC_CSUBSETREG,
  1943. LOC_SUBSETREG,
  1944. LOC_CSUBSETREF,
  1945. LOC_SUBSETREF:
  1946. begin
  1947. reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset,sizeof(pint));
  1948. { todo: pass actual vmt pointer type to hlcg }
  1949. hlcg.a_load_loc_reg(list,voidpointertype,voidpointertype,selfloc,href.base);
  1950. end;
  1951. else
  1952. internalerror(200305057);
  1953. end;
  1954. end;
  1955. vmtreg:=cg.getaddressregister(list);
  1956. hlcg.g_maybe_testself(list,selfdef,href.base);
  1957. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,vmtreg);
  1958. { test validity of VMT }
  1959. if not(is_interface(objdef)) and
  1960. not(is_cppclass(objdef)) and
  1961. not(is_objc_class_or_protocol(objdef)) then
  1962. cg.g_maybe_testvmt(list,vmtreg,objdef);
  1963. end;
  1964. function getprocalign : shortint;
  1965. begin
  1966. { gprof uses 16 byte granularity }
  1967. if (cs_profile in current_settings.moduleswitches) then
  1968. result:=16
  1969. else
  1970. result:=current_settings.alignment.procalign;
  1971. end;
  1972. procedure gen_fpc_dummy(list : TAsmList);
  1973. begin
  1974. {$ifdef i386}
  1975. { fix me! }
  1976. list.concat(Taicpu.Op_const_reg(A_MOV,S_L,1,NR_EAX));
  1977. list.concat(Taicpu.Op_const(A_RET,S_W,12));
  1978. {$endif i386}
  1979. end;
  1980. end.