ncgutil.pas 105 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Helper routines for all code generators
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit ncgutil;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node,cpuinfo,
  23. globtype,
  24. cpubase,cgbase,
  25. aasmbase,aasmtai,aasmcpu,
  26. symconst,symbase,symdef,symsym,symtype,symtable
  27. {$ifndef cpu64bit}
  28. ,cg64f32
  29. {$endif cpu64bit}
  30. ;
  31. type
  32. tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
  33. procedure firstcomplex(p : tbinarynode);
  34. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  35. // procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
  36. procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  37. procedure location_force_fpureg(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
  38. procedure location_force_mem(list:TAAsmoutput;var l:tlocation);
  39. procedure location_force_mmregscalar(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
  40. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  41. procedure gen_proc_symbol(list:Taasmoutput);
  42. procedure gen_proc_symbol_end(list:Taasmoutput);
  43. procedure gen_stackalloc_code(list:Taasmoutput);
  44. procedure gen_stackfree_code(list:Taasmoutput;usesacc,usesacchi:boolean);
  45. procedure gen_save_used_regs(list:TAAsmoutput);
  46. procedure gen_restore_used_regs(list:TAAsmoutput;usesacc,usesacchi,usesfpu:boolean);
  47. procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
  48. procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
  49. procedure gen_entry_code(list:TAAsmoutput);
  50. procedure gen_exit_code(list:TAAsmoutput);
  51. procedure gen_load_para_value(list:TAAsmoutput);
  52. procedure gen_load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
  53. (*
  54. procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
  55. procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
  56. *)
  57. {#
  58. Allocate the buffers for exception management and setjmp environment.
  59. Return a pointer to these buffers, send them to the utility routine
  60. so they are registered, and then call setjmp.
  61. Then compare the result of setjmp with 0, and if not equal
  62. to zero, then jump to exceptlabel.
  63. Also store the result of setjmp to a temporary space by calling g_save_exception_reason
  64. It is to note that this routine may be called *after* the stackframe of a
  65. routine has been called, therefore on machines where the stack cannot
  66. be modified, all temps should be allocated on the heap instead of the
  67. stack.
  68. }
  69. procedure new_exception(list:TAAsmoutput;const jmpbuf,envbuf, href : treference;
  70. a : aword; exceptlabel : tasmlabel);
  71. procedure free_exception(list:TAAsmoutput;const jmpbuf, envbuf, href : treference;
  72. a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
  73. procedure insertconstdata(sym : ttypedconstsym);
  74. procedure insertbssdata(sym : tvarsym);
  75. procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
  76. procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
  77. procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
  78. procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
  79. procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
  80. implementation
  81. uses
  82. {$ifdef Delphi}
  83. Sysutils,
  84. {$else}
  85. strings,
  86. {$endif}
  87. cutils,cclasses,
  88. globals,systems,verbose,
  89. defutil,
  90. procinfo,paramgr,fmodule,
  91. regvars,
  92. {$ifdef GDB}
  93. gdb,
  94. {$endif GDB}
  95. ncon,
  96. tgobj,cgobj;
  97. const
  98. { Please leave this here, this module should NOT use
  99. exprasmlist, the lists are always passed as arguments.
  100. Declaring it as string here results in an error when compiling (PFV) }
  101. exprasmlist = 'error';
  102. {*****************************************************************************
  103. Misc Helpers
  104. *****************************************************************************}
  105. { DO NOT RELY on the fact that the tnode is not yet swaped
  106. because of inlining code PM }
  107. procedure firstcomplex(p : tbinarynode);
  108. var
  109. hp : tnode;
  110. begin
  111. { always calculate boolean AND and OR from left to right }
  112. if (p.nodetype in [orn,andn]) and
  113. is_boolean(p.left.resulttype.def) then
  114. begin
  115. if nf_swaped in p.flags then
  116. internalerror(234234);
  117. end
  118. else
  119. if (
  120. (p.location.loc=LOC_FPUREGISTER) and
  121. (p.right.registersfpu > p.left.registersfpu)
  122. ) or
  123. (
  124. (
  125. (
  126. ((p.left.registersfpu = 0) and (p.right.registersfpu = 0)) or
  127. (p.location.loc<>LOC_FPUREGISTER)
  128. ) and
  129. (p.left.registers32<p.right.registers32)
  130. )
  131. ) then
  132. begin
  133. hp:=p.left;
  134. p.left:=p.right;
  135. p.right:=hp;
  136. if nf_swaped in p.flags then
  137. exclude(p.flags,nf_swaped)
  138. else
  139. include(p.flags,nf_swaped);
  140. end;
  141. end;
  142. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  143. {
  144. produces jumps to true respectively false labels using boolean expressions
  145. depending on whether the loading of regvars is currently being
  146. synchronized manually (such as in an if-node) or automatically (most of
  147. the other cases where this procedure is called), loadregvars can be
  148. "lr_load_regvars" or "lr_dont_load_regvars"
  149. }
  150. var
  151. opsize : tcgsize;
  152. storepos : tfileposinfo;
  153. begin
  154. if nf_error in p.flags then
  155. exit;
  156. storepos:=aktfilepos;
  157. aktfilepos:=p.fileinfo;
  158. if is_boolean(p.resulttype.def) then
  159. begin
  160. {$ifdef OLDREGVARS}
  161. if loadregvars = lr_load_regvars then
  162. load_all_regvars(list);
  163. {$endif OLDREGVARS}
  164. if is_constboolnode(p) then
  165. begin
  166. if tordconstnode(p).value<>0 then
  167. cg.a_jmp_always(list,truelabel)
  168. else
  169. cg.a_jmp_always(list,falselabel)
  170. end
  171. else
  172. begin
  173. opsize:=def_cgsize(p.resulttype.def);
  174. case p.location.loc of
  175. LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
  176. begin
  177. {$ifdef OLDREGVARS}
  178. if (p.location.loc = LOC_CREGISTER) then
  179. load_regvar_reg(list,p.location.register);
  180. {$endif OLDREGVARS}
  181. cg.a_cmp_const_loc_label(list,opsize,OC_NE,
  182. 0,p.location,truelabel);
  183. { !!! should happen right after cmp (JM) }
  184. location_release(list,p.location);
  185. cg.a_jmp_always(list,falselabel);
  186. end;
  187. LOC_JUMP:
  188. ;
  189. {$ifdef cpuflags}
  190. LOC_FLAGS :
  191. begin
  192. cg.a_jmp_flags(list,p.location.resflags,
  193. truelabel);
  194. cg.a_jmp_always(list,falselabel);
  195. end;
  196. {$endif cpuflags}
  197. else
  198. begin
  199. printnode(output,p);
  200. internalerror(200308241);
  201. end;
  202. end;
  203. end;
  204. end
  205. else
  206. internalerror(200112305);
  207. aktfilepos:=storepos;
  208. end;
  209. (*
  210. This code needs fixing. It is not safe to use rgint; on the m68000 it
  211. would be rgaddr.
  212. procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
  213. begin
  214. case t.loc of
  215. LOC_REGISTER:
  216. begin
  217. { can't be a regvar, since it would be LOC_CREGISTER then }
  218. exclude(regs,getsupreg(t.register));
  219. if t.registerhigh<>NR_NO then
  220. exclude(regs,getsupreg(t.registerhigh));
  221. end;
  222. LOC_CREFERENCE,LOC_REFERENCE:
  223. begin
  224. if not(cs_regvars in aktglobalswitches) or
  225. (getsupreg(t.reference.base) in cg.rgint.usableregs) then
  226. exclude(regs,getsupreg(t.reference.base));
  227. if not(cs_regvars in aktglobalswitches) or
  228. (getsupreg(t.reference.index) in cg.rgint.usableregs) then
  229. exclude(regs,getsupreg(t.reference.index));
  230. end;
  231. end;
  232. end;
  233. *)
  234. {*****************************************************************************
  235. EXCEPTION MANAGEMENT
  236. *****************************************************************************}
  237. procedure new_exception(list:TAAsmoutput;const jmpbuf,envbuf, href : treference;
  238. a : aword; exceptlabel : tasmlabel);
  239. var
  240. paraloc1,paraloc2,paraloc3 : tparalocation;
  241. begin
  242. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  243. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  244. paraloc3:=paramanager.getintparaloc(pocall_default,3);
  245. paramanager.allocparaloc(list,paraloc3);
  246. cg.a_paramaddr_ref(list,envbuf,paraloc3);
  247. paramanager.allocparaloc(list,paraloc2);
  248. cg.a_paramaddr_ref(list,jmpbuf,paraloc2);
  249. { push type of exceptionframe }
  250. paramanager.allocparaloc(list,paraloc1);
  251. cg.a_param_const(list,OS_S32,1,paraloc1);
  252. paramanager.freeparaloc(list,paraloc3);
  253. paramanager.freeparaloc(list,paraloc2);
  254. paramanager.freeparaloc(list,paraloc1);
  255. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  256. cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
  257. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  258. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  259. paramanager.allocparaloc(list,paraloc1);
  260. cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
  261. paramanager.freeparaloc(list,paraloc1);
  262. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  263. cg.a_call_name(list,'FPC_SETJMP');
  264. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  265. cg.g_exception_reason_save(list, href);
  266. cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,NR_FUNCTION_RESULT_REG,exceptlabel);
  267. end;
  268. procedure free_exception(list:TAAsmoutput;const jmpbuf, envbuf, href : treference;
  269. a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
  270. begin
  271. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  272. cg.a_call_name(list,'FPC_POPADDRSTACK');
  273. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  274. if not onlyfree then
  275. begin
  276. cg.g_exception_reason_load(list, href);
  277. cg.a_cmp_const_reg_label(list,OS_S32,OC_EQ,a,NR_FUNCTION_RESULT_REG,endexceptlabel);
  278. end;
  279. end;
  280. {*****************************************************************************
  281. TLocation
  282. *****************************************************************************}
  283. {$ifndef cpu64bit}
  284. { 32-bit version }
  285. procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  286. var
  287. hregister,
  288. hregisterhi : tregister;
  289. hreg64 : tregister64;
  290. hl : tasmlabel;
  291. oldloc : tlocation;
  292. begin
  293. oldloc:=l;
  294. if dst_size=OS_NO then
  295. internalerror(200309144);
  296. { handle transformations to 64bit separate }
  297. if dst_size in [OS_64,OS_S64] then
  298. begin
  299. if not (l.size in [OS_64,OS_S64]) then
  300. begin
  301. { load a smaller size to OS_64 }
  302. if l.loc=LOC_REGISTER then
  303. begin
  304. hregister:=cg.makeregsize(l.registerlow,OS_32);
  305. cg.a_load_reg_reg(list,l.size,OS_32,l.registerlow,hregister);
  306. end
  307. else
  308. begin
  309. location_release(list,l);
  310. hregister:=cg.getintregister(list,OS_INT);
  311. end;
  312. { load value in low register }
  313. case l.loc of
  314. LOC_FLAGS :
  315. cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
  316. LOC_JUMP :
  317. begin
  318. cg.a_label(list,truelabel);
  319. cg.a_load_const_reg(list,OS_INT,1,hregister);
  320. objectlibrary.getlabel(hl);
  321. cg.a_jmp_always(list,hl);
  322. cg.a_label(list,falselabel);
  323. cg.a_load_const_reg(list,OS_INT,0,hregister);
  324. cg.a_label(list,hl);
  325. end;
  326. else
  327. cg.a_load_loc_reg(list,OS_INT,l,hregister);
  328. end;
  329. { reset hi part, take care of the signed bit of the current value }
  330. hregisterhi:=cg.getintregister(list,OS_INT);
  331. if (dst_size=OS_S64) and
  332. (l.size in [OS_S8,OS_S16,OS_S32]) then
  333. begin
  334. if l.loc=LOC_CONSTANT then
  335. begin
  336. if (longint(l.value)<0) then
  337. cg.a_load_const_reg(list,OS_32,$ffffffff,hregisterhi)
  338. else
  339. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  340. end
  341. else
  342. begin
  343. cg.a_op_const_reg_reg(list,OP_SAR,OS_32,31,hregister,
  344. hregisterhi);
  345. end;
  346. end
  347. else
  348. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  349. location_reset(l,LOC_REGISTER,dst_size);
  350. l.registerlow:=hregister;
  351. l.registerhigh:=hregisterhi;
  352. end
  353. else
  354. begin
  355. { 64bit to 64bit }
  356. if (l.loc=LOC_REGISTER) or
  357. ((l.loc=LOC_CREGISTER) and maybeconst) then
  358. begin
  359. hregister:=l.registerlow;
  360. hregisterhi:=l.registerhigh;
  361. end
  362. else
  363. begin
  364. hregister:=cg.getintregister(list,OS_INT);
  365. hregisterhi:=cg.getintregister(list,OS_INT);
  366. location_release(list,l);
  367. end;
  368. hreg64.reglo:=hregister;
  369. hreg64.reghi:=hregisterhi;
  370. { load value in new register }
  371. cg64.a_load64_loc_reg(list,l,hreg64);
  372. location_reset(l,LOC_REGISTER,dst_size);
  373. l.registerlow:=hregister;
  374. l.registerhigh:=hregisterhi;
  375. end;
  376. end
  377. else
  378. begin
  379. {Do not bother to recycle the existing register. The register
  380. allocator eliminates unnecessary moves, so it's not needed
  381. and trying to recycle registers can cause problems because
  382. the registers changes size and may need aditional constraints.}
  383. location_release(list,l);
  384. hregister:=cg.getintregister(list,dst_size);
  385. { load value in new register }
  386. case l.loc of
  387. LOC_FLAGS :
  388. cg.g_flags2reg(list,dst_size,l.resflags,hregister);
  389. LOC_JUMP :
  390. begin
  391. cg.a_label(list,truelabel);
  392. cg.a_load_const_reg(list,dst_size,1,hregister);
  393. objectlibrary.getlabel(hl);
  394. cg.a_jmp_always(list,hl);
  395. cg.a_label(list,falselabel);
  396. cg.a_load_const_reg(list,dst_size,0,hregister);
  397. cg.a_label(list,hl);
  398. end;
  399. else
  400. begin
  401. { load_loc_reg can only handle size >= l.size, when the
  402. new size is smaller then we need to adjust the size
  403. of the orignal and maybe recalculate l.register for i386 }
  404. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  405. begin
  406. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  407. l.register:=cg.makeregsize(l.register,dst_size);
  408. { for big endian systems, the reference's offset must }
  409. { be increased in this case, since they have the }
  410. { MSB first in memory and e.g. byte(word_var) should }
  411. { return the second byte in this case (JM) }
  412. if (target_info.endian = ENDIAN_BIG) and
  413. (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  414. inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
  415. {$ifdef i386}
  416. l.size:=dst_size;
  417. {$endif i386}
  418. end;
  419. cg.a_load_loc_reg(list,dst_size,l,hregister);
  420. {$ifndef i386}
  421. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  422. l.size:=dst_size;
  423. {$endif not i386}
  424. end;
  425. end;
  426. if (l.loc <> LOC_CREGISTER) or
  427. not maybeconst then
  428. location_reset(l,LOC_REGISTER,dst_size)
  429. else
  430. location_reset(l,LOC_CREGISTER,dst_size);
  431. l.register:=hregister;
  432. end;
  433. { Release temp when it was a reference }
  434. if oldloc.loc=LOC_REFERENCE then
  435. location_freetemp(list,oldloc);
  436. end;
  437. {$else cpu64bit}
  438. { 64-bit version }
  439. procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  440. var
  441. hregister : tregister;
  442. hl : tasmlabel;
  443. oldloc : tlocation;
  444. begin
  445. oldloc:=l;
  446. if dst_size=OS_NO then
  447. internalerror(200309144);
  448. { handle transformations to 64bit separate }
  449. if dst_size in [OS_64,OS_S64] then
  450. begin
  451. { load a smaller size to OS_64 }
  452. if l.loc=LOC_REGISTER then
  453. hregister:=cg.makeregsize(l.register,OS_INT)
  454. else
  455. begin
  456. location_release(list,l);
  457. hregister:=cg.getintregister(list,OS_INT);
  458. end;
  459. { load value in low register }
  460. case l.loc of
  461. {$ifdef cpuflags}
  462. LOC_FLAGS :
  463. cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
  464. {$endif cpuflags}
  465. LOC_JUMP :
  466. begin
  467. cg.a_label(list,truelabel);
  468. cg.a_load_const_reg(list,OS_INT,1,hregister);
  469. objectlibrary.getlabel(hl);
  470. cg.a_jmp_always(list,hl);
  471. cg.a_label(list,falselabel);
  472. cg.a_load_const_reg(list,OS_INT,0,hregister);
  473. cg.a_label(list,hl);
  474. end;
  475. else
  476. cg.a_load_loc_reg(list,OS_INT,l,hregister);
  477. end;
  478. location_reset(l,LOC_REGISTER,dst_size);
  479. l.register:=hregister;
  480. end
  481. else
  482. begin
  483. { transformations to 32bit or smaller }
  484. if l.loc=LOC_REGISTER then
  485. begin
  486. hregister:=l.register;
  487. end
  488. else
  489. begin
  490. { get new register }
  491. if (l.loc=LOC_CREGISTER) and
  492. maybeconst and
  493. (TCGSize2Size[dst_size]=TCGSize2Size[l.size]) then
  494. hregister:=l.register
  495. else
  496. begin
  497. location_release(list,l);
  498. hregister:=cg.getintregister(list,OS_INT);
  499. end;
  500. end;
  501. hregister:=cg.makeregsize(hregister,dst_size);
  502. { load value in new register }
  503. case l.loc of
  504. {$ifdef cpuflags}
  505. LOC_FLAGS :
  506. cg.g_flags2reg(list,dst_size,l.resflags,hregister);
  507. {$endif cpuflags}
  508. LOC_JUMP :
  509. begin
  510. cg.a_label(list,truelabel);
  511. cg.a_load_const_reg(list,dst_size,1,hregister);
  512. objectlibrary.getlabel(hl);
  513. cg.a_jmp_always(list,hl);
  514. cg.a_label(list,falselabel);
  515. cg.a_load_const_reg(list,dst_size,0,hregister);
  516. cg.a_label(list,hl);
  517. end;
  518. else
  519. begin
  520. { load_loc_reg can only handle size >= l.size, when the
  521. new size is smaller then we need to adjust the size
  522. of the orignal and maybe recalculate l.register for i386 }
  523. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  524. begin
  525. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  526. l.register:=cg.makeregsize(l.register,dst_size);
  527. { for big endian systems, the reference's offset must }
  528. { be increased in this case, since they have the }
  529. { MSB first in memory and e.g. byte(word_var) should }
  530. { return the second byte in this case (JM) }
  531. if (target_info.endian = ENDIAN_BIG) and
  532. (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  533. inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
  534. {$ifdef i386}
  535. l.size:=dst_size;
  536. {$endif i386}
  537. end;
  538. cg.a_load_loc_reg(list,dst_size,l,hregister);
  539. {$ifndef i386}
  540. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  541. l.size:=dst_size;
  542. {$endif not i386}
  543. end;
  544. end;
  545. location_reset(l,LOC_REGISTER,dst_size);
  546. l.register:=hregister;
  547. end;
  548. { Release temp when it was a reference }
  549. if oldloc.loc=LOC_REFERENCE then
  550. location_freetemp(list,oldloc);
  551. end;
  552. {$endif cpu64bit}
  553. procedure location_force_fpureg(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
  554. var
  555. reg : tregister;
  556. href : treference;
  557. begin
  558. if (l.loc<>LOC_FPUREGISTER) and
  559. ((l.loc<>LOC_CFPUREGISTER) or (not maybeconst)) then
  560. begin
  561. { if it's in an mm register, store to memory first }
  562. if (l.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
  563. begin
  564. tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
  565. cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,href,mms_movescalar);
  566. location_release(list,l);
  567. location_reset(l,LOC_REFERENCE,l.size);
  568. l.reference:=href;
  569. end;
  570. reg:=cg.getfpuregister(list,l.size);
  571. cg.a_loadfpu_loc_reg(list,l,reg);
  572. location_freetemp(list,l);
  573. location_release(list,l);
  574. location_reset(l,LOC_FPUREGISTER,l.size);
  575. l.register:=reg;
  576. end;
  577. end;
  578. procedure location_force_mmregscalar(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
  579. var
  580. reg : tregister;
  581. href : treference;
  582. begin
  583. if (l.loc<>LOC_MMREGISTER) and
  584. ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then
  585. begin
  586. { if it's in an fpu register, store to memory first }
  587. if (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
  588. begin
  589. tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
  590. cg.a_loadfpu_reg_ref(list,l.size,l.register,href);
  591. location_release(list,l);
  592. location_reset(l,LOC_REFERENCE,l.size);
  593. l.reference:=href;
  594. end;
  595. reg:=cg.getmmregister(list,l.size);
  596. cg.a_loadmm_loc_reg(list,l.size,l,reg,mms_movescalar);
  597. location_freetemp(list,l);
  598. location_release(list,l);
  599. location_reset(l,LOC_MMREGISTER,l.size);
  600. l.register:=reg;
  601. end;
  602. end;
  603. procedure location_force_mem(list:TAAsmoutput;var l:tlocation);
  604. var
  605. r : treference;
  606. begin
  607. case l.loc of
  608. LOC_FPUREGISTER,
  609. LOC_CFPUREGISTER :
  610. begin
  611. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  612. cg.a_loadfpu_reg_ref(list,l.size,l.register,r);
  613. location_release(list,l);
  614. location_reset(l,LOC_REFERENCE,l.size);
  615. l.reference:=r;
  616. end;
  617. LOC_MMREGISTER,
  618. LOC_CMMREGISTER:
  619. begin
  620. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  621. cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,r,mms_movescalar);
  622. location_release(list,l);
  623. location_reset(l,LOC_REFERENCE,l.size);
  624. l.reference:=r;
  625. end;
  626. LOC_CONSTANT,
  627. LOC_REGISTER,
  628. LOC_CREGISTER :
  629. begin
  630. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  631. if l.size in [OS_64,OS_S64] then
  632. begin
  633. cg64.a_load64_loc_ref(list,l,r);
  634. location_release(list,l);
  635. end
  636. else
  637. begin
  638. location_release(list,l);
  639. cg.a_load_loc_ref(list,l.size,l,r);
  640. end;
  641. location_reset(l,LOC_REFERENCE,l.size);
  642. l.reference:=r;
  643. end;
  644. LOC_CREFERENCE,
  645. LOC_REFERENCE : ;
  646. else
  647. internalerror(200203219);
  648. end;
  649. end;
  650. {*****************************************************************************
  651. Maybe_Save
  652. *****************************************************************************}
  653. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  654. begin
  655. {$ifdef i386}
  656. if (needed>=maxfpuregs) and
  657. (l.loc = LOC_FPUREGISTER) then
  658. begin
  659. location_force_mem(list,l);
  660. maybe_pushfpu:=true;
  661. end
  662. else
  663. maybe_pushfpu:=false;
  664. {$endif i386}
  665. end;
  666. {****************************************************************************
  667. Init/Finalize Code
  668. ****************************************************************************}
  669. procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
  670. var
  671. href1,href2 : treference;
  672. list:TAAsmoutput;
  673. hsym : tvarsym;
  674. l : longint;
  675. loadref : boolean;
  676. localcopyloc : tparalocation;
  677. begin
  678. list:=taasmoutput(arg);
  679. if (tsym(p).typ=varsym) and
  680. (tvarsym(p).varspez=vs_value) and
  681. (paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
  682. begin
  683. loadref:=true;
  684. case tvarsym(p).localloc.loc of
  685. LOC_REGISTER :
  686. begin
  687. reference_reset_base(href1,tvarsym(p).localloc.register,0);
  688. loadref:=false;
  689. end;
  690. LOC_REFERENCE :
  691. reference_reset_base(href1,tvarsym(p).localloc.reference.index,
  692. tvarsym(p).localloc.reference.offset);
  693. else
  694. internalerror(200309181);
  695. end;
  696. if is_open_array(tvarsym(p).vartype.def) or
  697. is_array_of_const(tvarsym(p).vartype.def) then
  698. begin
  699. { cdecl functions don't have a high pointer so it is not possible to generate
  700. a local copy }
  701. if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  702. begin
  703. hsym:=tvarsym(tsym(p).owner.search('high'+p.name));
  704. if not assigned(hsym) then
  705. internalerror(200306061);
  706. case hsym.localloc.loc of
  707. LOC_REFERENCE :
  708. begin
  709. { this code is only executed before the code for the body and the entry/exit code is generated
  710. so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
  711. }
  712. include(current_procinfo.flags,pi_do_call);
  713. reference_reset_base(href2,hsym.localloc.reference.index,hsym.localloc.reference.offset);
  714. cg.g_copyvaluepara_openarray(list,href1,href2,tarraydef(tvarsym(p).vartype.def).elesize)
  715. end
  716. else
  717. internalerror(200309182);
  718. end;
  719. end;
  720. end
  721. else
  722. begin
  723. if tvarsym(p).localloc.loc<>LOC_REFERENCE then
  724. internalerror(200309183);
  725. { Allocate space for the local copy }
  726. l:=tvarsym(p).getvaluesize;
  727. localcopyloc.loc:=LOC_REFERENCE;
  728. localcopyloc.size:=int_cgsize(l);
  729. tg.GetLocal(list,l,localcopyloc.reference);
  730. { Copy data }
  731. reference_reset_base(href2,localcopyloc.reference.index,localcopyloc.reference.offset);
  732. if is_shortstring(tvarsym(p).vartype.def) then
  733. begin
  734. { this code is only executed before the code for the body and the entry/exit code is generated
  735. so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
  736. }
  737. include(current_procinfo.flags,pi_do_call);
  738. cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,loadref)
  739. end
  740. else
  741. cg.g_concatcopy(list,href1,href2,tvarsym(p).vartype.def.size,true,loadref);
  742. { update localloc of varsym }
  743. tg.Ungetlocal(list,tvarsym(p).localloc.reference);
  744. tvarsym(p).localloc:=localcopyloc;
  745. end;
  746. end;
  747. end;
  748. { generates the code for initialisation of local data }
  749. procedure initialize_data(p : tnamedindexitem;arg:pointer);
  750. var
  751. href : treference;
  752. list:TAAsmoutput;
  753. begin
  754. list:=taasmoutput(arg);
  755. if (tsym(p).typ=varsym) and
  756. (tvarsym(p).refs>0) and
  757. assigned(tvarsym(p).vartype.def) and
  758. not(is_class(tvarsym(p).vartype.def)) and
  759. tvarsym(p).vartype.def.needs_inittable then
  760. begin
  761. if (cs_implicit_exceptions in aktmoduleswitches) then
  762. include(current_procinfo.flags,pi_needs_implicit_finally);
  763. if tvarsym(p).owner.symtabletype=localsymtable then
  764. begin
  765. case tvarsym(p).localloc.loc of
  766. LOC_REFERENCE :
  767. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  768. else
  769. internalerror(2003091810);
  770. end;
  771. end
  772. else
  773. reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
  774. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  775. end;
  776. end;
  777. { generates the code for finalisation of local data }
  778. procedure finalize_data(p : tnamedindexitem;arg:pointer);
  779. var
  780. href : treference;
  781. list:TAAsmoutput;
  782. begin
  783. list:=taasmoutput(arg);
  784. case tsym(p).typ of
  785. varsym :
  786. begin
  787. if (tvarsym(p).refs>0) and
  788. not(vo_is_funcret in tvarsym(p).varoptions) and
  789. assigned(tvarsym(p).vartype.def) and
  790. not(is_class(tvarsym(p).vartype.def)) and
  791. tvarsym(p).vartype.def.needs_inittable then
  792. begin
  793. if tvarsym(p).owner.symtabletype=localsymtable then
  794. begin
  795. case tvarsym(p).localloc.loc of
  796. LOC_REFERENCE :
  797. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  798. else
  799. internalerror(2003091811);
  800. end;
  801. end
  802. else
  803. reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
  804. cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
  805. end;
  806. end;
  807. typedconstsym :
  808. begin
  809. if ttypedconstsym(p).is_writable and
  810. ttypedconstsym(p).typedconsttype.def.needs_inittable then
  811. begin
  812. reference_reset_symbol(href,objectlibrary.newasmsymboldata(ttypedconstsym(p).mangledname),0);
  813. cg.g_finalize(list,ttypedconstsym(p).typedconsttype.def,href,false);
  814. end;
  815. end;
  816. end;
  817. end;
  818. { generates the code for incrementing the reference count of parameters and
  819. initialize out parameters }
  820. procedure init_paras(p : tnamedindexitem;arg:pointer);
  821. var
  822. href : treference;
  823. tmpreg : tregister;
  824. list:TAAsmoutput;
  825. begin
  826. list:=taasmoutput(arg);
  827. if (tsym(p).typ=varsym) and
  828. not is_class(tvarsym(p).vartype.def) and
  829. tvarsym(p).vartype.def.needs_inittable then
  830. begin
  831. case tvarsym(p).varspez of
  832. vs_value :
  833. begin
  834. if (cs_implicit_exceptions in aktmoduleswitches) then
  835. include(current_procinfo.flags,pi_needs_implicit_finally);
  836. if tvarsym(p).localloc.loc<>LOC_REFERENCE then
  837. internalerror(200309187);
  838. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  839. cg.g_incrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
  840. end;
  841. vs_out :
  842. begin
  843. case tvarsym(p).localloc.loc of
  844. LOC_REFERENCE :
  845. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  846. else
  847. internalerror(2003091810);
  848. end;
  849. tmpreg:=cg.getaddressregister(list);
  850. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,tmpreg);
  851. reference_reset_base(href,tmpreg,0);
  852. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  853. cg.ungetregister(list,tmpreg);
  854. end;
  855. end;
  856. end;
  857. end;
  858. { generates the code for decrementing the reference count of parameters }
  859. procedure final_paras(p : tnamedindexitem;arg:pointer);
  860. var
  861. href : treference;
  862. list:TAAsmoutput;
  863. begin
  864. list:=taasmoutput(arg);
  865. if (tsym(p).typ=varsym) and
  866. not is_class(tvarsym(p).vartype.def) and
  867. tvarsym(p).vartype.def.needs_inittable then
  868. begin
  869. if (tvarsym(p).varspez=vs_value) then
  870. begin
  871. if tvarsym(p).localloc.loc<>LOC_REFERENCE then
  872. internalerror(200309188);
  873. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  874. cg.g_decrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
  875. end;
  876. end
  877. else if (tsym(p).typ=varsym) and
  878. (tvarsym(p).varspez=vs_value) and
  879. (is_open_array(tvarsym(p).vartype.def) or
  880. is_array_of_const(tvarsym(p).vartype.def)) then
  881. begin
  882. { cdecl functions don't have a high pointer so it is not possible to generate
  883. a local copy }
  884. if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  885. begin
  886. reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
  887. cg.g_releasevaluepara_openarray(list,href);
  888. end;
  889. end;
  890. end;
  891. { Initialize temp ansi/widestrings,interfaces }
  892. procedure inittempvariables(list:taasmoutput);
  893. var
  894. hp : ptemprecord;
  895. href : treference;
  896. begin
  897. hp:=tg.templist;
  898. while assigned(hp) do
  899. begin
  900. if assigned(hp^.def) and
  901. hp^.def.needs_inittable then
  902. begin
  903. if (cs_implicit_exceptions in aktmoduleswitches) then
  904. include(current_procinfo.flags,pi_needs_implicit_finally);
  905. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  906. cg.g_initialize(list,hp^.def,href,false);
  907. end;
  908. hp:=hp^.next;
  909. end;
  910. end;
  911. procedure finalizetempvariables(list:taasmoutput);
  912. var
  913. hp : ptemprecord;
  914. href : treference;
  915. paraloc1 : tparalocation;
  916. begin
  917. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  918. hp:=tg.templist;
  919. while assigned(hp) do
  920. begin
  921. if assigned(hp^.def) and
  922. hp^.def.needs_inittable then
  923. begin
  924. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  925. cg.g_finalize(list,hp^.def,href,false);
  926. end;
  927. hp:=hp^.next;
  928. end;
  929. end;
  930. procedure gen_load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
  931. var
  932. ressym : tvarsym;
  933. resloc : tlocation;
  934. href : treference;
  935. hreg : tregister;
  936. begin
  937. { Is the loading needed? }
  938. if is_void(current_procinfo.procdef.rettype.def) or
  939. (
  940. (po_assembler in current_procinfo.procdef.procoptions) and
  941. (not(assigned(current_procinfo.procdef.funcretsym)) or
  942. (tvarsym(current_procinfo.procdef.funcretsym).refs=0))
  943. ) then
  944. exit;
  945. { Constructors need to return self }
  946. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  947. begin
  948. cg.getexplicitregister(list,NR_FUNCTION_RETURN_REG);
  949. { return the self pointer }
  950. ressym:=tvarsym(current_procinfo.procdef.parast.search('self'));
  951. if not assigned(ressym) then
  952. internalerror(200305058);
  953. case ressym.localloc.loc of
  954. LOC_REFERENCE :
  955. reference_reset_base(href,ressym.localloc.reference.index,ressym.localloc.reference.offset);
  956. else
  957. internalerror(2003091810);
  958. end;
  959. cg.ungetregister(list,NR_FUNCTION_RETURN_REG);
  960. // for the optimizer
  961. cg.a_reg_alloc(list,NR_FUNCTION_RETURN_REG);
  962. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_FUNCTION_RETURN_REG);
  963. uses_acc:=true;
  964. exit;
  965. end;
  966. ressym := tvarsym(current_procinfo.procdef.funcretsym);
  967. if (ressym.refs>0) then
  968. begin
  969. case ressym.localloc.loc of
  970. LOC_FPUREGISTER,
  971. LOC_REGISTER :
  972. begin
  973. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  974. location_reset(resloc,LOC_CREGISTER,OS_ADDR)
  975. else
  976. if ressym.vartype.def.deftype = floatdef then
  977. location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procinfo.procdef.rettype.def))
  978. else
  979. location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
  980. resloc.register:=ressym.localloc.register;
  981. end;
  982. LOC_REFERENCE :
  983. begin
  984. location_reset(resloc,LOC_REFERENCE,def_cgsize(current_procinfo.procdef.rettype.def));
  985. reference_reset_base(resloc.reference,ressym.localloc.reference.index,ressym.localloc.reference.offset);
  986. end;
  987. else
  988. internalerror(200309184);
  989. end;
  990. { Here, we return the function result. In most architectures, the value is
  991. passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
  992. function returns in a register and the caller receives it in an other one }
  993. case current_procinfo.procdef.rettype.def.deftype of
  994. orddef,
  995. enumdef :
  996. begin
  997. uses_acc:=true;
  998. {$ifndef cpu64bit}
  999. if resloc.size in [OS_64,OS_S64] then
  1000. begin
  1001. uses_acchi:=true;
  1002. cg.getexplicitregister(list,NR_FUNCTION_RETURN64_LOW_REG);
  1003. cg.getexplicitregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
  1004. cg.ungetregister(list,NR_FUNCTION_RETURN64_LOW_REG);
  1005. cg.ungetregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
  1006. // for the optimizer
  1007. cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_LOW_REG);
  1008. cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
  1009. cg64.a_load64_loc_reg(list,resloc,joinreg64(NR_FUNCTION_RETURN64_LOW_REG,
  1010. NR_FUNCTION_RETURN64_HIGH_REG));
  1011. end
  1012. else
  1013. {$endif cpu64bit}
  1014. begin
  1015. cg.getexplicitregister(list,NR_FUNCTION_RETURN_REG);
  1016. hreg:=cg.makeregsize(NR_FUNCTION_RETURN_REG,resloc.size);
  1017. cg.ungetregister(list,hreg);
  1018. // for the optimizer
  1019. cg.a_reg_alloc(list,NR_FUNCTION_RETURN_REG);
  1020. cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
  1021. end;
  1022. end;
  1023. floatdef :
  1024. begin
  1025. uses_fpu := true;
  1026. {$ifdef cpufpemu}
  1027. if cs_fp_emulation in aktmoduleswitches then
  1028. cg.a_loadfpu_loc_reg(list,resloc,NR_FUNCTION_RETURN_REG)
  1029. else
  1030. {$endif cpufpemu}
  1031. cg.a_loadfpu_loc_reg(list,resloc,NR_FPU_RESULT_REG);
  1032. end;
  1033. else
  1034. begin
  1035. if not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1036. begin
  1037. uses_acc:=true;
  1038. {$ifndef cpu64bit}
  1039. { Win32 can return records in EAX:EDX }
  1040. if resloc.size in [OS_64,OS_S64] then
  1041. begin
  1042. uses_acchi:=true;
  1043. cg.getexplicitregister(list,NR_FUNCTION_RETURN64_LOW_REG);
  1044. cg.getexplicitregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
  1045. cg.ungetregister(list,NR_FUNCTION_RETURN64_LOW_REG);
  1046. cg.ungetregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
  1047. // for the optimizer
  1048. cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_LOW_REG);
  1049. cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
  1050. cg64.a_load64_loc_reg(list,resloc,joinreg64(NR_FUNCTION_RETURN64_LOW_REG,
  1051. NR_FUNCTION_RETURN64_HIGH_REG));
  1052. end
  1053. else
  1054. {$endif cpu64bit}
  1055. begin
  1056. cg.getexplicitregister(list,NR_FUNCTION_RETURN_REG);
  1057. hreg:=cg.makeregsize(NR_FUNCTION_RETURN_REG,resloc.size);
  1058. cg.ungetregister(list,hreg);
  1059. // for the optimizer
  1060. cg.a_reg_alloc(list,NR_FUNCTION_RETURN_REG);
  1061. cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
  1062. end;
  1063. end
  1064. end;
  1065. end;
  1066. end;
  1067. end;
  1068. procedure gen_load_para_value(list:TAAsmoutput);
  1069. var
  1070. hp : tparaitem;
  1071. href : treference;
  1072. gotregvarparas : boolean;
  1073. begin
  1074. { Store register parameters in reference or in register variable }
  1075. if assigned(current_procinfo.procdef.parast) and
  1076. not (po_assembler in current_procinfo.procdef.procoptions) then
  1077. begin
  1078. { move register parameters which aren't regable into memory }
  1079. { we do this before init_paras because that one calls routines which may overwrite these }
  1080. { registers and it also expects the values to be in memory }
  1081. hp:=tparaitem(current_procinfo.procdef.para.first);
  1082. gotregvarparas := false;
  1083. while assigned(hp) do
  1084. begin
  1085. case tvarsym(hp.parasym).localloc.loc of
  1086. LOC_REGISTER :
  1087. begin
  1088. gotregvarparas := true;
  1089. { cg.a_load_param_reg will first allocate and then deallocate paraloc }
  1090. { register (if the parameter resides in a register) and then allocate }
  1091. { the regvar (which is currently not allocated) }
  1092. cg.a_loadany_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.register,nil);
  1093. end;
  1094. LOC_FPUREGISTER:
  1095. begin
  1096. gotregvarparas := true;
  1097. { cg.a_load_param_reg will first allocate and then deallocate paraloc }
  1098. { register (if the parameter resides in a register) and then allocate }
  1099. { the regvar (which is currently not allocated) }
  1100. cg.a_loadany_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.register,nil);
  1101. end;
  1102. LOC_REFERENCE :
  1103. begin
  1104. if hp.paraloc[calleeside].loc<>LOC_REFERENCE then
  1105. begin
  1106. if getsupreg(hp.paraloc[calleeside].register)<first_int_imreg then
  1107. begin
  1108. {$ifndef cpu64bit}
  1109. if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
  1110. begin
  1111. cg.getexplicitregister(list,hp.paraloc[calleeside].registerlow);
  1112. cg.getexplicitregister(list,hp.paraloc[calleeside].registerhigh);
  1113. end
  1114. else
  1115. {$endif cpu64bit}
  1116. cg.getexplicitregister(list,hp.paraloc[calleeside].register);
  1117. end;
  1118. { Release parameter register }
  1119. {$ifndef cpu64bit}
  1120. if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
  1121. begin
  1122. cg.ungetregister(list,hp.paraloc[calleeside].registerlow);
  1123. cg.ungetregister(list,hp.paraloc[calleeside].registerhigh);
  1124. end
  1125. else
  1126. {$endif cpu64bit}
  1127. cg.ungetregister(list,hp.paraloc[calleeside].register);
  1128. reference_reset_base(href,tvarsym(hp.parasym).localloc.reference.index,tvarsym(hp.parasym).localloc.reference.offset);
  1129. cg.a_loadany_param_ref(list,hp.paraloc[calleeside],href,nil);
  1130. end;
  1131. end;
  1132. else
  1133. internalerror(200309185);
  1134. end;
  1135. hp:=tparaitem(hp.next);
  1136. end;
  1137. if gotregvarparas then
  1138. begin
  1139. { deallocate all register variables again }
  1140. hp:=tparaitem(current_procinfo.procdef.para.first);
  1141. while assigned(hp) do
  1142. begin
  1143. if (tvarsym(hp.parasym).localloc.loc=LOC_REGISTER) then
  1144. cg.ungetregister(list,tvarsym(hp.parasym).localloc.register);
  1145. hp:=tparaitem(hp.next);
  1146. end;
  1147. end;
  1148. end;
  1149. { generate copies of call by value parameters, must be done before
  1150. the initialization and body is parsed because the refcounts are
  1151. incremented using the local copies }
  1152. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1153. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1154. end;
  1155. procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
  1156. begin
  1157. { initialize local data like ansistrings }
  1158. case current_procinfo.procdef.proctypeoption of
  1159. potype_unitinit:
  1160. begin
  1161. { this is also used for initialization of variables in a
  1162. program which does not have a globalsymtable }
  1163. if assigned(current_module.globalsymtable) then
  1164. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1165. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1166. end;
  1167. { units have seperate code for initilization and finalization }
  1168. potype_unitfinalize: ;
  1169. { program init/final is generated in separate procedure }
  1170. potype_proginit: ;
  1171. else
  1172. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1173. end;
  1174. { initialisizes temp. ansi/wide string data }
  1175. inittempvariables(list);
  1176. { initialize ansi/widesstring para's }
  1177. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1178. {$ifdef OLDREGVARS}
  1179. load_regvars(list,nil);
  1180. {$endif OLDREGVARS}
  1181. end;
  1182. procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
  1183. begin
  1184. {$ifdef OLDREGVARS}
  1185. cleanup_regvars(list);
  1186. {$endif OLDREGVARS}
  1187. { finalize temporary data }
  1188. finalizetempvariables(list);
  1189. { finalize local data like ansistrings}
  1190. case current_procinfo.procdef.proctypeoption of
  1191. potype_unitfinalize:
  1192. begin
  1193. { this is also used for initialization of variables in a
  1194. program which does not have a globalsymtable }
  1195. if assigned(current_module.globalsymtable) then
  1196. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1197. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1198. end;
  1199. { units/progs have separate code for initialization and finalization }
  1200. potype_unitinit: ;
  1201. { program init/final is generated in separate procedure }
  1202. potype_proginit: ;
  1203. else
  1204. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1205. end;
  1206. { finalize paras data }
  1207. if assigned(current_procinfo.procdef.parast) then
  1208. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1209. end;
  1210. procedure gen_entry_code(list:TAAsmoutput);
  1211. var
  1212. href : treference;
  1213. paraloc1,
  1214. paraloc2 : tparalocation;
  1215. begin
  1216. { the actual profile code can clobber some registers,
  1217. therefore if the context must be saved, do it before
  1218. the actual call to the profile code
  1219. }
  1220. if (cs_profile in aktmoduleswitches) and
  1221. not(po_assembler in current_procinfo.procdef.procoptions) then
  1222. begin
  1223. { non-win32 can call mcout even in main }
  1224. if not (target_info.system in [system_i386_win32,system_i386_wdosx]) then
  1225. cg.g_profilecode(list)
  1226. else
  1227. { wdosx, and win32 should not call mcount before monstartup has been called }
  1228. if not (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1229. cg.g_profilecode(list);
  1230. end;
  1231. { call startup helpers from main program }
  1232. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1233. begin
  1234. { initialize profiling for win32 }
  1235. if (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1236. (cs_profile in aktmoduleswitches) then
  1237. begin
  1238. reference_reset_symbol(href,objectlibrary.newasmsymboldata('etext'),0);
  1239. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  1240. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  1241. paramanager.allocparaloc(list,paraloc2);
  1242. cg.a_paramaddr_ref(list,href,paraloc2);
  1243. reference_reset_symbol(href,objectlibrary.newasmsymboldata('__image_base__'),0);
  1244. paramanager.allocparaloc(list,paraloc1);
  1245. cg.a_paramaddr_ref(list,href,paraloc1);
  1246. paramanager.freeparaloc(list,paraloc2);
  1247. paramanager.freeparaloc(list,paraloc1);
  1248. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1249. cg.a_call_name(list,'_monstartup');
  1250. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
  1251. end;
  1252. { initialize units }
  1253. cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1254. cg.a_call_name(list,'FPC_INITIALIZEUNITS');
  1255. cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1256. end;
  1257. {$ifdef GDB}
  1258. if (cs_debuginfo in aktmoduleswitches) then
  1259. list.concat(Tai_force_line.Create);
  1260. {$endif GDB}
  1261. {$ifdef OLDREGVARS}
  1262. load_regvars(list,nil);
  1263. {$endif OLDREGVARS}
  1264. end;
  1265. procedure gen_exit_code(list:TAAsmoutput);
  1266. begin
  1267. { call __EXIT for main program }
  1268. if (not DLLsource) and
  1269. (current_procinfo.procdef.proctypeoption=potype_proginit) then
  1270. cg.a_call_name(list,'FPC_DO_EXIT');
  1271. end;
  1272. {****************************************************************************
  1273. Entry/Exit
  1274. ****************************************************************************}
  1275. procedure gen_proc_symbol(list:Taasmoutput);
  1276. var
  1277. hs : string;
  1278. begin
  1279. { add symbol entry point as well as debug information }
  1280. { will be inserted in front of the rest of this list. }
  1281. { Insert alignment and assembler names }
  1282. { Align, gprof uses 16 byte granularity }
  1283. if (cs_profile in aktmoduleswitches) then
  1284. list.concat(Tai_align.create(16))
  1285. else
  1286. list.concat(Tai_align.create(aktalignment.procalign));
  1287. {$ifdef GDB}
  1288. if (cs_debuginfo in aktmoduleswitches) then
  1289. begin
  1290. if (po_public in current_procinfo.procdef.procoptions) then
  1291. Tprocsym(current_procinfo.procdef.procsym).is_global:=true;
  1292. current_procinfo.procdef.concatstabto(list);
  1293. Tprocsym(current_procinfo.procdef.procsym).isstabwritten:=true;
  1294. end;
  1295. {$endif GDB}
  1296. repeat
  1297. hs:=current_procinfo.procdef.aliasnames.getfirst;
  1298. if hs='' then
  1299. break;
  1300. {$ifdef GDB}
  1301. if (cs_debuginfo in aktmoduleswitches) and
  1302. target_info.use_function_relative_addresses then
  1303. list.concat(Tai_stab_function_name.create(strpnew(hs)));
  1304. {$endif GDB}
  1305. if (cs_profile in aktmoduleswitches) or
  1306. (po_public in current_procinfo.procdef.procoptions) then
  1307. list.concat(Tai_symbol.createname_global(hs,0))
  1308. else
  1309. list.concat(Tai_symbol.createname(hs,0));
  1310. until false;
  1311. end;
  1312. procedure gen_proc_symbol_end(list:Taasmoutput);
  1313. {$ifdef GDB}
  1314. var
  1315. stabsendlabel : tasmlabel;
  1316. mangled_length : longint;
  1317. p : pchar;
  1318. {$endif GDB}
  1319. begin
  1320. list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
  1321. {$ifdef GDB}
  1322. if (cs_debuginfo in aktmoduleswitches) then
  1323. begin
  1324. objectlibrary.getlabel(stabsendlabel);
  1325. cg.a_label(list,stabsendlabel);
  1326. { define calling EBP as pseudo local var PM }
  1327. { this enables test if the function is a local one !! }
  1328. {if assigned(current_procinfo.parent) and
  1329. (current_procinfo.procdef.parast.symtablelevel>normal_function_level) then
  1330. list.concat(Tai_stabs.Create(strpnew(
  1331. '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
  1332. tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.parent_framepointer_offset)))); }
  1333. if (not is_void(current_procinfo.procdef.rettype.def)) and
  1334. (tvarsym(current_procinfo.procdef.funcretsym).refs>0) then
  1335. begin
  1336. if tvarsym(current_procinfo.procdef.funcretsym).localloc.loc=LOC_REFERENCE then
  1337. begin
  1338. {$warning Need to add gdb support for ret in param register calling}
  1339. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1340. begin
  1341. list.concat(Tai_stabs.Create(strpnew(
  1342. '"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1343. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1344. if (m_result in aktmodeswitches) then
  1345. list.concat(Tai_stabs.Create(strpnew(
  1346. '"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1347. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))))
  1348. end
  1349. else
  1350. begin
  1351. list.concat(Tai_stabs.Create(strpnew(
  1352. '"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1353. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1354. if (m_result in aktmodeswitches) then
  1355. list.concat(Tai_stabs.Create(strpnew(
  1356. '"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
  1357. tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
  1358. end;
  1359. end;
  1360. end;
  1361. mangled_length:=length(current_procinfo.procdef.mangledname);
  1362. getmem(p,2*mangled_length+50);
  1363. strpcopy(p,'192,0,0,');
  1364. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1365. if (target_info.use_function_relative_addresses) then
  1366. begin
  1367. strpcopy(strend(p),'-');
  1368. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1369. end;
  1370. list.concat(Tai_stabn.Create(strnew(p)));
  1371. {List.concat(Tai_stabn.Create(strpnew('192,0,0,'
  1372. +current_procinfo.procdef.mangledname))));
  1373. p[0]:='2';p[1]:='2';p[2]:='4';
  1374. strpcopy(strend(p),'_end');}
  1375. strpcopy(p,'224,0,0,'+stabsendlabel.name);
  1376. if (target_info.use_function_relative_addresses) then
  1377. begin
  1378. strpcopy(strend(p),'-');
  1379. strpcopy(strend(p),current_procinfo.procdef.mangledname);
  1380. end;
  1381. list.concatlist(withdebuglist);
  1382. list.concat(Tai_stabn.Create(strnew(p)));
  1383. { strpnew('224,0,0,'
  1384. +current_procinfo.procdef.mangledname+'_end'))));}
  1385. freemem(p,2*mangled_length+50);
  1386. end;
  1387. {$endif GDB}
  1388. end;
  1389. procedure gen_stackalloc_code(list:Taasmoutput);
  1390. var
  1391. hitemp,
  1392. lotemp,
  1393. stackframe : longint;
  1394. begin
  1395. { Calculate size of stackframe }
  1396. stackframe:=current_procinfo.calc_stackframe_size;
  1397. { All temps are know, write offsets used for information }
  1398. if (cs_asm_source in aktglobalswitches) then
  1399. begin
  1400. if tg.direction>0 then
  1401. begin
  1402. lotemp:=current_procinfo.tempstart;
  1403. hitemp:=tg.lasttemp;
  1404. end
  1405. else
  1406. begin
  1407. lotemp:=tg.lasttemp;
  1408. hitemp:=current_procinfo.tempstart;
  1409. end;
  1410. list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
  1411. tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
  1412. end;
  1413. {$ifndef powerpc}
  1414. { at least for the ppc this applies always, so this code isn't usable (FK) }
  1415. { omit stack frame ? }
  1416. if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
  1417. begin
  1418. CGmessage(cg_d_stackframe_omited);
  1419. if stackframe<>0 then
  1420. cg.g_stackpointer_alloc(list,stackframe);
  1421. end
  1422. else
  1423. {$endif powerpc}
  1424. begin
  1425. if (po_interrupt in current_procinfo.procdef.procoptions) then
  1426. cg.g_interrupt_stackframe_entry(list);
  1427. cg.g_stackframe_entry(list,stackframe);
  1428. {Never call stack checking before the standard system unit
  1429. has been initialized.}
  1430. if (cs_check_stack in aktlocalswitches) and (current_procinfo.procdef.proctypeoption<>potype_proginit) then
  1431. cg.g_stackcheck(list,stackframe);
  1432. end;
  1433. end;
  1434. procedure gen_stackfree_code(list:Taasmoutput;usesacc,usesacchi:boolean);
  1435. var
  1436. stacksize,
  1437. retsize : longint;
  1438. begin
  1439. {$ifndef powerpc}
  1440. { remove stackframe }
  1441. if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
  1442. begin
  1443. stacksize:=current_procinfo.calc_stackframe_size;
  1444. if (stacksize<>0) then
  1445. cg.a_op_const_reg(list,OP_ADD,OS_32,stacksize,current_procinfo.framepointer);
  1446. end
  1447. else
  1448. cg.g_restore_frame_pointer(list);
  1449. {$endif}
  1450. {$ifdef x86}
  1451. { at last, the return is generated }
  1452. if (po_interrupt in current_procinfo.procdef.procoptions) then
  1453. cg.g_interrupt_stackframe_exit(list,usesacc,usesacchi)
  1454. else
  1455. {$endif x86}
  1456. begin
  1457. if current_procinfo.procdef.proccalloption in clearstack_pocalls then
  1458. begin
  1459. retsize:=0;
  1460. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1461. inc(retsize,POINTER_SIZE);
  1462. end
  1463. else
  1464. retsize:=current_procinfo.para_stack_size;
  1465. cg.g_return_from_proc(list,retsize);
  1466. end;
  1467. if usesacchi then
  1468. begin
  1469. cg.a_reg_dealloc(list,NR_FUNCTION_RETURN64_LOW_REG);
  1470. cg.a_reg_dealloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
  1471. end
  1472. else if usesacc then
  1473. cg.a_reg_dealloc(list,NR_FUNCTION_RETURN_REG);
  1474. end;
  1475. procedure gen_save_used_regs(list:TAAsmoutput);
  1476. begin
  1477. { Pure assembler routines need to save the registers themselves }
  1478. if (po_assembler in current_procinfo.procdef.procoptions) then
  1479. exit;
  1480. { for the save all registers we can simply use a pusha,popa which
  1481. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1482. if (po_saveregisters in current_procinfo.procdef.procoptions) then
  1483. cg.g_save_all_registers(list)
  1484. else
  1485. if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
  1486. cg.g_save_standard_registers(list);
  1487. end;
  1488. procedure gen_restore_used_regs(list:TAAsmoutput;usesacc,usesacchi,usesfpu:boolean);
  1489. begin
  1490. { Pure assembler routines need to save the registers themselves }
  1491. if (po_assembler in current_procinfo.procdef.procoptions) then
  1492. exit;
  1493. { for the save all registers we can simply use a pusha,popa which
  1494. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1495. if (po_saveregisters in current_procinfo.procdef.procoptions) then
  1496. cg.g_restore_all_registers(list,usesacc,usesacchi)
  1497. else
  1498. if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
  1499. cg.g_restore_standard_registers(list);
  1500. end;
  1501. {****************************************************************************
  1502. Inlining
  1503. ****************************************************************************}
  1504. (*
  1505. procedure load_inlined_return_value(list:TAAsmoutput);
  1506. var
  1507. ressym: tvarsym;
  1508. resloc: tlocation;
  1509. r,r2 : tregister;
  1510. begin
  1511. if not is_void(current_procinfo.procdef.rettype.def) then
  1512. begin
  1513. ressym := tvarsym(current_procinfo.procdef.funcretsym);
  1514. if ressym.reg.enum <> R_NO then
  1515. begin
  1516. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1517. location_reset(resloc,LOC_CREGISTER,OS_ADDR)
  1518. else
  1519. if ressym.vartype.def.deftype = floatdef then
  1520. location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procinfo.procdef.rettype.def))
  1521. else
  1522. location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
  1523. resloc.register := ressym.reg;
  1524. end
  1525. else
  1526. begin
  1527. location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
  1528. reference_reset_base(resloc.reference,current_procinfo.framepointer,tvarsym(current_procinfo.procdef.funcretsym).adjusted_address);
  1529. end;
  1530. { Here, we return the function result. In most architectures, the value is
  1531. passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
  1532. function returns in a register and the caller receives it in an other one }
  1533. case current_procinfo.procdef.rettype.def.deftype of
  1534. orddef,
  1535. enumdef :
  1536. begin
  1537. {$ifndef cpu64bit}
  1538. if resloc.size in [OS_64,OS_S64] then
  1539. begin
  1540. r:=cg.getregisterint(list,OS_INT);
  1541. r2:=cg.getregisterint(list,OS_INT);
  1542. cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
  1543. end
  1544. else
  1545. {$endif cpu64bit}
  1546. begin
  1547. r:=cg.getregisterint(list,resloc.size);
  1548. cg.a_load_loc_reg(list,resloc.size,resloc,r);
  1549. end;
  1550. end;
  1551. floatdef :
  1552. begin
  1553. {$ifdef cpufpemu}
  1554. if cs_fp_emulation in aktmoduleswitches then
  1555. r.enum := FUNCTION_RETURN_REG
  1556. else
  1557. {$endif cpufpemu}
  1558. r.enum:=FPU_RESULT_REG;
  1559. cg.a_loadfpu_loc_reg(list,resloc,r);
  1560. end;
  1561. else
  1562. begin
  1563. if not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1564. begin
  1565. {$ifndef cpu64bit}
  1566. { Win32 can return records in EAX:EDX }
  1567. if resloc.size in [OS_64,OS_S64] then
  1568. begin
  1569. r:=cg.getregisterint(list,OS_INT);
  1570. r2:=cg.getregisterint(list,OS_INT);
  1571. cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
  1572. end
  1573. else
  1574. {$endif cpu64bit}
  1575. begin
  1576. r:=cg.getregisterint(list,resloc.size);
  1577. cg.a_load_loc_reg(list,resloc.size,resloc,r);
  1578. end;
  1579. end
  1580. end;
  1581. end;
  1582. end;
  1583. end;
  1584. procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
  1585. begin
  1586. { initialize return value }
  1587. initretvalue(list);
  1588. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1589. { initialisizes temp. ansi/wide string data }
  1590. inittempvariables(list);
  1591. { initialize ansi/widesstring para's }
  1592. if assigned(current_procinfo.procdef.parast) then
  1593. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1594. { generate copies of call by value parameters }
  1595. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1596. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1597. load_regvars(list,nil);
  1598. end;
  1599. procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
  1600. var
  1601. usesacc,
  1602. usesacchi,
  1603. usesfpu : boolean;
  1604. begin
  1605. if aktexitlabel.is_used then
  1606. cg.a_label(list,aktexitlabel);
  1607. cleanup_regvars(list);
  1608. { finalize temporary data }
  1609. finalizetempvariables(list);
  1610. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1611. { finalize paras data }
  1612. if assigned(current_procinfo.procdef.parast) then
  1613. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1614. { handle return value, this is not done for assembler routines when
  1615. they didn't reference the result variable }
  1616. if not(po_assembler in current_procinfo.procdef.procoptions) or
  1617. (assigned(current_procinfo.procdef.funcretsym) and
  1618. (tvarsym(current_procinfo.procdef.funcretsym).refcount>1)) then
  1619. begin
  1620. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  1621. internalerror(200305263);
  1622. // load_inlined_return_value(list);
  1623. load_return_value(list,usesacc,usesacchi,usesfpu)
  1624. end;
  1625. cleanup_regvars(list);
  1626. end;
  1627. *)
  1628. {****************************************************************************
  1629. Const Data
  1630. ****************************************************************************}
  1631. procedure insertconstdata(sym : ttypedconstsym);
  1632. { this does not affect the local stack space, since all
  1633. typed constansts and initialized variables are always
  1634. put in the .data / .rodata section
  1635. }
  1636. var
  1637. storefilepos : tfileposinfo;
  1638. curconstsegment : taasmoutput;
  1639. l : longint;
  1640. begin
  1641. storefilepos:=aktfilepos;
  1642. aktfilepos:=sym.fileinfo;
  1643. if sym.is_writable then
  1644. curconstsegment:=datasegment
  1645. else
  1646. curconstsegment:=consts;
  1647. l:=sym.getsize;
  1648. { insert cut for smartlinking or alignment }
  1649. if (cs_create_smart in aktmoduleswitches) then
  1650. curconstSegment.concat(Tai_cut.Create);
  1651. curconstSegment.concat(Tai_align.create(const_align(l)));
  1652. {$ifdef GDB}
  1653. if cs_debuginfo in aktmoduleswitches then
  1654. sym.concatstabto(curconstsegment);
  1655. {$endif GDB}
  1656. if (sym.owner.symtabletype=globalsymtable) or
  1657. (cs_create_smart in aktmoduleswitches) or
  1658. (assigned(current_procinfo) and
  1659. (current_procinfo.procdef.proccalloption=pocall_inline)) or
  1660. DLLSource then
  1661. curconstSegment.concat(Tai_symbol.Createdataname_global(sym.mangledname,l))
  1662. else
  1663. curconstSegment.concat(Tai_symbol.Createdataname(sym.mangledname,l));
  1664. aktfilepos:=storefilepos;
  1665. end;
  1666. procedure insertbssdata(sym : tvarsym);
  1667. var
  1668. l,varalign : longint;
  1669. storefilepos : tfileposinfo;
  1670. begin
  1671. storefilepos:=aktfilepos;
  1672. aktfilepos:=sym.fileinfo;
  1673. l:=sym.getvaluesize;
  1674. if (vo_is_thread_var in sym.varoptions) then
  1675. inc(l,pointer_size);
  1676. varalign:=var_align(l);
  1677. {
  1678. sym.address:=align(datasize,varalign);
  1679. datasize:=tvarsym(sym).address+l;
  1680. }
  1681. { insert cut for smartlinking or alignment }
  1682. if (cs_create_smart in aktmoduleswitches) then
  1683. bssSegment.concat(Tai_cut.Create);
  1684. bssSegment.concat(Tai_align.create(varalign));
  1685. {$ifdef GDB}
  1686. if cs_debuginfo in aktmoduleswitches then
  1687. sym.concatstabto(bsssegment);
  1688. {$endif GDB}
  1689. if (sym.owner.symtabletype=globalsymtable) or
  1690. (cs_create_smart in aktmoduleswitches) or
  1691. DLLSource or
  1692. (assigned(current_procinfo) and
  1693. (current_procinfo.procdef.proccalloption=pocall_inline)) or
  1694. (vo_is_exported in sym.varoptions) or
  1695. (vo_is_C_var in sym.varoptions) then
  1696. bssSegment.concat(Tai_datablock.Create_global(sym.mangledname,l))
  1697. else
  1698. bssSegment.concat(Tai_datablock.Create(sym.mangledname,l));
  1699. aktfilepos:=storefilepos;
  1700. end;
  1701. procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
  1702. var
  1703. sym : tsym;
  1704. begin
  1705. sym:=tsym(st.symindex.first);
  1706. while assigned(sym) do
  1707. begin
  1708. { Only allocate space for referenced locals }
  1709. if (sym.typ=varsym) and
  1710. (tvarsym(sym).refs>0) then
  1711. begin
  1712. with tvarsym(sym) do
  1713. begin
  1714. {$warning TODO Add support for register variables}
  1715. localloc.loc:=LOC_REFERENCE;
  1716. tg.GetLocal(list,getvaluesize,localloc.reference);
  1717. if cs_asm_source in aktglobalswitches then
  1718. list.concat(Tai_comment.Create(strpnew('Local '+realname+' located at '+
  1719. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1720. end;
  1721. end;
  1722. sym:=tsym(sym.indexnext);
  1723. end;
  1724. end;
  1725. procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
  1726. var
  1727. sym : tsym;
  1728. begin
  1729. sym:=tsym(st.symindex.first);
  1730. while assigned(sym) do
  1731. begin
  1732. if (sym.typ=varsym) and
  1733. (tvarsym(sym).refs>0) then
  1734. begin
  1735. with tvarsym(sym) do
  1736. begin
  1737. { Note: We need to keep the data available in memory
  1738. for the sub procedures that can access local data
  1739. in the parent procedures }
  1740. case localloc.loc of
  1741. LOC_REFERENCE :
  1742. tg.Ungetlocal(list,localloc.reference);
  1743. LOC_REGISTER :
  1744. begin
  1745. {$ifndef cpu64bit}
  1746. if localloc.size in [OS_64,OS_S64] then
  1747. begin
  1748. cg.ungetregister(list,localloc.registerlow);
  1749. cg.ungetregister(list,localloc.registerhigh);
  1750. end
  1751. else
  1752. {$endif cpu64bit}
  1753. cg.ungetregister(list,localloc.register);
  1754. end;
  1755. end;
  1756. end;
  1757. end;
  1758. sym:=tsym(sym.indexnext);
  1759. end;
  1760. end;
  1761. procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
  1762. var
  1763. sym : tsym;
  1764. begin
  1765. sym:=tsym(st.symindex.first);
  1766. while assigned(sym) do
  1767. begin
  1768. if sym.typ=varsym then
  1769. begin
  1770. with tvarsym(sym) do
  1771. begin
  1772. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1773. begin
  1774. case paraitem.paraloc[calleeside].loc of
  1775. LOC_FPUREGISTER,
  1776. LOC_REGISTER:
  1777. begin
  1778. (*
  1779. if paraitem.paraloc[calleeside].register=NR_NO then
  1780. begin
  1781. paraitem.paraloc[calleeside].loc:=LOC_REGISTER;
  1782. paraitem.paraloc[calleeside].size:=paraitem.paraloc[calleeside].size;
  1783. {$ifndef cpu64bit}
  1784. if paraitem.paraloc[calleeside].size in [OS_64,OS_S64] then
  1785. begin
  1786. paraitem.paraloc[calleeside].registerlow:=cg.getregisterint(list,OS_32);
  1787. paraitem.paraloc[calleeside].registerhigh:=cg.getregisterint(list,OS_32);
  1788. end
  1789. else
  1790. {$endif cpu64bit}
  1791. paraitem.paraloc[calleeside].register:=cg.getregisterint(list,localloc.size);
  1792. end;
  1793. *)
  1794. (*
  1795. {$warning TODO Allocate register paras}
  1796. localloc.loc:=LOC_REGISTER;
  1797. localloc.size:=paraitem.paraloc[calleeside].size;
  1798. {$ifndef cpu64bit}
  1799. if localloc.size in [OS_64,OS_S64] then
  1800. begin
  1801. localloc.registerlow:=cg.getregisterint(list,OS_32);
  1802. localloc.registerhigh:=cg.getregisterint(list,OS_32);
  1803. end
  1804. else
  1805. {$endif cpu64bit}
  1806. localloc.register:=cg.getregisterint(list,localloc.size);
  1807. *)
  1808. localloc.loc:=LOC_REFERENCE;
  1809. localloc.size:=paraitem.paraloc[calleeside].size;
  1810. tg.GetLocal(list,tcgsize2size[localloc.size],localloc.reference);
  1811. end
  1812. else
  1813. localloc:=paraitem.paraloc[calleeside];
  1814. end;
  1815. end
  1816. else
  1817. localloc:=paraitem.paraloc[calleeside];
  1818. if cs_asm_source in aktglobalswitches then
  1819. begin
  1820. case localloc.loc of
  1821. LOC_REFERENCE :
  1822. list.concat(Tai_comment.Create(strpnew('Para '+realname+' located at '+
  1823. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1824. end;
  1825. end;
  1826. end;
  1827. end;
  1828. sym:=tsym(sym.indexnext);
  1829. end;
  1830. end;
  1831. procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
  1832. var
  1833. sym : tsym;
  1834. begin
  1835. sym:=tsym(st.symindex.first);
  1836. while assigned(sym) do
  1837. begin
  1838. if sym.typ=varsym then
  1839. begin
  1840. with tvarsym(sym) do
  1841. begin
  1842. {$warning TODO Allocate register paras}
  1843. localloc.loc:=LOC_REFERENCE;
  1844. localloc.size:=int_cgsize(paramanager.push_size(vs_value,vartype.def,pocall_inline));
  1845. tg.GetLocal(list,tcgsize2size[localloc.size],localloc.reference);
  1846. if cs_asm_source in aktglobalswitches then
  1847. begin
  1848. case localloc.loc of
  1849. LOC_REFERENCE :
  1850. list.concat(Tai_comment.Create(strpnew('Para '+realname+' allocated at '+
  1851. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1852. end;
  1853. end;
  1854. paraitem.paraloc[callerside]:=localloc;
  1855. paraitem.paraloc[calleeside]:=localloc;
  1856. end;
  1857. end;
  1858. sym:=tsym(sym.indexnext);
  1859. end;
  1860. end;
  1861. procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
  1862. var
  1863. sym : tsym;
  1864. begin
  1865. sym:=tsym(st.symindex.first);
  1866. while assigned(sym) do
  1867. begin
  1868. if sym.typ=varsym then
  1869. begin
  1870. with tvarsym(sym) do
  1871. begin
  1872. { Note: We need to keep the data available in memory
  1873. for the sub procedures that can access local data
  1874. in the parent procedures }
  1875. case localloc.loc of
  1876. LOC_REFERENCE :
  1877. tg.UngetLocal(list,localloc.reference);
  1878. LOC_REGISTER :
  1879. begin
  1880. if localloc.register<>paraitem.paraloc[calleeside].register then
  1881. begin
  1882. {$ifndef cpu64bit}
  1883. if localloc.size in [OS_64,OS_S64] then
  1884. begin
  1885. cg.ungetregister(list,localloc.registerlow);
  1886. cg.ungetregister(list,localloc.registerhigh);
  1887. end
  1888. else
  1889. {$endif cpu64bit}
  1890. cg.ungetregister(list,localloc.register);
  1891. end;
  1892. end;
  1893. end;
  1894. end;
  1895. end;
  1896. sym:=tsym(sym.indexnext);
  1897. end;
  1898. end;
  1899. end.
  1900. {
  1901. $Log$
  1902. Revision 1.180 2003-12-28 21:57:43 jonas
  1903. * fixed procedures declared as "interrupt" for non-x86
  1904. Revision 1.179 2003/12/26 13:19:16 florian
  1905. * rtl and compiler compile with -Cfsse2
  1906. Revision 1.178 2003/12/26 00:32:21 florian
  1907. + fpu<->mm register conversion
  1908. Revision 1.177 2003/12/24 00:10:02 florian
  1909. - delete parameter in cg64 methods removed
  1910. Revision 1.176 2003/12/23 14:38:07 florian
  1911. + second_floataddsse implemented
  1912. Revision 1.175 2003/12/22 19:00:17 florian
  1913. * fixed some x86-64 issues
  1914. Revision 1.174 2003/12/07 16:28:30 jonas
  1915. * fixed typo found by Charlie
  1916. Revision 1.173 2003/12/06 01:15:22 florian
  1917. * reverted Peter's alloctemp patch; hopefully properly
  1918. Revision 1.172 2003/12/03 23:13:20 peter
  1919. * delayed paraloc allocation, a_param_*() gets extra parameter
  1920. if it needs to allocate temp or real paralocation
  1921. * optimized/simplified int-real loading
  1922. Revision 1.171 2003/11/30 19:35:29 florian
  1923. * fixed several arm related problems
  1924. Revision 1.170 2003/11/29 20:13:25 florian
  1925. * fixed several pi_do_call problems
  1926. Revision 1.169 2003/11/23 17:05:15 peter
  1927. * register calling is left-right
  1928. * parameter ordering
  1929. * left-right calling inserts result parameter last
  1930. Revision 1.168 2003/11/22 00:31:25 jonas
  1931. + extra allocations of function result regs for the optimiser
  1932. Revision 1.167 2003/11/11 21:10:12 peter
  1933. * remove temporary stdcall hack
  1934. Revision 1.166 2003/11/10 22:02:52 peter
  1935. * cross unit inlining fixed
  1936. Revision 1.165 2003/11/07 15:58:32 florian
  1937. * Florian's culmutative nr. 1; contains:
  1938. - invalid calling conventions for a certain cpu are rejected
  1939. - arm softfloat calling conventions
  1940. - -Sp for cpu dependend code generation
  1941. - several arm fixes
  1942. - remaining code for value open array paras on heap
  1943. Revision 1.164 2003/11/04 19:03:50 peter
  1944. * fixes for temp type patch
  1945. Revision 1.163 2003/11/04 15:35:13 peter
  1946. * fix for referencecounted temps
  1947. Revision 1.162 2003/10/25 11:34:02 florian
  1948. * fixed compilation of ppc system unit
  1949. Revision 1.161 2003/10/19 01:34:30 florian
  1950. * some ppc stuff fixed
  1951. * memory leak fixed
  1952. Revision 1.160 2003/10/17 15:08:34 peter
  1953. * commented out more obsolete constants
  1954. Revision 1.159 2003/10/17 14:38:32 peter
  1955. * 64k registers supported
  1956. * fixed some memory leaks
  1957. Revision 1.158 2003/10/10 17:48:13 peter
  1958. * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
  1959. * tregisteralloctor renamed to trgobj
  1960. * removed rgobj from a lot of units
  1961. * moved location_* and reference_* to cgobj
  1962. * first things for mmx register allocation
  1963. Revision 1.157 2003/10/09 21:31:37 daniel
  1964. * Register allocator splitted, ans abstract now
  1965. Revision 1.156 2003/10/07 18:18:16 peter
  1966. * fix register calling for assembler procedures
  1967. * fix result loading for assembler procedures
  1968. Revision 1.155 2003/10/07 15:17:07 peter
  1969. * inline supported again, LOC_REFERENCEs are used to pass the
  1970. parameters
  1971. * inlineparasymtable,inlinelocalsymtable removed
  1972. * exitlabel inserting fixed
  1973. Revision 1.154 2003/10/01 20:34:48 peter
  1974. * procinfo unit contains tprocinfo
  1975. * cginfo renamed to cgbase
  1976. * moved cgmessage to verbose
  1977. * fixed ppc and sparc compiles
  1978. Revision 1.153 2003/09/30 21:02:37 peter
  1979. * updates for inlining
  1980. Revision 1.152 2003/09/29 20:58:56 peter
  1981. * optimized releasing of registers
  1982. Revision 1.151 2003/09/28 21:47:18 peter
  1983. * register paras and local copies updates
  1984. Revision 1.150 2003/09/28 17:55:03 peter
  1985. * parent framepointer changed to hidden parameter
  1986. * tloadparentfpnode added
  1987. Revision 1.149 2003/09/28 13:39:38 peter
  1988. * optimized releasing of registers
  1989. Revision 1.148 2003/09/25 21:28:00 peter
  1990. * parameter fixes
  1991. Revision 1.147 2003/09/23 21:03:59 peter
  1992. * check for refs>0 in init/final local data
  1993. Revision 1.146 2003/09/23 17:56:05 peter
  1994. * locals and paras are allocated in the code generation
  1995. * tvarsym.localloc contains the location of para/local when
  1996. generating code for the current procedure
  1997. Revision 1.145 2003/09/16 16:17:01 peter
  1998. * varspez in calls to push_addr_param
  1999. Revision 1.144 2003/09/14 21:33:37 peter
  2000. * location_force_reg gives IE when size=OS_NO
  2001. Revision 1.143 2003/09/14 19:18:10 peter
  2002. * remove obsolete code already in comments
  2003. Revision 1.142 2003/09/11 11:54:59 florian
  2004. * improved arm code generation
  2005. * move some protected and private field around
  2006. * the temp. register for register parameters/arguments are now released
  2007. before the move to the parameter register is done. This improves
  2008. the code in a lot of cases.
  2009. Revision 1.141 2003/09/10 08:31:47 marco
  2010. * Patch from Peter for paraloc
  2011. Revision 1.140 2003/09/07 22:09:35 peter
  2012. * preparations for different default calling conventions
  2013. * various RA fixes
  2014. Revision 1.139 2003/09/03 15:55:01 peter
  2015. * NEWRA branch merged
  2016. Revision 1.138 2003/09/03 11:18:37 florian
  2017. * fixed arm concatcopy
  2018. + arm support in the common compiler sources added
  2019. * moved some generic cg code around
  2020. + tfputype added
  2021. * ...
  2022. Revision 1.137.2.4 2003/08/31 15:46:26 peter
  2023. * more updates for tregister
  2024. Revision 1.137.2.3 2003/08/29 17:28:59 peter
  2025. * next batch of updates
  2026. Revision 1.137.2.2 2003/08/28 18:35:08 peter
  2027. * tregister changed to cardinal
  2028. Revision 1.137.2.1 2003/08/27 19:55:54 peter
  2029. * first tregister patch
  2030. Revision 1.137 2003/08/20 20:29:06 daniel
  2031. * Some more R_NO changes
  2032. * Preventive code to loadref added
  2033. Revision 1.136 2003/08/20 17:48:49 peter
  2034. * fixed stackalloc to not allocate localst.datasize twice
  2035. * order of stackalloc code fixed for implicit init/final
  2036. Revision 1.135 2003/08/17 16:59:20 jonas
  2037. * fixed regvars so they work with newra (at least for ppc)
  2038. * fixed some volatile register bugs
  2039. + -dnotranslation option for -dnewra, which causes the registers not to
  2040. be translated from virtual to normal registers. Requires support in
  2041. the assembler writer as well, which is only implemented in aggas/
  2042. agppcgas currently
  2043. Revision 1.134 2003/08/11 21:18:20 peter
  2044. * start of sparc support for newra
  2045. Revision 1.133 2003/08/09 18:56:54 daniel
  2046. * cs_regalloc renamed to cs_regvars to avoid confusion with register
  2047. allocator
  2048. * Some preventive changes to i386 spillinh code
  2049. Revision 1.132 2003/08/03 14:09:50 daniel
  2050. * Fixed a register allocator bug
  2051. * Figured out why -dnewra generates superfluous "mov reg1,reg2"
  2052. statements: changes in location_force. These moves are now no longer
  2053. constrained so they are optimized away.
  2054. Revision 1.131 2003/07/23 11:04:15 jonas
  2055. * split en_exit_code into a part that may allocate a register and a part
  2056. that doesn't, so the former can be done before the register colouring
  2057. has been performed
  2058. Revision 1.130 2003/07/06 17:58:22 peter
  2059. * framepointer fixes for sparc
  2060. * parent framepointer code more generic
  2061. Revision 1.129 2003/07/06 15:31:20 daniel
  2062. * Fixed register allocator. *Lots* of fixes.
  2063. Revision 1.128 2003/07/02 22:18:04 peter
  2064. * paraloc splitted in callerparaloc,calleeparaloc
  2065. * sparc calling convention updates
  2066. Revision 1.127 2003/06/17 18:13:51 jonas
  2067. * fixed -dnewra compilation problems
  2068. Revision 1.126 2003/06/17 16:32:44 peter
  2069. * alloc register for function result
  2070. Revision 1.125 2003/06/13 21:19:30 peter
  2071. * current_procdef removed, use current_procinfo.procdef instead
  2072. Revision 1.124 2003/06/09 12:23:30 peter
  2073. * init/final of procedure data splitted from genentrycode
  2074. * use asmnode getposition to insert final at the correct position
  2075. als for the implicit try...finally
  2076. Revision 1.123 2003/06/07 18:57:04 jonas
  2077. + added freeintparaloc
  2078. * ppc get/freeintparaloc now check whether the parameter regs are
  2079. properly allocated/deallocated (and get an extra list para)
  2080. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  2081. * fixed lot of missing pi_do_call's
  2082. Revision 1.122 2003/06/06 14:43:02 peter
  2083. * g_copyopenarrayvalue gets length reference
  2084. * don't copy open arrays for cdecl
  2085. Revision 1.121 2003/06/03 21:11:09 peter
  2086. * cg.a_load_* get a from and to size specifier
  2087. * makeregsize only accepts newregister
  2088. * i386 uses generic tcgnotnode,tcgunaryminus
  2089. Revision 1.120 2003/06/03 15:49:49 jonas
  2090. * fixed ref/loc problems
  2091. Revision 1.119 2003/06/03 15:06:37 daniel
  2092. * fixed conflict marks
  2093. Revision 1.118 2003/06/03 13:01:59 daniel
  2094. * Register allocator finished
  2095. Revision 1.117 2003/06/02 21:42:05 jonas
  2096. * function results can now also be regvars
  2097. - removed tprocinfo.return_offset, never use it again since it's invalid
  2098. if the result is a regvar
  2099. Revision 1.116 2003/06/01 21:38:06 peter
  2100. * getregisterfpu size parameter added
  2101. * op_const_reg size parameter added
  2102. * sparc updates
  2103. Revision 1.115 2003/05/31 20:28:17 jonas
  2104. * changed copyvalueparas so it also supports register parameters
  2105. (except for copy_value_openarray, but that one is seriously broken
  2106. anyway, since it expects that the high parameter will always be in
  2107. memory right after the pointer to the array, while it could just as
  2108. will be in a register)
  2109. Revision 1.114 2003/05/31 15:05:28 peter
  2110. * FUNCTION_RESULT64_LOW/HIGH_REG added for int64 results
  2111. Revision 1.113 2003/05/31 00:48:15 jonas
  2112. * fixed my previous commit
  2113. Revision 1.112 2003/05/30 23:57:08 peter
  2114. * more sparc cleanup
  2115. * accumulator removed, splitted in function_return_reg (called) and
  2116. function_result_reg (caller)
  2117. Revision 1.111 2003/05/30 23:49:18 jonas
  2118. * a_load_loc_reg now has an extra size parameter for the destination
  2119. register (properly fixes what I worked around in revision 1.106 of
  2120. ncgutil.pas)
  2121. Revision 1.110 2003/05/30 18:52:10 jonas
  2122. * fixed bug with intregvars
  2123. * locapara.loc can also be LOC_CFPUREGISTER -> also fixed
  2124. rcgppc.a_param_ref, which previously got bogus size values
  2125. Revision 1.109 2003/05/27 21:19:08 jonas
  2126. * fixed ppc cycle
  2127. Revision 1.108 2003/05/27 14:28:14 jonas
  2128. * patch from Peter for nested procedures
  2129. Revision 1.107 2003/05/26 21:17:17 peter
  2130. * procinlinenode removed
  2131. * aktexit2label removed, fast exit removed
  2132. + tcallnode.inlined_pass_2 added
  2133. Revision 1.106 2003/05/24 11:59:42 jonas
  2134. * fixed integer typeconversion problems
  2135. Revision 1.105 2003/05/23 14:27:35 peter
  2136. * remove some unit dependencies
  2137. * current_procinfo changes to store more info
  2138. Revision 1.104 2003/05/15 18:58:53 peter
  2139. * removed selfpointer_offset, vmtpointer_offset
  2140. * tvarsym.adjusted_address
  2141. * address in localsymtable is now in the real direction
  2142. * removed some obsolete globals
  2143. Revision 1.103 2003/05/14 19:37:25 jonas
  2144. * patch from Peter for int64 function results
  2145. Revision 1.102 2003/05/13 19:14:41 peter
  2146. * failn removed
  2147. * inherited result code check moven to pexpr
  2148. Revision 1.101 2003/05/13 15:16:13 peter
  2149. * removed ret_in_acc, it's the reverse of ret_in_param
  2150. * fixed ret_in_param for win32 cdecl array
  2151. Revision 1.100 2003/05/12 08:08:27 jonas
  2152. * fixed several initialization and finalization related bugs (missing
  2153. tg.direction's, wrong paralocation for decreasing refcount of
  2154. everything but ansistrings)
  2155. Revision 1.99 2003/05/11 21:37:03 peter
  2156. * moved implicit exception frame from ncgutil to psub
  2157. * constructor/destructor helpers moved from cobj/ncgutil to psub
  2158. Revision 1.98 2003/05/11 14:45:12 peter
  2159. * tloadnode does not support objectsymtable,withsymtable anymore
  2160. * withnode cleanup
  2161. * direct with rewritten to use temprefnode
  2162. Revision 1.97 2003/05/10 13:20:23 jonas
  2163. * moved storing of register parameters to memory even earlier in the
  2164. entry code to fix problems with constructors
  2165. Revision 1.96 2003/05/09 17:47:02 peter
  2166. * self moved to hidden parameter
  2167. * removed hdisposen,hnewn,selfn
  2168. Revision 1.95 2003/04/29 07:28:52 michael
  2169. + Patch from peter to fix wrong pushing of ansistring function results in open array
  2170. Revision 1.94 2003/04/28 21:17:38 peter
  2171. * do not finalize function results
  2172. Revision 1.93 2003/04/27 16:30:34 jonas
  2173. * store register para's to memory before copying the valuepara's, because
  2174. that one requires them to be there already (and it calls subroutines ->
  2175. could overwrite those registers)
  2176. Revision 1.92 2003/04/27 11:21:33 peter
  2177. * aktprocdef renamed to current_procinfo.procdef
  2178. * procinfo renamed to current_procinfo
  2179. * procinfo will now be stored in current_module so it can be
  2180. cleaned up properly
  2181. * gen_main_procsym changed to create_main_proc and release_main_proc
  2182. to also generate a tprocinfo structure
  2183. * fixed unit implicit initfinal
  2184. Revision 1.91 2003/04/27 07:29:50 peter
  2185. * current_procinfo.procdef cleanup, current_procinfo.procdef is now always nil when parsing
  2186. a new procdef declaration
  2187. * aktprocsym removed
  2188. * lexlevel removed, use symtable.symtablelevel instead
  2189. * implicit init/final code uses the normal genentry/genexit
  2190. * funcret state checking updated for new funcret handling
  2191. Revision 1.90 2003/04/26 17:21:08 florian
  2192. * fixed passing of fpu values by fpu register
  2193. Revision 1.89 2003/04/25 20:59:33 peter
  2194. * removed funcretn,funcretsym, function result is now in varsym
  2195. and aliases for result and function name are added using absolutesym
  2196. * vs_hidden parameter for funcret passed in parameter
  2197. * vs_hidden fixes
  2198. * writenode changed to printnode and released from extdebug
  2199. * -vp option added to generate a tree.log with the nodetree
  2200. * nicer printnode for statements, callnode
  2201. Revision 1.88 2003/04/23 12:35:34 florian
  2202. * fixed several issues with powerpc
  2203. + applied a patch from Jonas for nested function calls (PowerPC only)
  2204. * ...
  2205. Revision 1.87 2003/04/22 14:33:38 peter
  2206. * removed some notes/hints
  2207. Revision 1.86 2003/04/22 13:47:08 peter
  2208. * fixed C style array of const
  2209. * fixed C array passing
  2210. * fixed left to right with high parameters
  2211. Revision 1.85 2003/04/22 10:09:35 daniel
  2212. + Implemented the actual register allocator
  2213. + Scratch registers unavailable when new register allocator used
  2214. + maybe_save/maybe_restore unavailable when new register allocator used
  2215. Revision 1.84 2003/04/16 09:26:55 jonas
  2216. * assembler procedures now again get a stackframe if they have local
  2217. variables. No space is reserved for a function result however.
  2218. Also, the register parameters aren't automatically saved on the stack
  2219. anymore in assembler procedures.
  2220. Revision 1.83 2003/04/06 21:11:23 olle
  2221. * changed newasmsymbol to newasmsymboldata for data symbols
  2222. Revision 1.82 2003/03/30 20:59:07 peter
  2223. * fix classmethod from classmethod call
  2224. * move BeforeDestruction/AfterConstruction calls to
  2225. genentrycode/genexitcode instead of generating them on the fly
  2226. after a call to a constructor
  2227. Revision 1.81 2003/03/28 19:16:56 peter
  2228. * generic constructor working for i386
  2229. * remove fixed self register
  2230. * esi added as address register for i386
  2231. Revision 1.80 2003/03/17 15:52:20 peter
  2232. * fix range error
  2233. Revision 1.79 2003/03/11 21:46:24 jonas
  2234. * lots of new regallocator fixes, both in generic and ppc-specific code
  2235. (ppc compiler still can't compile the linux system unit though)
  2236. Revision 1.78 2003/02/26 21:15:43 daniel
  2237. * Fixed the optimizer
  2238. Revision 1.77 2003/02/19 22:00:14 daniel
  2239. * Code generator converted to new register notation
  2240. - Horribily outdated todo.txt removed
  2241. Revision 1.76 2003/02/15 22:17:38 carl
  2242. * bugfix of FPU emulation code
  2243. Revision 1.75 2003/01/09 22:00:53 florian
  2244. * fixed some PowerPC issues
  2245. Revision 1.74 2003/01/09 20:41:10 florian
  2246. * fixed broken PowerPC compiler
  2247. Revision 1.73 2003/01/08 18:43:56 daniel
  2248. * Tregister changed into a record
  2249. Revision 1.72 2002/12/29 23:51:43 florian
  2250. * web bug 2214 fixed: ie 10 in const array constructors
  2251. Revision 1.71 2002/12/24 15:56:50 peter
  2252. * stackpointer_alloc added for adjusting ESP. Win32 needs
  2253. this for the pageprotection
  2254. Revision 1.70 2002/12/05 14:39:21 florian
  2255. * added missing then, Carl did you really a make fullcycle :) ?
  2256. Revision 1.69 2002/12/03 22:13:39 carl
  2257. * bugfix of problems with profile code which clobbers some registers
  2258. Revision 1.68 2002/12/01 22:06:59 carl
  2259. * warning of portabilitiy problems with parasize / localsize
  2260. Revision 1.67 2002/11/30 18:44:57 carl
  2261. + profiling support for Win32
  2262. Revision 1.66 2002/11/30 14:39:15 carl
  2263. * try to fix profiling for win32
  2264. Revision 1.65 2002/11/28 23:28:14 florian
  2265. * push_value_para didn't release floatdef locations, fixes tw2045
  2266. Revision 1.64 2002/11/27 02:33:19 peter
  2267. * copy_value_on_stack method added for cdecl record passing
  2268. Revision 1.63 2002/11/25 17:43:18 peter
  2269. * splitted defbase in defutil,symutil,defcmp
  2270. * merged isconvertable and is_equal into compare_defs(_ext)
  2271. * made operator search faster by walking the list only once
  2272. Revision 1.62 2002/11/18 17:31:55 peter
  2273. * pass proccalloption to ret_in_xxx and push_xxx functions
  2274. Revision 1.61 2002/11/17 17:49:08 mazen
  2275. + return_result_reg and FUNCTION_RESULT_REG are now used, in all plateforms, to pass functions result between called function and its caller. See the explanation of each one
  2276. Revision 1.60 2002/11/17 16:31:56 carl
  2277. * memory optimization (3-4%) : cleanup of tai fields,
  2278. cleanup of tdef and tsym fields.
  2279. * make it work for m68k
  2280. Revision 1.59 2002/11/15 01:58:51 peter
  2281. * merged changes from 1.0.7 up to 04-11
  2282. - -V option for generating bug report tracing
  2283. - more tracing for option parsing
  2284. - errors for cdecl and high()
  2285. - win32 import stabs
  2286. - win32 records<=8 are returned in eax:edx (turned off by default)
  2287. - heaptrc update
  2288. - more info for temp management in .s file with EXTDEBUG
  2289. Revision 1.58 2002/11/10 19:07:45 mazen
  2290. * SPARC calling mechanism almost OK (as in GCC./mppcsparc )
  2291. Revision 1.57 2002/11/03 20:22:40 mazen
  2292. * parameter handling updated
  2293. Revision 1.56 2002/10/16 19:01:43 peter
  2294. + $IMPLICITEXCEPTIONS switch to turn on/off generation of the
  2295. implicit exception frames for procedures with initialized variables
  2296. and for constructors. The default is on for compatibility
  2297. Revision 1.55 2002/10/14 19:42:33 peter
  2298. * only use init tables for threadvars
  2299. Revision 1.54 2002/10/06 19:41:30 peter
  2300. * Add finalization of typed consts
  2301. * Finalization of globals in the main program
  2302. Revision 1.53 2002/10/05 15:18:42 carl
  2303. * fix heap leaks
  2304. Revision 1.52 2002/09/30 07:00:46 florian
  2305. * fixes to common code to get the alpha compiler compiled applied
  2306. Revision 1.51 2002/09/22 14:02:35 carl
  2307. * stack checking cannot be called before system unit is initialized
  2308. * MC68020 define
  2309. Revision 1.50 2002/09/17 18:54:03 jonas
  2310. * a_load_reg_reg() now has two size parameters: source and dest. This
  2311. allows some optimizations on architectures that don't encode the
  2312. register size in the register name.
  2313. Revision 1.49 2002/09/10 21:48:30 florian
  2314. * improved handling of procedures with register calling conventions
  2315. Revision 1.48 2002/09/07 15:25:03 peter
  2316. * old logs removed and tabs fixed
  2317. Revision 1.47 2002/09/02 18:44:48 peter
  2318. * fixed (not) pushing of empty parameters
  2319. * fixed implicit initialization/finalization generation
  2320. * fixed/optimized local copy of value arguments init/final
  2321. Revision 1.46 2002/09/01 19:27:34 peter
  2322. * use index register when available for generating a reference with
  2323. only a signle register. Using the base register could possibly
  2324. destroy the framepointer
  2325. Revision 1.45 2002/09/01 18:50:20 peter
  2326. * fixed maybe_save that did not support a reference with only
  2327. a index register. It now also updates the location with the new
  2328. base register only
  2329. Revision 1.44 2002/09/01 14:42:41 peter
  2330. * removevaluepara added to fix the stackpointer so restoring of
  2331. saved registers works
  2332. Revision 1.43 2002/08/25 19:25:18 peter
  2333. * sym.insert_in_data removed
  2334. * symtable.insertvardata/insertconstdata added
  2335. * removed insert_in_data call from symtable.insert, it needs to be
  2336. called separatly. This allows to deref the address calculation
  2337. * procedures now calculate the parast addresses after the procedure
  2338. directives are parsed. This fixes the cdecl parast problem
  2339. * push_addr_param has an extra argument that specifies if cdecl is used
  2340. or not
  2341. Revision 1.42 2002/08/24 18:38:26 peter
  2342. * really use tt_noreuse for exception frame buffers
  2343. Revision 1.41 2002/08/23 16:14:49 peter
  2344. * tempgen cleanup
  2345. * tt_noreuse temp type added that will be used in genentrycode
  2346. Revision 1.40 2002/08/18 10:42:37 florian
  2347. * remaining assembler writer bugs fixed, the errors in the
  2348. system unit are inline assembler problems
  2349. Revision 1.39 2002/08/17 09:23:36 florian
  2350. * first part of procinfo rewrite
  2351. Revision 1.38 2002/08/16 14:24:57 carl
  2352. * issameref() to test if two references are the same (then emit no opcodes)
  2353. + ret_in_reg to replace ret_in_acc
  2354. (fix some register allocation bugs at the same time)
  2355. + save_std_register now has an extra parameter which is the
  2356. usedinproc registers
  2357. Revision 1.37 2002/08/15 15:15:55 carl
  2358. * jmpbuf size allocation for exceptions is now cpu specific (as it should)
  2359. * more generic nodes for maths
  2360. * several fixes for better m68k support
  2361. Revision 1.36 2002/08/14 19:25:09 carl
  2362. * fix Florian's last commit for m68k compilation
  2363. Revision 1.35 2002/08/13 21:40:56 florian
  2364. * more fixes for ppc calling conventions
  2365. Revision 1.34 2002/08/12 15:08:39 carl
  2366. + stab register indexes for powerpc (moved from gdb to cpubase)
  2367. + tprocessor enumeration moved to cpuinfo
  2368. + linker in target_info is now a class
  2369. * many many updates for m68k (will soon start to compile)
  2370. - removed some ifdef or correct them for correct cpu
  2371. Revision 1.33 2002/08/11 14:32:27 peter
  2372. * renamed current_library to objectlibrary
  2373. Revision 1.32 2002/08/11 13:24:12 peter
  2374. * saving of asmsymbols in ppu supported
  2375. * asmsymbollist global is removed and moved into a new class
  2376. tasmlibrarydata that will hold the info of a .a file which
  2377. corresponds with a single module. Added librarydata to tmodule
  2378. to keep the library info stored for the module. In the future the
  2379. objectfiles will also be stored to the tasmlibrarydata class
  2380. * all getlabel/newasmsymbol and friends are moved to the new class
  2381. Revision 1.31 2002/08/09 19:16:57 carl
  2382. * stack allocation is now done separately (at the end) of genentrycode
  2383. so temps. can be allocated before.
  2384. * fix generic exception handling
  2385. Revision 1.30 2002/08/06 20:55:21 florian
  2386. * first part of ppc calling conventions fix
  2387. Revision 1.29 2002/08/04 19:09:22 carl
  2388. + added generic exception support (still does not work!)
  2389. + more documentation
  2390. Revision 1.28 2002/07/29 21:23:42 florian
  2391. * more fixes for the ppc
  2392. + wrappers for the tcnvnode.first_* stuff introduced
  2393. }