ncgutil.pas 83 KB

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