ncgutil.pas 83 KB

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