ncgutil.pas 66 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704
  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,
  23. cginfo,cpubase,aasm,
  24. rgobj;
  25. type
  26. tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
  27. tmaybesave = record
  28. saved : boolean;
  29. ref : treference;
  30. end;
  31. procedure firstcomplex(p : tbinarynode);
  32. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  33. procedure remove_non_regvars_from_loc(const t: tlocation; var regs: tregisterset);
  34. procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  35. procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
  36. procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
  37. procedure maybe_restore(list:taasmoutput;var l:tlocation;const s:tmaybesave);
  38. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  39. procedure push_value_para(p:tnode;inlined,is_cdecl:boolean;
  40. para_offset:longint;alignment : longint);
  41. procedure genentrycode(list : TAAsmoutput;
  42. make_global:boolean;
  43. stackframe:longint;
  44. var parasize:longint;var nostackframe:boolean;
  45. inlined : boolean);
  46. procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe,inlined:boolean);
  47. procedure genimplicitunitinit(list : TAAsmoutput);
  48. procedure genimplicitunitfinal(list : TAAsmoutput);
  49. implementation
  50. uses
  51. {$ifdef Delphi}
  52. Sysutils,
  53. {$else}
  54. strings,
  55. {$endif}
  56. cutils,cclasses,globtype,globals,systems,verbose,
  57. symbase,symconst,symtype,symsym,symdef,symtable,types,
  58. fmodule,
  59. cgbase,regvars,tainst,cpuasm,
  60. {$ifdef GDB}
  61. gdb,
  62. {$endif GDB}
  63. ncon,
  64. tgobj,cpuinfo,cgobj,cgcpu,cg64f32;
  65. {*****************************************************************************
  66. Misc Helpers
  67. *****************************************************************************}
  68. { DO NOT RELY on the fact that the tnode is not yet swaped
  69. because of inlining code PM }
  70. procedure firstcomplex(p : tbinarynode);
  71. var
  72. hp : tnode;
  73. begin
  74. { always calculate boolean AND and OR from left to right }
  75. if (p.nodetype in [orn,andn]) and
  76. (p.left.resulttype.def.deftype=orddef) and
  77. (torddef(p.left.resulttype.def).typ in [bool8bit,bool16bit,bool32bit]) then
  78. begin
  79. { p.swaped:=false}
  80. if nf_swaped in p.flags then
  81. internalerror(234234);
  82. end
  83. else
  84. if (((p.location.loc=LOC_FPUREGISTER) and
  85. (p.right.registersfpu > p.left.registersfpu)) or
  86. ((((p.left.registersfpu = 0) and
  87. (p.right.registersfpu = 0)) or
  88. (p.location.loc<>LOC_FPUREGISTER)) and
  89. (p.left.registers32<p.right.registers32))) and
  90. { the following check is appropriate, because all }
  91. { 4 registers are rarely used and it is thereby }
  92. { achieved that the extra code is being dropped }
  93. { by exchanging not commutative operators }
  94. (p.right.registers32<=c_countusableregsint) then
  95. begin
  96. hp:=p.left;
  97. p.left:=p.right;
  98. p.right:=hp;
  99. if nf_swaped in p.flags then
  100. exclude(p.flags,nf_swaped)
  101. else
  102. include(p.flags,nf_swaped);
  103. end;
  104. end;
  105. procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
  106. {
  107. produces jumps to true respectively false labels using boolean expressions
  108. depending on whether the loading of regvars is currently being
  109. synchronized manually (such as in an if-node) or automatically (most of
  110. the other cases where this procedure is called), loadregvars can be
  111. "lr_load_regvars" or "lr_dont_load_regvars"
  112. }
  113. var
  114. opsize : tcgsize;
  115. storepos : tfileposinfo;
  116. begin
  117. if nf_error in p.flags then
  118. exit;
  119. storepos:=aktfilepos;
  120. aktfilepos:=p.fileinfo;
  121. if is_boolean(p.resulttype.def) then
  122. begin
  123. if loadregvars = lr_load_regvars then
  124. load_all_regvars(list);
  125. if is_constboolnode(p) then
  126. begin
  127. if tordconstnode(p).value<>0 then
  128. cg.a_jmp_always(list,truelabel)
  129. else
  130. cg.a_jmp_always(list,falselabel)
  131. end
  132. else
  133. begin
  134. opsize:=def_cgsize(p.resulttype.def);
  135. case p.location.loc of
  136. LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
  137. begin
  138. if (p.location.loc = LOC_CREGISTER) then
  139. load_regvar_reg(list,p.location.register);
  140. cg.a_cmp_const_loc_label(list,opsize,OC_NE,
  141. 0,p.location,truelabel);
  142. { !!! should happen right after cmp (JM) }
  143. location_release(list,p.location);
  144. cg.a_jmp_always(list,falselabel);
  145. end;
  146. LOC_FLAGS :
  147. begin
  148. cg.a_jmp_flags(list,p.location.resflags,
  149. truelabel);
  150. cg.a_jmp_always(list,falselabel);
  151. end;
  152. end;
  153. end;
  154. end
  155. else
  156. internalerror(200112305);
  157. aktfilepos:=storepos;
  158. end;
  159. procedure remove_non_regvars_from_loc(const t: tlocation; var regs: tregisterset);
  160. begin
  161. case t.loc of
  162. LOC_REGISTER:
  163. begin
  164. { can't be a regvar, since it would be LOC_CREGISTER then }
  165. exclude(regs,t.register);
  166. if t.registerhigh <> R_NO then
  167. exclude(regs,t.registerhigh);
  168. end;
  169. LOC_CREFERENCE,LOC_REFERENCE:
  170. begin
  171. if not(cs_regalloc in aktglobalswitches) or
  172. (t.reference.base in rg.usableregsint) then
  173. exclude(regs,t.reference.base);
  174. if not(cs_regalloc in aktglobalswitches) or
  175. (t.reference.index in rg.usableregsint) then
  176. exclude(regs,t.reference.index);
  177. end;
  178. end;
  179. end;
  180. {*****************************************************************************
  181. TLocation
  182. *****************************************************************************}
  183. { 32-bit version }
  184. procedure location_force_reg32(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  185. var
  186. hregister,
  187. hregisterhi : tregister;
  188. hl : tasmlabel;
  189. begin
  190. { handle transformations to 64bit separate }
  191. if dst_size in [OS_64,OS_S64] then
  192. begin
  193. if not (l.size in [OS_64,OS_S64]) then
  194. begin
  195. { load a smaller size to OS_64 }
  196. if l.loc=LOC_REGISTER then
  197. hregister:=rg.makeregsize(l.registerlow,OS_INT)
  198. else
  199. hregister:=rg.getregisterint(list);
  200. { load value in low register }
  201. case l.loc of
  202. LOC_FLAGS :
  203. cg.g_flags2reg(list,l.resflags,hregister);
  204. LOC_JUMP :
  205. begin
  206. cg.a_label(list,truelabel);
  207. cg.a_load_const_reg(list,OS_INT,1,hregister);
  208. getlabel(hl);
  209. cg.a_jmp_always(list,hl);
  210. cg.a_label(list,falselabel);
  211. cg.a_load_const_reg(list,OS_INT,0,hregister);
  212. cg.a_label(list,hl);
  213. end;
  214. else
  215. cg.a_load_loc_reg(list,l,hregister);
  216. end;
  217. { reset hi part, take care of the signed bit of the current value }
  218. hregisterhi:=rg.getregisterint(list);
  219. if (dst_size=OS_S64) and
  220. (l.size in [OS_S8,OS_S16,OS_S32]) then
  221. begin
  222. if l.loc=LOC_CONSTANT then
  223. begin
  224. if (longint(l.value)<0) then
  225. cg.a_load_const_reg(list,OS_32,$ffffffff,hregisterhi)
  226. else
  227. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  228. end
  229. else
  230. begin
  231. cg.a_load_reg_reg(list,OS_32,hregister,hregisterhi);
  232. cg.a_op_const_reg(list,OP_SAR,31,hregisterhi);
  233. end;
  234. end
  235. else
  236. cg.a_load_const_reg(list,OS_32,0,hregisterhi);
  237. location_reset(l,LOC_REGISTER,dst_size);
  238. l.registerlow:=hregister;
  239. l.registerhigh:=hregisterhi;
  240. end
  241. else
  242. begin
  243. { 64bit to 64bit }
  244. if (l.loc=LOC_REGISTER) or
  245. ((l.loc=LOC_CREGISTER) and maybeconst) then
  246. begin
  247. hregister:=l.registerlow;
  248. hregisterhi:=l.registerhigh;
  249. end
  250. else
  251. begin
  252. hregister:=rg.getregisterint(list);
  253. hregisterhi:=rg.getregisterint(list);
  254. end;
  255. { load value in new register }
  256. tcg64f32(cg).a_load64_loc_reg(list,l,hregister,hregisterhi);
  257. location_reset(l,LOC_REGISTER,dst_size);
  258. l.registerlow:=hregister;
  259. l.registerhigh:=hregisterhi;
  260. end;
  261. end
  262. else
  263. begin
  264. { transformations to 32bit or smaller }
  265. if l.loc=LOC_REGISTER then
  266. begin
  267. { if the previous was 64bit release the high register }
  268. if l.size in [OS_64,OS_S64] then
  269. begin
  270. rg.ungetregisterint(list,l.registerhigh);
  271. l.registerhigh:=R_NO;
  272. end;
  273. hregister:=l.register;
  274. end
  275. else
  276. begin
  277. { get new register }
  278. if (l.loc=LOC_CREGISTER) and
  279. maybeconst and
  280. (TCGSize2Size[dst_size]=TCGSize2Size[l.size]) then
  281. hregister:=l.register
  282. else
  283. hregister:=rg.getregisterint(list);
  284. end;
  285. hregister:=rg.makeregsize(hregister,dst_size);
  286. { load value in new register }
  287. case l.loc of
  288. LOC_FLAGS :
  289. cg.g_flags2reg(list,l.resflags,hregister);
  290. LOC_JUMP :
  291. begin
  292. cg.a_label(list,truelabel);
  293. cg.a_load_const_reg(list,dst_size,1,hregister);
  294. getlabel(hl);
  295. cg.a_jmp_always(list,hl);
  296. cg.a_label(list,falselabel);
  297. cg.a_load_const_reg(list,dst_size,0,hregister);
  298. cg.a_label(list,hl);
  299. end;
  300. else
  301. begin
  302. { load_loc_reg can only handle size >= l.size, when the
  303. new size is smaller then we need to adjust the size
  304. of the orignal and maybe recalculate l.register for i386 }
  305. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  306. begin
  307. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  308. l.register:=rg.makeregsize(l.register,dst_size);
  309. l.size:=dst_size;
  310. end;
  311. cg.a_load_loc_reg(list,l,hregister);
  312. end;
  313. end;
  314. location_reset(l,LOC_REGISTER,dst_size);
  315. l.register:=hregister;
  316. end;
  317. end;
  318. { 64-bit version }
  319. procedure location_force_reg64(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  320. var
  321. hregister : tregister;
  322. hl : tasmlabel;
  323. begin
  324. { handle transformations to 64bit separate }
  325. if dst_size in [OS_64,OS_S64] then
  326. begin
  327. { load a smaller size to OS_64 }
  328. if l.loc=LOC_REGISTER then
  329. hregister:=rg.makeregsize(l.register,OS_INT)
  330. else
  331. hregister:=rg.getregisterint(list);
  332. { load value in low register }
  333. case l.loc of
  334. LOC_FLAGS :
  335. cg.g_flags2reg(list,l.resflags,hregister);
  336. LOC_JUMP :
  337. begin
  338. cg.a_label(list,truelabel);
  339. cg.a_load_const_reg(list,OS_INT,1,hregister);
  340. getlabel(hl);
  341. cg.a_jmp_always(list,hl);
  342. cg.a_label(list,falselabel);
  343. cg.a_load_const_reg(list,OS_INT,0,hregister);
  344. cg.a_label(list,hl);
  345. end;
  346. else
  347. cg.a_load_loc_reg(list,l,hregister);
  348. end;
  349. location_reset(l,LOC_REGISTER,dst_size);
  350. l.register:=hregister;
  351. end
  352. else
  353. begin
  354. { transformations to 32bit or smaller }
  355. if l.loc=LOC_REGISTER then
  356. begin
  357. hregister:=l.register;
  358. end
  359. else
  360. begin
  361. { get new register }
  362. if (l.loc=LOC_CREGISTER) and
  363. maybeconst and
  364. (TCGSize2Size[dst_size]=TCGSize2Size[l.size]) then
  365. hregister:=l.register
  366. else
  367. hregister:=rg.getregisterint(list);
  368. end;
  369. hregister:=rg.makeregsize(hregister,dst_size);
  370. { load value in new register }
  371. case l.loc of
  372. LOC_FLAGS :
  373. cg.g_flags2reg(list,l.resflags,hregister);
  374. LOC_JUMP :
  375. begin
  376. cg.a_label(list,truelabel);
  377. cg.a_load_const_reg(list,dst_size,1,hregister);
  378. getlabel(hl);
  379. cg.a_jmp_always(list,hl);
  380. cg.a_label(list,falselabel);
  381. cg.a_load_const_reg(list,dst_size,0,hregister);
  382. cg.a_label(list,hl);
  383. end;
  384. else
  385. begin
  386. { load_loc_reg can only handle size >= l.size, when the
  387. new size is smaller then we need to adjust the size
  388. of the orignal and maybe recalculate l.register for i386 }
  389. if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
  390. begin
  391. if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  392. l.register:=rg.makeregsize(l.register,dst_size);
  393. l.size:=dst_size;
  394. end;
  395. cg.a_load_loc_reg(list,l,hregister);
  396. end;
  397. end;
  398. location_reset(l,LOC_REGISTER,dst_size);
  399. l.register:=hregister;
  400. end;
  401. end;
  402. procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
  403. begin
  404. { release previous location before demanding a new register }
  405. if (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  406. begin
  407. location_freetemp(list,l);
  408. location_release(list,l);
  409. end;
  410. if sizeof(aword) < 8 then
  411. location_force_reg32(list, l, dst_size, maybeconst)
  412. else
  413. location_force_reg64(list, l, dst_size, maybeconst);
  414. end;
  415. procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
  416. var
  417. r : treference;
  418. begin
  419. case l.loc of
  420. LOC_FPUREGISTER,
  421. LOC_CFPUREGISTER :
  422. begin
  423. tg.gettempofsizereference(list,TCGSize2Size[l.size],r);
  424. cg.a_loadfpu_reg_ref(list,l.size,l.register,r);
  425. location_reset(l,LOC_REFERENCE,l.size);
  426. l.reference:=r;
  427. end;
  428. LOC_CONSTANT,
  429. LOC_REGISTER,
  430. LOC_CREGISTER :
  431. begin
  432. tg.gettempofsizereference(list,TCGSize2Size[l.size],r);
  433. if l.size in [OS_64,OS_S64] then
  434. tcg64f32(cg).a_load64_loc_ref(list,l,r)
  435. else
  436. cg.a_load_loc_ref(list,l,r);
  437. location_reset(l,LOC_REFERENCE,l.size);
  438. l.reference:=r;
  439. end;
  440. LOC_CREFERENCE,
  441. LOC_REFERENCE : ;
  442. else
  443. internalerror(200203219);
  444. end;
  445. end;
  446. {*****************************************************************************
  447. Maybe_Save
  448. *****************************************************************************}
  449. procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
  450. begin
  451. s.saved:=false;
  452. if l.loc=LOC_CREGISTER then
  453. begin
  454. s.saved:=true;
  455. exit;
  456. end;
  457. if needed>rg.countunusedregsint then
  458. begin
  459. case l.loc of
  460. LOC_REGISTER :
  461. begin
  462. if l.size in [OS_64,OS_S64] then
  463. begin
  464. tg.gettempofsizereference(exprasmlist,8,s.ref);
  465. tcg64f32(cg).a_load64_reg_ref(exprasmlist,l.registerlow,l.registerhigh,s.ref);
  466. end
  467. else
  468. begin
  469. tg.gettempofsizereference(exprasmlist,TCGSize2Size[l.size],s.ref);
  470. cg.a_load_reg_ref(exprasmlist,l.size,l.register,s.ref);
  471. end;
  472. location_release(exprasmlist,l);
  473. s.saved:=true;
  474. end;
  475. LOC_REFERENCE,
  476. LOC_CREFERENCE :
  477. begin
  478. if ((l.reference.base<>R_NO) or
  479. (l.reference.index<>R_NO)) then
  480. begin
  481. { load address into a single base register }
  482. cg.a_loadaddr_ref_reg(list,l.reference,l.reference.base);
  483. { save base register }
  484. tg.gettempofsizereference(exprasmlist,TCGSize2Size[OS_ADDR],s.ref);
  485. cg.a_load_reg_ref(exprasmlist,OS_ADDR,l.reference.base,s.ref);
  486. { release }
  487. location_release(exprasmlist,l);
  488. s.saved:=true;
  489. end;
  490. end;
  491. end;
  492. end;
  493. end;
  494. procedure maybe_restore(list:taasmoutput;var l:tlocation;const s:tmaybesave);
  495. begin
  496. if not s.saved then
  497. exit;
  498. if l.loc=LOC_CREGISTER then
  499. begin
  500. load_regvar_reg(list,l.register);
  501. exit;
  502. end;
  503. case l.loc of
  504. LOC_REGISTER :
  505. begin
  506. if l.size in [OS_64,OS_S64] then
  507. begin
  508. l.registerlow:=rg.getregisterint(exprasmlist);
  509. l.registerhigh:=rg.getregisterint(exprasmlist);
  510. tcg64f32(cg).a_load64_ref_reg(exprasmlist,s.ref,l.registerlow,l.registerhigh);
  511. end
  512. else
  513. begin
  514. l.register:=rg.getregisterint(exprasmlist);
  515. cg.a_load_ref_reg(exprasmlist,OS_INT,s.ref,l.register);
  516. end;
  517. end;
  518. LOC_CREFERENCE,
  519. LOC_REFERENCE :
  520. begin
  521. reference_reset(l.reference);
  522. l.reference.base:=rg.getaddressregister(exprasmlist);
  523. cg.a_load_ref_reg(exprasmlist,OS_ADDR,s.ref,l.reference.base);
  524. end;
  525. end;
  526. tg.ungetiftemp(exprasmlist,s.ref);
  527. end;
  528. function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
  529. begin
  530. if needed>=maxfpuregs then
  531. begin
  532. if l.loc = LOC_FPUREGISTER then
  533. begin
  534. location_force_mem(list,l);
  535. maybe_pushfpu:=true;
  536. end
  537. else
  538. maybe_pushfpu:=false;
  539. end
  540. else
  541. maybe_pushfpu:=false;
  542. end;
  543. {*****************************************************************************
  544. Push Value Para
  545. *****************************************************************************}
  546. procedure push_value_para(p:tnode;inlined,is_cdecl:boolean;
  547. para_offset:longint;alignment : longint);
  548. var
  549. tempreference : treference;
  550. href : treference;
  551. hreg : tregister;
  552. sizetopush,
  553. size : longint;
  554. cgsize : tcgsize;
  555. begin
  556. { Move flags and jump in register to make it less complex }
  557. if p.location.loc in [LOC_FLAGS,LOC_JUMP] then
  558. location_force_reg(exprasmlist,p.location,def_cgsize(p.resulttype.def),false);
  559. { Handle Floating point types differently }
  560. if p.resulttype.def.deftype=floatdef then
  561. begin
  562. case p.location.loc of
  563. LOC_FPUREGISTER,
  564. LOC_CFPUREGISTER:
  565. begin
  566. size:=align(tfloatdef(p.resulttype.def).size,alignment);
  567. inc(pushedparasize,size);
  568. if not inlined then
  569. cg.a_op_const_reg(exprasmlist,OP_SUB,size,STACK_POINTER_REG);
  570. {$ifdef GDB}
  571. if (cs_debuginfo in aktmoduleswitches) and
  572. (exprasmList.first=exprasmList.last) then
  573. exprasmList.concat(Tai_force_line.Create);
  574. {$endif GDB}
  575. { this is the easiest case for inlined !! }
  576. if inlined then
  577. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize)
  578. else
  579. reference_reset_base(href,stack_pointer_reg,0);
  580. cg.a_loadfpu_reg_ref(exprasmlist,
  581. def_cgsize(p.resulttype.def),p.location.register,href);
  582. end;
  583. LOC_REFERENCE,
  584. LOC_CREFERENCE :
  585. begin
  586. sizetopush:=align(p.resulttype.def.size,alignment);
  587. tempreference:=p.location.reference;
  588. inc(tempreference.offset,sizetopush);
  589. while (sizetopush>0) do
  590. begin
  591. if sizetopush>=4 then
  592. begin
  593. cgsize:=OS_32;
  594. inc(pushedparasize,4);
  595. dec(tempreference.offset,4);
  596. dec(sizetopush,4);
  597. end
  598. else
  599. begin
  600. cgsize:=OS_16;
  601. inc(pushedparasize,2);
  602. dec(tempreference.offset,2);
  603. dec(sizetopush,2);
  604. end;
  605. if inlined then
  606. begin
  607. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  608. cg.a_load_ref_ref(exprasmlist,cgsize,tempreference,href);
  609. end
  610. else
  611. cg.a_param_ref(exprasmlist,cgsize,tempreference,-1);
  612. end;
  613. end;
  614. else
  615. internalerror(200204243);
  616. end;
  617. end
  618. else
  619. begin
  620. { call by value open array ? }
  621. if is_cdecl and
  622. push_addr_param(p.resulttype.def) then
  623. begin
  624. if not (p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  625. internalerror(200204241);
  626. { push on stack }
  627. size:=align(p.resulttype.def.size,alignment);
  628. inc(pushedparasize,size);
  629. cg.a_op_const_reg(exprasmlist,OP_SUB,size,STACK_POINTER_REG);
  630. reference_reset_base(href,STACK_POINTER_REG,0);
  631. cg.g_concatcopy(exprasmlist,p.location.reference,href,size,false,false);
  632. end
  633. else
  634. begin
  635. case p.location.loc of
  636. LOC_CONSTANT,
  637. LOC_REGISTER,
  638. LOC_CREGISTER,
  639. LOC_REFERENCE,
  640. LOC_CREFERENCE :
  641. begin
  642. cgsize:=def_cgsize(p.resulttype.def);
  643. if cgsize in [OS_64,OS_S64] then
  644. begin
  645. inc(pushedparasize,8);
  646. if inlined then
  647. begin
  648. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  649. tcg64f32(cg).a_load64_loc_ref(exprasmlist,p.location,href);
  650. end
  651. else
  652. tcg64f32(cg).a_param64_loc(exprasmlist,p.location,-1);
  653. end
  654. else
  655. begin
  656. case cgsize of
  657. OS_8,OS_S8 :
  658. begin
  659. if alignment=4 then
  660. cgsize:=OS_32
  661. else
  662. cgsize:=OS_16;
  663. end;
  664. OS_16,OS_S16 :
  665. begin
  666. if alignment=4 then
  667. cgsize:=OS_32;
  668. end;
  669. end;
  670. { update register to use to match alignment }
  671. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  672. begin
  673. hreg:=p.location.register;
  674. p.location.register:=rg.makeregsize(p.location.register,cgsize);
  675. end;
  676. inc(pushedparasize,alignment);
  677. if inlined then
  678. begin
  679. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  680. cg.a_load_loc_ref(exprasmlist,p.location,href);
  681. end
  682. else
  683. cg.a_param_loc(exprasmlist,p.location,-1);
  684. { restore old register }
  685. if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  686. p.location.register:=hreg;
  687. end;
  688. location_release(exprasmlist,p.location);
  689. end;
  690. {$ifdef SUPPORT_MMX}
  691. LOC_MMXREGISTER,
  692. LOC_CMMXREGISTER:
  693. begin
  694. inc(pushedparasize,8);
  695. if inlined then
  696. begin
  697. reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
  698. cg.a_loadmm_reg_ref(exprasmlist,p.location.register,href);
  699. end
  700. else
  701. cg.a_parammm_reg(exprasmlist,p.location.register);
  702. end;
  703. {$endif SUPPORT_MMX}
  704. else
  705. internalerror(200204241);
  706. end;
  707. end;
  708. end;
  709. end;
  710. {****************************************************************************
  711. Entry/Exit Code
  712. ****************************************************************************}
  713. procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
  714. var
  715. href1,href2 : treference;
  716. list : taasmoutput;
  717. begin
  718. list:=taasmoutput(arg);
  719. if (tsym(p).typ=varsym) and
  720. (tvarsym(p).varspez=vs_value) and
  721. (push_addr_param(tvarsym(p).vartype.def)) then
  722. begin
  723. reference_reset_base(href1,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
  724. if is_open_array(tvarsym(p).vartype.def) or
  725. is_array_of_const(tvarsym(p).vartype.def) then
  726. cg.g_copyvaluepara_openarray(list,href1,tarraydef(tvarsym(p).vartype.def).elesize)
  727. else
  728. begin
  729. reference_reset_base(href2,procinfo^.framepointer,-tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup);
  730. if is_shortstring(tvarsym(p).vartype.def) then
  731. cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,true)
  732. else
  733. cg.g_concatcopy(list,href1,href2,tvarsym(p).vartype.def.size,true,true);
  734. end;
  735. end;
  736. end;
  737. procedure initialize_threadvar(p : tnamedindexitem;arg:pointer);
  738. var
  739. href : treference;
  740. list : taasmoutput;
  741. begin
  742. list:=taasmoutput(arg);
  743. if (tsym(p).typ=varsym) and
  744. (vo_is_thread_var in tvarsym(p).varoptions) then
  745. begin
  746. cg.a_param_const(list,OS_INT,tvarsym(p).getsize,2);
  747. reference_reset_symbol(href,newasmsymbol(tvarsym(p).mangledname),0);
  748. cg.a_paramaddr_ref(list,href,2);
  749. rg.saveregvars(list,all_registers);
  750. cg.a_call_name(list,'FPC_INIT_THREADVAR');
  751. end;
  752. end;
  753. { generates the code for initialisation of local data }
  754. procedure initialize_data(p : tnamedindexitem;arg:pointer);
  755. var
  756. href : treference;
  757. list : taasmoutput;
  758. begin
  759. list:=taasmoutput(arg);
  760. if (tsym(p).typ=varsym) and
  761. assigned(tvarsym(p).vartype.def) and
  762. not(is_class(tvarsym(p).vartype.def)) and
  763. tvarsym(p).vartype.def.needs_inittable then
  764. begin
  765. if assigned(procinfo) then
  766. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  767. if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
  768. reference_reset_base(href,procinfo^.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
  769. else
  770. reference_reset_symbol(href,newasmsymbol(tvarsym(p).mangledname),0);
  771. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  772. end;
  773. end;
  774. { generates the code for finalisation of local data }
  775. procedure finalize_data(p : tnamedindexitem;arg:pointer);
  776. var
  777. href : treference;
  778. list : taasmoutput;
  779. begin
  780. list:=taasmoutput(arg);
  781. if (tsym(p).typ=varsym) and
  782. assigned(tvarsym(p).vartype.def) and
  783. not(is_class(tvarsym(p).vartype.def)) and
  784. tvarsym(p).vartype.def.needs_inittable then
  785. begin
  786. if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
  787. reference_reset_base(href,procinfo^.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
  788. else
  789. reference_reset_symbol(href,newasmsymbol(tvarsym(p).mangledname),0);
  790. cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
  791. end;
  792. end;
  793. { generates the code for incrementing the reference count of parameters and
  794. initialize out parameters }
  795. procedure init_paras(p : tnamedindexitem;arg:pointer);
  796. var
  797. href : treference;
  798. tmpreg : tregister;
  799. list : taasmoutput;
  800. begin
  801. list:=taasmoutput(arg);
  802. if (tsym(p).typ=varsym) and
  803. not is_class(tvarsym(p).vartype.def) and
  804. tvarsym(p).vartype.def.needs_inittable then
  805. begin
  806. case tvarsym(p).varspez of
  807. vs_value :
  808. begin
  809. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  810. if assigned(tvarsym(p).localvarsym) then
  811. reference_reset_base(href,procinfo^.framepointer,
  812. -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
  813. else
  814. reference_reset_base(href,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
  815. cg.g_incrrefcount(list,tvarsym(p).vartype.def,href);
  816. end;
  817. vs_out :
  818. begin
  819. reference_reset_base(href,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
  820. tmpreg:=cg.get_scratch_reg_address(list);
  821. cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
  822. reference_reset_base(href,tmpreg,0);
  823. cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
  824. end;
  825. end;
  826. end;
  827. end;
  828. { generates the code for decrementing the reference count of parameters }
  829. procedure final_paras(p : tnamedindexitem;arg:pointer);
  830. var
  831. href : treference;
  832. list : taasmoutput;
  833. begin
  834. list:=taasmoutput(arg);
  835. if (tsym(p).typ=varsym) and
  836. not is_class(tvarsym(p).vartype.def) and
  837. tvarsym(p).vartype.def.needs_inittable then
  838. begin
  839. if (tvarsym(p).varspez=vs_value) then
  840. begin
  841. if assigned(tvarsym(p).localvarsym) then
  842. reference_reset_base(href,procinfo^.framepointer,
  843. -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
  844. else
  845. reference_reset_base(href,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
  846. cg.g_decrrefcount(list,tvarsym(p).vartype.def,href);
  847. end;
  848. end;
  849. end;
  850. { Initialize temp ansi/widestrings,interfaces }
  851. procedure inittempvariables(list:taasmoutput);
  852. var
  853. hp : ptemprecord;
  854. href : treference;
  855. begin
  856. hp:=tg.templist;
  857. while assigned(hp) do
  858. begin
  859. if hp^.temptype in [tt_ansistring,tt_freeansistring,
  860. tt_widestring,tt_freewidestring,
  861. tt_interfacecom] then
  862. begin
  863. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  864. reference_reset_base(href,procinfo^.framepointer,hp^.pos);
  865. cg.a_load_const_ref(list,OS_ADDR,0,href);
  866. end;
  867. hp:=hp^.next;
  868. end;
  869. end;
  870. procedure finalizetempvariables(list:taasmoutput);
  871. var
  872. hp : ptemprecord;
  873. href : treference;
  874. begin
  875. hp:=tg.templist;
  876. while assigned(hp) do
  877. begin
  878. case hp^.temptype of
  879. tt_ansistring,
  880. tt_freeansistring :
  881. begin
  882. reference_reset_base(href,procinfo^.framepointer,hp^.pos);
  883. cg.a_paramaddr_ref(list,href,1);
  884. cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
  885. end;
  886. tt_widestring,
  887. tt_freewidestring :
  888. begin
  889. reference_reset_base(href,procinfo^.framepointer,hp^.pos);
  890. cg.a_paramaddr_ref(list,href,1);
  891. cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
  892. end;
  893. tt_interfacecom :
  894. begin
  895. reference_reset_base(href,procinfo^.framepointer,hp^.pos);
  896. cg.a_paramaddr_ref(list,href,1);
  897. cg.a_call_name(list,'FPC_INTF_DECR_REF');
  898. end;
  899. end;
  900. hp:=hp^.next;
  901. end;
  902. end;
  903. procedure handle_return_value(list:TAAsmoutput; inlined : boolean;var uses_acc,uses_acchi : boolean);
  904. var
  905. href : treference;
  906. hreg : tregister;
  907. cgsize : TCGSize;
  908. begin
  909. if not is_void(aktprocdef.rettype.def) then
  910. begin
  911. if (tfuncretsym(aktprocdef.funcretsym).funcretstate<>vs_assigned) and
  912. (not inlined) then
  913. CGMessage(sym_w_function_result_not_set);
  914. reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
  915. cgsize:=def_cgsize(aktprocdef.rettype.def);
  916. case aktprocdef.rettype.def.deftype of
  917. orddef,
  918. enumdef :
  919. begin
  920. uses_acc:=true;
  921. cg.a_reg_alloc(list,accumulator);
  922. if cgsize in [OS_64,OS_S64] then
  923. begin
  924. uses_acchi:=true;
  925. cg.a_reg_alloc(list,accumulatorhigh);
  926. tcg64f32(cg).a_load64_ref_reg(list,href,accumulator,accumulatorhigh);
  927. end
  928. else
  929. begin
  930. hreg:=rg.makeregsize(accumulator,cgsize);
  931. cg.a_load_ref_reg(list,cgsize,href,hreg);
  932. end;
  933. end;
  934. floatdef :
  935. begin
  936. cg.a_loadfpu_ref_reg(list,cgsize,href,fpuresultreg);
  937. end;
  938. else
  939. begin
  940. if ret_in_acc(aktprocdef.rettype.def) then
  941. begin
  942. uses_acc:=true;
  943. cg.a_reg_alloc(list,accumulator);
  944. cg.a_load_ref_reg(list,cgsize,href,accumulator);
  945. end
  946. end;
  947. end;
  948. end;
  949. end;
  950. procedure handle_fast_exit_return_value(list:TAAsmoutput);
  951. var
  952. href : treference;
  953. hreg : tregister;
  954. cgsize : TCGSize;
  955. begin
  956. if not is_void(aktprocdef.rettype.def) then
  957. begin
  958. reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
  959. cgsize:=def_cgsize(aktprocdef.rettype.def);
  960. case aktprocdef.rettype.def.deftype of
  961. orddef,
  962. enumdef :
  963. begin
  964. if cgsize in [OS_64,OS_S64] then
  965. tcg64f32(cg).a_load64_reg_ref(list,accumulator,accumulatorhigh,href)
  966. else
  967. begin
  968. hreg:=rg.makeregsize(accumulator,cgsize);
  969. cg.a_load_reg_ref(list,cgsize,hreg,href);
  970. end;
  971. end;
  972. floatdef :
  973. begin
  974. cg.a_loadfpu_reg_ref(list,cgsize,fpuresultreg,href);
  975. end;
  976. else
  977. begin
  978. if ret_in_acc(aktprocdef.rettype.def) then
  979. cg.a_load_reg_ref(list,cgsize,accumulator,href);
  980. end;
  981. end;
  982. end;
  983. end;
  984. procedure genentrycode(list : TAAsmoutput;
  985. make_global:boolean;
  986. stackframe:longint;
  987. var parasize:longint;var nostackframe:boolean;
  988. inlined : boolean);
  989. var
  990. hs : string;
  991. href : treference;
  992. p : tsymtable;
  993. tempbuf : treference;
  994. tmpreg : tregister;
  995. begin
  996. { Insert alignment and assembler names }
  997. if not inlined then
  998. begin
  999. { Align, gprof uses 16 byte granularity }
  1000. if (cs_profile in aktmoduleswitches) then
  1001. list.concat(Tai_align.Create_op(16,$90))
  1002. else
  1003. list.concat(Tai_align.Create(aktalignment.procalign));
  1004. if (cs_profile in aktmoduleswitches) or
  1005. (aktprocdef.owner.symtabletype=globalsymtable) or
  1006. (assigned(procinfo^._class) and (procinfo^._class.owner.symtabletype=globalsymtable)) then
  1007. make_global:=true;
  1008. if make_global or ((procinfo^.flags and pi_is_global) <> 0) then
  1009. aktprocsym.is_global := True;
  1010. {$ifdef GDB}
  1011. if (cs_debuginfo in aktmoduleswitches) then
  1012. begin
  1013. aktprocdef.concatstabto(list);
  1014. aktprocsym.isstabwritten:=true;
  1015. end;
  1016. {$endif GDB}
  1017. repeat
  1018. hs:=aktprocdef.aliasnames.getfirst;
  1019. if hs='' then
  1020. break;
  1021. {$ifdef GDB}
  1022. if (cs_debuginfo in aktmoduleswitches) and
  1023. target_info.use_function_relative_addresses then
  1024. list.concat(Tai_stab_function_name.Create(strpnew(hs)));
  1025. {$endif GDB}
  1026. if make_global then
  1027. list.concat(Tai_symbol.Createname_global(hs,0))
  1028. else
  1029. list.concat(Tai_symbol.Createname(hs,0));
  1030. until false;
  1031. { omit stack frame ? }
  1032. if (procinfo^.framepointer=STACK_POINTER_REG) then
  1033. begin
  1034. CGMessage(cg_d_stackframe_omited);
  1035. nostackframe:=true;
  1036. if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
  1037. parasize:=0
  1038. else
  1039. parasize:=aktprocdef.parast.datasize+procinfo^.para_offset-4;
  1040. if stackframe<>0 then
  1041. cg.a_op_const_reg(list,OP_SUB,stackframe,procinfo^.framepointer);
  1042. end
  1043. else
  1044. begin
  1045. nostackframe:=false;
  1046. if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
  1047. parasize:=0
  1048. else
  1049. parasize:=aktprocdef.parast.datasize+procinfo^.para_offset-target_info.first_parm_offset;
  1050. if (po_interrupt in aktprocdef.procoptions) then
  1051. cg.g_interrupt_stackframe_entry(list);
  1052. cg.g_stackframe_entry(list,stackframe);
  1053. if (cs_check_stack in aktlocalswitches) then
  1054. cg.g_stackcheck(list,stackframe);
  1055. end;
  1056. if (cs_profile in aktmoduleswitches) and
  1057. not(po_assembler in aktprocdef.procoptions) then
  1058. cg.g_profilecode(list);
  1059. end;
  1060. { for the save all registers we can simply use a pusha,popa which
  1061. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1062. if (po_saveregisters in aktprocdef.procoptions) then
  1063. cg.g_save_all_registers(list)
  1064. else
  1065. { should we save edi,esi,ebx like C ? }
  1066. if (po_savestdregs in aktprocdef.procoptions) then
  1067. cg.g_save_standard_registers(list);
  1068. { a constructor needs a help procedure }
  1069. if (aktprocdef.proctypeoption=potype_constructor) then
  1070. cg.g_call_constructor_helper(list);
  1071. { don't load ESI, does the caller }
  1072. { we must do it for local function }
  1073. { that can be called from a foreach_static }
  1074. { of another object than self !! PM }
  1075. if assigned(procinfo^._class) and { !!!!! shouldn't we load ESI always? }
  1076. (lexlevel>normal_function_level) then
  1077. cg.g_maybe_loadself(list);
  1078. { When message method contains self as a parameter,
  1079. we must load it into ESI }
  1080. If (po_containsself in aktprocdef.procoptions) then
  1081. begin
  1082. list.concat(Tairegalloc.Alloc(self_pointer_reg));
  1083. reference_reset_base(href,procinfo^.framepointer,procinfo^.selfpointer_offset);
  1084. cg.a_load_ref_reg(list,OS_ADDR,href,self_pointer_reg);
  1085. end;
  1086. { initialize return value }
  1087. if (not is_void(aktprocdef.rettype.def)) and
  1088. (aktprocdef.rettype.def.needs_inittable) then
  1089. begin
  1090. procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
  1091. reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
  1092. cg.g_initialize(list,aktprocdef.rettype.def,href,ret_in_param(aktprocdef.rettype.def));
  1093. end;
  1094. { initialisize local data like ansistrings }
  1095. case aktprocdef.proctypeoption of
  1096. potype_unitinit:
  1097. begin
  1098. { using current_module.globalsymtable is hopefully }
  1099. { more robust than symtablestack and symtablestack.next }
  1100. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1101. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1102. end;
  1103. { units have seperate code for initilization and finalization }
  1104. potype_unitfinalize: ;
  1105. else
  1106. aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
  1107. end;
  1108. { initialisizes temp. ansi/wide string data }
  1109. inittempvariables(list);
  1110. { generate copies of call by value parameters }
  1111. if not(po_assembler in aktprocdef.procoptions) and
  1112. not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_palmossyscall,pocall_system]) then
  1113. aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
  1114. if assigned( aktprocdef.parast) then
  1115. aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
  1116. if (not inlined) then
  1117. begin
  1118. { call startup helpers from main program }
  1119. if (aktprocdef.proctypeoption=potype_proginit) then
  1120. begin
  1121. { initialize profiling for win32 }
  1122. if (target_info.target in [target_I386_WIN32,target_I386_wdosx]) and
  1123. (cs_profile in aktmoduleswitches) then
  1124. cg.a_call_name(list,'__monstartup');
  1125. { add local threadvars in units (only if needed because not all platforms
  1126. have threadvar support) }
  1127. if have_local_threadvars then
  1128. cg.a_call_name(list,'FPC_INITIALIZELOCALTHREADVARS');
  1129. { add global threadvars }
  1130. p:=symtablestack;
  1131. while assigned(p) do
  1132. begin
  1133. p.foreach_static({$ifndef TP}@{$endif}initialize_threadvar,list);
  1134. p:=p.next;
  1135. end;
  1136. { initialize units }
  1137. cg.a_call_name(list,'FPC_INITIALIZEUNITS');
  1138. end;
  1139. { do we need an exception frame because of ansi/widestrings/interfaces ? }
  1140. if ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
  1141. { but it's useless in init/final code of units }
  1142. not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
  1143. begin
  1144. include(rg.usedinproc,accumulator);
  1145. { allocate exception frame buffer }
  1146. cg.a_op_const_reg(list,OP_SUB,36,STACK_POINTER_REG);
  1147. tmpreg:=rg.getaddressregister(list);
  1148. cg.a_load_reg_reg(list,OS_ADDR,STACK_POINTER_REG,tmpreg);
  1149. reference_reset_base(tempbuf,tmpreg,0);
  1150. cg.g_push_exception(list,tempbuf,1,aktexitlabel);
  1151. reference_release(list,tempbuf);
  1152. { probably we've to reload self here }
  1153. cg.g_maybe_loadself(list);
  1154. end;
  1155. {$ifdef GDB}
  1156. if (cs_debuginfo in aktmoduleswitches) then
  1157. list.concat(Tai_force_line.Create);
  1158. {$endif GDB}
  1159. end;
  1160. if inlined then
  1161. load_regvars(list,nil);
  1162. end;
  1163. procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe,inlined:boolean);
  1164. var
  1165. {$ifdef GDB}
  1166. stabsendlabel : tasmlabel;
  1167. mangled_length : longint;
  1168. p : pchar;
  1169. st : string[2];
  1170. {$endif GDB}
  1171. okexitlabel,
  1172. noreraiselabel,nodestroycall : tasmlabel;
  1173. tmpreg : tregister;
  1174. href : treference;
  1175. usesacc,
  1176. usesacchi,
  1177. usesself : boolean;
  1178. pd : tprocdef;
  1179. begin
  1180. if aktexit2label.is_used and
  1181. ((procinfo^.flags and (pi_needs_implicit_finally or pi_uses_exceptions)) <> 0) then
  1182. begin
  1183. cg.a_jmp_always(list,aktexitlabel);
  1184. cg.a_label(list,aktexit2label);
  1185. handle_fast_exit_return_value(list);
  1186. end;
  1187. if aktexitlabel.is_used then
  1188. list.concat(Tai_label.Create(aktexitlabel));
  1189. cleanup_regvars(list);
  1190. { call the destructor help procedure }
  1191. if (aktprocdef.proctypeoption=potype_destructor) and
  1192. assigned(procinfo^._class) then
  1193. cg.g_call_destructor_helper(list);
  1194. { finalize temporary data }
  1195. finalizetempvariables(list);
  1196. { finalize local data like ansistrings}
  1197. case aktprocdef.proctypeoption of
  1198. potype_unitfinalize:
  1199. begin
  1200. { using current_module.globalsymtable is hopefully }
  1201. { more robust than symtablestack and symtablestack.next }
  1202. tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1203. tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1204. end;
  1205. { units have seperate code for initialization and finalization }
  1206. potype_unitinit: ;
  1207. else
  1208. aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
  1209. end;
  1210. { finalize paras data }
  1211. if assigned(aktprocdef.parast) then
  1212. aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
  1213. { do we need to handle exceptions because of ansi/widestrings ? }
  1214. if not inlined and
  1215. ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
  1216. { but it's useless in init/final code of units }
  1217. not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
  1218. begin
  1219. { the exception helper routines modify all registers }
  1220. aktprocdef.usedregisters:=all_registers;
  1221. getlabel(noreraiselabel);
  1222. cg.g_pop_exception(list,noreraiselabel);
  1223. if (aktprocdef.proctypeoption=potype_constructor) then
  1224. begin
  1225. if assigned(procinfo^._class) then
  1226. begin
  1227. pd:=procinfo^._class.searchdestructor;
  1228. if assigned(pd) then
  1229. begin
  1230. getlabel(nodestroycall);
  1231. reference_reset_base(href,procinfo^.framepointer,procinfo^.selfpointer_offset);
  1232. cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nodestroycall);
  1233. if is_class(procinfo^._class) then
  1234. begin
  1235. cg.a_param_const(list,OS_INT,1,2);
  1236. cg.a_param_reg(list,OS_ADDR,self_pointer_reg,1);
  1237. end
  1238. else if is_object(procinfo^._class) then
  1239. begin
  1240. cg.a_param_reg(list,OS_ADDR,self_pointer_reg,2);
  1241. reference_reset_symbol(href,newasmsymbol(procinfo^._class.vmt_mangledname),0);
  1242. cg.a_paramaddr_ref(list,href,1);
  1243. end
  1244. else
  1245. Internalerror(200006164);
  1246. if (po_virtualmethod in pd.procoptions) then
  1247. begin
  1248. reference_reset_base(href,self_pointer_reg,0);
  1249. tmpreg:=cg.get_scratch_reg_address(list);
  1250. cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
  1251. reference_reset_base(href,tmpreg,procinfo^._class.vmtmethodoffset(pd.extnumber));
  1252. cg.free_scratch_reg(list,tmpreg);
  1253. cg.a_call_ref(list,href);
  1254. end
  1255. else
  1256. cg.a_call_name(list,pd.mangledname);
  1257. { not necessary because the result is never assigned in the
  1258. case of an exception (FK) }
  1259. cg.a_label(list,nodestroycall);
  1260. end;
  1261. end
  1262. end
  1263. else
  1264. begin
  1265. { no constructor }
  1266. { must be the return value finalized before reraising the exception? }
  1267. if (not is_void(aktprocdef.rettype.def)) and
  1268. (aktprocdef.rettype.def.needs_inittable) and
  1269. ((aktprocdef.rettype.def.deftype<>objectdef) or
  1270. not is_class(aktprocdef.rettype.def)) then
  1271. begin
  1272. reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
  1273. cg.g_finalize(list,aktprocdef.rettype.def,href,ret_in_param(aktprocdef.rettype.def));
  1274. end;
  1275. end;
  1276. cg.a_call_name(list,'FPC_RERAISE');
  1277. cg.a_label(list,noreraiselabel);
  1278. end;
  1279. { call __EXIT for main program }
  1280. if (not DLLsource) and
  1281. (not inlined) and
  1282. (aktprocdef.proctypeoption=potype_proginit) then
  1283. cg.a_call_name(list,'FPC_DO_EXIT');
  1284. { handle return value, this is not done for assembler routines when
  1285. they didn't reference the result variable }
  1286. usesacc:=false;
  1287. usesacchi:=false;
  1288. usesself:=false;
  1289. if not(po_assembler in aktprocdef.procoptions) or
  1290. (assigned(aktprocdef.funcretsym) and
  1291. (tfuncretsym(aktprocdef.funcretsym).refcount>1)) then
  1292. begin
  1293. if (aktprocdef.proctypeoption<>potype_constructor) then
  1294. handle_return_value(list,inlined,usesacc,usesacchi)
  1295. else
  1296. begin
  1297. { successful constructor deletes the zero flag }
  1298. { and returns self in eax }
  1299. { eax must be set to zero if the allocation failed !!! }
  1300. getlabel(okexitlabel);
  1301. cg.a_jmp_always(list,okexitlabel);
  1302. cg.a_label(list,faillabel);
  1303. cg.g_call_fail_helper(list);
  1304. cg.a_label(list,okexitlabel);
  1305. { for classes this is done after the call to }
  1306. { AfterConstruction }
  1307. if is_object(procinfo^._class) then
  1308. begin
  1309. cg.a_reg_alloc(list,accumulator);
  1310. cg.a_load_reg_reg(list,OS_ADDR,self_pointer_reg,accumulator);
  1311. usesacc:=true;
  1312. end;
  1313. {$ifdef i386}
  1314. list.concat(taicpu.op_reg_reg(A_TEST,S_L,R_ESI,R_ESI));
  1315. {$else}
  1316. {$warning constructor returns in flags for i386}
  1317. {$endif i386}
  1318. usesself:=true;
  1319. end;
  1320. end;
  1321. if aktexit2label.is_used and not aktexit2label.is_set then
  1322. cg.a_label(list,aktexit2label);
  1323. {$ifdef GDB}
  1324. if ((cs_debuginfo in aktmoduleswitches) and not inlined) then
  1325. begin
  1326. getlabel(stabsendlabel);
  1327. cg.a_label(list,stabsendlabel);
  1328. end;
  1329. {$endif GDB}
  1330. { for the save all registers we can simply use a pusha,popa which
  1331. push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
  1332. if (po_saveregisters in aktprocdef.procoptions) then
  1333. cg.g_restore_all_registers(list,usesself,usesacc,usesacchi)
  1334. else
  1335. { should we restore edi ? }
  1336. if (po_savestdregs in aktprocdef.procoptions) then
  1337. cg.g_restore_standard_registers(list);
  1338. { remove stackframe }
  1339. if not inlined then
  1340. begin
  1341. if (not nostackframe) then
  1342. cg.g_restore_frame_pointer(list)
  1343. else
  1344. if (tg.gettempsize<>0) then
  1345. cg.a_op_const_reg(list,OP_ADD,tg.gettempsize,STACK_POINTER_REG);
  1346. end;
  1347. { at last, the return is generated }
  1348. if not inlined then
  1349. begin
  1350. if (po_interrupt in aktprocdef.procoptions) then
  1351. cg.g_interrupt_stackframe_exit(list,usesself,usesacc,usesacchi)
  1352. else
  1353. cg.g_return_from_proc(list,parasize);
  1354. end;
  1355. if not inlined then
  1356. list.concat(Tai_symbol_end.Createname(aktprocdef.mangledname));
  1357. {$ifdef GDB}
  1358. if (cs_debuginfo in aktmoduleswitches) and not inlined then
  1359. begin
  1360. if assigned(procinfo^._class) then
  1361. if (not assigned(procinfo^.parent) or
  1362. not assigned(procinfo^.parent^._class)) then
  1363. begin
  1364. if (po_classmethod in aktprocdef.procoptions) or
  1365. ((po_virtualmethod in aktprocdef.procoptions) and
  1366. (potype_constructor=aktprocdef.proctypeoption)) or
  1367. (po_staticmethod in aktprocdef.procoptions) then
  1368. begin
  1369. list.concat(Tai_stabs.Create(strpnew(
  1370. '"pvmt:p'+tstoreddef(pvmttype.def).numberstring+'",'+
  1371. tostr(N_tsym)+',0,0,'+tostr(procinfo^.selfpointer_offset))));
  1372. end
  1373. else
  1374. begin
  1375. if not(is_class(procinfo^._class)) then
  1376. st:='v'
  1377. else
  1378. st:='p';
  1379. list.concat(Tai_stabs.Create(strpnew(
  1380. '"$t:'+st+procinfo^._class.numberstring+'",'+
  1381. tostr(N_tsym)+',0,0,'+tostr(procinfo^.selfpointer_offset))));
  1382. end;
  1383. end
  1384. else
  1385. begin
  1386. if not is_class(procinfo^._class) then
  1387. st:='*'
  1388. else
  1389. st:='';
  1390. list.concat(Tai_stabs.Create(strpnew(
  1391. '"$t:r'+st+procinfo^._class.numberstring+'",'+
  1392. tostr(N_RSYM)+',0,0,'+tostr(GDB_i386index[SELF_POINTER_REG]))));
  1393. end;
  1394. { define calling EBP as pseudo local var PM }
  1395. { this enables test if the function is a local one !! }
  1396. if assigned(procinfo^.parent) and (lexlevel>normal_function_level) then
  1397. list.concat(Tai_stabs.Create(strpnew(
  1398. '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
  1399. tostr(N_LSYM)+',0,0,'+tostr(procinfo^.framepointer_offset))));
  1400. if (not is_void(aktprocdef.rettype.def)) then
  1401. begin
  1402. if ret_in_param(aktprocdef.rettype.def) then
  1403. list.concat(Tai_stabs.Create(strpnew(
  1404. '"'+aktprocsym.name+':X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
  1405. tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))))
  1406. else
  1407. list.concat(Tai_stabs.Create(strpnew(
  1408. '"'+aktprocsym.name+':X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
  1409. tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))));
  1410. if (m_result in aktmodeswitches) then
  1411. if ret_in_param(aktprocdef.rettype.def) then
  1412. list.concat(Tai_stabs.Create(strpnew(
  1413. '"RESULT:X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
  1414. tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))))
  1415. else
  1416. list.concat(Tai_stabs.Create(strpnew(
  1417. '"RESULT:X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
  1418. tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))));
  1419. end;
  1420. mangled_length:=length(aktprocdef.mangledname);
  1421. getmem(p,2*mangled_length+50);
  1422. strpcopy(p,'192,0,0,');
  1423. strpcopy(strend(p),aktprocdef.mangledname);
  1424. if (target_info.use_function_relative_addresses) then
  1425. begin
  1426. strpcopy(strend(p),'-');
  1427. strpcopy(strend(p),aktprocdef.mangledname);
  1428. end;
  1429. list.concat(Tai_stabn.Create(strnew(p)));
  1430. {List.concat(Tai_stabn.Create(strpnew('192,0,0,'
  1431. +aktprocdef.mangledname))));
  1432. p[0]:='2';p[1]:='2';p[2]:='4';
  1433. strpcopy(strend(p),'_end');}
  1434. strpcopy(p,'224,0,0,'+stabsendlabel.name);
  1435. if (target_info.use_function_relative_addresses) then
  1436. begin
  1437. strpcopy(strend(p),'-');
  1438. strpcopy(strend(p),aktprocdef.mangledname);
  1439. end;
  1440. list.concatlist(withdebuglist);
  1441. list.concat(Tai_stabn.Create(strnew(p)));
  1442. { strpnew('224,0,0,'
  1443. +aktprocdef.mangledname+'_end'))));}
  1444. freemem(p,2*mangled_length+50);
  1445. end;
  1446. {$endif GDB}
  1447. if inlined then
  1448. cleanup_regvars(list);
  1449. end;
  1450. procedure genimplicitunitinit(list : TAAsmoutput);
  1451. begin
  1452. { using current_module.globalsymtable is hopefully }
  1453. { more robust than symtablestack and symtablestack.next }
  1454. tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
  1455. tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
  1456. list.insert(Tai_symbol.Createname_global('INIT$$'+current_module.modulename^,0));
  1457. list.insert(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_init',0));
  1458. {$ifdef GDB}
  1459. if (cs_debuginfo in aktmoduleswitches) and
  1460. target_info.use_function_relative_addresses then
  1461. list.insert(Tai_stab_function_name.Create(strpnew('INIT$$'+current_module.modulename^)));
  1462. {$endif GDB}
  1463. cg.g_return_from_proc(list,0);
  1464. end;
  1465. procedure genimplicitunitfinal(list : TAAsmoutput);
  1466. begin
  1467. { using current_module.globalsymtable is hopefully }
  1468. { more robust than symtablestack and symtablestack.next }
  1469. tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
  1470. tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
  1471. list.insert(Tai_symbol.Createname_global('FINALIZE$$'+current_module.modulename^,0));
  1472. list.insert(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_finalize',0));
  1473. {$ifdef GDB}
  1474. if (cs_debuginfo in aktmoduleswitches) and
  1475. target_info.use_function_relative_addresses then
  1476. list.insert(Tai_stab_function_name.Create(strpnew('FINALIZE$$'+current_module.modulename^)));
  1477. {$endif GDB}
  1478. cg.g_return_from_proc(list,0);
  1479. end;
  1480. end.
  1481. {
  1482. $Log$
  1483. Revision 1.17 2002-05-20 13:30:40 carl
  1484. * bugfix of hdisponen (base must be set, not index)
  1485. * more portability fixes
  1486. Revision 1.16 2002/05/18 13:34:09 peter
  1487. * readded missing revisions
  1488. Revision 1.15 2002/05/16 19:46:37 carl
  1489. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1490. + try to fix temp allocation (still in ifdef)
  1491. + generic constructor calls
  1492. + start of tassembler / tmodulebase class cleanup
  1493. Revision 1.13 2002/05/13 19:54:37 peter
  1494. * removed n386ld and n386util units
  1495. * maybe_save/maybe_restore added instead of the old maybe_push
  1496. Revision 1.12 2002/05/12 19:58:36 carl
  1497. * some small portability fixes
  1498. Revision 1.11 2002/05/12 16:53:07 peter
  1499. * moved entry and exitcode to ncgutil and cgobj
  1500. * foreach gets extra argument for passing local data to the
  1501. iterator function
  1502. * -CR checks also class typecasts at runtime by changing them
  1503. into as
  1504. * fixed compiler to cycle with the -CR option
  1505. * fixed stabs with elf writer, finally the global variables can
  1506. be watched
  1507. * removed a lot of routines from cga unit and replaced them by
  1508. calls to cgobj
  1509. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1510. u32bit then the other is typecasted also to u32bit without giving
  1511. a rangecheck warning/error.
  1512. * fixed pascal calling method with reversing also the high tree in
  1513. the parast, detected by tcalcst3 test
  1514. Revision 1.10 2002/04/21 19:02:03 peter
  1515. * removed newn and disposen nodes, the code is now directly
  1516. inlined from pexpr
  1517. * -an option that will write the secondpass nodes to the .s file, this
  1518. requires EXTDEBUG define to actually write the info
  1519. * fixed various internal errors and crashes due recent code changes
  1520. Revision 1.9 2002/04/21 15:24:38 carl
  1521. + a_jmp_cond -> a_jmp_always (a_jmp_cond is NOT portable)
  1522. + changeregsize -> rg.makeregsize
  1523. Revision 1.8 2002/04/19 15:39:34 peter
  1524. * removed some more routines from cga
  1525. * moved location_force_reg/mem to ncgutil
  1526. * moved arrayconstructnode secondpass to ncgld
  1527. Revision 1.7 2002/04/15 18:58:47 carl
  1528. + target_info.size_of_pointer -> pointer_Size
  1529. Revision 1.6 2002/04/06 18:10:42 jonas
  1530. * several powerpc-related additions and fixes
  1531. Revision 1.5 2002/04/04 19:05:57 peter
  1532. * removed unused units
  1533. * use tlocation.size in cg.a_*loc*() routines
  1534. Revision 1.4 2002/04/02 17:11:28 peter
  1535. * tlocation,treference update
  1536. * LOC_CONSTANT added for better constant handling
  1537. * secondadd splitted in multiple routines
  1538. * location_force_reg added for loading a location to a register
  1539. of a specified size
  1540. * secondassignment parses now first the right and then the left node
  1541. (this is compatible with Kylix). This saves a lot of push/pop especially
  1542. with string operations
  1543. * adapted some routines to use the new cg methods
  1544. Revision 1.3 2002/03/31 20:26:34 jonas
  1545. + a_loadfpu_* and a_loadmm_* methods in tcg
  1546. * register allocation is now handled by a class and is mostly processor
  1547. independent (+rgobj.pas and i386/rgcpu.pas)
  1548. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  1549. * some small improvements and fixes to the optimizer
  1550. * some register allocation fixes
  1551. * some fpuvaroffset fixes in the unary minus node
  1552. * push/popusedregisters is now called rg.save/restoreusedregisters and
  1553. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  1554. also better optimizable)
  1555. * fixed and optimized register saving/restoring for new/dispose nodes
  1556. * LOC_FPU locations now also require their "register" field to be set to
  1557. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  1558. - list field removed of the tnode class because it's not used currently
  1559. and can cause hard-to-find bugs
  1560. Revision 1.2 2002/03/04 19:10:11 peter
  1561. * removed compiler warnings
  1562. }