ncgutil.pas 105 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719
  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. list.concat(Tai_comment.Create(strpnew('Para '+realname+' located at '+
  1826. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1827. end;
  1828. end;
  1829. end;
  1830. end;
  1831. sym:=tsym(sym.indexnext);
  1832. end;
  1833. end;
  1834. procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
  1835. var
  1836. sym : tsym;
  1837. begin
  1838. sym:=tsym(st.symindex.first);
  1839. while assigned(sym) do
  1840. begin
  1841. if sym.typ=varsym then
  1842. begin
  1843. with tvarsym(sym) do
  1844. begin
  1845. {$warning TODO Allocate register paras}
  1846. localloc.loc:=LOC_REFERENCE;
  1847. localloc.size:=int_cgsize(paramanager.push_size(vs_value,vartype.def,pocall_inline));
  1848. tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
  1849. if cs_asm_source in aktglobalswitches then
  1850. begin
  1851. case localloc.loc of
  1852. LOC_REFERENCE :
  1853. list.concat(Tai_comment.Create(strpnew('Para '+realname+' allocated at '+
  1854. std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
  1855. end;
  1856. end;
  1857. paraitem.paraloc[callerside]:=localloc;
  1858. paraitem.paraloc[calleeside]:=localloc;
  1859. end;
  1860. end;
  1861. sym:=tsym(sym.indexnext);
  1862. end;
  1863. end;
  1864. procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
  1865. var
  1866. sym : tsym;
  1867. begin
  1868. sym:=tsym(st.symindex.first);
  1869. while assigned(sym) do
  1870. begin
  1871. if sym.typ=varsym then
  1872. begin
  1873. with tvarsym(sym) do
  1874. begin
  1875. { Note: We need to keep the data available in memory
  1876. for the sub procedures that can access local data
  1877. in the parent procedures }
  1878. case localloc.loc of
  1879. LOC_REFERENCE :
  1880. tg.UngetLocal(list,localloc.reference);
  1881. LOC_REGISTER :
  1882. begin
  1883. if localloc.register<>paraitem.paraloc[calleeside].register then
  1884. begin
  1885. {$ifndef cpu64bit}
  1886. if localloc.size in [OS_64,OS_S64] then
  1887. begin
  1888. cg.ungetregister(list,localloc.registerlow);
  1889. cg.ungetregister(list,localloc.registerhigh);
  1890. end
  1891. else
  1892. {$endif cpu64bit}
  1893. cg.ungetregister(list,localloc.register);
  1894. end;
  1895. end;
  1896. end;
  1897. end;
  1898. end;
  1899. sym:=tsym(sym.indexnext);
  1900. end;
  1901. end;
  1902. end.
  1903. {
  1904. $Log$
  1905. Revision 1.182 2004-01-13 18:08:58 florian
  1906. * x86-64 compilation fixed
  1907. Revision 1.181 2004/01/12 22:11:38 peter
  1908. * use localalign info for alignment for locals and temps
  1909. * sparc fpu flags branching added
  1910. * moved powerpc copy_valye_openarray to generic
  1911. Revision 1.180 2003/12/28 21:57:43 jonas
  1912. * fixed procedures declared as "interrupt" for non-x86
  1913. Revision 1.179 2003/12/26 13:19:16 florian
  1914. * rtl and compiler compile with -Cfsse2
  1915. Revision 1.178 2003/12/26 00:32:21 florian
  1916. + fpu<->mm register conversion
  1917. Revision 1.177 2003/12/24 00:10:02 florian
  1918. - delete parameter in cg64 methods removed
  1919. Revision 1.176 2003/12/23 14:38:07 florian
  1920. + second_floataddsse implemented
  1921. Revision 1.175 2003/12/22 19:00:17 florian
  1922. * fixed some x86-64 issues
  1923. Revision 1.174 2003/12/07 16:28:30 jonas
  1924. * fixed typo found by Charlie
  1925. Revision 1.173 2003/12/06 01:15:22 florian
  1926. * reverted Peter's alloctemp patch; hopefully properly
  1927. Revision 1.172 2003/12/03 23:13:20 peter
  1928. * delayed paraloc allocation, a_param_*() gets extra parameter
  1929. if it needs to allocate temp or real paralocation
  1930. * optimized/simplified int-real loading
  1931. Revision 1.171 2003/11/30 19:35:29 florian
  1932. * fixed several arm related problems
  1933. Revision 1.170 2003/11/29 20:13:25 florian
  1934. * fixed several pi_do_call problems
  1935. Revision 1.169 2003/11/23 17:05:15 peter
  1936. * register calling is left-right
  1937. * parameter ordering
  1938. * left-right calling inserts result parameter last
  1939. Revision 1.168 2003/11/22 00:31:25 jonas
  1940. + extra allocations of function result regs for the optimiser
  1941. Revision 1.167 2003/11/11 21:10:12 peter
  1942. * remove temporary stdcall hack
  1943. Revision 1.166 2003/11/10 22:02:52 peter
  1944. * cross unit inlining fixed
  1945. Revision 1.165 2003/11/07 15:58:32 florian
  1946. * Florian's culmutative nr. 1; contains:
  1947. - invalid calling conventions for a certain cpu are rejected
  1948. - arm softfloat calling conventions
  1949. - -Sp for cpu dependend code generation
  1950. - several arm fixes
  1951. - remaining code for value open array paras on heap
  1952. Revision 1.164 2003/11/04 19:03:50 peter
  1953. * fixes for temp type patch
  1954. Revision 1.163 2003/11/04 15:35:13 peter
  1955. * fix for referencecounted temps
  1956. Revision 1.162 2003/10/25 11:34:02 florian
  1957. * fixed compilation of ppc system unit
  1958. Revision 1.161 2003/10/19 01:34:30 florian
  1959. * some ppc stuff fixed
  1960. * memory leak fixed
  1961. Revision 1.160 2003/10/17 15:08:34 peter
  1962. * commented out more obsolete constants
  1963. Revision 1.159 2003/10/17 14:38:32 peter
  1964. * 64k registers supported
  1965. * fixed some memory leaks
  1966. Revision 1.158 2003/10/10 17:48:13 peter
  1967. * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
  1968. * tregisteralloctor renamed to trgobj
  1969. * removed rgobj from a lot of units
  1970. * moved location_* and reference_* to cgobj
  1971. * first things for mmx register allocation
  1972. Revision 1.157 2003/10/09 21:31:37 daniel
  1973. * Register allocator splitted, ans abstract now
  1974. Revision 1.156 2003/10/07 18:18:16 peter
  1975. * fix register calling for assembler procedures
  1976. * fix result loading for assembler procedures
  1977. Revision 1.155 2003/10/07 15:17:07 peter
  1978. * inline supported again, LOC_REFERENCEs are used to pass the
  1979. parameters
  1980. * inlineparasymtable,inlinelocalsymtable removed
  1981. * exitlabel inserting fixed
  1982. Revision 1.154 2003/10/01 20:34:48 peter
  1983. * procinfo unit contains tprocinfo
  1984. * cginfo renamed to cgbase
  1985. * moved cgmessage to verbose
  1986. * fixed ppc and sparc compiles
  1987. Revision 1.153 2003/09/30 21:02:37 peter
  1988. * updates for inlining
  1989. Revision 1.152 2003/09/29 20:58:56 peter
  1990. * optimized releasing of registers
  1991. Revision 1.151 2003/09/28 21:47:18 peter
  1992. * register paras and local copies updates
  1993. Revision 1.150 2003/09/28 17:55:03 peter
  1994. * parent framepointer changed to hidden parameter
  1995. * tloadparentfpnode added
  1996. Revision 1.149 2003/09/28 13:39:38 peter
  1997. * optimized releasing of registers
  1998. Revision 1.148 2003/09/25 21:28:00 peter
  1999. * parameter fixes
  2000. Revision 1.147 2003/09/23 21:03:59 peter
  2001. * check for refs>0 in init/final local data
  2002. Revision 1.146 2003/09/23 17:56:05 peter
  2003. * locals and paras are allocated in the code generation
  2004. * tvarsym.localloc contains the location of para/local when
  2005. generating code for the current procedure
  2006. Revision 1.145 2003/09/16 16:17:01 peter
  2007. * varspez in calls to push_addr_param
  2008. Revision 1.144 2003/09/14 21:33:37 peter
  2009. * location_force_reg gives IE when size=OS_NO
  2010. Revision 1.143 2003/09/14 19:18:10 peter
  2011. * remove obsolete code already in comments
  2012. Revision 1.142 2003/09/11 11:54:59 florian
  2013. * improved arm code generation
  2014. * move some protected and private field around
  2015. * the temp. register for register parameters/arguments are now released
  2016. before the move to the parameter register is done. This improves
  2017. the code in a lot of cases.
  2018. Revision 1.141 2003/09/10 08:31:47 marco
  2019. * Patch from Peter for paraloc
  2020. Revision 1.140 2003/09/07 22:09:35 peter
  2021. * preparations for different default calling conventions
  2022. * various RA fixes
  2023. Revision 1.139 2003/09/03 15:55:01 peter
  2024. * NEWRA branch merged
  2025. Revision 1.138 2003/09/03 11:18:37 florian
  2026. * fixed arm concatcopy
  2027. + arm support in the common compiler sources added
  2028. * moved some generic cg code around
  2029. + tfputype added
  2030. * ...
  2031. Revision 1.137.2.4 2003/08/31 15:46:26 peter
  2032. * more updates for tregister
  2033. Revision 1.137.2.3 2003/08/29 17:28:59 peter
  2034. * next batch of updates
  2035. Revision 1.137.2.2 2003/08/28 18:35:08 peter
  2036. * tregister changed to cardinal
  2037. Revision 1.137.2.1 2003/08/27 19:55:54 peter
  2038. * first tregister patch
  2039. Revision 1.137 2003/08/20 20:29:06 daniel
  2040. * Some more R_NO changes
  2041. * Preventive code to loadref added
  2042. Revision 1.136 2003/08/20 17:48:49 peter
  2043. * fixed stackalloc to not allocate localst.datasize twice
  2044. * order of stackalloc code fixed for implicit init/final
  2045. Revision 1.135 2003/08/17 16:59:20 jonas
  2046. * fixed regvars so they work with newra (at least for ppc)
  2047. * fixed some volatile register bugs
  2048. + -dnotranslation option for -dnewra, which causes the registers not to
  2049. be translated from virtual to normal registers. Requires support in
  2050. the assembler writer as well, which is only implemented in aggas/
  2051. agppcgas currently
  2052. Revision 1.134 2003/08/11 21:18:20 peter
  2053. * start of sparc support for newra
  2054. Revision 1.133 2003/08/09 18:56:54 daniel
  2055. * cs_regalloc renamed to cs_regvars to avoid confusion with register
  2056. allocator
  2057. * Some preventive changes to i386 spillinh code
  2058. Revision 1.132 2003/08/03 14:09:50 daniel
  2059. * Fixed a register allocator bug
  2060. * Figured out why -dnewra generates superfluous "mov reg1,reg2"
  2061. statements: changes in location_force. These moves are now no longer
  2062. constrained so they are optimized away.
  2063. Revision 1.131 2003/07/23 11:04:15 jonas
  2064. * split en_exit_code into a part that may allocate a register and a part
  2065. that doesn't, so the former can be done before the register colouring
  2066. has been performed
  2067. Revision 1.130 2003/07/06 17:58:22 peter
  2068. * framepointer fixes for sparc
  2069. * parent framepointer code more generic
  2070. Revision 1.129 2003/07/06 15:31:20 daniel
  2071. * Fixed register allocator. *Lots* of fixes.
  2072. Revision 1.128 2003/07/02 22:18:04 peter
  2073. * paraloc splitted in callerparaloc,calleeparaloc
  2074. * sparc calling convention updates
  2075. Revision 1.127 2003/06/17 18:13:51 jonas
  2076. * fixed -dnewra compilation problems
  2077. Revision 1.126 2003/06/17 16:32:44 peter
  2078. * alloc register for function result
  2079. Revision 1.125 2003/06/13 21:19:30 peter
  2080. * current_procdef removed, use current_procinfo.procdef instead
  2081. Revision 1.124 2003/06/09 12:23:30 peter
  2082. * init/final of procedure data splitted from genentrycode
  2083. * use asmnode getposition to insert final at the correct position
  2084. als for the implicit try...finally
  2085. Revision 1.123 2003/06/07 18:57:04 jonas
  2086. + added freeintparaloc
  2087. * ppc get/freeintparaloc now check whether the parameter regs are
  2088. properly allocated/deallocated (and get an extra list para)
  2089. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  2090. * fixed lot of missing pi_do_call's
  2091. Revision 1.122 2003/06/06 14:43:02 peter
  2092. * g_copyopenarrayvalue gets length reference
  2093. * don't copy open arrays for cdecl
  2094. Revision 1.121 2003/06/03 21:11:09 peter
  2095. * cg.a_load_* get a from and to size specifier
  2096. * makeregsize only accepts newregister
  2097. * i386 uses generic tcgnotnode,tcgunaryminus
  2098. Revision 1.120 2003/06/03 15:49:49 jonas
  2099. * fixed ref/loc problems
  2100. Revision 1.119 2003/06/03 15:06:37 daniel
  2101. * fixed conflict marks
  2102. Revision 1.118 2003/06/03 13:01:59 daniel
  2103. * Register allocator finished
  2104. Revision 1.117 2003/06/02 21:42:05 jonas
  2105. * function results can now also be regvars
  2106. - removed tprocinfo.return_offset, never use it again since it's invalid
  2107. if the result is a regvar
  2108. Revision 1.116 2003/06/01 21:38:06 peter
  2109. * getregisterfpu size parameter added
  2110. * op_const_reg size parameter added
  2111. * sparc updates
  2112. Revision 1.115 2003/05/31 20:28:17 jonas
  2113. * changed copyvalueparas so it also supports register parameters
  2114. (except for copy_value_openarray, but that one is seriously broken
  2115. anyway, since it expects that the high parameter will always be in
  2116. memory right after the pointer to the array, while it could just as
  2117. will be in a register)
  2118. Revision 1.114 2003/05/31 15:05:28 peter
  2119. * FUNCTION_RESULT64_LOW/HIGH_REG added for int64 results
  2120. Revision 1.113 2003/05/31 00:48:15 jonas
  2121. * fixed my previous commit
  2122. Revision 1.112 2003/05/30 23:57:08 peter
  2123. * more sparc cleanup
  2124. * accumulator removed, splitted in function_return_reg (called) and
  2125. function_result_reg (caller)
  2126. Revision 1.111 2003/05/30 23:49:18 jonas
  2127. * a_load_loc_reg now has an extra size parameter for the destination
  2128. register (properly fixes what I worked around in revision 1.106 of
  2129. ncgutil.pas)
  2130. Revision 1.110 2003/05/30 18:52:10 jonas
  2131. * fixed bug with intregvars
  2132. * locapara.loc can also be LOC_CFPUREGISTER -> also fixed
  2133. rcgppc.a_param_ref, which previously got bogus size values
  2134. Revision 1.109 2003/05/27 21:19:08 jonas
  2135. * fixed ppc cycle
  2136. Revision 1.108 2003/05/27 14:28:14 jonas
  2137. * patch from Peter for nested procedures
  2138. Revision 1.107 2003/05/26 21:17:17 peter
  2139. * procinlinenode removed
  2140. * aktexit2label removed, fast exit removed
  2141. + tcallnode.inlined_pass_2 added
  2142. Revision 1.106 2003/05/24 11:59:42 jonas
  2143. * fixed integer typeconversion problems
  2144. Revision 1.105 2003/05/23 14:27:35 peter
  2145. * remove some unit dependencies
  2146. * current_procinfo changes to store more info
  2147. Revision 1.104 2003/05/15 18:58:53 peter
  2148. * removed selfpointer_offset, vmtpointer_offset
  2149. * tvarsym.adjusted_address
  2150. * address in localsymtable is now in the real direction
  2151. * removed some obsolete globals
  2152. Revision 1.103 2003/05/14 19:37:25 jonas
  2153. * patch from Peter for int64 function results
  2154. Revision 1.102 2003/05/13 19:14:41 peter
  2155. * failn removed
  2156. * inherited result code check moven to pexpr
  2157. Revision 1.101 2003/05/13 15:16:13 peter
  2158. * removed ret_in_acc, it's the reverse of ret_in_param
  2159. * fixed ret_in_param for win32 cdecl array
  2160. Revision 1.100 2003/05/12 08:08:27 jonas
  2161. * fixed several initialization and finalization related bugs (missing
  2162. tg.direction's, wrong paralocation for decreasing refcount of
  2163. everything but ansistrings)
  2164. Revision 1.99 2003/05/11 21:37:03 peter
  2165. * moved implicit exception frame from ncgutil to psub
  2166. * constructor/destructor helpers moved from cobj/ncgutil to psub
  2167. Revision 1.98 2003/05/11 14:45:12 peter
  2168. * tloadnode does not support objectsymtable,withsymtable anymore
  2169. * withnode cleanup
  2170. * direct with rewritten to use temprefnode
  2171. Revision 1.97 2003/05/10 13:20:23 jonas
  2172. * moved storing of register parameters to memory even earlier in the
  2173. entry code to fix problems with constructors
  2174. Revision 1.96 2003/05/09 17:47:02 peter
  2175. * self moved to hidden parameter
  2176. * removed hdisposen,hnewn,selfn
  2177. Revision 1.95 2003/04/29 07:28:52 michael
  2178. + Patch from peter to fix wrong pushing of ansistring function results in open array
  2179. Revision 1.94 2003/04/28 21:17:38 peter
  2180. * do not finalize function results
  2181. Revision 1.93 2003/04/27 16:30:34 jonas
  2182. * store register para's to memory before copying the valuepara's, because
  2183. that one requires them to be there already (and it calls subroutines ->
  2184. could overwrite those registers)
  2185. Revision 1.92 2003/04/27 11:21:33 peter
  2186. * aktprocdef renamed to current_procinfo.procdef
  2187. * procinfo renamed to current_procinfo
  2188. * procinfo will now be stored in current_module so it can be
  2189. cleaned up properly
  2190. * gen_main_procsym changed to create_main_proc and release_main_proc
  2191. to also generate a tprocinfo structure
  2192. * fixed unit implicit initfinal
  2193. Revision 1.91 2003/04/27 07:29:50 peter
  2194. * current_procinfo.procdef cleanup, current_procinfo.procdef is now always nil when parsing
  2195. a new procdef declaration
  2196. * aktprocsym removed
  2197. * lexlevel removed, use symtable.symtablelevel instead
  2198. * implicit init/final code uses the normal genentry/genexit
  2199. * funcret state checking updated for new funcret handling
  2200. Revision 1.90 2003/04/26 17:21:08 florian
  2201. * fixed passing of fpu values by fpu register
  2202. Revision 1.89 2003/04/25 20:59:33 peter
  2203. * removed funcretn,funcretsym, function result is now in varsym
  2204. and aliases for result and function name are added using absolutesym
  2205. * vs_hidden parameter for funcret passed in parameter
  2206. * vs_hidden fixes
  2207. * writenode changed to printnode and released from extdebug
  2208. * -vp option added to generate a tree.log with the nodetree
  2209. * nicer printnode for statements, callnode
  2210. Revision 1.88 2003/04/23 12:35:34 florian
  2211. * fixed several issues with powerpc
  2212. + applied a patch from Jonas for nested function calls (PowerPC only)
  2213. * ...
  2214. Revision 1.87 2003/04/22 14:33:38 peter
  2215. * removed some notes/hints
  2216. Revision 1.86 2003/04/22 13:47:08 peter
  2217. * fixed C style array of const
  2218. * fixed C array passing
  2219. * fixed left to right with high parameters
  2220. Revision 1.85 2003/04/22 10:09:35 daniel
  2221. + Implemented the actual register allocator
  2222. + Scratch registers unavailable when new register allocator used
  2223. + maybe_save/maybe_restore unavailable when new register allocator used
  2224. Revision 1.84 2003/04/16 09:26:55 jonas
  2225. * assembler procedures now again get a stackframe if they have local
  2226. variables. No space is reserved for a function result however.
  2227. Also, the register parameters aren't automatically saved on the stack
  2228. anymore in assembler procedures.
  2229. Revision 1.83 2003/04/06 21:11:23 olle
  2230. * changed newasmsymbol to newasmsymboldata for data symbols
  2231. Revision 1.82 2003/03/30 20:59:07 peter
  2232. * fix classmethod from classmethod call
  2233. * move BeforeDestruction/AfterConstruction calls to
  2234. genentrycode/genexitcode instead of generating them on the fly
  2235. after a call to a constructor
  2236. Revision 1.81 2003/03/28 19:16:56 peter
  2237. * generic constructor working for i386
  2238. * remove fixed self register
  2239. * esi added as address register for i386
  2240. Revision 1.80 2003/03/17 15:52:20 peter
  2241. * fix range error
  2242. Revision 1.79 2003/03/11 21:46:24 jonas
  2243. * lots of new regallocator fixes, both in generic and ppc-specific code
  2244. (ppc compiler still can't compile the linux system unit though)
  2245. Revision 1.78 2003/02/26 21:15:43 daniel
  2246. * Fixed the optimizer
  2247. Revision 1.77 2003/02/19 22:00:14 daniel
  2248. * Code generator converted to new register notation
  2249. - Horribily outdated todo.txt removed
  2250. Revision 1.76 2003/02/15 22:17:38 carl
  2251. * bugfix of FPU emulation code
  2252. Revision 1.75 2003/01/09 22:00:53 florian
  2253. * fixed some PowerPC issues
  2254. Revision 1.74 2003/01/09 20:41:10 florian
  2255. * fixed broken PowerPC compiler
  2256. Revision 1.73 2003/01/08 18:43:56 daniel
  2257. * Tregister changed into a record
  2258. Revision 1.72 2002/12/29 23:51:43 florian
  2259. * web bug 2214 fixed: ie 10 in const array constructors
  2260. Revision 1.71 2002/12/24 15:56:50 peter
  2261. * stackpointer_alloc added for adjusting ESP. Win32 needs
  2262. this for the pageprotection
  2263. Revision 1.70 2002/12/05 14:39:21 florian
  2264. * added missing then, Carl did you really a make fullcycle :) ?
  2265. Revision 1.69 2002/12/03 22:13:39 carl
  2266. * bugfix of problems with profile code which clobbers some registers
  2267. Revision 1.68 2002/12/01 22:06:59 carl
  2268. * warning of portabilitiy problems with parasize / localsize
  2269. Revision 1.67 2002/11/30 18:44:57 carl
  2270. + profiling support for Win32
  2271. Revision 1.66 2002/11/30 14:39:15 carl
  2272. * try to fix profiling for win32
  2273. Revision 1.65 2002/11/28 23:28:14 florian
  2274. * push_value_para didn't release floatdef locations, fixes tw2045
  2275. Revision 1.64 2002/11/27 02:33:19 peter
  2276. * copy_value_on_stack method added for cdecl record passing
  2277. Revision 1.63 2002/11/25 17:43:18 peter
  2278. * splitted defbase in defutil,symutil,defcmp
  2279. * merged isconvertable and is_equal into compare_defs(_ext)
  2280. * made operator search faster by walking the list only once
  2281. Revision 1.62 2002/11/18 17:31:55 peter
  2282. * pass proccalloption to ret_in_xxx and push_xxx functions
  2283. Revision 1.61 2002/11/17 17:49:08 mazen
  2284. + 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
  2285. Revision 1.60 2002/11/17 16:31:56 carl
  2286. * memory optimization (3-4%) : cleanup of tai fields,
  2287. cleanup of tdef and tsym fields.
  2288. * make it work for m68k
  2289. Revision 1.59 2002/11/15 01:58:51 peter
  2290. * merged changes from 1.0.7 up to 04-11
  2291. - -V option for generating bug report tracing
  2292. - more tracing for option parsing
  2293. - errors for cdecl and high()
  2294. - win32 import stabs
  2295. - win32 records<=8 are returned in eax:edx (turned off by default)
  2296. - heaptrc update
  2297. - more info for temp management in .s file with EXTDEBUG
  2298. Revision 1.58 2002/11/10 19:07:45 mazen
  2299. * SPARC calling mechanism almost OK (as in GCC./mppcsparc )
  2300. Revision 1.57 2002/11/03 20:22:40 mazen
  2301. * parameter handling updated
  2302. Revision 1.56 2002/10/16 19:01:43 peter
  2303. + $IMPLICITEXCEPTIONS switch to turn on/off generation of the
  2304. implicit exception frames for procedures with initialized variables
  2305. and for constructors. The default is on for compatibility
  2306. Revision 1.55 2002/10/14 19:42:33 peter
  2307. * only use init tables for threadvars
  2308. Revision 1.54 2002/10/06 19:41:30 peter
  2309. * Add finalization of typed consts
  2310. * Finalization of globals in the main program
  2311. Revision 1.53 2002/10/05 15:18:42 carl
  2312. * fix heap leaks
  2313. Revision 1.52 2002/09/30 07:00:46 florian
  2314. * fixes to common code to get the alpha compiler compiled applied
  2315. Revision 1.51 2002/09/22 14:02:35 carl
  2316. * stack checking cannot be called before system unit is initialized
  2317. * MC68020 define
  2318. Revision 1.50 2002/09/17 18:54:03 jonas
  2319. * a_load_reg_reg() now has two size parameters: source and dest. This
  2320. allows some optimizations on architectures that don't encode the
  2321. register size in the register name.
  2322. Revision 1.49 2002/09/10 21:48:30 florian
  2323. * improved handling of procedures with register calling conventions
  2324. Revision 1.48 2002/09/07 15:25:03 peter
  2325. * old logs removed and tabs fixed
  2326. Revision 1.47 2002/09/02 18:44:48 peter
  2327. * fixed (not) pushing of empty parameters
  2328. * fixed implicit initialization/finalization generation
  2329. * fixed/optimized local copy of value arguments init/final
  2330. Revision 1.46 2002/09/01 19:27:34 peter
  2331. * use index register when available for generating a reference with
  2332. only a signle register. Using the base register could possibly
  2333. destroy the framepointer
  2334. Revision 1.45 2002/09/01 18:50:20 peter
  2335. * fixed maybe_save that did not support a reference with only
  2336. a index register. It now also updates the location with the new
  2337. base register only
  2338. Revision 1.44 2002/09/01 14:42:41 peter
  2339. * removevaluepara added to fix the stackpointer so restoring of
  2340. saved registers works
  2341. Revision 1.43 2002/08/25 19:25:18 peter
  2342. * sym.insert_in_data removed
  2343. * symtable.insertvardata/insertconstdata added
  2344. * removed insert_in_data call from symtable.insert, it needs to be
  2345. called separatly. This allows to deref the address calculation
  2346. * procedures now calculate the parast addresses after the procedure
  2347. directives are parsed. This fixes the cdecl parast problem
  2348. * push_addr_param has an extra argument that specifies if cdecl is used
  2349. or not
  2350. Revision 1.42 2002/08/24 18:38:26 peter
  2351. * really use tt_noreuse for exception frame buffers
  2352. Revision 1.41 2002/08/23 16:14:49 peter
  2353. * tempgen cleanup
  2354. * tt_noreuse temp type added that will be used in genentrycode
  2355. Revision 1.40 2002/08/18 10:42:37 florian
  2356. * remaining assembler writer bugs fixed, the errors in the
  2357. system unit are inline assembler problems
  2358. Revision 1.39 2002/08/17 09:23:36 florian
  2359. * first part of procinfo rewrite
  2360. Revision 1.38 2002/08/16 14:24:57 carl
  2361. * issameref() to test if two references are the same (then emit no opcodes)
  2362. + ret_in_reg to replace ret_in_acc
  2363. (fix some register allocation bugs at the same time)
  2364. + save_std_register now has an extra parameter which is the
  2365. usedinproc registers
  2366. Revision 1.37 2002/08/15 15:15:55 carl
  2367. * jmpbuf size allocation for exceptions is now cpu specific (as it should)
  2368. * more generic nodes for maths
  2369. * several fixes for better m68k support
  2370. Revision 1.36 2002/08/14 19:25:09 carl
  2371. * fix Florian's last commit for m68k compilation
  2372. Revision 1.35 2002/08/13 21:40:56 florian
  2373. * more fixes for ppc calling conventions
  2374. Revision 1.34 2002/08/12 15:08:39 carl
  2375. + stab register indexes for powerpc (moved from gdb to cpubase)
  2376. + tprocessor enumeration moved to cpuinfo
  2377. + linker in target_info is now a class
  2378. * many many updates for m68k (will soon start to compile)
  2379. - removed some ifdef or correct them for correct cpu
  2380. Revision 1.33 2002/08/11 14:32:27 peter
  2381. * renamed current_library to objectlibrary
  2382. Revision 1.32 2002/08/11 13:24:12 peter
  2383. * saving of asmsymbols in ppu supported
  2384. * asmsymbollist global is removed and moved into a new class
  2385. tasmlibrarydata that will hold the info of a .a file which
  2386. corresponds with a single module. Added librarydata to tmodule
  2387. to keep the library info stored for the module. In the future the
  2388. objectfiles will also be stored to the tasmlibrarydata class
  2389. * all getlabel/newasmsymbol and friends are moved to the new class
  2390. Revision 1.31 2002/08/09 19:16:57 carl
  2391. * stack allocation is now done separately (at the end) of genentrycode
  2392. so temps. can be allocated before.
  2393. * fix generic exception handling
  2394. Revision 1.30 2002/08/06 20:55:21 florian
  2395. * first part of ppc calling conventions fix
  2396. Revision 1.29 2002/08/04 19:09:22 carl
  2397. + added generic exception support (still does not work!)
  2398. + more documentation
  2399. Revision 1.28 2002/07/29 21:23:42 florian
  2400. * more fixes for the ppc
  2401. + wrappers for the tcnvnode.first_* stuff introduced
  2402. }