ncgutil.pas 84 KB

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