ncgutil.pas 66 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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(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(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.15 2002-05-16 19:46:37 carl
  1484. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1485. + try to fix temp allocation (still in ifdef)
  1486. + generic constructor calls
  1487. + start of tassembler / tmodulebase class cleanup
  1488. Revision 1.13 2002/05/13 19:54:37 peter
  1489. * removed n386ld and n386util units
  1490. * maybe_save/maybe_restore added instead of the old maybe_push
  1491. Revision 1.12 2002/05/12 19:58:36 carl
  1492. * some small portability fixes
  1493. Revision 1.11 2002/05/12 16:53:07 peter
  1494. * moved entry and exitcode to ncgutil and cgobj
  1495. * foreach gets extra argument for passing local data to the
  1496. iterator function
  1497. * -CR checks also class typecasts at runtime by changing them
  1498. into as
  1499. * fixed compiler to cycle with the -CR option
  1500. * fixed stabs with elf writer, finally the global variables can
  1501. be watched
  1502. * removed a lot of routines from cga unit and replaced them by
  1503. calls to cgobj
  1504. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1505. u32bit then the other is typecasted also to u32bit without giving
  1506. a rangecheck warning/error.
  1507. * fixed pascal calling method with reversing also the high tree in
  1508. the parast, detected by tcalcst3 test
  1509. Revision 1.10 2002/04/21 19:02:03 peter
  1510. * removed newn and disposen nodes, the code is now directly
  1511. inlined from pexpr
  1512. * -an option that will write the secondpass nodes to the .s file, this
  1513. requires EXTDEBUG define to actually write the info
  1514. * fixed various internal errors and crashes due recent code changes
  1515. Revision 1.9 2002/04/21 15:24:38 carl
  1516. + a_jmp_cond -> a_jmp_always (a_jmp_cond is NOT portable)
  1517. + changeregsize -> rg.makeregsize
  1518. Revision 1.8 2002/04/19 15:39:34 peter
  1519. * removed some more routines from cga
  1520. * moved location_force_reg/mem to ncgutil
  1521. * moved arrayconstructnode secondpass to ncgld
  1522. Revision 1.7 2002/04/15 18:58:47 carl
  1523. + target_info.size_of_pointer -> pointer_Size
  1524. Revision 1.6 2002/04/06 18:10:42 jonas
  1525. * several powerpc-related additions and fixes
  1526. Revision 1.5 2002/04/04 19:05:57 peter
  1527. * removed unused units
  1528. * use tlocation.size in cg.a_*loc*() routines
  1529. Revision 1.4 2002/04/02 17:11:28 peter
  1530. * tlocation,treference update
  1531. * LOC_CONSTANT added for better constant handling
  1532. * secondadd splitted in multiple routines
  1533. * location_force_reg added for loading a location to a register
  1534. of a specified size
  1535. * secondassignment parses now first the right and then the left node
  1536. (this is compatible with Kylix). This saves a lot of push/pop especially
  1537. with string operations
  1538. * adapted some routines to use the new cg methods
  1539. Revision 1.3 2002/03/31 20:26:34 jonas
  1540. + a_loadfpu_* and a_loadmm_* methods in tcg
  1541. * register allocation is now handled by a class and is mostly processor
  1542. independent (+rgobj.pas and i386/rgcpu.pas)
  1543. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  1544. * some small improvements and fixes to the optimizer
  1545. * some register allocation fixes
  1546. * some fpuvaroffset fixes in the unary minus node
  1547. * push/popusedregisters is now called rg.save/restoreusedregisters and
  1548. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  1549. also better optimizable)
  1550. * fixed and optimized register saving/restoring for new/dispose nodes
  1551. * LOC_FPU locations now also require their "register" field to be set to
  1552. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  1553. - list field removed of the tnode class because it's not used currently
  1554. and can cause hard-to-find bugs
  1555. Revision 1.2 2002/03/04 19:10:11 peter
  1556. * removed compiler warnings
  1557. Revision 1.1 2001/12/30 17:24:48 jonas
  1558. * range checking is now processor independent (part in cgobj,
  1559. part in cg64f32) and should work correctly again (it needed
  1560. some changes after the changes of the low and high of
  1561. tordef's to int64)
  1562. * maketojumpbool() is now processor independent (in ncgutil)
  1563. * getregister32 is now called getregisterint
  1564. }