ncgutil.pas 85 KB

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