ncgutil.pas 87 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251
  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,
  25. aasmbase,aasmtai,aasmcpu,
  26. cginfo,symbase,symdef,symtype,
  27. {$ifndef cpu64bit}
  28. cg64f32,
  29. {$endif cpu64bit}
  30. rgobj;
  31. type
  32. tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
  33. tmaybesave = record
  34. saved : boolean;
  35. ref : treference;
  36. end;
  37. procedure firstcomplex(p : tbinarynode);
  38. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  39. procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsupregset);
  40. procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  41. procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
  42. {$ifndef newra}
  43. procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
  44. procedure maybe_restore(list:taasmoutput;var l:tlocation;const s:tmaybesave);
  45. {$endif}
  46. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  47. procedure push_value_para(list:taasmoutput;p:tnode;calloption:tproccalloption;
  48. para_offset:longint;alignment : longint;
  49. const locpara : tparalocation);
  50. procedure genentrycode(list : TAAsmoutput;stackframe:longint;inlined : boolean);
  51. procedure genexitcode(list : TAAsmoutput;inlined:boolean);
  52. procedure geninlineentrycode(list : TAAsmoutput;stackframe:longint);
  53. procedure geninlineexitcode(list : TAAsmoutput;inlined:boolean);
  54. {#
  55. Allocate the buffers for exception management and setjmp environment.
  56. Return a pointer to these buffers, send them to the utility routine
  57. so they are registered, and then call setjmp.
  58. Then compare the result of setjmp with 0, and if not equal
  59. to zero, then jump to exceptlabel.
  60. Also store the result of setjmp to a temporary space by calling g_save_exception_reason
  61. It is to note that this routine may be called *after* the stackframe of a
  62. routine has been called, therefore on machines where the stack cannot
  63. be modified, all temps should be allocated on the heap instead of the
  64. stack.
  65. }
  66. procedure new_exception(list : taasmoutput;const jmpbuf,envbuf, href : treference;
  67. a : aword; exceptlabel : tasmlabel);
  68. procedure free_exception(list : taasmoutput;const jmpbuf, envbuf, href : treference;
  69. a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
  70. implementation
  71. uses
  72. {$ifdef Delphi}
  73. Sysutils,
  74. {$else}
  75. strings,
  76. {$endif}
  77. cutils,cclasses,
  78. globals,systems,verbose,
  79. symconst,symsym,symtable,defutil,
  80. paramgr,fmodule,
  81. cgbase,regvars,
  82. {$ifdef GDB}
  83. gdb,
  84. {$endif GDB}
  85. ncon,
  86. tgobj,cgobj;
  87. const
  88. { Please leave this here, this module should NOT use
  89. exprasmlist, the lists are always passed as arguments.
  90. Declaring it as string here results in an error when compiling (PFV) }
  91. exprasmlist = 'error';
  92. {*****************************************************************************
  93. Misc Helpers
  94. *****************************************************************************}
  95. { DO NOT RELY on the fact that the tnode is not yet swaped
  96. because of inlining code PM }
  97. procedure firstcomplex(p : tbinarynode);
  98. var
  99. hp : tnode;
  100. begin
  101. { always calculate boolean AND and OR from left to right }
  102. if (p.nodetype in [orn,andn]) and
  103. is_boolean(p.left.resulttype.def) then
  104. begin
  105. if nf_swaped in p.flags then
  106. internalerror(234234);
  107. end
  108. else
  109. if (
  110. (p.location.loc=LOC_FPUREGISTER) and
  111. (p.right.registersfpu > p.left.registersfpu)
  112. ) or
  113. (
  114. (
  115. (
  116. ((p.left.registersfpu = 0) and (p.right.registersfpu = 0)) or
  117. (p.location.loc<>LOC_FPUREGISTER)
  118. ) and
  119. (p.left.registers32<p.right.registers32)
  120. ) and
  121. { the following check is appropriate, because all }
  122. { 4 registers are rarely used and it is thereby }
  123. { achieved that the extra code is being dropped }
  124. { by exchanging not commutative operators }
  125. (p.right.registers32<=c_countusableregsint)
  126. ) then
  127. begin
  128. hp:=p.left;
  129. p.left:=p.right;
  130. p.right:=hp;
  131. if nf_swaped in p.flags then
  132. exclude(p.flags,nf_swaped)
  133. else
  134. include(p.flags,nf_swaped);
  135. end;
  136. end;
  137. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  138. {
  139. produces jumps to true respectively false labels using boolean expressions
  140. depending on whether the loading of regvars is currently being
  141. synchronized manually (such as in an if-node) or automatically (most of
  142. the other cases where this procedure is called), loadregvars can be
  143. "lr_load_regvars" or "lr_dont_load_regvars"
  144. }
  145. var
  146. opsize : tcgsize;
  147. storepos : tfileposinfo;
  148. begin
  149. if nf_error in p.flags then
  150. exit;
  151. storepos:=aktfilepos;
  152. aktfilepos:=p.fileinfo;
  153. if is_boolean(p.resulttype.def) then
  154. begin
  155. if loadregvars = lr_load_regvars then
  156. load_all_regvars(list);
  157. if is_constboolnode(p) then
  158. begin
  159. if tordconstnode(p).value<>0 then
  160. cg.a_jmp_always(list,truelabel)
  161. else
  162. cg.a_jmp_always(list,falselabel)
  163. end
  164. else
  165. begin
  166. opsize:=def_cgsize(p.resulttype.def);
  167. case p.location.loc of
  168. LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
  169. begin
  170. if (p.location.loc = LOC_CREGISTER) then
  171. load_regvar_reg(list,p.location.register);
  172. cg.a_cmp_const_loc_label(list,opsize,OC_NE,
  173. 0,p.location,truelabel);
  174. { !!! should happen right after cmp (JM) }
  175. location_release(list,p.location);
  176. cg.a_jmp_always(list,falselabel);
  177. end;
  178. {$ifdef cpuflags}
  179. LOC_FLAGS :
  180. begin
  181. cg.a_jmp_flags(list,p.location.resflags,
  182. truelabel);
  183. cg.a_jmp_always(list,falselabel);
  184. end;
  185. {$endif cpuflags}
  186. end;
  187. end;
  188. end
  189. else
  190. internalerror(200112305);
  191. aktfilepos:=storepos;
  192. end;
  193. procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsupregset);
  194. begin
  195. case t.loc of
  196. LOC_REGISTER:
  197. begin
  198. { can't be a regvar, since it would be LOC_CREGISTER then }
  199. if t.register.enum<>R_INTREGISTER then
  200. internalerror(200301154);
  201. if t.registerhigh.enum<>R_INTREGISTER then
  202. internalerror(200301154);
  203. exclude(regs,t.register.number shr 8);
  204. if t.registerhigh.enum <> R_NO then
  205. exclude(regs,t.registerhigh.number shr 8);
  206. end;
  207. LOC_CREFERENCE,LOC_REFERENCE:
  208. begin
  209. if t.reference.base.enum<>R_INTREGISTER then
  210. internalerror(200301154);
  211. if t.reference.index.enum<>R_INTREGISTER then
  212. internalerror(200301154);
  213. if not(cs_regalloc in aktglobalswitches) or
  214. ((t.reference.base.number shr 8) in rg.usableregsint) then
  215. exclude(regs,t.reference.base.number shr 8);
  216. if not(cs_regalloc in aktglobalswitches) or
  217. ((t.reference.index.number shr 8) in rg.usableregsint) then
  218. exclude(regs,t.reference.index.number shr 8);
  219. end;
  220. end;
  221. end;
  222. {*****************************************************************************
  223. EXCEPTION MANAGEMENT
  224. *****************************************************************************}
  225. procedure new_exception(list : taasmoutput;const jmpbuf,envbuf, href : treference;
  226. a : aword; exceptlabel : tasmlabel);
  227. var r:Tregister;
  228. begin
  229. cg.a_paramaddr_ref(list,envbuf,paramanager.getintparaloc(3));
  230. cg.a_paramaddr_ref(list,jmpbuf,paramanager.getintparaloc(2));
  231. { push type of exceptionframe }
  232. cg.a_param_const(list,OS_S32,1,paramanager.getintparaloc(1));
  233. cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
  234. r.enum:=R_INTREGISTER;
  235. r.number:=NR_ACCUMULATOR;
  236. cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(1));
  237. cg.a_call_name(list,'FPC_SETJMP');
  238. cg.g_exception_reason_save(list, href);
  239. cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,r,exceptlabel);
  240. end;
  241. procedure free_exception(list : taasmoutput;const jmpbuf, envbuf, href : treference;
  242. a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
  243. var r:Tregister;
  244. begin
  245. cg.a_call_name(list,'FPC_POPADDRSTACK');
  246. if not onlyfree then
  247. begin
  248. cg.g_exception_reason_load(list, href);
  249. r.enum:=R_INTREGISTER;
  250. r.number:=NR_ACCUMULATOR;
  251. cg.a_cmp_const_reg_label(list,OS_S32,OC_EQ,a,r,endexceptlabel);
  252. end;
  253. end;
  254. {*****************************************************************************
  255. TLocation
  256. *****************************************************************************}
  257. {$ifndef cpu64bit}
  258. { 32-bit version }
  259. procedure location_force(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  260. var
  261. hregister,
  262. hregisterhi : tregister;
  263. hreg64 : tregister64;
  264. hl : tasmlabel;
  265. begin
  266. { handle transformations to 64bit separate }
  267. if dst_size in [OS_64,OS_S64] then
  268. begin
  269. if not (l.size in [OS_64,OS_S64]) then
  270. begin
  271. { load a smaller size to OS_64 }
  272. if l.loc=LOC_REGISTER then
  273. begin
  274. hregister.enum:=R_INTREGISTER;
  275. hregister.number:=(l.registerlow.number and not $ff) or R_SUBWHOLE;
  276. cg.a_load_reg_reg(list,l.size,OS_32,l.registerlow,hregister);
  277. end
  278. else
  279. hregister:=rg.getregisterint(list,OS_INT);
  280. { load value in low register }
  281. case l.loc of
  282. LOC_FLAGS :
  283. cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
  284. LOC_JUMP :
  285. begin
  286. cg.a_label(list,truelabel);
  287. cg.a_load_const_reg(list,OS_INT,1,hregister);
  288. objectlibrary.getlabel(hl);
  289. cg.a_jmp_always(list,hl);
  290. cg.a_label(list,falselabel);
  291. cg.a_load_const_reg(list,OS_INT,0,hregister);
  292. cg.a_label(list,hl);
  293. end;
  294. else
  295. cg.a_load_loc_reg(list,l,hregister);
  296. end;
  297. { reset hi part, take care of the signed bit of the current value }
  298. hregisterhi:=rg.getregisterint(list,OS_INT);
  299. if (dst_size=OS_S64) and
  300. (l.size in [OS_S8,OS_S16,OS_S32]) then
  301. begin
  302. if l.loc=LOC_CONSTANT then
  303. begin
  304. if (longint(l.value)<0) then
  305. cg.a_load_const_reg(list,OS_32,$ffffffff,hregisterhi)
  306. else
  307. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  308. end
  309. else
  310. begin
  311. cg.a_op_const_reg_reg(list,OP_SAR,OS_32,31,hregister,
  312. hregisterhi);
  313. end;
  314. end
  315. else
  316. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  317. location_reset(l,LOC_REGISTER,dst_size);
  318. l.registerlow:=hregister;
  319. l.registerhigh:=hregisterhi;
  320. end
  321. else
  322. begin
  323. { 64bit to 64bit }
  324. if (l.loc=LOC_REGISTER) or
  325. ((l.loc=LOC_CREGISTER) and maybeconst) then
  326. begin
  327. hregister:=l.registerlow;
  328. hregisterhi:=l.registerhigh;
  329. end
  330. else
  331. begin
  332. hregister:=rg.getregisterint(list,OS_INT);
  333. hregisterhi:=rg.getregisterint(list,OS_INT);
  334. end;
  335. hreg64.reglo:=hregister;
  336. hreg64.reghi:=hregisterhi;
  337. { load value in new register }
  338. cg64.a_load64_loc_reg(list,l,hreg64);
  339. location_reset(l,LOC_REGISTER,dst_size);
  340. l.registerlow:=hregister;
  341. l.registerhigh:=hregisterhi;
  342. end;
  343. end
  344. else
  345. begin
  346. { transformations to 32bit or smaller }
  347. if l.loc=LOC_REGISTER then
  348. begin
  349. { if the previous was 64bit release the high register }
  350. if l.size in [OS_64,OS_S64] then
  351. begin
  352. rg.ungetregisterint(list,l.registerhigh);
  353. l.registerhigh.enum:=R_NO;
  354. end;
  355. hregister:=l.register;
  356. end
  357. else
  358. begin
  359. { get new register }
  360. if (l.loc=LOC_CREGISTER) and
  361. maybeconst and
  362. (TCGSize2Size[dst_size]=TCGSize2Size[l.size]) then
  363. hregister:=l.register
  364. else
  365. begin
  366. hregister.enum:=R_INTREGISTER;
  367. hregister.number:=NR_NO;
  368. end;
  369. end;
  370. if hregister.enum<>R_INTREGISTER then
  371. internalerror(200302022);
  372. { need to load into address register? }
  373. if (dst_size=OS_ADDR) then
  374. begin
  375. if (hregister.number=NR_NO) or
  376. (not rg.isaddressregister(hregister)) then
  377. hregister:=rg.getaddressregister(list);
  378. end
  379. else
  380. begin
  381. if (hregister.number=NR_NO) {or
  382. rg.isaddressregister(hregister)} then
  383. hregister:=rg.getregisterint(list,dst_size);
  384. end;
  385. hregister.number:=(hregister.number and not $ff) or cgsize2subreg(dst_size);
  386. { load value in new register }
  387. case l.loc of
  388. LOC_FLAGS :
  389. cg.g_flags2reg(list,dst_size,l.resflags,hregister);
  390. LOC_JUMP :
  391. begin
  392. cg.a_label(list,truelabel);
  393. cg.a_load_const_reg(list,dst_size,1,hregister);
  394. objectlibrary.getlabel(hl);
  395. cg.a_jmp_always(list,hl);
  396. cg.a_label(list,falselabel);
  397. cg.a_load_const_reg(list,dst_size,0,hregister);
  398. cg.a_label(list,hl);
  399. end;
  400. else
  401. begin
  402. { load_loc_reg can only handle size >= l.size, when the
  403. new size is smaller then we need to adjust the size
  404. of the orignal and maybe recalculate l.register for i386 }
  405. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  406. begin
  407. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  408. begin
  409. {$ifndef i386}
  410. hregisterhi := l.register;
  411. {$endif not i386}
  412. l.register.number:=(l.register.number and not $ff) or cgsize2subreg(dst_size);
  413. {$ifndef i386}
  414. { necessary for all processors that do not have subregisters (JM) }
  415. cg.a_load_reg_reg(list,l.size,dst_size,hregisterhi,l.register);
  416. {$endif not i386}
  417. end;
  418. { for big endian systems, the reference's offset must }
  419. { be increased in this case, since they have the }
  420. { MSB first in memory and e.g. byte(word_var) should }
  421. { return the second byte in this case (JM) }
  422. if (target_info.endian = ENDIAN_BIG) and
  423. (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  424. inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
  425. l.size:=dst_size;
  426. end;
  427. cg.a_load_loc_reg(list,l,hregister);
  428. { Release old register when the superregister is changed }
  429. if (l.loc=LOC_REGISTER) and
  430. (l.register.number shr 8<>hregister.number shr 8) then
  431. begin
  432. if rg.isaddressregister(l.register) then
  433. rg.ungetaddressregister(list,l.register)
  434. else
  435. rg.ungetregisterint(list,l.register);
  436. end;
  437. end;
  438. end;
  439. location_reset(l,LOC_REGISTER,dst_size);
  440. l.register:=hregister;
  441. end;
  442. end;
  443. {$else cpu64bit}
  444. { 64-bit version }
  445. procedure location_force(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  446. var
  447. hregister : tregister;
  448. hl : tasmlabel;
  449. begin
  450. { handle transformations to 64bit separate }
  451. if dst_size in [OS_64,OS_S64] then
  452. begin
  453. { load a smaller size to OS_64 }
  454. if l.loc=LOC_REGISTER then
  455. hregister:=rg.makeregsize(l.register,OS_INT)
  456. else
  457. hregister:=rg.getregisterint(list,OS_INT);
  458. { load value in low register }
  459. case l.loc of
  460. {$ifdef cpuflags}
  461. LOC_FLAGS :
  462. cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
  463. {$endif cpuflags}
  464. LOC_JUMP :
  465. begin
  466. cg.a_label(list,truelabel);
  467. cg.a_load_const_reg(list,OS_INT,1,hregister);
  468. objectlibrary.getlabel(hl);
  469. cg.a_jmp_always(list,hl);
  470. cg.a_label(list,falselabel);
  471. cg.a_load_const_reg(list,OS_INT,0,hregister);
  472. cg.a_label(list,hl);
  473. end;
  474. else
  475. cg.a_load_loc_reg(list,l,hregister);
  476. end;
  477. location_reset(l,LOC_REGISTER,dst_size);
  478. l.register:=hregister;
  479. end
  480. else
  481. begin
  482. { transformations to 32bit or smaller }
  483. if l.loc=LOC_REGISTER then
  484. begin
  485. hregister:=l.register;
  486. end
  487. else
  488. begin
  489. { get new register }
  490. if (l.loc=LOC_CREGISTER) and
  491. maybeconst and
  492. (TCGSize2Size[dst_size]=TCGSize2Size[l.size]) then
  493. hregister:=l.register
  494. else
  495. hregister:=rg.getregisterint(list,OS_INT);
  496. end;
  497. hregister:=rg.makeregsize(hregister,dst_size);
  498. { load value in new register }
  499. case l.loc of
  500. {$ifdef cpuflags}
  501. LOC_FLAGS :
  502. cg.g_flags2reg(list,dst_size,l.resflags,hregister);
  503. {$endif cpuflags}
  504. LOC_JUMP :
  505. begin
  506. cg.a_label(list,truelabel);
  507. cg.a_load_const_reg(list,dst_size,1,hregister);
  508. objectlibrary.getlabel(hl);
  509. cg.a_jmp_always(list,hl);
  510. cg.a_label(list,falselabel);
  511. cg.a_load_const_reg(list,dst_size,0,hregister);
  512. cg.a_label(list,hl);
  513. end;
  514. else
  515. begin
  516. { load_loc_reg can only handle size >= l.size, when the
  517. new size is smaller then we need to adjust the size
  518. of the orignal and maybe recalculate l.register for i386 }
  519. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  520. begin
  521. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  522. l.register:=rg.makeregsize(l.register,dst_size);
  523. { for big endian systems, the reference's offset must }
  524. { be increased in this case, since they have the }
  525. { MSB first in memory and e.g. byte(word_var) should }
  526. { return the second byte in this case (JM) }
  527. if (target_info.endian = ENDIAN_BIG) and
  528. (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  529. inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
  530. l.size:=dst_size;
  531. end;
  532. cg.a_load_loc_reg(list,l,hregister);
  533. end;
  534. end;
  535. location_reset(l,LOC_REGISTER,dst_size);
  536. l.register:=hregister;
  537. end;
  538. end;
  539. {$endif cpu64bit}
  540. procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  541. begin
  542. { release previous location before demanding a new register }
  543. if (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  544. begin
  545. location_freetemp(list,l);
  546. location_release(list,l);
  547. end;
  548. location_force(list, l, dst_size, maybeconst)
  549. end;
  550. procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
  551. var
  552. r : treference;
  553. begin
  554. case l.loc of
  555. LOC_FPUREGISTER,
  556. LOC_CFPUREGISTER :
  557. begin
  558. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  559. cg.a_loadfpu_reg_ref(list,l.size,l.register,r);
  560. location_release(list,l);
  561. location_reset(l,LOC_REFERENCE,l.size);
  562. l.reference:=r;
  563. end;
  564. LOC_CONSTANT,
  565. LOC_REGISTER,
  566. LOC_CREGISTER :
  567. begin
  568. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
  569. if l.size in [OS_64,OS_S64] then
  570. cg64.a_load64_loc_ref(list,l,r)
  571. else
  572. cg.a_load_loc_ref(list,l,r);
  573. location_release(list,l);
  574. location_reset(l,LOC_REFERENCE,l.size);
  575. l.reference:=r;
  576. end;
  577. LOC_CREFERENCE,
  578. LOC_REFERENCE : ;
  579. else
  580. internalerror(200203219);
  581. end;
  582. end;
  583. {*****************************************************************************
  584. Maybe_Save
  585. *****************************************************************************}
  586. {$ifndef newra}
  587. procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
  588. begin
  589. s.saved:=false;
  590. if l.loc=LOC_CREGISTER then
  591. begin
  592. s.saved:=true;
  593. exit;
  594. end;
  595. if needed>rg.countunusedregsint then
  596. begin
  597. case l.loc of
  598. LOC_REGISTER :
  599. begin
  600. {$ifndef cpu64bit}
  601. if l.size in [OS_64,OS_S64] then
  602. begin
  603. tg.GetTemp(list,8,tt_normal,s.ref);
  604. cg64.a_load64_reg_ref(list,joinreg64(l.registerlow,l.registerhigh),s.ref);
  605. end
  606. else
  607. {$endif cpu64bit}
  608. begin
  609. tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,s.ref);
  610. cg.a_load_reg_ref(list,l.size,l.register,s.ref);
  611. end;
  612. location_release(list,l);
  613. s.saved:=true;
  614. end;
  615. LOC_REFERENCE,
  616. LOC_CREFERENCE :
  617. begin
  618. if l.reference.base.enum<>R_INTREGISTER then
  619. internalerror(200302101);
  620. if l.reference.index.enum<>R_INTREGISTER then
  621. internalerror(200302101);
  622. if ((l.reference.base.number<>NR_NO) or
  623. (l.reference.index.number<>NR_NO)) then
  624. begin
  625. { load address into a single base register }
  626. if l.reference.index.number<>NR_NO then
  627. begin
  628. cg.a_loadaddr_ref_reg(list,l.reference,l.reference.index);
  629. rg.ungetregisterint(list,l.reference.base);
  630. reference_reset_base(l.reference,l.reference.index,0);
  631. end
  632. else
  633. begin
  634. cg.a_loadaddr_ref_reg(list,l.reference,l.reference.base);
  635. rg.ungetregisterint(list,l.reference.index);
  636. reference_reset_base(l.reference,l.reference.base,0);
  637. end;
  638. { save base register }
  639. tg.GetTemp(list,TCGSize2Size[OS_ADDR],tt_normal,s.ref);
  640. cg.a_load_reg_ref(list,OS_ADDR,l.reference.base,s.ref);
  641. { release }
  642. location_release(list,l);
  643. s.saved:=true;
  644. end;
  645. end;
  646. end;
  647. end;
  648. end;
  649. procedure maybe_restore(list:taasmoutput;var l:tlocation;const s:tmaybesave);
  650. begin
  651. if not s.saved then
  652. exit;
  653. if l.loc=LOC_CREGISTER then
  654. begin
  655. load_regvar_reg(list,l.register);
  656. exit;
  657. end;
  658. case l.loc of
  659. LOC_REGISTER :
  660. begin
  661. {$ifndef cpu64bit}
  662. if l.size in [OS_64,OS_S64] then
  663. begin
  664. l.registerlow:=rg.getregisterint(list,OS_INT);
  665. l.registerhigh:=rg.getregisterint(list,OS_INT);
  666. cg64.a_load64_ref_reg(list,s.ref,joinreg64(l.registerlow,l.registerhigh));
  667. end
  668. else
  669. {$endif cpu64bit}
  670. begin
  671. l.register:=rg.getregisterint(list,OS_INT);
  672. cg.a_load_ref_reg(list,OS_INT,s.ref,l.register);
  673. end;
  674. end;
  675. LOC_CREFERENCE,
  676. LOC_REFERENCE :
  677. begin
  678. reference_reset(l.reference);
  679. l.reference.base:=rg.getaddressregister(list);
  680. cg.a_load_ref_reg(list,OS_ADDR,s.ref,l.reference.base);
  681. end;
  682. end;
  683. tg.ungetiftemp(list,s.ref);
  684. end;
  685. {$endif newra}
  686. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  687. begin
  688. if (needed>=maxfpuregs) and
  689. (l.loc = LOC_FPUREGISTER) then
  690. begin
  691. location_force_mem(list,l);
  692. maybe_pushfpu:=true;
  693. end
  694. else
  695. maybe_pushfpu:=false;
  696. end;
  697. {*****************************************************************************
  698. Push Value Para
  699. *****************************************************************************}
  700. procedure push_value_para(list:taasmoutput;p:tnode;calloption:tproccalloption;
  701. para_offset:longint;alignment : longint;
  702. const locpara : tparalocation);
  703. var
  704. tempreference : treference;
  705. href : treference;
  706. hreg : tregister;
  707. sizetopush,
  708. size : longint;
  709. cgsize : tcgsize;
  710. r:Tregister;
  711. begin
  712. { we've nothing to push when the size of the parameter is 0 }
  713. if p.resulttype.def.size=0 then
  714. exit;
  715. { Move flags and jump in register to make it less complex }
  716. if p.location.loc in [LOC_FLAGS,LOC_JUMP] then
  717. location_force_reg(list,p.location,def_cgsize(p.resulttype.def),false);
  718. { Handle Floating point types differently }
  719. if p.resulttype.def.deftype=floatdef then
  720. begin
  721. case p.location.loc of
  722. LOC_FPUREGISTER,
  723. LOC_CFPUREGISTER:
  724. begin
  725. {$ifdef i386}
  726. size:=align(tfloatdef(p.resulttype.def).size,alignment);
  727. inc(pushedparasize,size);
  728. if calloption<>pocall_inline then
  729. cg.g_stackpointer_alloc(list,size);
  730. {$ifdef GDB}
  731. if (cs_debuginfo in aktmoduleswitches) and
  732. (list.first=list.last) then
  733. list.concat(Tai_force_line.Create);
  734. {$endif GDB}
  735. { this is the easiest case for inlined !! }
  736. r.enum:=stack_pointer_reg;
  737. if calloption=pocall_inline then
  738. reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize)
  739. else
  740. reference_reset_base(href,r,0);
  741. cg.a_loadfpu_reg_ref(list,
  742. def_cgsize(p.resulttype.def),p.location.register,href);
  743. {$else i386}
  744. cg.a_paramfpu_reg(list,def_cgsize(p.resulttype.def),p.location.register,locpara);
  745. {$endif i386}
  746. end;
  747. LOC_REFERENCE,
  748. LOC_CREFERENCE :
  749. begin
  750. if locpara.loc=LOC_FPUREGISTER then
  751. cg.a_paramfpu_ref(list,def_cgsize(p.resulttype.def),p.location.reference,locpara)
  752. else
  753. begin
  754. sizetopush:=align(p.resulttype.def.size,alignment);
  755. tempreference:=p.location.reference;
  756. inc(tempreference.offset,sizetopush);
  757. while (sizetopush>0) do
  758. begin
  759. if sizetopush>=4 then
  760. begin
  761. cgsize:=OS_32;
  762. inc(pushedparasize,4);
  763. dec(tempreference.offset,4);
  764. dec(sizetopush,4);
  765. end
  766. else
  767. begin
  768. cgsize:=OS_16;
  769. inc(pushedparasize,2);
  770. dec(tempreference.offset,2);
  771. dec(sizetopush,2);
  772. end;
  773. if calloption=pocall_inline then
  774. begin
  775. reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
  776. cg.a_load_ref_ref(list,cgsize,tempreference,href);
  777. end
  778. else
  779. cg.a_param_ref(list,cgsize,tempreference,locpara);
  780. end;
  781. end;
  782. end;
  783. else
  784. internalerror(200204243);
  785. end;
  786. location_release(list,p.location);
  787. end
  788. else
  789. begin
  790. { copy the value on the stack or use normal parameter push? }
  791. if paramanager.copy_value_on_stack(p.resulttype.def,calloption) then
  792. begin
  793. {$ifdef i386}
  794. if not (p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  795. internalerror(200204241);
  796. { push on stack }
  797. size:=align(p.resulttype.def.size,alignment);
  798. inc(pushedparasize,size);
  799. cg.g_stackpointer_alloc(list,size);
  800. r.enum:=R_INTREGISTER;
  801. r.number:=NR_STACK_POINTER_REG;
  802. reference_reset_base(href,r,0);
  803. cg.g_concatcopy(list,p.location.reference,href,size,false,false);
  804. {$else i386}
  805. cg.a_param_copy_ref(list,p.resulttype.def.size,p.location.reference,locpara);
  806. {$endif i386}
  807. end
  808. else
  809. begin
  810. case p.location.loc of
  811. LOC_CONSTANT,
  812. LOC_REGISTER,
  813. LOC_CREGISTER,
  814. LOC_REFERENCE,
  815. LOC_CREFERENCE :
  816. begin
  817. cgsize:=def_cgsize(p.resulttype.def);
  818. if cgsize in [OS_64,OS_S64] then
  819. begin
  820. inc(pushedparasize,8);
  821. if calloption=pocall_inline then
  822. begin
  823. reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
  824. if p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
  825. begin
  826. size:=align(p.resulttype.def.size,alignment);
  827. cg.g_concatcopy(list,p.location.reference,href,size,false,false)
  828. end
  829. else
  830. cg64.a_load64_loc_ref(list,p.location,href);
  831. end
  832. else
  833. cg64.a_param64_loc(list,p.location,locpara);
  834. end
  835. else
  836. begin
  837. case cgsize of
  838. OS_8,OS_S8 :
  839. begin
  840. if alignment=4 then
  841. cgsize:=OS_32
  842. else
  843. cgsize:=OS_16;
  844. end;
  845. OS_16,OS_S16 :
  846. begin
  847. if alignment=4 then
  848. cgsize:=OS_32;
  849. end;
  850. end;
  851. { update register to use to match alignment }
  852. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  853. begin
  854. if p.location.register.enum<>R_INTREGISTER then
  855. internalerror(200302024);
  856. hreg:=p.location.register;
  857. p.location.register.number:=(p.location.register.number and not $ff) or cgsize2subreg(cgsize);
  858. end;
  859. inc(pushedparasize,alignment);
  860. if calloption=pocall_inline then
  861. begin
  862. reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
  863. if p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
  864. begin
  865. size:=align(p.resulttype.def.size,alignment);
  866. cg.g_concatcopy(list,p.location.reference,href,size,false,false)
  867. end
  868. else
  869. cg.a_load_loc_ref(list,p.location,href);
  870. end
  871. else
  872. cg.a_param_loc(list,p.location,locpara);
  873. { restore old register }
  874. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  875. p.location.register:=hreg;
  876. end;
  877. location_release(list,p.location);
  878. end;
  879. {$ifdef SUPPORT_MMX}
  880. LOC_MMXREGISTER,
  881. LOC_CMMXREGISTER:
  882. begin
  883. inc(pushedparasize,8);
  884. if calloption=pocall_inline then
  885. begin
  886. reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
  887. cg.a_loadmm_reg_ref(list,p.location.register,href);
  888. end
  889. else
  890. cg.a_parammm_reg(list,p.location.register);
  891. end;
  892. {$endif SUPPORT_MMX}
  893. else
  894. internalerror(200204241);
  895. end;
  896. end;
  897. end;
  898. end;
  899. {****************************************************************************
  900. Entry/Exit Code
  901. ****************************************************************************}
  902. procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
  903. var
  904. href1,href2 : treference;
  905. list : taasmoutput;
  906. begin
  907. list:=taasmoutput(arg);
  908. if (tsym(p).typ=varsym) and
  909. (tvarsym(p).varspez=vs_value) and
  910. (paramanager.push_addr_param(tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
  911. begin
  912. reference_reset_base(href1,current_procinfo.framepointer,tvarsym(p).adjusted_address);
  913. if is_open_array(tvarsym(p).vartype.def) or
  914. is_array_of_const(tvarsym(p).vartype.def) then
  915. cg.g_copyvaluepara_openarray(list,href1,tarraydef(tvarsym(p).vartype.def).elesize)
  916. else
  917. begin
  918. reference_reset_base(href2,current_procinfo.framepointer,tvarsym(p).localvarsym.adjusted_address);
  919. if is_shortstring(tvarsym(p).vartype.def) then
  920. cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,true)
  921. else
  922. cg.g_concatcopy(list,href1,href2,tvarsym(p).vartype.def.size,true,true);
  923. end;
  924. end;
  925. end;
  926. { generates the code for initialisation of local data }
  927. procedure initialize_data(p : tnamedindexitem;arg:pointer);
  928. var
  929. href : treference;
  930. list : taasmoutput;
  931. begin
  932. list:=taasmoutput(arg);
  933. if (tsym(p).typ=varsym) and
  934. not(vo_is_local_copy in tvarsym(p).varoptions) and
  935. assigned(tvarsym(p).vartype.def) and
  936. not(is_class(tvarsym(p).vartype.def)) and
  937. tvarsym(p).vartype.def.needs_inittable then
  938. begin
  939. if (cs_implicit_exceptions in aktmoduleswitches) then
  940. include(current_procinfo.flags,pi_needs_implicit_finally);
  941. if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
  942. reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address)
  943. else
  944. reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
  945. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  946. end;
  947. end;
  948. { generates the code for finalisation of local data }
  949. procedure finalize_data(p : tnamedindexitem;arg:pointer);
  950. var
  951. href : treference;
  952. list : taasmoutput;
  953. begin
  954. list:=taasmoutput(arg);
  955. case tsym(p).typ of
  956. varsym :
  957. begin
  958. if not(vo_is_local_copy in tvarsym(p).varoptions) and
  959. not(vo_is_funcret in tvarsym(p).varoptions) and
  960. assigned(tvarsym(p).vartype.def) and
  961. not(is_class(tvarsym(p).vartype.def)) and
  962. tvarsym(p).vartype.def.needs_inittable then
  963. begin
  964. if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
  965. reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address)
  966. else
  967. reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
  968. cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
  969. end;
  970. end;
  971. typedconstsym :
  972. begin
  973. if ttypedconstsym(p).is_writable and
  974. ttypedconstsym(p).typedconsttype.def.needs_inittable then
  975. begin
  976. reference_reset_symbol(href,objectlibrary.newasmsymboldata(ttypedconstsym(p).mangledname),0);
  977. cg.g_finalize(list,ttypedconstsym(p).typedconsttype.def,href,false);
  978. end;
  979. end;
  980. end;
  981. end;
  982. { generates the code for incrementing the reference count of parameters and
  983. initialize out parameters }
  984. procedure init_paras(p : tnamedindexitem;arg:pointer);
  985. var
  986. href : treference;
  987. tmpreg : tregister;
  988. list : taasmoutput;
  989. begin
  990. list:=taasmoutput(arg);
  991. if (tsym(p).typ=varsym) and
  992. not is_class(tvarsym(p).vartype.def) and
  993. tvarsym(p).vartype.def.needs_inittable then
  994. begin
  995. case tvarsym(p).varspez of
  996. vs_value :
  997. begin
  998. if (cs_implicit_exceptions in aktmoduleswitches) then
  999. include(current_procinfo.flags,pi_needs_implicit_finally);
  1000. if assigned(tvarsym(p).localvarsym) then
  1001. reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).localvarsym.adjusted_address)
  1002. else
  1003. reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address);
  1004. cg.g_incrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
  1005. end;
  1006. vs_out :
  1007. begin
  1008. reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address);
  1009. {$ifdef newra}
  1010. tmpreg:=rg.getaddressregister(list);
  1011. {$else}
  1012. tmpreg:=cg.get_scratch_reg_address(list);
  1013. {$endif}
  1014. cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
  1015. reference_reset_base(href,tmpreg,0);
  1016. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  1017. {$ifdef newra}
  1018. rg.ungetregisterint(list,tmpreg);
  1019. {$else}
  1020. cg.free_scratch_reg(list,tmpreg);
  1021. {$endif newra}
  1022. end;
  1023. end;
  1024. end;
  1025. end;
  1026. { generates the code for decrementing the reference count of parameters }
  1027. procedure final_paras(p : tnamedindexitem;arg:pointer);
  1028. var
  1029. href : treference;
  1030. list : taasmoutput;
  1031. begin
  1032. list:=taasmoutput(arg);
  1033. if (tsym(p).typ=varsym) and
  1034. not is_class(tvarsym(p).vartype.def) and
  1035. tvarsym(p).vartype.def.needs_inittable then
  1036. begin
  1037. if (tvarsym(p).varspez=vs_value) then
  1038. begin
  1039. if assigned(tvarsym(p).localvarsym) then
  1040. reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).localvarsym.adjusted_address)
  1041. else
  1042. reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address);
  1043. cg.g_decrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
  1044. end;
  1045. end;
  1046. end;
  1047. { Initialize temp ansi/widestrings,interfaces }
  1048. procedure inittempvariables(list:taasmoutput);
  1049. var
  1050. hp : ptemprecord;
  1051. href : treference;
  1052. begin
  1053. hp:=tg.templist;
  1054. while assigned(hp) do
  1055. begin
  1056. if hp^.temptype in [tt_ansistring,tt_freeansistring,
  1057. tt_widestring,tt_freewidestring,
  1058. tt_interfacecom,tt_freeinterfacecom] then
  1059. begin
  1060. if (cs_implicit_exceptions in aktmoduleswitches) then
  1061. include(current_procinfo.flags,pi_needs_implicit_finally);
  1062. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  1063. cg.a_load_const_ref(list,OS_ADDR,0,href);
  1064. end;
  1065. hp:=hp^.next;
  1066. end;
  1067. end;
  1068. procedure finalizetempvariables(list:taasmoutput);
  1069. var
  1070. hp : ptemprecord;
  1071. href : treference;
  1072. begin
  1073. hp:=tg.templist;
  1074. while assigned(hp) do
  1075. begin
  1076. case hp^.temptype of
  1077. tt_ansistring,
  1078. tt_freeansistring :
  1079. begin
  1080. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  1081. cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
  1082. cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
  1083. end;
  1084. tt_widestring,
  1085. tt_freewidestring :
  1086. begin
  1087. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  1088. cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
  1089. cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
  1090. end;
  1091. tt_interfacecom :
  1092. begin
  1093. reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
  1094. cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
  1095. cg.a_call_name(list,'FPC_INTF_DECR_REF');
  1096. end;
  1097. end;
  1098. hp:=hp^.next;
  1099. end;
  1100. end;
  1101. procedure initretvalue(list:taasmoutput);
  1102. var
  1103. paraloc : tparalocation;
  1104. href : treference;
  1105. begin
  1106. if not is_void(current_procdef.rettype.def) then
  1107. begin
  1108. { for now the pointer to the result can't be a register }
  1109. if paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
  1110. begin
  1111. {$ifdef powerpc}
  1112. { no stack space is allocated in this case -> can't save the result reg on the stack }
  1113. if not(po_assembler in current_procdef.procoptions) then
  1114. {$endif powerpc}
  1115. begin
  1116. paraloc:=paramanager.getfuncretparaloc(current_procdef);
  1117. reference_reset_base(href,current_procinfo.framepointer,current_procinfo.return_offset);
  1118. case paraloc.loc of
  1119. LOC_CREGISTER,
  1120. LOC_REGISTER:
  1121. if not(paraloc.size in [OS_64,OS_S64]) then
  1122. cg.a_load_reg_ref(list,paraloc.size,paraloc.register,href)
  1123. else
  1124. cg64.a_load64_reg_ref(list,paraloc.register64,href);
  1125. LOC_CFPUREGISTER,
  1126. LOC_FPUREGISTER:
  1127. cg.a_load_reg_ref(list,paraloc.size,paraloc.register,href);
  1128. LOC_CMMREGISTER,
  1129. LOC_MMREGISTER:
  1130. cg.a_loadmm_reg_ref(list,paraloc.register,href);
  1131. end;
  1132. end;
  1133. end;
  1134. { initialize return value }
  1135. if (current_procdef.rettype.def.needs_inittable) then
  1136. begin
  1137. {$ifdef powerpc}
  1138. if (po_assembler in current_procdef.procoptions) then
  1139. internalerror(200304161);
  1140. {$endif powerpc}
  1141. if (cs_implicit_exceptions in aktmoduleswitches) then
  1142. include(current_procinfo.flags,pi_needs_implicit_finally);
  1143. reference_reset_base(href,current_procinfo.framepointer,current_procinfo.return_offset);
  1144. cg.g_initialize(list,current_procdef.rettype.def,href,paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption));
  1145. end;
  1146. end;
  1147. end;
  1148. procedure handle_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
  1149. var
  1150. href : treference;
  1151. hreg,r,r2 : tregister;
  1152. cgsize : TCGSize;
  1153. begin
  1154. if not is_void(current_procdef.rettype.def) then
  1155. begin
  1156. reference_reset_base(href,current_procinfo.framepointer,current_procinfo.return_offset);
  1157. cgsize:=def_cgsize(current_procdef.rettype.def);
  1158. { Here, we return the function result. In most architectures, the value is
  1159. passed into the accumulator, but in a windowed architecure like sparc a
  1160. function returns in a register and the caller receives it in an other one }
  1161. case current_procdef.rettype.def.deftype of
  1162. orddef,
  1163. enumdef :
  1164. begin
  1165. uses_acc:=true;
  1166. r.enum:=R_INTREGISTER;
  1167. r.number:=NR_RETURN_RESULT_REG;
  1168. cg.a_reg_alloc(list,r);
  1169. {$ifndef cpu64bit}
  1170. if cgsize in [OS_64,OS_S64] then
  1171. begin
  1172. uses_acchi:=true;
  1173. r2.enum:=R_INTREGISTER;
  1174. r2.number:=NR_ACCUMULATORHIGH;
  1175. cg.a_reg_alloc(list,r2);
  1176. cg64.a_load64_ref_reg(list,href,joinreg64(r,r2));
  1177. end
  1178. else
  1179. {$endif cpu64bit}
  1180. begin
  1181. hreg.enum:=R_INTREGISTER;
  1182. hreg.number:=RS_RETURN_RESULT_REG shl 8 or cgsize2subreg(cgsize);
  1183. cg.a_load_ref_reg(list,cgsize,href,hreg);
  1184. end;
  1185. end;
  1186. floatdef :
  1187. begin
  1188. uses_fpu := true;
  1189. {$ifdef cpufpemu}
  1190. if cs_fp_emulation in aktmoduleswitches then
  1191. r.enum := accumulator
  1192. else
  1193. {$endif cpufpemu}
  1194. r.enum:=fpu_result_reg;
  1195. cg.a_loadfpu_ref_reg(list,cgsize,href,r);
  1196. end;
  1197. else
  1198. begin
  1199. if not paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
  1200. begin
  1201. uses_acc:=true;
  1202. r.enum:=R_INTREGISTER;
  1203. r.number:=NR_RETURN_RESULT_REG;
  1204. cg.a_reg_alloc(list,r);
  1205. {$ifndef cpu64bit}
  1206. { Win32 can return records in EAX:EDX }
  1207. if cgsize in [OS_64,OS_S64] then
  1208. begin
  1209. uses_acchi:=true;
  1210. r2.enum:=R_INTREGISTER;
  1211. r2.number:=NR_ACCUMULATORHIGH;
  1212. cg.a_reg_alloc(list,r2);
  1213. cg64.a_load64_ref_reg(list,href,joinreg64(r,r2));
  1214. end
  1215. else
  1216. {$endif cpu64bit}
  1217. begin
  1218. hreg.enum:=R_INTREGISTER;
  1219. hreg.number:=RS_RETURN_RESULT_REG shl 8 or cgsize2subreg(cgsize);
  1220. cg.a_load_ref_reg(list,cgsize,href,hreg);
  1221. end;
  1222. end
  1223. end;
  1224. end;
  1225. end;
  1226. end;
  1227. procedure genentrycode(list : TAAsmoutput;stackframe:longint;inlined : boolean);
  1228. var
  1229. hs : string;
  1230. href : treference;
  1231. stackalloclist : taasmoutput;
  1232. hp : tparaitem;
  1233. rsp : tregister;
  1234. begin
  1235. if not inlined then
  1236. stackalloclist:=taasmoutput.Create;
  1237. { the actual stack allocation code, symbol entry point and
  1238. gdb stabs information is generated AFTER the rest of this
  1239. code, since temp. allocation might occur before - carl
  1240. }
  1241. if assigned(current_procdef.parast) then
  1242. begin
  1243. if not (po_assembler in current_procdef.procoptions) then
  1244. begin
  1245. { move register parameters which aren't regable into memory }
  1246. { we do this before init_paras because that one calls routines which may overwrite these }
  1247. { registers and it also expects the values to be in memory }
  1248. hp:=tparaitem(current_procdef.para.first);
  1249. while assigned(hp) do
  1250. begin
  1251. if Tvarsym(hp.parasym).reg.enum>lastreg then
  1252. internalerror(200301081);
  1253. if (tvarsym(hp.parasym).reg.enum<>R_NO) then
  1254. case hp.paraloc.loc of
  1255. LOC_CREGISTER,
  1256. LOC_REGISTER:
  1257. // if not(hp.paraloc.size in [OS_S64,OS_64]) then
  1258. cg.a_load_reg_reg(list,hp.paraloc.size,OS_32,hp.paraloc.register,tvarsym(hp.parasym).reg);
  1259. // else
  1260. // cg64.a_load64_reg_reg(list,hp.paraloc.register64,tvarsym(hp.parasym).reg);
  1261. LOC_CFPUREGISTER,
  1262. LOC_FPUREGISTER:
  1263. cg.a_loadfpu_reg_reg(list,hp.paraloc.register,tvarsym(hp.parasym).reg);
  1264. end
  1265. else if (hp.paraloc.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER,
  1266. LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER]) and
  1267. (tvarsym(hp.parasym).reg.enum=R_NO) then
  1268. begin
  1269. reference_reset_base(href,current_procinfo.framepointer,tvarsym(hp.parasym).adjusted_address);
  1270. case hp.paraloc.loc of
  1271. LOC_CREGISTER,
  1272. LOC_REGISTER:
  1273. if not(hp.paraloc.size in [OS_S64,OS_64]) then
  1274. cg.a_load_reg_ref(list,hp.paraloc.size,hp.paraloc.register,href)
  1275. else
  1276. cg64.a_load64_reg_ref(list,hp.paraloc.register64,href);
  1277. LOC_FPUREGISTER,
  1278. LOC_CFPUREGISTER:
  1279. cg.a_loadfpu_reg_ref(list,hp.paraloc.size,hp.paraloc.register,href);
  1280. else
  1281. internalerror(2002081302);
  1282. end;
  1283. end;
  1284. hp:=tparaitem(hp.next);
  1285. end;
  1286. end;
  1287. end;
  1288. { for the save all registers we can simply use a pusha,popa which
  1289. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1290. if (po_saveregisters in current_procdef.procoptions) then
  1291. cg.g_save_all_registers(list)
  1292. else
  1293. { should we save edi,esi,ebx like C ? }
  1294. if (po_savestdregs in current_procdef.procoptions) then
  1295. cg.g_save_standard_registers(list,current_procdef.usedintregisters);
  1296. { Save stackpointer value }
  1297. if not inlined and
  1298. (current_procinfo.framepointer.number<>NR_STACK_POINTER_REG) and
  1299. ((po_savestdregs in current_procdef.procoptions) or
  1300. (po_saveregisters in current_procdef.procoptions)) then
  1301. begin
  1302. tg.GetTemp(list,POINTER_SIZE,tt_noreuse,current_procinfo.save_stackptr_ref);
  1303. rsp.enum:=R_INTREGISTER;
  1304. rsp.number:=NR_STACK_POINTER_REG;
  1305. cg.a_load_reg_ref(list,OS_ADDR,rsp,current_procinfo.save_stackptr_ref);
  1306. end;
  1307. { the actual profile code can clobber some registers,
  1308. therefore if the context must be saved, do it before
  1309. the actual call to the profile code
  1310. }
  1311. if (cs_profile in aktmoduleswitches) and
  1312. not(po_assembler in current_procdef.procoptions) and
  1313. not(inlined) then
  1314. begin
  1315. { non-win32 can call mcout even in main }
  1316. if not (target_info.system in [system_i386_win32,system_i386_wdosx]) then
  1317. cg.g_profilecode(list)
  1318. else
  1319. { wdosx, and win32 should not call mcount before monstartup has been called }
  1320. if not (current_procdef.proctypeoption=potype_proginit) then
  1321. cg.g_profilecode(list);
  1322. end;
  1323. { initialize return value }
  1324. initretvalue(list);
  1325. { initialize local data like ansistrings }
  1326. case current_procdef.proctypeoption of
  1327. potype_unitinit:
  1328. begin
  1329. { this is also used for initialization of variables in a
  1330. program which does not have a globalsymtable }
  1331. if assigned(current_module.globalsymtable) then
  1332. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1333. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1334. end;
  1335. { units have seperate code for initilization and finalization }
  1336. potype_unitfinalize: ;
  1337. { program init/final is generated in separate procedure }
  1338. potype_proginit: ;
  1339. else
  1340. current_procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1341. end;
  1342. { initialisizes temp. ansi/wide string data }
  1343. inittempvariables(list);
  1344. { initialize ansi/widesstring para's }
  1345. if assigned(current_procdef.parast) then
  1346. begin
  1347. current_procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1348. end;
  1349. { generate copies of call by value parameters }
  1350. if not(po_assembler in current_procdef.procoptions) then
  1351. current_procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1352. if (not inlined) then
  1353. begin
  1354. { call startup helpers from main program }
  1355. if (current_procdef.proctypeoption=potype_proginit) then
  1356. begin
  1357. { initialize profiling for win32 }
  1358. if (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1359. (cs_profile in aktmoduleswitches) then
  1360. begin
  1361. reference_reset_symbol(href,objectlibrary.newasmsymboldata('etext'),0);
  1362. cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
  1363. reference_reset_symbol(href,objectlibrary.newasmsymboldata('__image_base__'),0);
  1364. cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
  1365. cg.a_call_name(list,'_monstartup');
  1366. end;
  1367. { initialize units }
  1368. cg.a_call_name(list,'FPC_INITIALIZEUNITS');
  1369. end;
  1370. {$ifdef GDB}
  1371. if (cs_debuginfo in aktmoduleswitches) then
  1372. list.concat(Tai_force_line.Create);
  1373. {$endif GDB}
  1374. end;
  1375. if inlined then
  1376. load_regvars(list,nil);
  1377. {************************* Stack allocation **************************}
  1378. { and symbol entry point as well as debug information }
  1379. { will be inserted in front of the rest of this list. }
  1380. { Insert alignment and assembler names }
  1381. if not inlined then
  1382. begin
  1383. { Align, gprof uses 16 byte granularity }
  1384. if (cs_profile in aktmoduleswitches) then
  1385. stackalloclist.concat(Tai_align.Create(16))
  1386. else
  1387. stackalloclist.concat(Tai_align.Create(aktalignment.procalign));
  1388. {$ifdef GDB}
  1389. if (cs_debuginfo in aktmoduleswitches) then
  1390. begin
  1391. if (po_public in current_procdef.procoptions) then
  1392. tprocsym(current_procdef.procsym).is_global:=true;
  1393. current_procdef.concatstabto(stackalloclist);
  1394. tprocsym(current_procdef.procsym).isstabwritten:=true;
  1395. end;
  1396. {$endif GDB}
  1397. repeat
  1398. hs:=current_procdef.aliasnames.getfirst;
  1399. if hs='' then
  1400. break;
  1401. {$ifdef GDB}
  1402. if (cs_debuginfo in aktmoduleswitches) and
  1403. target_info.use_function_relative_addresses then
  1404. stackalloclist.concat(Tai_stab_function_name.Create(strpnew(hs)));
  1405. {$endif GDB}
  1406. if (cs_profile in aktmoduleswitches) or
  1407. (po_public in current_procdef.procoptions) then
  1408. stackalloclist.concat(Tai_symbol.Createname_global(hs,0))
  1409. else
  1410. stackalloclist.concat(Tai_symbol.Createname(hs,0));
  1411. until false;
  1412. stackframe:=stackframe+tg.gettempsize;
  1413. {$ifndef m68k}
  1414. { give a warning if the limit of local variables is reached }
  1415. if stackframe > maxlocalsize then
  1416. Message(cg_w_localsize_too_big);
  1417. {$endif}
  1418. {$ifndef powerpc}
  1419. { at least for the ppc this applies always, so this code isn't usable (FK) }
  1420. { omit stack frame ? }
  1421. if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then
  1422. begin
  1423. CGMessage(cg_d_stackframe_omited);
  1424. if stackframe<>0 then
  1425. cg.g_stackpointer_alloc(stackalloclist,stackframe);
  1426. end
  1427. else
  1428. {$endif powerpc}
  1429. begin
  1430. if (po_interrupt in current_procdef.procoptions) then
  1431. cg.g_interrupt_stackframe_entry(stackalloclist);
  1432. cg.g_stackframe_entry(stackalloclist,stackframe);
  1433. { never call stack checking before the standard system unit
  1434. has not been initialized
  1435. }
  1436. if (cs_check_stack in aktlocalswitches) and (current_procdef.proctypeoption<>potype_proginit) then
  1437. cg.g_stackcheck(stackalloclist,stackframe);
  1438. end;
  1439. list.insertlist(stackalloclist);
  1440. stackalloclist.free;
  1441. end;
  1442. {************************* End Stack allocation **************************}
  1443. end;
  1444. procedure genexitcode(list : TAAsmoutput;inlined:boolean);
  1445. var
  1446. {$ifdef GDB}
  1447. stabsendlabel : tasmlabel;
  1448. mangled_length : longint;
  1449. p : pchar;
  1450. {$endif GDB}
  1451. okexitlabel : tasmlabel;
  1452. href : treference;
  1453. srsym : tsym;
  1454. usesacc,
  1455. usesacchi,
  1456. usesfpu : boolean;
  1457. rsp,r : Tregister;
  1458. retsize : longint;
  1459. begin
  1460. if aktexitlabel.is_used then
  1461. cg.a_label(list,aktexitlabel);
  1462. cleanup_regvars(list);
  1463. { finalize temporary data }
  1464. finalizetempvariables(list);
  1465. { finalize local data like ansistrings}
  1466. case current_procdef.proctypeoption of
  1467. potype_unitfinalize:
  1468. begin
  1469. { this is also used for initialization of variables in a
  1470. program which does not have a globalsymtable }
  1471. if assigned(current_module.globalsymtable) then
  1472. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1473. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1474. end;
  1475. { units/progs have separate code for initialization and finalization }
  1476. potype_unitinit: ;
  1477. { program init/final is generated in separate procedure }
  1478. potype_proginit: ;
  1479. else
  1480. current_procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1481. end;
  1482. { finalize paras data }
  1483. if assigned(current_procdef.parast) then
  1484. current_procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1485. { call __EXIT for main program }
  1486. if (not DLLsource) and
  1487. (not inlined) and
  1488. (current_procdef.proctypeoption=potype_proginit) then
  1489. begin
  1490. cg.a_call_name(list,'FPC_DO_EXIT');
  1491. end;
  1492. { handle return value, this is not done for assembler routines when
  1493. they didn't reference the result variable }
  1494. usesacc:=false;
  1495. usesacchi:=false;
  1496. if not(po_assembler in current_procdef.procoptions) or
  1497. (assigned(current_procdef.funcretsym) and
  1498. (tvarsym(current_procdef.funcretsym).refcount>1)) then
  1499. begin
  1500. if (current_procdef.proctypeoption=potype_constructor) then
  1501. begin
  1502. objectlibrary.getlabel(okexitlabel);
  1503. cg.a_jmp_always(list,okexitlabel);
  1504. { Success exit }
  1505. cg.a_label(list,okexitlabel);
  1506. r.enum:=R_INTREGISTER;
  1507. r.number:=NR_ACCUMULATOR;
  1508. cg.a_reg_alloc(list,r);
  1509. { return the self pointer }
  1510. srsym:=tvarsym(current_procdef.parast.search('self'));
  1511. if not assigned(srsym) then
  1512. internalerror(200305058);
  1513. reference_reset_base(href,current_procinfo.framepointer,tvarsym(srsym).adjusted_address);
  1514. cg.a_load_ref_reg(list,OS_ADDR,href,r);
  1515. cg.a_reg_dealloc(list,r);
  1516. usesacc:=true;
  1517. end
  1518. else
  1519. handle_return_value(list,usesacc,usesacchi,usesfpu)
  1520. end;
  1521. {$ifdef GDB}
  1522. if ((cs_debuginfo in aktmoduleswitches) and not inlined) then
  1523. begin
  1524. objectlibrary.getlabel(stabsendlabel);
  1525. cg.a_label(list,stabsendlabel);
  1526. end;
  1527. {$endif GDB}
  1528. { Restore stackpointer if it was saved }
  1529. if not inlined and
  1530. (current_procinfo.framepointer.number<>NR_STACK_POINTER_REG) and
  1531. ((po_savestdregs in current_procdef.procoptions) or
  1532. (po_saveregisters in current_procdef.procoptions)) then
  1533. begin
  1534. rsp.enum:=R_INTREGISTER;
  1535. rsp.number:=NR_STACK_POINTER_REG;
  1536. cg.a_load_ref_reg(list,OS_ADDR,current_procinfo.save_stackptr_ref,rsp);
  1537. tg.UngetTemp(list,current_procinfo.save_stackptr_ref);
  1538. end;
  1539. { for the save all registers we can simply use a pusha,popa which
  1540. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1541. if (po_saveregisters in current_procdef.procoptions) then
  1542. cg.g_restore_all_registers(list,usesacc,usesacchi)
  1543. else
  1544. { should we restore edi ? }
  1545. if (po_savestdregs in current_procdef.procoptions) then
  1546. cg.g_restore_standard_registers(list,current_procdef.usedintregisters);
  1547. { remove stackframe }
  1548. if not inlined then
  1549. begin
  1550. if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then
  1551. begin
  1552. if (tg.gettempsize<>0) then
  1553. cg.a_op_const_reg(list,OP_ADD,tg.gettempsize,current_procinfo.framepointer);
  1554. end
  1555. else
  1556. cg.g_restore_frame_pointer(list);
  1557. end;
  1558. { at last, the return is generated }
  1559. if not inlined then
  1560. begin
  1561. if (po_interrupt in current_procdef.procoptions) then
  1562. cg.g_interrupt_stackframe_exit(list,usesacc,usesacchi)
  1563. else
  1564. begin
  1565. if (po_clearstack in current_procdef.procoptions) then
  1566. begin
  1567. retsize:=0;
  1568. if paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
  1569. inc(retsize,POINTER_SIZE);
  1570. end
  1571. else
  1572. begin
  1573. retsize:=current_procdef.parast.datasize;
  1574. if current_procdef.parast.address_fixup>target_info.first_parm_offset then
  1575. inc(retsize,current_procdef.parast.address_fixup-target_info.first_parm_offset);
  1576. end;
  1577. cg.g_return_from_proc(list,retsize);
  1578. end;
  1579. end;
  1580. if not inlined then
  1581. list.concat(Tai_symbol_end.Createname(current_procdef.mangledname));
  1582. {$ifdef GDB}
  1583. if (cs_debuginfo in aktmoduleswitches) and not inlined then
  1584. begin
  1585. { define calling EBP as pseudo local var PM }
  1586. { this enables test if the function is a local one !! }
  1587. if assigned(current_procinfo.parent) and
  1588. (current_procdef.parast.symtablelevel>normal_function_level) then
  1589. list.concat(Tai_stabs.Create(strpnew(
  1590. '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
  1591. tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.framepointer_offset))));
  1592. if (not is_void(current_procdef.rettype.def)) then
  1593. begin
  1594. if paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
  1595. list.concat(Tai_stabs.Create(strpnew(
  1596. '"'+current_procdef.procsym.name+':X*'+tstoreddef(current_procdef.rettype.def).numberstring+'",'+
  1597. tostr(N_tsym)+',0,0,'+tostr(current_procinfo.return_offset))))
  1598. else
  1599. list.concat(Tai_stabs.Create(strpnew(
  1600. '"'+current_procdef.procsym.name+':X'+tstoreddef(current_procdef.rettype.def).numberstring+'",'+
  1601. tostr(N_tsym)+',0,0,'+tostr(current_procinfo.return_offset))));
  1602. if (m_result in aktmodeswitches) then
  1603. if paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
  1604. list.concat(Tai_stabs.Create(strpnew(
  1605. '"RESULT:X*'+tstoreddef(current_procdef.rettype.def).numberstring+'",'+
  1606. tostr(N_tsym)+',0,0,'+tostr(current_procinfo.return_offset))))
  1607. else
  1608. list.concat(Tai_stabs.Create(strpnew(
  1609. '"RESULT:X'+tstoreddef(current_procdef.rettype.def).numberstring+'",'+
  1610. tostr(N_tsym)+',0,0,'+tostr(current_procinfo.return_offset))));
  1611. end;
  1612. mangled_length:=length(current_procdef.mangledname);
  1613. getmem(p,2*mangled_length+50);
  1614. strpcopy(p,'192,0,0,');
  1615. strpcopy(strend(p),current_procdef.mangledname);
  1616. if (target_info.use_function_relative_addresses) then
  1617. begin
  1618. strpcopy(strend(p),'-');
  1619. strpcopy(strend(p),current_procdef.mangledname);
  1620. end;
  1621. list.concat(Tai_stabn.Create(strnew(p)));
  1622. {List.concat(Tai_stabn.Create(strpnew('192,0,0,'
  1623. +current_procdef.mangledname))));
  1624. p[0]:='2';p[1]:='2';p[2]:='4';
  1625. strpcopy(strend(p),'_end');}
  1626. strpcopy(p,'224,0,0,'+stabsendlabel.name);
  1627. if (target_info.use_function_relative_addresses) then
  1628. begin
  1629. strpcopy(strend(p),'-');
  1630. strpcopy(strend(p),current_procdef.mangledname);
  1631. end;
  1632. list.concatlist(withdebuglist);
  1633. list.concat(Tai_stabn.Create(strnew(p)));
  1634. { strpnew('224,0,0,'
  1635. +current_procdef.mangledname+'_end'))));}
  1636. freemem(p,2*mangled_length+50);
  1637. end;
  1638. {$endif GDB}
  1639. if inlined then
  1640. cleanup_regvars(list);
  1641. end;
  1642. {****************************************************************************
  1643. Inlining
  1644. ****************************************************************************}
  1645. procedure handle_inlined_return_value(list:TAAsmoutput);
  1646. var
  1647. href : treference;
  1648. r,r2 : tregister;
  1649. cgsize : TCGSize;
  1650. begin
  1651. if not is_void(current_procdef.rettype.def) then
  1652. begin
  1653. reference_reset_base(href,current_procinfo.framepointer,current_procinfo.return_offset);
  1654. cgsize:=def_cgsize(current_procdef.rettype.def);
  1655. { Here, we return the function result. In most architectures, the value is
  1656. passed into the accumulator, but in a windowed architecure like sparc a
  1657. function returns in a register and the caller receives it in an other one }
  1658. case current_procdef.rettype.def.deftype of
  1659. orddef,
  1660. enumdef :
  1661. begin
  1662. {$ifndef cpu64bit}
  1663. if cgsize in [OS_64,OS_S64] then
  1664. begin
  1665. r:=rg.getregisterint(list,OS_INT);
  1666. r2:=rg.getregisterint(list,OS_INT);
  1667. cg64.a_load64_ref_reg(list,href,joinreg64(r,r2));
  1668. end
  1669. else
  1670. {$endif cpu64bit}
  1671. begin
  1672. r:=rg.getregisterint(list,cgsize);
  1673. cg.a_load_ref_reg(list,cgsize,href,r);
  1674. end;
  1675. end;
  1676. floatdef :
  1677. begin
  1678. {$ifdef cpufpemu}
  1679. if cs_fp_emulation in aktmoduleswitches then
  1680. r.enum := accumulator
  1681. else
  1682. {$endif cpufpemu}
  1683. r.enum:=fpu_result_reg;
  1684. cg.a_loadfpu_ref_reg(list,cgsize,href,r);
  1685. end;
  1686. else
  1687. begin
  1688. if not paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
  1689. begin
  1690. {$ifndef cpu64bit}
  1691. { Win32 can return records in EAX:EDX }
  1692. if cgsize in [OS_64,OS_S64] then
  1693. begin
  1694. r:=rg.getregisterint(list,OS_INT);
  1695. r2:=rg.getregisterint(list,OS_INT);
  1696. cg64.a_load64_ref_reg(list,href,joinreg64(r,r2));
  1697. end
  1698. else
  1699. {$endif cpu64bit}
  1700. begin
  1701. r:=rg.getregisterint(list,cgsize);
  1702. cg.a_load_ref_reg(list,cgsize,href,r);
  1703. end;
  1704. end
  1705. end;
  1706. end;
  1707. end;
  1708. end;
  1709. procedure geninlineentrycode(list : TAAsmoutput;stackframe:longint);
  1710. begin
  1711. { initialize return value }
  1712. initretvalue(list);
  1713. current_procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1714. { initialisizes temp. ansi/wide string data }
  1715. inittempvariables(list);
  1716. { initialize ansi/widesstring para's }
  1717. if assigned(current_procdef.parast) then
  1718. current_procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1719. { generate copies of call by value parameters }
  1720. if not(po_assembler in current_procdef.procoptions) then
  1721. current_procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1722. load_regvars(list,nil);
  1723. end;
  1724. procedure geninlineexitcode(list : TAAsmoutput;inlined:boolean);
  1725. var
  1726. usesacc,
  1727. usesacchi,
  1728. usesfpu : boolean;
  1729. begin
  1730. if aktexitlabel.is_used then
  1731. cg.a_label(list,aktexitlabel);
  1732. cleanup_regvars(list);
  1733. { finalize temporary data }
  1734. finalizetempvariables(list);
  1735. current_procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1736. { finalize paras data }
  1737. if assigned(current_procdef.parast) then
  1738. current_procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1739. { handle return value, this is not done for assembler routines when
  1740. they didn't reference the result variable }
  1741. if not(po_assembler in current_procdef.procoptions) or
  1742. (assigned(current_procdef.funcretsym) and
  1743. (tvarsym(current_procdef.funcretsym).refcount>1)) then
  1744. begin
  1745. if (current_procdef.proctypeoption=potype_constructor) then
  1746. internalerror(200305263);
  1747. // handle_inlined_return_value(list);
  1748. handle_return_value(list,usesacc,usesacchi,usesfpu)
  1749. end;
  1750. cleanup_regvars(list);
  1751. end;
  1752. end.
  1753. {
  1754. $Log$
  1755. Revision 1.108 2003-05-27 14:28:14 jonas
  1756. * patch from Peter for nested procedures
  1757. Revision 1.107 2003/05/26 21:17:17 peter
  1758. * procinlinenode removed
  1759. * aktexit2label removed, fast exit removed
  1760. + tcallnode.inlined_pass_2 added
  1761. Revision 1.106 2003/05/24 11:59:42 jonas
  1762. * fixed integer typeconversion problems
  1763. Revision 1.105 2003/05/23 14:27:35 peter
  1764. * remove some unit dependencies
  1765. * current_procinfo changes to store more info
  1766. Revision 1.104 2003/05/15 18:58:53 peter
  1767. * removed selfpointer_offset, vmtpointer_offset
  1768. * tvarsym.adjusted_address
  1769. * address in localsymtable is now in the real direction
  1770. * removed some obsolete globals
  1771. Revision 1.103 2003/05/14 19:37:25 jonas
  1772. * patch from Peter for int64 function results
  1773. Revision 1.102 2003/05/13 19:14:41 peter
  1774. * failn removed
  1775. * inherited result code check moven to pexpr
  1776. Revision 1.101 2003/05/13 15:16:13 peter
  1777. * removed ret_in_acc, it's the reverse of ret_in_param
  1778. * fixed ret_in_param for win32 cdecl array
  1779. Revision 1.100 2003/05/12 08:08:27 jonas
  1780. * fixed several initialization and finalization related bugs (missing
  1781. tg.direction's, wrong paralocation for decreasing refcount of
  1782. everything but ansistrings)
  1783. Revision 1.99 2003/05/11 21:37:03 peter
  1784. * moved implicit exception frame from ncgutil to psub
  1785. * constructor/destructor helpers moved from cobj/ncgutil to psub
  1786. Revision 1.98 2003/05/11 14:45:12 peter
  1787. * tloadnode does not support objectsymtable,withsymtable anymore
  1788. * withnode cleanup
  1789. * direct with rewritten to use temprefnode
  1790. Revision 1.97 2003/05/10 13:20:23 jonas
  1791. * moved storing of register parameters to memory even earlier in the
  1792. entry code to fix problems with constructors
  1793. Revision 1.96 2003/05/09 17:47:02 peter
  1794. * self moved to hidden parameter
  1795. * removed hdisposen,hnewn,selfn
  1796. Revision 1.95 2003/04/29 07:28:52 michael
  1797. + Patch from peter to fix wrong pushing of ansistring function results in open array
  1798. Revision 1.94 2003/04/28 21:17:38 peter
  1799. * do not finalize function results
  1800. Revision 1.93 2003/04/27 16:30:34 jonas
  1801. * store register para's to memory before copying the valuepara's, because
  1802. that one requires them to be there already (and it calls subroutines ->
  1803. could overwrite those registers)
  1804. Revision 1.92 2003/04/27 11:21:33 peter
  1805. * aktprocdef renamed to current_procdef
  1806. * procinfo renamed to current_procinfo
  1807. * procinfo will now be stored in current_module so it can be
  1808. cleaned up properly
  1809. * gen_main_procsym changed to create_main_proc and release_main_proc
  1810. to also generate a tprocinfo structure
  1811. * fixed unit implicit initfinal
  1812. Revision 1.91 2003/04/27 07:29:50 peter
  1813. * current_procdef cleanup, current_procdef is now always nil when parsing
  1814. a new procdef declaration
  1815. * aktprocsym removed
  1816. * lexlevel removed, use symtable.symtablelevel instead
  1817. * implicit init/final code uses the normal genentry/genexit
  1818. * funcret state checking updated for new funcret handling
  1819. Revision 1.90 2003/04/26 17:21:08 florian
  1820. * fixed passing of fpu values by fpu register
  1821. Revision 1.89 2003/04/25 20:59:33 peter
  1822. * removed funcretn,funcretsym, function result is now in varsym
  1823. and aliases for result and function name are added using absolutesym
  1824. * vs_hidden parameter for funcret passed in parameter
  1825. * vs_hidden fixes
  1826. * writenode changed to printnode and released from extdebug
  1827. * -vp option added to generate a tree.log with the nodetree
  1828. * nicer printnode for statements, callnode
  1829. Revision 1.88 2003/04/23 12:35:34 florian
  1830. * fixed several issues with powerpc
  1831. + applied a patch from Jonas for nested function calls (PowerPC only)
  1832. * ...
  1833. Revision 1.87 2003/04/22 14:33:38 peter
  1834. * removed some notes/hints
  1835. Revision 1.86 2003/04/22 13:47:08 peter
  1836. * fixed C style array of const
  1837. * fixed C array passing
  1838. * fixed left to right with high parameters
  1839. Revision 1.85 2003/04/22 10:09:35 daniel
  1840. + Implemented the actual register allocator
  1841. + Scratch registers unavailable when new register allocator used
  1842. + maybe_save/maybe_restore unavailable when new register allocator used
  1843. Revision 1.84 2003/04/16 09:26:55 jonas
  1844. * assembler procedures now again get a stackframe if they have local
  1845. variables. No space is reserved for a function result however.
  1846. Also, the register parameters aren't automatically saved on the stack
  1847. anymore in assembler procedures.
  1848. Revision 1.83 2003/04/06 21:11:23 olle
  1849. * changed newasmsymbol to newasmsymboldata for data symbols
  1850. Revision 1.82 2003/03/30 20:59:07 peter
  1851. * fix classmethod from classmethod call
  1852. * move BeforeDestruction/AfterConstruction calls to
  1853. genentrycode/genexitcode instead of generating them on the fly
  1854. after a call to a constructor
  1855. Revision 1.81 2003/03/28 19:16:56 peter
  1856. * generic constructor working for i386
  1857. * remove fixed self register
  1858. * esi added as address register for i386
  1859. Revision 1.80 2003/03/17 15:52:20 peter
  1860. * fix range error
  1861. Revision 1.79 2003/03/11 21:46:24 jonas
  1862. * lots of new regallocator fixes, both in generic and ppc-specific code
  1863. (ppc compiler still can't compile the linux system unit though)
  1864. Revision 1.78 2003/02/26 21:15:43 daniel
  1865. * Fixed the optimizer
  1866. Revision 1.77 2003/02/19 22:00:14 daniel
  1867. * Code generator converted to new register notation
  1868. - Horribily outdated todo.txt removed
  1869. Revision 1.76 2003/02/15 22:17:38 carl
  1870. * bugfix of FPU emulation code
  1871. Revision 1.75 2003/01/09 22:00:53 florian
  1872. * fixed some PowerPC issues
  1873. Revision 1.74 2003/01/09 20:41:10 florian
  1874. * fixed broken PowerPC compiler
  1875. Revision 1.73 2003/01/08 18:43:56 daniel
  1876. * Tregister changed into a record
  1877. Revision 1.72 2002/12/29 23:51:43 florian
  1878. * web bug 2214 fixed: ie 10 in const array constructors
  1879. Revision 1.71 2002/12/24 15:56:50 peter
  1880. * stackpointer_alloc added for adjusting ESP. Win32 needs
  1881. this for the pageprotection
  1882. Revision 1.70 2002/12/05 14:39:21 florian
  1883. * added missing then, Carl did you really a make fullcycle :) ?
  1884. Revision 1.69 2002/12/03 22:13:39 carl
  1885. * bugfix of problems with profile code which clobbers some registers
  1886. Revision 1.68 2002/12/01 22:06:59 carl
  1887. * warning of portabilitiy problems with parasize / localsize
  1888. Revision 1.67 2002/11/30 18:44:57 carl
  1889. + profiling support for Win32
  1890. Revision 1.66 2002/11/30 14:39:15 carl
  1891. * try to fix profiling for win32
  1892. Revision 1.65 2002/11/28 23:28:14 florian
  1893. * push_value_para didn't release floatdef locations, fixes tw2045
  1894. Revision 1.64 2002/11/27 02:33:19 peter
  1895. * copy_value_on_stack method added for cdecl record passing
  1896. Revision 1.63 2002/11/25 17:43:18 peter
  1897. * splitted defbase in defutil,symutil,defcmp
  1898. * merged isconvertable and is_equal into compare_defs(_ext)
  1899. * made operator search faster by walking the list only once
  1900. Revision 1.62 2002/11/18 17:31:55 peter
  1901. * pass proccalloption to ret_in_xxx and push_xxx functions
  1902. Revision 1.61 2002/11/17 17:49:08 mazen
  1903. + 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
  1904. Revision 1.60 2002/11/17 16:31:56 carl
  1905. * memory optimization (3-4%) : cleanup of tai fields,
  1906. cleanup of tdef and tsym fields.
  1907. * make it work for m68k
  1908. Revision 1.59 2002/11/15 01:58:51 peter
  1909. * merged changes from 1.0.7 up to 04-11
  1910. - -V option for generating bug report tracing
  1911. - more tracing for option parsing
  1912. - errors for cdecl and high()
  1913. - win32 import stabs
  1914. - win32 records<=8 are returned in eax:edx (turned off by default)
  1915. - heaptrc update
  1916. - more info for temp management in .s file with EXTDEBUG
  1917. Revision 1.58 2002/11/10 19:07:45 mazen
  1918. * SPARC calling mechanism almost OK (as in GCC./mppcsparc )
  1919. Revision 1.57 2002/11/03 20:22:40 mazen
  1920. * parameter handling updated
  1921. Revision 1.56 2002/10/16 19:01:43 peter
  1922. + $IMPLICITEXCEPTIONS switch to turn on/off generation of the
  1923. implicit exception frames for procedures with initialized variables
  1924. and for constructors. The default is on for compatibility
  1925. Revision 1.55 2002/10/14 19:42:33 peter
  1926. * only use init tables for threadvars
  1927. Revision 1.54 2002/10/06 19:41:30 peter
  1928. * Add finalization of typed consts
  1929. * Finalization of globals in the main program
  1930. Revision 1.53 2002/10/05 15:18:42 carl
  1931. * fix heap leaks
  1932. Revision 1.52 2002/09/30 07:00:46 florian
  1933. * fixes to common code to get the alpha compiler compiled applied
  1934. Revision 1.51 2002/09/22 14:02:35 carl
  1935. * stack checking cannot be called before system unit is initialized
  1936. * MC68020 define
  1937. Revision 1.50 2002/09/17 18:54:03 jonas
  1938. * a_load_reg_reg() now has two size parameters: source and dest. This
  1939. allows some optimizations on architectures that don't encode the
  1940. register size in the register name.
  1941. Revision 1.49 2002/09/10 21:48:30 florian
  1942. * improved handling of procedures with register calling conventions
  1943. Revision 1.48 2002/09/07 15:25:03 peter
  1944. * old logs removed and tabs fixed
  1945. Revision 1.47 2002/09/02 18:44:48 peter
  1946. * fixed (not) pushing of empty parameters
  1947. * fixed implicit initialization/finalization generation
  1948. * fixed/optimized local copy of value arguments init/final
  1949. Revision 1.46 2002/09/01 19:27:34 peter
  1950. * use index register when available for generating a reference with
  1951. only a signle register. Using the base register could possibly
  1952. destroy the framepointer
  1953. Revision 1.45 2002/09/01 18:50:20 peter
  1954. * fixed maybe_save that did not support a reference with only
  1955. a index register. It now also updates the location with the new
  1956. base register only
  1957. Revision 1.44 2002/09/01 14:42:41 peter
  1958. * removevaluepara added to fix the stackpointer so restoring of
  1959. saved registers works
  1960. Revision 1.43 2002/08/25 19:25:18 peter
  1961. * sym.insert_in_data removed
  1962. * symtable.insertvardata/insertconstdata added
  1963. * removed insert_in_data call from symtable.insert, it needs to be
  1964. called separatly. This allows to deref the address calculation
  1965. * procedures now calculate the parast addresses after the procedure
  1966. directives are parsed. This fixes the cdecl parast problem
  1967. * push_addr_param has an extra argument that specifies if cdecl is used
  1968. or not
  1969. Revision 1.42 2002/08/24 18:38:26 peter
  1970. * really use tt_noreuse for exception frame buffers
  1971. Revision 1.41 2002/08/23 16:14:49 peter
  1972. * tempgen cleanup
  1973. * tt_noreuse temp type added that will be used in genentrycode
  1974. Revision 1.40 2002/08/18 10:42:37 florian
  1975. * remaining assembler writer bugs fixed, the errors in the
  1976. system unit are inline assembler problems
  1977. Revision 1.39 2002/08/17 09:23:36 florian
  1978. * first part of procinfo rewrite
  1979. Revision 1.38 2002/08/16 14:24:57 carl
  1980. * issameref() to test if two references are the same (then emit no opcodes)
  1981. + ret_in_reg to replace ret_in_acc
  1982. (fix some register allocation bugs at the same time)
  1983. + save_std_register now has an extra parameter which is the
  1984. usedinproc registers
  1985. Revision 1.37 2002/08/15 15:15:55 carl
  1986. * jmpbuf size allocation for exceptions is now cpu specific (as it should)
  1987. * more generic nodes for maths
  1988. * several fixes for better m68k support
  1989. Revision 1.36 2002/08/14 19:25:09 carl
  1990. * fix Florian's last commit for m68k compilation
  1991. Revision 1.35 2002/08/13 21:40:56 florian
  1992. * more fixes for ppc calling conventions
  1993. Revision 1.34 2002/08/12 15:08:39 carl
  1994. + stab register indexes for powerpc (moved from gdb to cpubase)
  1995. + tprocessor enumeration moved to cpuinfo
  1996. + linker in target_info is now a class
  1997. * many many updates for m68k (will soon start to compile)
  1998. - removed some ifdef or correct them for correct cpu
  1999. Revision 1.33 2002/08/11 14:32:27 peter
  2000. * renamed current_library to objectlibrary
  2001. Revision 1.32 2002/08/11 13:24:12 peter
  2002. * saving of asmsymbols in ppu supported
  2003. * asmsymbollist global is removed and moved into a new class
  2004. tasmlibrarydata that will hold the info of a .a file which
  2005. corresponds with a single module. Added librarydata to tmodule
  2006. to keep the library info stored for the module. In the future the
  2007. objectfiles will also be stored to the tasmlibrarydata class
  2008. * all getlabel/newasmsymbol and friends are moved to the new class
  2009. Revision 1.31 2002/08/09 19:16:57 carl
  2010. * stack allocation is now done separately (at the end) of genentrycode
  2011. so temps. can be allocated before.
  2012. * fix generic exception handling
  2013. Revision 1.30 2002/08/06 20:55:21 florian
  2014. * first part of ppc calling conventions fix
  2015. Revision 1.29 2002/08/04 19:09:22 carl
  2016. + added generic exception support (still does not work!)
  2017. + more documentation
  2018. Revision 1.28 2002/07/29 21:23:42 florian
  2019. * more fixes for the ppc
  2020. + wrappers for the tcnvnode.first_* stuff introduced
  2021. }