ncgutil.pas 106 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729
  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,tvarsym(p).vartype.def,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. {$ifndef cpu64bit}
  1468. if usesacchi then
  1469. begin
  1470. cg.a_reg_dealloc(list,NR_FUNCTION_RETURN64_LOW_REG);
  1471. cg.a_reg_dealloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
  1472. end
  1473. else
  1474. {$endif cpu64bit}
  1475. if usesacc then
  1476. cg.a_reg_dealloc(list,NR_FUNCTION_RETURN_REG);
  1477. end;
  1478. procedure gen_save_used_regs(list:TAAsmoutput);
  1479. begin
  1480. { Pure assembler routines need to save the registers themselves }
  1481. if (po_assembler in current_procinfo.procdef.procoptions) then
  1482. exit;
  1483. { for the save all registers we can simply use a pusha,popa which
  1484. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1485. if (po_saveregisters in current_procinfo.procdef.procoptions) then
  1486. cg.g_save_all_registers(list)
  1487. else
  1488. if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
  1489. cg.g_save_standard_registers(list);
  1490. end;
  1491. procedure gen_restore_used_regs(list:TAAsmoutput;usesacc,usesacchi,usesfpu:boolean);
  1492. begin
  1493. { Pure assembler routines need to save the registers themselves }
  1494. if (po_assembler in current_procinfo.procdef.procoptions) then
  1495. exit;
  1496. { for the save all registers we can simply use a pusha,popa which
  1497. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1498. if (po_saveregisters in current_procinfo.procdef.procoptions) then
  1499. cg.g_restore_all_registers(list,usesacc,usesacchi)
  1500. else
  1501. if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
  1502. cg.g_restore_standard_registers(list);
  1503. end;
  1504. {****************************************************************************
  1505. Inlining
  1506. ****************************************************************************}
  1507. (*
  1508. procedure load_inlined_return_value(list:TAAsmoutput);
  1509. var
  1510. ressym: tvarsym;
  1511. resloc: tlocation;
  1512. r,r2 : tregister;
  1513. begin
  1514. if not is_void(current_procinfo.procdef.rettype.def) then
  1515. begin
  1516. ressym := tvarsym(current_procinfo.procdef.funcretsym);
  1517. if ressym.reg.enum <> R_NO then
  1518. begin
  1519. if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1520. location_reset(resloc,LOC_CREGISTER,OS_ADDR)
  1521. else
  1522. if ressym.vartype.def.deftype = floatdef then
  1523. location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procinfo.procdef.rettype.def))
  1524. else
  1525. location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
  1526. resloc.register := ressym.reg;
  1527. end
  1528. else
  1529. begin
  1530. location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
  1531. reference_reset_base(resloc.reference,current_procinfo.framepointer,tvarsym(current_procinfo.procdef.funcretsym).adjusted_address);
  1532. end;
  1533. { Here, we return the function result. In most architectures, the value is
  1534. passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
  1535. function returns in a register and the caller receives it in an other one }
  1536. case current_procinfo.procdef.rettype.def.deftype of
  1537. orddef,
  1538. enumdef :
  1539. begin
  1540. {$ifndef cpu64bit}
  1541. if resloc.size in [OS_64,OS_S64] then
  1542. begin
  1543. r:=cg.getregisterint(list,OS_INT);
  1544. r2:=cg.getregisterint(list,OS_INT);
  1545. cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
  1546. end
  1547. else
  1548. {$endif cpu64bit}
  1549. begin
  1550. r:=cg.getregisterint(list,resloc.size);
  1551. cg.a_load_loc_reg(list,resloc.size,resloc,r);
  1552. end;
  1553. end;
  1554. floatdef :
  1555. begin
  1556. {$ifdef cpufpemu}
  1557. if cs_fp_emulation in aktmoduleswitches then
  1558. r.enum := FUNCTION_RETURN_REG
  1559. else
  1560. {$endif cpufpemu}
  1561. r.enum:=FPU_RESULT_REG;
  1562. cg.a_loadfpu_loc_reg(list,resloc,r);
  1563. end;
  1564. else
  1565. begin
  1566. if not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
  1567. begin
  1568. {$ifndef cpu64bit}
  1569. { Win32 can return records in EAX:EDX }
  1570. if resloc.size in [OS_64,OS_S64] then
  1571. begin
  1572. r:=cg.getregisterint(list,OS_INT);
  1573. r2:=cg.getregisterint(list,OS_INT);
  1574. cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
  1575. end
  1576. else
  1577. {$endif cpu64bit}
  1578. begin
  1579. r:=cg.getregisterint(list,resloc.size);
  1580. cg.a_load_loc_reg(list,resloc.size,resloc,r);
  1581. end;
  1582. end
  1583. end;
  1584. end;
  1585. end;
  1586. end;
  1587. procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
  1588. begin
  1589. { initialize return value }
  1590. initretvalue(list);
  1591. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1592. { initialisizes temp. ansi/wide string data }
  1593. inittempvariables(list);
  1594. { initialize ansi/widesstring para's }
  1595. if assigned(current_procinfo.procdef.parast) then
  1596. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1597. { generate copies of call by value parameters }
  1598. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1599. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1600. load_regvars(list,nil);
  1601. end;
  1602. procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
  1603. var
  1604. usesacc,
  1605. usesacchi,
  1606. usesfpu : boolean;
  1607. begin
  1608. if aktexitlabel.is_used then
  1609. cg.a_label(list,aktexitlabel);
  1610. cleanup_regvars(list);
  1611. { finalize temporary data }
  1612. finalizetempvariables(list);
  1613. current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1614. { finalize paras data }
  1615. if assigned(current_procinfo.procdef.parast) then
  1616. current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1617. { handle return value, this is not done for assembler routines when
  1618. they didn't reference the result variable }
  1619. if not(po_assembler in current_procinfo.procdef.procoptions) or
  1620. (assigned(current_procinfo.procdef.funcretsym) and
  1621. (tvarsym(current_procinfo.procdef.funcretsym).refcount>1)) then
  1622. begin
  1623. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  1624. internalerror(200305263);
  1625. // load_inlined_return_value(list);
  1626. load_return_value(list,usesacc,usesacchi,usesfpu)
  1627. end;
  1628. cleanup_regvars(list);
  1629. end;
  1630. *)
  1631. {****************************************************************************
  1632. Const Data
  1633. ****************************************************************************}
  1634. procedure insertconstdata(sym : ttypedconstsym);
  1635. { this does not affect the local stack space, since all
  1636. typed constansts and initialized variables are always
  1637. put in the .data / .rodata section
  1638. }
  1639. var
  1640. storefilepos : tfileposinfo;
  1641. curconstsegment : taasmoutput;
  1642. l : longint;
  1643. begin
  1644. storefilepos:=aktfilepos;
  1645. aktfilepos:=sym.fileinfo;
  1646. if sym.is_writable then
  1647. curconstsegment:=datasegment
  1648. else
  1649. curconstsegment:=consts;
  1650. l:=sym.getsize;
  1651. { insert cut for smartlinking or alignment }
  1652. if (cs_create_smart in aktmoduleswitches) then
  1653. curconstSegment.concat(Tai_cut.Create);
  1654. curconstSegment.concat(Tai_align.create(const_align(l)));
  1655. {$ifdef GDB}
  1656. if cs_debuginfo in aktmoduleswitches then
  1657. sym.concatstabto(curconstsegment);
  1658. {$endif GDB}
  1659. if (sym.owner.symtabletype=globalsymtable) or
  1660. (cs_create_smart in aktmoduleswitches) or
  1661. (assigned(current_procinfo) and
  1662. (current_procinfo.procdef.proccalloption=pocall_inline)) or
  1663. DLLSource then
  1664. curconstSegment.concat(Tai_symbol.Createdataname_global(sym.mangledname,l))
  1665. else
  1666. curconstSegment.concat(Tai_symbol.Createdataname(sym.mangledname,l));
  1667. aktfilepos:=storefilepos;
  1668. end;
  1669. procedure insertbssdata(sym : tvarsym);
  1670. var
  1671. l,varalign : longint;
  1672. storefilepos : tfileposinfo;
  1673. begin
  1674. storefilepos:=aktfilepos;
  1675. aktfilepos:=sym.fileinfo;
  1676. l:=sym.getvaluesize;
  1677. if (vo_is_thread_var in sym.varoptions) then
  1678. inc(l,pointer_size);
  1679. varalign:=var_align(l);
  1680. {
  1681. sym.address:=align(datasize,varalign);
  1682. datasize:=tvarsym(sym).address+l;
  1683. }
  1684. { insert cut for smartlinking or alignment }
  1685. if (cs_create_smart in aktmoduleswitches) then
  1686. bssSegment.concat(Tai_cut.Create);
  1687. bssSegment.concat(Tai_align.create(varalign));
  1688. {$ifdef GDB}
  1689. if cs_debuginfo in aktmoduleswitches then
  1690. sym.concatstabto(bsssegment);
  1691. {$endif GDB}
  1692. if (sym.owner.symtabletype=globalsymtable) or
  1693. (cs_create_smart in aktmoduleswitches) or
  1694. DLLSource or
  1695. (assigned(current_procinfo) and
  1696. (current_procinfo.procdef.proccalloption=pocall_inline)) or
  1697. (vo_is_exported in sym.varoptions) or
  1698. (vo_is_C_var in sym.varoptions) then
  1699. bssSegment.concat(Tai_datablock.Create_global(sym.mangledname,l))
  1700. else
  1701. bssSegment.concat(Tai_datablock.Create(sym.mangledname,l));
  1702. aktfilepos:=storefilepos;
  1703. end;
  1704. procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
  1705. var
  1706. sym : tsym;
  1707. begin
  1708. sym:=tsym(st.symindex.first);
  1709. while assigned(sym) do
  1710. begin
  1711. { Only allocate space for referenced locals }
  1712. if (sym.typ=varsym) and
  1713. (tvarsym(sym).refs>0) then
  1714. begin
  1715. with tvarsym(sym) do
  1716. begin
  1717. {$warning TODO Add support for register variables}
  1718. localloc.loc:=LOC_REFERENCE;
  1719. tg.GetLocal(list,getvaluesize,vartype.def,localloc.reference);
  1720. if cs_asm_source in aktglobalswitches then
  1721. list.concat(Tai_comment.Create(strpnew('Local '+realname+' located at '+
  1722. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1723. end;
  1724. end;
  1725. sym:=tsym(sym.indexnext);
  1726. end;
  1727. end;
  1728. procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
  1729. var
  1730. sym : tsym;
  1731. begin
  1732. sym:=tsym(st.symindex.first);
  1733. while assigned(sym) do
  1734. begin
  1735. if (sym.typ=varsym) and
  1736. (tvarsym(sym).refs>0) then
  1737. begin
  1738. with tvarsym(sym) do
  1739. begin
  1740. { Note: We need to keep the data available in memory
  1741. for the sub procedures that can access local data
  1742. in the parent procedures }
  1743. case localloc.loc of
  1744. LOC_REFERENCE :
  1745. tg.Ungetlocal(list,localloc.reference);
  1746. LOC_REGISTER :
  1747. begin
  1748. {$ifndef cpu64bit}
  1749. if localloc.size in [OS_64,OS_S64] then
  1750. begin
  1751. cg.ungetregister(list,localloc.registerlow);
  1752. cg.ungetregister(list,localloc.registerhigh);
  1753. end
  1754. else
  1755. {$endif cpu64bit}
  1756. cg.ungetregister(list,localloc.register);
  1757. end;
  1758. end;
  1759. end;
  1760. end;
  1761. sym:=tsym(sym.indexnext);
  1762. end;
  1763. end;
  1764. procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
  1765. var
  1766. sym : tsym;
  1767. begin
  1768. sym:=tsym(st.symindex.first);
  1769. while assigned(sym) do
  1770. begin
  1771. if sym.typ=varsym then
  1772. begin
  1773. with tvarsym(sym) do
  1774. begin
  1775. if not(po_assembler in current_procinfo.procdef.procoptions) then
  1776. begin
  1777. case paraitem.paraloc[calleeside].loc of
  1778. LOC_FPUREGISTER,
  1779. LOC_REGISTER:
  1780. begin
  1781. (*
  1782. if paraitem.paraloc[calleeside].register=NR_NO then
  1783. begin
  1784. paraitem.paraloc[calleeside].loc:=LOC_REGISTER;
  1785. paraitem.paraloc[calleeside].size:=paraitem.paraloc[calleeside].size;
  1786. {$ifndef cpu64bit}
  1787. if paraitem.paraloc[calleeside].size in [OS_64,OS_S64] then
  1788. begin
  1789. paraitem.paraloc[calleeside].registerlow:=cg.getregisterint(list,OS_32);
  1790. paraitem.paraloc[calleeside].registerhigh:=cg.getregisterint(list,OS_32);
  1791. end
  1792. else
  1793. {$endif cpu64bit}
  1794. paraitem.paraloc[calleeside].register:=cg.getregisterint(list,localloc.size);
  1795. end;
  1796. *)
  1797. (*
  1798. {$warning TODO Allocate register paras}
  1799. localloc.loc:=LOC_REGISTER;
  1800. localloc.size:=paraitem.paraloc[calleeside].size;
  1801. {$ifndef cpu64bit}
  1802. if localloc.size in [OS_64,OS_S64] then
  1803. begin
  1804. localloc.registerlow:=cg.getregisterint(list,OS_32);
  1805. localloc.registerhigh:=cg.getregisterint(list,OS_32);
  1806. end
  1807. else
  1808. {$endif cpu64bit}
  1809. localloc.register:=cg.getregisterint(list,localloc.size);
  1810. *)
  1811. localloc.loc:=LOC_REFERENCE;
  1812. localloc.size:=paraitem.paraloc[calleeside].size;
  1813. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1814. end
  1815. else
  1816. localloc:=paraitem.paraloc[calleeside];
  1817. end;
  1818. end
  1819. else
  1820. localloc:=paraitem.paraloc[calleeside];
  1821. if cs_asm_source in aktglobalswitches then
  1822. begin
  1823. case localloc.loc of
  1824. LOC_REFERENCE :
  1825. begin
  1826. list.concat(Tai_comment.Create(strpnew('Para '+realname+' located at '+
  1827. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1828. {$ifdef powerpc}
  1829. localloc.size:=paraitem.paraloc[calleeside].size;
  1830. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1831. {$endif powerpc}
  1832. end;
  1833. end;
  1834. end;
  1835. end;
  1836. end;
  1837. sym:=tsym(sym.indexnext);
  1838. end;
  1839. end;
  1840. procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
  1841. var
  1842. sym : tsym;
  1843. begin
  1844. sym:=tsym(st.symindex.first);
  1845. while assigned(sym) do
  1846. begin
  1847. if sym.typ=varsym then
  1848. begin
  1849. with tvarsym(sym) do
  1850. begin
  1851. {$warning TODO Allocate register paras}
  1852. localloc.loc:=LOC_REFERENCE;
  1853. localloc.size:=int_cgsize(paramanager.push_size(vs_value,vartype.def,pocall_inline));
  1854. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1855. if cs_asm_source in aktglobalswitches then
  1856. begin
  1857. case localloc.loc of
  1858. LOC_REFERENCE :
  1859. list.concat(Tai_comment.Create(strpnew('Para '+realname+' allocated at '+
  1860. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1861. end;
  1862. end;
  1863. paraitem.paraloc[callerside]:=localloc;
  1864. paraitem.paraloc[calleeside]:=localloc;
  1865. end;
  1866. end;
  1867. sym:=tsym(sym.indexnext);
  1868. end;
  1869. end;
  1870. procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
  1871. var
  1872. sym : tsym;
  1873. begin
  1874. sym:=tsym(st.symindex.first);
  1875. while assigned(sym) do
  1876. begin
  1877. if sym.typ=varsym then
  1878. begin
  1879. with tvarsym(sym) do
  1880. begin
  1881. { Note: We need to keep the data available in memory
  1882. for the sub procedures that can access local data
  1883. in the parent procedures }
  1884. case localloc.loc of
  1885. LOC_REFERENCE :
  1886. tg.UngetLocal(list,localloc.reference);
  1887. LOC_REGISTER :
  1888. begin
  1889. if localloc.register<>paraitem.paraloc[calleeside].register then
  1890. begin
  1891. {$ifndef cpu64bit}
  1892. if localloc.size in [OS_64,OS_S64] then
  1893. begin
  1894. cg.ungetregister(list,localloc.registerlow);
  1895. cg.ungetregister(list,localloc.registerhigh);
  1896. end
  1897. else
  1898. {$endif cpu64bit}
  1899. cg.ungetregister(list,localloc.register);
  1900. end;
  1901. end;
  1902. end;
  1903. end;
  1904. end;
  1905. sym:=tsym(sym.indexnext);
  1906. end;
  1907. end;
  1908. end.
  1909. {
  1910. $Log$
  1911. Revision 1.183 2004-01-17 15:55:10 jonas
  1912. * fixed allocation of parameters passed by reference for powerpc in
  1913. callee
  1914. Revision 1.182 2004/01/13 18:08:58 florian
  1915. * x86-64 compilation fixed
  1916. Revision 1.181 2004/01/12 22:11:38 peter
  1917. * use localalign info for alignment for locals and temps
  1918. * sparc fpu flags branching added
  1919. * moved powerpc copy_valye_openarray to generic
  1920. Revision 1.180 2003/12/28 21:57:43 jonas
  1921. * fixed procedures declared as "interrupt" for non-x86
  1922. Revision 1.179 2003/12/26 13:19:16 florian
  1923. * rtl and compiler compile with -Cfsse2
  1924. Revision 1.178 2003/12/26 00:32:21 florian
  1925. + fpu<->mm register conversion
  1926. Revision 1.177 2003/12/24 00:10:02 florian
  1927. - delete parameter in cg64 methods removed
  1928. Revision 1.176 2003/12/23 14:38:07 florian
  1929. + second_floataddsse implemented
  1930. Revision 1.175 2003/12/22 19:00:17 florian
  1931. * fixed some x86-64 issues
  1932. Revision 1.174 2003/12/07 16:28:30 jonas
  1933. * fixed typo found by Charlie
  1934. Revision 1.173 2003/12/06 01:15:22 florian
  1935. * reverted Peter's alloctemp patch; hopefully properly
  1936. Revision 1.172 2003/12/03 23:13:20 peter
  1937. * delayed paraloc allocation, a_param_*() gets extra parameter
  1938. if it needs to allocate temp or real paralocation
  1939. * optimized/simplified int-real loading
  1940. Revision 1.171 2003/11/30 19:35:29 florian
  1941. * fixed several arm related problems
  1942. Revision 1.170 2003/11/29 20:13:25 florian
  1943. * fixed several pi_do_call problems
  1944. Revision 1.169 2003/11/23 17:05:15 peter
  1945. * register calling is left-right
  1946. * parameter ordering
  1947. * left-right calling inserts result parameter last
  1948. Revision 1.168 2003/11/22 00:31:25 jonas
  1949. + extra allocations of function result regs for the optimiser
  1950. Revision 1.167 2003/11/11 21:10:12 peter
  1951. * remove temporary stdcall hack
  1952. Revision 1.166 2003/11/10 22:02:52 peter
  1953. * cross unit inlining fixed
  1954. Revision 1.165 2003/11/07 15:58:32 florian
  1955. * Florian's culmutative nr. 1; contains:
  1956. - invalid calling conventions for a certain cpu are rejected
  1957. - arm softfloat calling conventions
  1958. - -Sp for cpu dependend code generation
  1959. - several arm fixes
  1960. - remaining code for value open array paras on heap
  1961. Revision 1.164 2003/11/04 19:03:50 peter
  1962. * fixes for temp type patch
  1963. Revision 1.163 2003/11/04 15:35:13 peter
  1964. * fix for referencecounted temps
  1965. Revision 1.162 2003/10/25 11:34:02 florian
  1966. * fixed compilation of ppc system unit
  1967. Revision 1.161 2003/10/19 01:34:30 florian
  1968. * some ppc stuff fixed
  1969. * memory leak fixed
  1970. Revision 1.160 2003/10/17 15:08:34 peter
  1971. * commented out more obsolete constants
  1972. Revision 1.159 2003/10/17 14:38:32 peter
  1973. * 64k registers supported
  1974. * fixed some memory leaks
  1975. Revision 1.158 2003/10/10 17:48:13 peter
  1976. * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
  1977. * tregisteralloctor renamed to trgobj
  1978. * removed rgobj from a lot of units
  1979. * moved location_* and reference_* to cgobj
  1980. * first things for mmx register allocation
  1981. Revision 1.157 2003/10/09 21:31:37 daniel
  1982. * Register allocator splitted, ans abstract now
  1983. Revision 1.156 2003/10/07 18:18:16 peter
  1984. * fix register calling for assembler procedures
  1985. * fix result loading for assembler procedures
  1986. Revision 1.155 2003/10/07 15:17:07 peter
  1987. * inline supported again, LOC_REFERENCEs are used to pass the
  1988. parameters
  1989. * inlineparasymtable,inlinelocalsymtable removed
  1990. * exitlabel inserting fixed
  1991. Revision 1.154 2003/10/01 20:34:48 peter
  1992. * procinfo unit contains tprocinfo
  1993. * cginfo renamed to cgbase
  1994. * moved cgmessage to verbose
  1995. * fixed ppc and sparc compiles
  1996. Revision 1.153 2003/09/30 21:02:37 peter
  1997. * updates for inlining
  1998. Revision 1.152 2003/09/29 20:58:56 peter
  1999. * optimized releasing of registers
  2000. Revision 1.151 2003/09/28 21:47:18 peter
  2001. * register paras and local copies updates
  2002. Revision 1.150 2003/09/28 17:55:03 peter
  2003. * parent framepointer changed to hidden parameter
  2004. * tloadparentfpnode added
  2005. Revision 1.149 2003/09/28 13:39:38 peter
  2006. * optimized releasing of registers
  2007. Revision 1.148 2003/09/25 21:28:00 peter
  2008. * parameter fixes
  2009. Revision 1.147 2003/09/23 21:03:59 peter
  2010. * check for refs>0 in init/final local data
  2011. Revision 1.146 2003/09/23 17:56:05 peter
  2012. * locals and paras are allocated in the code generation
  2013. * tvarsym.localloc contains the location of para/local when
  2014. generating code for the current procedure
  2015. Revision 1.145 2003/09/16 16:17:01 peter
  2016. * varspez in calls to push_addr_param
  2017. Revision 1.144 2003/09/14 21:33:37 peter
  2018. * location_force_reg gives IE when size=OS_NO
  2019. Revision 1.143 2003/09/14 19:18:10 peter
  2020. * remove obsolete code already in comments
  2021. Revision 1.142 2003/09/11 11:54:59 florian
  2022. * improved arm code generation
  2023. * move some protected and private field around
  2024. * the temp. register for register parameters/arguments are now released
  2025. before the move to the parameter register is done. This improves
  2026. the code in a lot of cases.
  2027. Revision 1.141 2003/09/10 08:31:47 marco
  2028. * Patch from Peter for paraloc
  2029. Revision 1.140 2003/09/07 22:09:35 peter
  2030. * preparations for different default calling conventions
  2031. * various RA fixes
  2032. Revision 1.139 2003/09/03 15:55:01 peter
  2033. * NEWRA branch merged
  2034. Revision 1.138 2003/09/03 11:18:37 florian
  2035. * fixed arm concatcopy
  2036. + arm support in the common compiler sources added
  2037. * moved some generic cg code around
  2038. + tfputype added
  2039. * ...
  2040. Revision 1.137.2.4 2003/08/31 15:46:26 peter
  2041. * more updates for tregister
  2042. Revision 1.137.2.3 2003/08/29 17:28:59 peter
  2043. * next batch of updates
  2044. Revision 1.137.2.2 2003/08/28 18:35:08 peter
  2045. * tregister changed to cardinal
  2046. Revision 1.137.2.1 2003/08/27 19:55:54 peter
  2047. * first tregister patch
  2048. Revision 1.137 2003/08/20 20:29:06 daniel
  2049. * Some more R_NO changes
  2050. * Preventive code to loadref added
  2051. Revision 1.136 2003/08/20 17:48:49 peter
  2052. * fixed stackalloc to not allocate localst.datasize twice
  2053. * order of stackalloc code fixed for implicit init/final
  2054. Revision 1.135 2003/08/17 16:59:20 jonas
  2055. * fixed regvars so they work with newra (at least for ppc)
  2056. * fixed some volatile register bugs
  2057. + -dnotranslation option for -dnewra, which causes the registers not to
  2058. be translated from virtual to normal registers. Requires support in
  2059. the assembler writer as well, which is only implemented in aggas/
  2060. agppcgas currently
  2061. Revision 1.134 2003/08/11 21:18:20 peter
  2062. * start of sparc support for newra
  2063. Revision 1.133 2003/08/09 18:56:54 daniel
  2064. * cs_regalloc renamed to cs_regvars to avoid confusion with register
  2065. allocator
  2066. * Some preventive changes to i386 spillinh code
  2067. Revision 1.132 2003/08/03 14:09:50 daniel
  2068. * Fixed a register allocator bug
  2069. * Figured out why -dnewra generates superfluous "mov reg1,reg2"
  2070. statements: changes in location_force. These moves are now no longer
  2071. constrained so they are optimized away.
  2072. Revision 1.131 2003/07/23 11:04:15 jonas
  2073. * split en_exit_code into a part that may allocate a register and a part
  2074. that doesn't, so the former can be done before the register colouring
  2075. has been performed
  2076. Revision 1.130 2003/07/06 17:58:22 peter
  2077. * framepointer fixes for sparc
  2078. * parent framepointer code more generic
  2079. Revision 1.129 2003/07/06 15:31:20 daniel
  2080. * Fixed register allocator. *Lots* of fixes.
  2081. Revision 1.128 2003/07/02 22:18:04 peter
  2082. * paraloc splitted in callerparaloc,calleeparaloc
  2083. * sparc calling convention updates
  2084. Revision 1.127 2003/06/17 18:13:51 jonas
  2085. * fixed -dnewra compilation problems
  2086. Revision 1.126 2003/06/17 16:32:44 peter
  2087. * alloc register for function result
  2088. Revision 1.125 2003/06/13 21:19:30 peter
  2089. * current_procdef removed, use current_procinfo.procdef instead
  2090. Revision 1.124 2003/06/09 12:23:30 peter
  2091. * init/final of procedure data splitted from genentrycode
  2092. * use asmnode getposition to insert final at the correct position
  2093. als for the implicit try...finally
  2094. Revision 1.123 2003/06/07 18:57:04 jonas
  2095. + added freeintparaloc
  2096. * ppc get/freeintparaloc now check whether the parameter regs are
  2097. properly allocated/deallocated (and get an extra list para)
  2098. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  2099. * fixed lot of missing pi_do_call's
  2100. Revision 1.122 2003/06/06 14:43:02 peter
  2101. * g_copyopenarrayvalue gets length reference
  2102. * don't copy open arrays for cdecl
  2103. Revision 1.121 2003/06/03 21:11:09 peter
  2104. * cg.a_load_* get a from and to size specifier
  2105. * makeregsize only accepts newregister
  2106. * i386 uses generic tcgnotnode,tcgunaryminus
  2107. Revision 1.120 2003/06/03 15:49:49 jonas
  2108. * fixed ref/loc problems
  2109. Revision 1.119 2003/06/03 15:06:37 daniel
  2110. * fixed conflict marks
  2111. Revision 1.118 2003/06/03 13:01:59 daniel
  2112. * Register allocator finished
  2113. Revision 1.117 2003/06/02 21:42:05 jonas
  2114. * function results can now also be regvars
  2115. - removed tprocinfo.return_offset, never use it again since it's invalid
  2116. if the result is a regvar
  2117. Revision 1.116 2003/06/01 21:38:06 peter
  2118. * getregisterfpu size parameter added
  2119. * op_const_reg size parameter added
  2120. * sparc updates
  2121. Revision 1.115 2003/05/31 20:28:17 jonas
  2122. * changed copyvalueparas so it also supports register parameters
  2123. (except for copy_value_openarray, but that one is seriously broken
  2124. anyway, since it expects that the high parameter will always be in
  2125. memory right after the pointer to the array, while it could just as
  2126. will be in a register)
  2127. Revision 1.114 2003/05/31 15:05:28 peter
  2128. * FUNCTION_RESULT64_LOW/HIGH_REG added for int64 results
  2129. Revision 1.113 2003/05/31 00:48:15 jonas
  2130. * fixed my previous commit
  2131. Revision 1.112 2003/05/30 23:57:08 peter
  2132. * more sparc cleanup
  2133. * accumulator removed, splitted in function_return_reg (called) and
  2134. function_result_reg (caller)
  2135. Revision 1.111 2003/05/30 23:49:18 jonas
  2136. * a_load_loc_reg now has an extra size parameter for the destination
  2137. register (properly fixes what I worked around in revision 1.106 of
  2138. ncgutil.pas)
  2139. Revision 1.110 2003/05/30 18:52:10 jonas
  2140. * fixed bug with intregvars
  2141. * locapara.loc can also be LOC_CFPUREGISTER -> also fixed
  2142. rcgppc.a_param_ref, which previously got bogus size values
  2143. Revision 1.109 2003/05/27 21:19:08 jonas
  2144. * fixed ppc cycle
  2145. Revision 1.108 2003/05/27 14:28:14 jonas
  2146. * patch from Peter for nested procedures
  2147. Revision 1.107 2003/05/26 21:17:17 peter
  2148. * procinlinenode removed
  2149. * aktexit2label removed, fast exit removed
  2150. + tcallnode.inlined_pass_2 added
  2151. Revision 1.106 2003/05/24 11:59:42 jonas
  2152. * fixed integer typeconversion problems
  2153. Revision 1.105 2003/05/23 14:27:35 peter
  2154. * remove some unit dependencies
  2155. * current_procinfo changes to store more info
  2156. Revision 1.104 2003/05/15 18:58:53 peter
  2157. * removed selfpointer_offset, vmtpointer_offset
  2158. * tvarsym.adjusted_address
  2159. * address in localsymtable is now in the real direction
  2160. * removed some obsolete globals
  2161. Revision 1.103 2003/05/14 19:37:25 jonas
  2162. * patch from Peter for int64 function results
  2163. Revision 1.102 2003/05/13 19:14:41 peter
  2164. * failn removed
  2165. * inherited result code check moven to pexpr
  2166. Revision 1.101 2003/05/13 15:16:13 peter
  2167. * removed ret_in_acc, it's the reverse of ret_in_param
  2168. * fixed ret_in_param for win32 cdecl array
  2169. Revision 1.100 2003/05/12 08:08:27 jonas
  2170. * fixed several initialization and finalization related bugs (missing
  2171. tg.direction's, wrong paralocation for decreasing refcount of
  2172. everything but ansistrings)
  2173. Revision 1.99 2003/05/11 21:37:03 peter
  2174. * moved implicit exception frame from ncgutil to psub
  2175. * constructor/destructor helpers moved from cobj/ncgutil to psub
  2176. Revision 1.98 2003/05/11 14:45:12 peter
  2177. * tloadnode does not support objectsymtable,withsymtable anymore
  2178. * withnode cleanup
  2179. * direct with rewritten to use temprefnode
  2180. Revision 1.97 2003/05/10 13:20:23 jonas
  2181. * moved storing of register parameters to memory even earlier in the
  2182. entry code to fix problems with constructors
  2183. Revision 1.96 2003/05/09 17:47:02 peter
  2184. * self moved to hidden parameter
  2185. * removed hdisposen,hnewn,selfn
  2186. Revision 1.95 2003/04/29 07:28:52 michael
  2187. + Patch from peter to fix wrong pushing of ansistring function results in open array
  2188. Revision 1.94 2003/04/28 21:17:38 peter
  2189. * do not finalize function results
  2190. Revision 1.93 2003/04/27 16:30:34 jonas
  2191. * store register para's to memory before copying the valuepara's, because
  2192. that one requires them to be there already (and it calls subroutines ->
  2193. could overwrite those registers)
  2194. Revision 1.92 2003/04/27 11:21:33 peter
  2195. * aktprocdef renamed to current_procinfo.procdef
  2196. * procinfo renamed to current_procinfo
  2197. * procinfo will now be stored in current_module so it can be
  2198. cleaned up properly
  2199. * gen_main_procsym changed to create_main_proc and release_main_proc
  2200. to also generate a tprocinfo structure
  2201. * fixed unit implicit initfinal
  2202. Revision 1.91 2003/04/27 07:29:50 peter
  2203. * current_procinfo.procdef cleanup, current_procinfo.procdef is now always nil when parsing
  2204. a new procdef declaration
  2205. * aktprocsym removed
  2206. * lexlevel removed, use symtable.symtablelevel instead
  2207. * implicit init/final code uses the normal genentry/genexit
  2208. * funcret state checking updated for new funcret handling
  2209. Revision 1.90 2003/04/26 17:21:08 florian
  2210. * fixed passing of fpu values by fpu register
  2211. Revision 1.89 2003/04/25 20:59:33 peter
  2212. * removed funcretn,funcretsym, function result is now in varsym
  2213. and aliases for result and function name are added using absolutesym
  2214. * vs_hidden parameter for funcret passed in parameter
  2215. * vs_hidden fixes
  2216. * writenode changed to printnode and released from extdebug
  2217. * -vp option added to generate a tree.log with the nodetree
  2218. * nicer printnode for statements, callnode
  2219. Revision 1.88 2003/04/23 12:35:34 florian
  2220. * fixed several issues with powerpc
  2221. + applied a patch from Jonas for nested function calls (PowerPC only)
  2222. * ...
  2223. Revision 1.87 2003/04/22 14:33:38 peter
  2224. * removed some notes/hints
  2225. Revision 1.86 2003/04/22 13:47:08 peter
  2226. * fixed C style array of const
  2227. * fixed C array passing
  2228. * fixed left to right with high parameters
  2229. Revision 1.85 2003/04/22 10:09:35 daniel
  2230. + Implemented the actual register allocator
  2231. + Scratch registers unavailable when new register allocator used
  2232. + maybe_save/maybe_restore unavailable when new register allocator used
  2233. Revision 1.84 2003/04/16 09:26:55 jonas
  2234. * assembler procedures now again get a stackframe if they have local
  2235. variables. No space is reserved for a function result however.
  2236. Also, the register parameters aren't automatically saved on the stack
  2237. anymore in assembler procedures.
  2238. Revision 1.83 2003/04/06 21:11:23 olle
  2239. * changed newasmsymbol to newasmsymboldata for data symbols
  2240. Revision 1.82 2003/03/30 20:59:07 peter
  2241. * fix classmethod from classmethod call
  2242. * move BeforeDestruction/AfterConstruction calls to
  2243. genentrycode/genexitcode instead of generating them on the fly
  2244. after a call to a constructor
  2245. Revision 1.81 2003/03/28 19:16:56 peter
  2246. * generic constructor working for i386
  2247. * remove fixed self register
  2248. * esi added as address register for i386
  2249. Revision 1.80 2003/03/17 15:52:20 peter
  2250. * fix range error
  2251. Revision 1.79 2003/03/11 21:46:24 jonas
  2252. * lots of new regallocator fixes, both in generic and ppc-specific code
  2253. (ppc compiler still can't compile the linux system unit though)
  2254. Revision 1.78 2003/02/26 21:15:43 daniel
  2255. * Fixed the optimizer
  2256. Revision 1.77 2003/02/19 22:00:14 daniel
  2257. * Code generator converted to new register notation
  2258. - Horribily outdated todo.txt removed
  2259. Revision 1.76 2003/02/15 22:17:38 carl
  2260. * bugfix of FPU emulation code
  2261. Revision 1.75 2003/01/09 22:00:53 florian
  2262. * fixed some PowerPC issues
  2263. Revision 1.74 2003/01/09 20:41:10 florian
  2264. * fixed broken PowerPC compiler
  2265. Revision 1.73 2003/01/08 18:43:56 daniel
  2266. * Tregister changed into a record
  2267. Revision 1.72 2002/12/29 23:51:43 florian
  2268. * web bug 2214 fixed: ie 10 in const array constructors
  2269. Revision 1.71 2002/12/24 15:56:50 peter
  2270. * stackpointer_alloc added for adjusting ESP. Win32 needs
  2271. this for the pageprotection
  2272. Revision 1.70 2002/12/05 14:39:21 florian
  2273. * added missing then, Carl did you really a make fullcycle :) ?
  2274. Revision 1.69 2002/12/03 22:13:39 carl
  2275. * bugfix of problems with profile code which clobbers some registers
  2276. Revision 1.68 2002/12/01 22:06:59 carl
  2277. * warning of portabilitiy problems with parasize / localsize
  2278. Revision 1.67 2002/11/30 18:44:57 carl
  2279. + profiling support for Win32
  2280. Revision 1.66 2002/11/30 14:39:15 carl
  2281. * try to fix profiling for win32
  2282. Revision 1.65 2002/11/28 23:28:14 florian
  2283. * push_value_para didn't release floatdef locations, fixes tw2045
  2284. Revision 1.64 2002/11/27 02:33:19 peter
  2285. * copy_value_on_stack method added for cdecl record passing
  2286. Revision 1.63 2002/11/25 17:43:18 peter
  2287. * splitted defbase in defutil,symutil,defcmp
  2288. * merged isconvertable and is_equal into compare_defs(_ext)
  2289. * made operator search faster by walking the list only once
  2290. Revision 1.62 2002/11/18 17:31:55 peter
  2291. * pass proccalloption to ret_in_xxx and push_xxx functions
  2292. Revision 1.61 2002/11/17 17:49:08 mazen
  2293. + 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
  2294. Revision 1.60 2002/11/17 16:31:56 carl
  2295. * memory optimization (3-4%) : cleanup of tai fields,
  2296. cleanup of tdef and tsym fields.
  2297. * make it work for m68k
  2298. Revision 1.59 2002/11/15 01:58:51 peter
  2299. * merged changes from 1.0.7 up to 04-11
  2300. - -V option for generating bug report tracing
  2301. - more tracing for option parsing
  2302. - errors for cdecl and high()
  2303. - win32 import stabs
  2304. - win32 records<=8 are returned in eax:edx (turned off by default)
  2305. - heaptrc update
  2306. - more info for temp management in .s file with EXTDEBUG
  2307. Revision 1.58 2002/11/10 19:07:45 mazen
  2308. * SPARC calling mechanism almost OK (as in GCC./mppcsparc )
  2309. Revision 1.57 2002/11/03 20:22:40 mazen
  2310. * parameter handling updated
  2311. Revision 1.56 2002/10/16 19:01:43 peter
  2312. + $IMPLICITEXCEPTIONS switch to turn on/off generation of the
  2313. implicit exception frames for procedures with initialized variables
  2314. and for constructors. The default is on for compatibility
  2315. Revision 1.55 2002/10/14 19:42:33 peter
  2316. * only use init tables for threadvars
  2317. Revision 1.54 2002/10/06 19:41:30 peter
  2318. * Add finalization of typed consts
  2319. * Finalization of globals in the main program
  2320. Revision 1.53 2002/10/05 15:18:42 carl
  2321. * fix heap leaks
  2322. Revision 1.52 2002/09/30 07:00:46 florian
  2323. * fixes to common code to get the alpha compiler compiled applied
  2324. Revision 1.51 2002/09/22 14:02:35 carl
  2325. * stack checking cannot be called before system unit is initialized
  2326. * MC68020 define
  2327. Revision 1.50 2002/09/17 18:54:03 jonas
  2328. * a_load_reg_reg() now has two size parameters: source and dest. This
  2329. allows some optimizations on architectures that don't encode the
  2330. register size in the register name.
  2331. Revision 1.49 2002/09/10 21:48:30 florian
  2332. * improved handling of procedures with register calling conventions
  2333. Revision 1.48 2002/09/07 15:25:03 peter
  2334. * old logs removed and tabs fixed
  2335. Revision 1.47 2002/09/02 18:44:48 peter
  2336. * fixed (not) pushing of empty parameters
  2337. * fixed implicit initialization/finalization generation
  2338. * fixed/optimized local copy of value arguments init/final
  2339. Revision 1.46 2002/09/01 19:27:34 peter
  2340. * use index register when available for generating a reference with
  2341. only a signle register. Using the base register could possibly
  2342. destroy the framepointer
  2343. Revision 1.45 2002/09/01 18:50:20 peter
  2344. * fixed maybe_save that did not support a reference with only
  2345. a index register. It now also updates the location with the new
  2346. base register only
  2347. Revision 1.44 2002/09/01 14:42:41 peter
  2348. * removevaluepara added to fix the stackpointer so restoring of
  2349. saved registers works
  2350. Revision 1.43 2002/08/25 19:25:18 peter
  2351. * sym.insert_in_data removed
  2352. * symtable.insertvardata/insertconstdata added
  2353. * removed insert_in_data call from symtable.insert, it needs to be
  2354. called separatly. This allows to deref the address calculation
  2355. * procedures now calculate the parast addresses after the procedure
  2356. directives are parsed. This fixes the cdecl parast problem
  2357. * push_addr_param has an extra argument that specifies if cdecl is used
  2358. or not
  2359. Revision 1.42 2002/08/24 18:38:26 peter
  2360. * really use tt_noreuse for exception frame buffers
  2361. Revision 1.41 2002/08/23 16:14:49 peter
  2362. * tempgen cleanup
  2363. * tt_noreuse temp type added that will be used in genentrycode
  2364. Revision 1.40 2002/08/18 10:42:37 florian
  2365. * remaining assembler writer bugs fixed, the errors in the
  2366. system unit are inline assembler problems
  2367. Revision 1.39 2002/08/17 09:23:36 florian
  2368. * first part of procinfo rewrite
  2369. Revision 1.38 2002/08/16 14:24:57 carl
  2370. * issameref() to test if two references are the same (then emit no opcodes)
  2371. + ret_in_reg to replace ret_in_acc
  2372. (fix some register allocation bugs at the same time)
  2373. + save_std_register now has an extra parameter which is the
  2374. usedinproc registers
  2375. Revision 1.37 2002/08/15 15:15:55 carl
  2376. * jmpbuf size allocation for exceptions is now cpu specific (as it should)
  2377. * more generic nodes for maths
  2378. * several fixes for better m68k support
  2379. Revision 1.36 2002/08/14 19:25:09 carl
  2380. * fix Florian's last commit for m68k compilation
  2381. Revision 1.35 2002/08/13 21:40:56 florian
  2382. * more fixes for ppc calling conventions
  2383. Revision 1.34 2002/08/12 15:08:39 carl
  2384. + stab register indexes for powerpc (moved from gdb to cpubase)
  2385. + tprocessor enumeration moved to cpuinfo
  2386. + linker in target_info is now a class
  2387. * many many updates for m68k (will soon start to compile)
  2388. - removed some ifdef or correct them for correct cpu
  2389. Revision 1.33 2002/08/11 14:32:27 peter
  2390. * renamed current_library to objectlibrary
  2391. Revision 1.32 2002/08/11 13:24:12 peter
  2392. * saving of asmsymbols in ppu supported
  2393. * asmsymbollist global is removed and moved into a new class
  2394. tasmlibrarydata that will hold the info of a .a file which
  2395. corresponds with a single module. Added librarydata to tmodule
  2396. to keep the library info stored for the module. In the future the
  2397. objectfiles will also be stored to the tasmlibrarydata class
  2398. * all getlabel/newasmsymbol and friends are moved to the new class
  2399. Revision 1.31 2002/08/09 19:16:57 carl
  2400. * stack allocation is now done separately (at the end) of genentrycode
  2401. so temps. can be allocated before.
  2402. * fix generic exception handling
  2403. Revision 1.30 2002/08/06 20:55:21 florian
  2404. * first part of ppc calling conventions fix
  2405. Revision 1.29 2002/08/04 19:09:22 carl
  2406. + added generic exception support (still does not work!)
  2407. + more documentation
  2408. Revision 1.28 2002/07/29 21:23:42 florian
  2409. * more fixes for the ppc
  2410. + wrappers for the tcnvnode.first_* stuff introduced
  2411. }