ncginl.pas 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere
  4. Generate generic inline nodes
  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 ncginl;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node,ninl;
  23. type
  24. tcginlinenode = class(tinlinenode)
  25. procedure pass_2;override;
  26. procedure second_assert;virtual;
  27. procedure second_sizeoftypeof;virtual;
  28. procedure second_length;virtual;
  29. procedure second_predsucc;virtual;
  30. procedure second_incdec;virtual;
  31. procedure second_typeinfo;virtual;
  32. procedure second_includeexclude;virtual;
  33. procedure second_pi; virtual;
  34. procedure second_arctan_real; virtual;
  35. procedure second_abs_real; virtual;
  36. procedure second_sqr_real; virtual;
  37. procedure second_sqrt_real; virtual;
  38. procedure second_ln_real; virtual;
  39. procedure second_cos_real; virtual;
  40. procedure second_sin_real; virtual;
  41. procedure second_assigned; virtual;
  42. procedure second_prefetch; virtual;
  43. end;
  44. implementation
  45. uses
  46. globtype,systems,
  47. cutils,verbose,globals,fmodule,
  48. symconst,symdef,defutil,symsym,
  49. aasmbase,aasmtai,aasmcpu,
  50. cgbase,pass_1,pass_2,
  51. cpuinfo,cpubase,paramgr,procinfo,
  52. nbas,ncon,ncal,ncnv,nld,
  53. tgobj,ncgutil,
  54. cgutils,cgobj,
  55. rgobj
  56. {$ifndef cpu64bit}
  57. ,cg64f32
  58. {$endif cpu64bit}
  59. ;
  60. {*****************************************************************************
  61. TCGINLINENODE
  62. *****************************************************************************}
  63. procedure tcginlinenode.pass_2;
  64. begin
  65. location_reset(location,LOC_VOID,OS_NO);
  66. case inlinenumber of
  67. in_assert_x_y:
  68. begin
  69. second_Assert;
  70. end;
  71. in_sizeof_x,
  72. in_typeof_x :
  73. begin
  74. second_SizeofTypeOf;
  75. end;
  76. in_length_x :
  77. begin
  78. second_Length;
  79. end;
  80. in_pred_x,
  81. in_succ_x:
  82. begin
  83. second_PredSucc;
  84. end;
  85. in_dec_x,
  86. in_inc_x :
  87. begin
  88. second_IncDec;
  89. end;
  90. in_typeinfo_x:
  91. begin
  92. second_TypeInfo;
  93. end;
  94. in_include_x_y,
  95. in_exclude_x_y:
  96. begin
  97. second_IncludeExclude;
  98. end;
  99. in_pi:
  100. begin
  101. second_pi;
  102. end;
  103. in_sin_extended:
  104. begin
  105. second_sin_real;
  106. end;
  107. in_arctan_extended:
  108. begin
  109. second_arctan_real;
  110. end;
  111. in_abs_extended:
  112. begin
  113. second_abs_real;
  114. end;
  115. in_sqr_extended:
  116. begin
  117. second_sqr_real;
  118. end;
  119. in_sqrt_extended:
  120. begin
  121. second_sqrt_real;
  122. end;
  123. in_ln_extended:
  124. begin
  125. second_ln_real;
  126. end;
  127. in_cos_extended:
  128. begin
  129. second_cos_real;
  130. end;
  131. in_prefetch_var:
  132. begin
  133. second_prefetch;
  134. end;
  135. in_assigned_x:
  136. begin
  137. second_assigned;
  138. end;
  139. {$ifdef SUPPORT_MMX}
  140. in_mmx_pcmpeqb..in_mmx_pcmpgtw:
  141. begin
  142. location_reset(location,LOC_MMXREGISTER,OS_NO);
  143. if left.location.loc=LOC_REGISTER then
  144. begin
  145. {!!!!!!!}
  146. end
  147. else if tcallparanode(left).left.location.loc=LOC_REGISTER then
  148. begin
  149. {!!!!!!!}
  150. end
  151. else
  152. begin
  153. {!!!!!!!}
  154. end;
  155. end;
  156. {$endif SUPPORT_MMX}
  157. else internalerror(9);
  158. end;
  159. end;
  160. {*****************************************************************************
  161. ASSERT GENERIC HANDLING
  162. *****************************************************************************}
  163. procedure tcginlinenode.second_Assert;
  164. var
  165. hp2 : tstringconstnode;
  166. otlabel,oflabel : tasmlabel;
  167. paraloc1,paraloc2,
  168. paraloc3,paraloc4 : tparalocation;
  169. begin
  170. { the node should be removed in the firstpass }
  171. if not (cs_do_assertion in aktlocalswitches) then
  172. internalerror(7123458);
  173. paraloc1:=paramanager.getintparaloc(pocall_default,1);
  174. paraloc2:=paramanager.getintparaloc(pocall_default,2);
  175. paraloc3:=paramanager.getintparaloc(pocall_default,3);
  176. paraloc4:=paramanager.getintparaloc(pocall_default,4);
  177. otlabel:=truelabel;
  178. oflabel:=falselabel;
  179. objectlibrary.getlabel(truelabel);
  180. objectlibrary.getlabel(falselabel);
  181. secondpass(tcallparanode(left).left);
  182. maketojumpbool(exprasmlist,tcallparanode(left).left,lr_load_regvars);
  183. cg.a_label(exprasmlist,falselabel);
  184. { erroraddr }
  185. paramanager.allocparaloc(exprasmlist,paraloc4);
  186. cg.a_param_reg(exprasmlist,OS_ADDR,NR_FRAME_POINTER_REG,paraloc4);
  187. { lineno }
  188. paramanager.allocparaloc(exprasmlist,paraloc3);
  189. cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paraloc3);
  190. { filename string }
  191. hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring);
  192. firstpass(tnode(hp2));
  193. secondpass(tnode(hp2));
  194. if codegenerror then
  195. exit;
  196. paramanager.allocparaloc(exprasmlist,paraloc2);
  197. cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paraloc2);
  198. hp2.free;
  199. { push msg }
  200. secondpass(tcallparanode(tcallparanode(left).right).left);
  201. paramanager.allocparaloc(exprasmlist,paraloc1);
  202. cg.a_paramaddr_ref(exprasmlist,tcallparanode(tcallparanode(left).right).left.location.reference,paraloc1);
  203. { call }
  204. paramanager.freeparaloc(exprasmlist,paraloc1);
  205. paramanager.freeparaloc(exprasmlist,paraloc2);
  206. paramanager.freeparaloc(exprasmlist,paraloc3);
  207. paramanager.freeparaloc(exprasmlist,paraloc4);
  208. cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  209. cg.a_call_name(exprasmlist,'FPC_ASSERT');
  210. cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  211. cg.a_label(exprasmlist,truelabel);
  212. truelabel:=otlabel;
  213. falselabel:=oflabel;
  214. end;
  215. {*****************************************************************************
  216. SIZEOF / TYPEOF GENERIC HANDLING
  217. *****************************************************************************}
  218. { second_handle_ the sizeof and typeof routines }
  219. procedure tcginlinenode.second_SizeOfTypeOf;
  220. var
  221. href,
  222. hrefvmt : treference;
  223. hregister : tregister;
  224. begin
  225. if inlinenumber=in_sizeof_x then
  226. location_reset(location,LOC_REGISTER,OS_INT)
  227. else
  228. location_reset(location,LOC_REGISTER,OS_ADDR);
  229. { for both cases load vmt }
  230. if left.nodetype=typen then
  231. begin
  232. hregister:=cg.getaddressregister(exprasmlist);
  233. reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname,AB_EXTERNAL,AT_DATA),0);
  234. cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
  235. end
  236. else
  237. begin
  238. secondpass(left);
  239. location_release(exprasmlist,left.location);
  240. hregister:=cg.getaddressregister(exprasmlist);
  241. { handle self inside a method of a class }
  242. case left.location.loc of
  243. LOC_CREGISTER,
  244. LOC_REGISTER :
  245. begin
  246. if (left.resulttype.def.deftype=classrefdef) or
  247. (po_staticmethod in current_procinfo.procdef.procoptions) then
  248. cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.register,hregister)
  249. else
  250. begin
  251. { load VMT pointer }
  252. reference_reset_base(hrefvmt,left.location.register,tobjectdef(left.resulttype.def).vmt_offset);
  253. cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,hrefvmt,hregister);
  254. end
  255. end;
  256. LOC_REFERENCE,
  257. LOC_CREFERENCE :
  258. begin
  259. if is_class(left.resulttype.def) then
  260. begin
  261. { deref class }
  262. cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,hregister);
  263. cg.g_maybe_testself(exprasmlist,hregister);
  264. { load VMT pointer }
  265. reference_reset_base(hrefvmt,hregister,tobjectdef(left.resulttype.def).vmt_offset);
  266. cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,hrefvmt,hregister);
  267. end
  268. else
  269. begin
  270. { load VMT pointer, but not for classrefdefs }
  271. if (left.resulttype.def.deftype=objectdef) then
  272. inc(left.location.reference.offset,tobjectdef(left.resulttype.def).vmt_offset);
  273. cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,hregister);
  274. end;
  275. end;
  276. else
  277. internalerror(200301301);
  278. end;
  279. end;
  280. { in sizeof load size }
  281. if inlinenumber=in_sizeof_x then
  282. begin
  283. reference_reset_base(href,hregister,0);
  284. cg.ungetregister(exprasmlist,hregister);
  285. hregister:=cg.getintregister(exprasmlist,OS_INT);
  286. cg.a_load_ref_reg(exprasmlist,OS_INT,OS_INT,href,hregister);
  287. end;
  288. location.register:=hregister;
  289. end;
  290. {*****************************************************************************
  291. LENGTH GENERIC HANDLING
  292. *****************************************************************************}
  293. procedure tcginlinenode.second_Length;
  294. var
  295. lengthlab : tasmlabel;
  296. hregister : tregister;
  297. href : treference;
  298. begin
  299. secondpass(left);
  300. if is_shortstring(left.resulttype.def) then
  301. begin
  302. location_copy(location,left.location);
  303. location.size:=OS_8;
  304. end
  305. else
  306. begin
  307. { length in ansi strings is at offset sizeof(aint)*2 }
  308. location_force_reg(exprasmlist,left.location,OS_ADDR,false);
  309. objectlibrary.getlabel(lengthlab);
  310. cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,left.location.register,lengthlab);
  311. reference_reset_base(href,left.location.register,-sizeof(aint)*2);
  312. hregister:=cg.makeregsize(exprasmlist,left.location.register,OS_INT);
  313. cg.a_load_ref_reg(exprasmlist,OS_INT,OS_INT,href,hregister);
  314. cg.a_label(exprasmlist,lengthlab);
  315. location_reset(location,LOC_REGISTER,OS_INT);
  316. location.register:=hregister;
  317. end;
  318. end;
  319. {*****************************************************************************
  320. PRED/SUCC GENERIC HANDLING
  321. *****************************************************************************}
  322. procedure tcginlinenode.second_PredSucc;
  323. var
  324. cgsize : TCGSize;
  325. cgop : topcg;
  326. begin
  327. secondpass(left);
  328. if inlinenumber=in_pred_x then
  329. cgop:=OP_SUB
  330. else
  331. cgop:=OP_ADD;
  332. cgsize:=def_cgsize(resulttype.def);
  333. { we need a value in a register }
  334. location_copy(location,left.location);
  335. location_force_reg(exprasmlist,location,cgsize,false);
  336. {$ifndef cpu64bit}
  337. if cgsize in [OS_64,OS_S64] then
  338. cg64.a_op64_const_reg(exprasmlist,cgop,1,location.register64)
  339. else
  340. {$endif cpu64bit}
  341. cg.a_op_const_reg(exprasmlist,cgop,location.size,1,location.register);
  342. cg.g_rangecheck(exprasmlist,location,resulttype.def,resulttype.def);
  343. end;
  344. {*****************************************************************************
  345. INC/DEC GENERIC HANDLING
  346. *****************************************************************************}
  347. procedure tcginlinenode.second_IncDec;
  348. const
  349. addsubop:array[in_inc_x..in_dec_x] of TOpCG=(OP_ADD,OP_SUB);
  350. var
  351. addvalue : TConstExprInt;
  352. addconstant : boolean;
  353. {$ifndef cpu64bit}
  354. hregisterhi,
  355. {$endif cpu64bit}
  356. hregister : tregister;
  357. cgsize : tcgsize;
  358. begin
  359. { set defaults }
  360. addconstant:=true;
  361. { load first parameter, must be a reference }
  362. secondpass(tcallparanode(left).left);
  363. cgsize:=def_cgsize(tcallparanode(left).left.resulttype.def);
  364. { get addvalue }
  365. case tcallparanode(left).left.resulttype.def.deftype of
  366. orddef,
  367. enumdef :
  368. addvalue:=1;
  369. pointerdef :
  370. begin
  371. if is_void(tpointerdef(tcallparanode(left).left.resulttype.def).pointertype.def) then
  372. addvalue:=1
  373. else
  374. addvalue:=tpointerdef(tcallparanode(left).left.resulttype.def).pointertype.def.size;
  375. end;
  376. else
  377. internalerror(10081);
  378. end;
  379. { second_ argument specified?, must be a s32bit in register }
  380. if assigned(tcallparanode(left).right) then
  381. begin
  382. secondpass(tcallparanode(tcallparanode(left).right).left);
  383. { when constant, just multiply the addvalue }
  384. if is_constintnode(tcallparanode(tcallparanode(left).right).left) then
  385. addvalue:=addvalue*get_ordinal_value(tcallparanode(tcallparanode(left).right).left)
  386. else
  387. begin
  388. location_force_reg(exprasmlist,tcallparanode(tcallparanode(left).right).left.location,cgsize,addvalue<=1);
  389. hregister:=tcallparanode(tcallparanode(left).right).left.location.register;
  390. {$ifndef cpu64bit}
  391. hregisterhi:=tcallparanode(tcallparanode(left).right).left.location.registerhigh;
  392. {$endif cpu64bit}
  393. { insert multiply with addvalue if its >1 }
  394. if addvalue>1 then
  395. cg.a_op_const_reg(exprasmlist,OP_IMUL,cgsize,addvalue,hregister);
  396. addconstant:=false;
  397. end;
  398. end;
  399. { write the add instruction }
  400. if addconstant then
  401. begin
  402. {$ifndef cpu64bit}
  403. if cgsize in [OS_64,OS_S64] then
  404. cg64.a_op64_const_loc(exprasmlist,addsubop[inlinenumber],addvalue,tcallparanode(left).left.location)
  405. else
  406. {$endif cpu64bit}
  407. cg.a_op_const_loc(exprasmlist,addsubop[inlinenumber],
  408. addvalue,tcallparanode(left).left.location);
  409. end
  410. else
  411. begin
  412. {$ifndef cpu64bit}
  413. if cgsize in [OS_64,OS_S64] then
  414. cg64.a_op64_reg_loc(exprasmlist,addsubop[inlinenumber],
  415. joinreg64(hregister,hregisterhi),tcallparanode(left).left.location)
  416. else
  417. {$endif cpu64bit}
  418. cg.a_op_reg_loc(exprasmlist,addsubop[inlinenumber],
  419. hregister,tcallparanode(left).left.location);
  420. location_release(exprasmlist,tcallparanode(tcallparanode(left).right).left.location);
  421. end;
  422. location_release(exprasmlist,tcallparanode(left).left.location);
  423. cg.g_overflowcheck(exprasmlist,tcallparanode(left).left.location,tcallparanode(left).resulttype.def);
  424. cg.g_rangecheck(exprasmlist,tcallparanode(left).left.location,tcallparanode(left).left.resulttype.def,
  425. tcallparanode(left).left.resulttype.def);
  426. end;
  427. {*****************************************************************************
  428. TYPEINFO GENERIC HANDLING
  429. *****************************************************************************}
  430. procedure tcginlinenode.second_typeinfo;
  431. var
  432. href : treference;
  433. begin
  434. location_reset(location,LOC_REGISTER,OS_ADDR);
  435. location.register:=cg.getaddressregister(exprasmlist);
  436. reference_reset_symbol(href,tstoreddef(left.resulttype.def).get_rtti_label(fullrtti),0);
  437. cg.a_loadaddr_ref_reg(exprasmlist,href,location.register);
  438. end;
  439. {*****************************************************************************
  440. INCLUDE/EXCLUDE GENERIC HANDLING
  441. *****************************************************************************}
  442. procedure tcginlinenode.second_IncludeExclude;
  443. var
  444. bitsperop,l : longint;
  445. opsize : tcgsize;
  446. cgop : topcg;
  447. addrreg2,addrreg,
  448. hregister,hregister2: tregister;
  449. use_small : boolean;
  450. href : treference;
  451. begin
  452. opsize:=OS_32;
  453. bitsperop:=(8*tcgsize2size[opsize]);
  454. secondpass(tcallparanode(left).left);
  455. if tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn then
  456. begin
  457. { calculate bit position }
  458. l:=1 shl (tordconstnode(tcallparanode(tcallparanode(left).right).left).value mod bitsperop);
  459. { determine operator }
  460. if inlinenumber=in_include_x_y then
  461. cgop:=OP_OR
  462. else
  463. begin
  464. cgop:=OP_AND;
  465. l:=not(l);
  466. end;
  467. case tcallparanode(left).left.location.loc of
  468. LOC_REFERENCE :
  469. begin
  470. inc(tcallparanode(left).left.location.reference.offset,
  471. (tordconstnode(tcallparanode(tcallparanode(left).right).left).value div bitsperop)*tcgsize2size[opsize]);
  472. cg.a_op_const_ref(exprasmlist,cgop,opsize,l,tcallparanode(left).left.location.reference);
  473. location_release(exprasmlist,tcallparanode(left).left.location);
  474. end;
  475. LOC_CREGISTER :
  476. cg.a_op_const_reg(exprasmlist,cgop,tcallparanode(left).left.location.size,l,tcallparanode(left).left.location.register);
  477. else
  478. internalerror(200405021);
  479. end;
  480. end
  481. else
  482. begin
  483. use_small:=
  484. { set type }
  485. (tsetdef(tcallparanode(left).left.resulttype.def).settype=smallset)
  486. and
  487. { elemenut number between 1 and 32 }
  488. ((tcallparanode(tcallparanode(left).right).left.resulttype.def.deftype=orddef) and
  489. (torddef(tcallparanode(tcallparanode(left).right).left.resulttype.def).high<=32) or
  490. (tcallparanode(tcallparanode(left).right).left.resulttype.def.deftype=enumdef) and
  491. (tenumdef(tcallparanode(tcallparanode(left).right).left.resulttype.def).max<=32));
  492. { generate code for the element to set }
  493. secondpass(tcallparanode(tcallparanode(left).right).left);
  494. { bitnumber - which must be loaded into register }
  495. hregister:=cg.getintregister(exprasmlist,opsize);
  496. hregister2:=cg.getintregister(exprasmlist,opsize);
  497. cg.a_load_loc_reg(exprasmlist,opsize,
  498. tcallparanode(tcallparanode(left).right).left.location,hregister);
  499. if use_small then
  500. begin
  501. { hregister contains the bitnumber to add }
  502. cg.a_load_const_reg(exprasmlist, opsize, 1, hregister2);
  503. cg.a_op_reg_reg(exprasmlist, OP_SHL, opsize, hregister, hregister2);
  504. { possiblities :
  505. bitnumber : LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER
  506. set value : LOC_REFERENCE, LOC_REGISTER
  507. }
  508. { location of set }
  509. if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
  510. begin
  511. if inlinenumber=in_include_x_y then
  512. begin
  513. cg.a_op_reg_ref(exprasmlist, OP_OR, opsize, hregister2,
  514. tcallparanode(left).left.location.reference);
  515. end
  516. else
  517. begin
  518. cg.a_op_reg_reg(exprasmlist, OP_NOT, opsize, hregister2,hregister2);
  519. cg.a_op_reg_ref(exprasmlist, OP_AND, opsize, hregister2,
  520. tcallparanode(left).left.location.reference);
  521. end;
  522. end
  523. else
  524. internalerror(20020728);
  525. end
  526. else
  527. begin
  528. { possiblities :
  529. bitnumber : LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER
  530. set value : LOC_REFERENCE
  531. }
  532. { hregister contains the bitnumber (div 32 to get the correct offset) }
  533. { hregister contains the bitnumber to add }
  534. cg.a_op_const_reg_reg(exprasmlist, OP_SHR, opsize, 5, hregister,hregister2);
  535. cg.a_op_const_reg(exprasmlist, OP_SHL, opsize, 2, hregister2);
  536. addrreg:=cg.getaddressregister(exprasmlist);
  537. { we need an extra address register to be able to do an ADD operation }
  538. addrreg2:=cg.getaddressregister(exprasmlist);
  539. cg.a_load_reg_reg(exprasmlist,opsize,OS_ADDR,hregister2,addrreg2);
  540. { calculate the correct address of the operand }
  541. cg.a_loadaddr_ref_reg(exprasmlist, tcallparanode(left).left.location.reference,addrreg);
  542. cg.a_op_reg_reg(exprasmlist, OP_ADD, OS_ADDR, addrreg2, addrreg);
  543. cg.ungetregister(exprasmlist,addrreg2);
  544. { hregister contains the bitnumber to add }
  545. cg.a_load_const_reg(exprasmlist, opsize, 1, hregister2);
  546. cg.a_op_const_reg(exprasmlist, OP_AND, opsize, 31, hregister);
  547. cg.a_op_reg_reg(exprasmlist, OP_SHL, opsize, hregister, hregister2);
  548. reference_reset_base(href,addrreg,0);
  549. if inlinenumber=in_include_x_y then
  550. cg.a_op_reg_ref(exprasmlist, OP_OR, opsize, hregister2, href)
  551. else
  552. begin
  553. cg.a_op_reg_reg(exprasmlist, OP_NOT, opsize, hregister2, hregister2);
  554. cg.a_op_reg_ref(exprasmlist, OP_AND, opsize, hregister2, href);
  555. end;
  556. cg.ungetregister(exprasmlist,addrreg);
  557. end;
  558. cg.ungetregister(exprasmlist,hregister);
  559. cg.ungetregister(exprasmlist,hregister2);
  560. end;
  561. end;
  562. {*****************************************************************************
  563. FLOAT GENERIC HANDLING
  564. *****************************************************************************}
  565. {
  566. These routines all call internal RTL routines, so if they are
  567. called here, they give an internal error
  568. }
  569. procedure tcginlinenode.second_pi;
  570. begin
  571. internalerror(20020718);
  572. end;
  573. procedure tcginlinenode.second_arctan_real;
  574. begin
  575. internalerror(20020718);
  576. end;
  577. procedure tcginlinenode.second_abs_real;
  578. begin
  579. internalerror(20020718);
  580. end;
  581. procedure tcginlinenode.second_sqr_real;
  582. begin
  583. internalerror(20020718);
  584. end;
  585. procedure tcginlinenode.second_sqrt_real;
  586. begin
  587. internalerror(20020718);
  588. end;
  589. procedure tcginlinenode.second_ln_real;
  590. begin
  591. internalerror(20020718);
  592. end;
  593. procedure tcginlinenode.second_cos_real;
  594. begin
  595. internalerror(20020718);
  596. end;
  597. procedure tcginlinenode.second_sin_real;
  598. begin
  599. internalerror(20020718);
  600. end;
  601. procedure tcginlinenode.second_prefetch;
  602. begin
  603. end;
  604. {*****************************************************************************
  605. ASSIGNED GENERIC HANDLING
  606. *****************************************************************************}
  607. procedure tcginlinenode.second_assigned;
  608. begin
  609. secondpass(tcallparanode(left).left);
  610. { force left to be an OS_ADDR, since in case of method procvars }
  611. { the size is 2*OS_ADDR (JM) }
  612. cg.a_cmp_const_loc_label(exprasmlist,OS_ADDR,OC_NE,0,tcallparanode(left).left.location,truelabel);
  613. cg.a_jmp_always(exprasmlist,falselabel);
  614. location_reset(location,LOC_JUMP,OS_NO);
  615. end;
  616. begin
  617. cinlinenode:=tcginlinenode;
  618. end.
  619. {
  620. $Log$
  621. Revision 1.59 2004-06-16 20:07:08 florian
  622. * dwarf branch merged
  623. Revision 1.58 2004/05/30 21:18:22 jonas
  624. * some optimizations and associated fixes for better regvar code
  625. Revision 1.57 2004/05/22 23:34:28 peter
  626. tai_regalloc.allocation changed to ratype to notify rgobj of register size changes
  627. Revision 1.56.2.4 2004/05/02 16:49:12 peter
  628. * 64 bit fixes
  629. Revision 1.56.2.3 2004/05/01 16:35:51 florian
  630. * fixed length(<ansi/widestring>) for 64 Bit CPUs
  631. Revision 1.56.2.2 2004/04/27 18:18:25 peter
  632. * aword -> aint
  633. Revision 1.56.2.1 2004/04/26 21:02:34 peter
  634. * 64bit fixes
  635. Revision 1.56 2004/03/02 00:36:33 olle
  636. * big transformation of Tai_[const_]Symbol.Create[data]name*
  637. Revision 1.55 2004/02/27 10:21:05 florian
  638. * top_symbol killed
  639. + refaddr to treference added
  640. + refsymbol to treference added
  641. * top_local stuff moved to an extra record to save memory
  642. + aint introduced
  643. * tppufile.get/putint64/aint implemented
  644. Revision 1.54 2004/02/05 16:58:43 florian
  645. * fixed (hopefully) the ansistring length bug
  646. Revision 1.53 2004/02/05 01:24:08 florian
  647. * several fixes to compile x86-64 system
  648. Revision 1.52 2004/02/02 20:41:59 florian
  649. + added prefetch(const mem) support
  650. Revision 1.51 2004/01/31 17:45:17 peter
  651. * Change several $ifdef i386 to x86
  652. * Change several OS_32 to OS_INT/OS_ADDR
  653. Revision 1.50 2003/12/31 20:47:02 jonas
  654. * properly fixed assigned() mess (by handling it separately in ncginl)
  655. -> all assigned()-related tests in the test suite work again
  656. Revision 1.49 2003/12/06 01:15:22 florian
  657. * reverted Peter's alloctemp patch; hopefully properly
  658. Revision 1.48 2003/12/03 23:13:20 peter
  659. * delayed paraloc allocation, a_param_*() gets extra parameter
  660. if it needs to allocate temp or real paralocation
  661. * optimized/simplified int-real loading
  662. Revision 1.47 2003/10/10 17:48:13 peter
  663. * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
  664. * tregisteralloctor renamed to trgobj
  665. * removed rgobj from a lot of units
  666. * moved location_* and reference_* to cgobj
  667. * first things for mmx register allocation
  668. Revision 1.46 2003/10/09 21:31:37 daniel
  669. * Register allocator splitted, ans abstract now
  670. Revision 1.45 2003/10/08 19:19:45 peter
  671. * set_varstate cleanup
  672. Revision 1.44 2003/10/05 21:21:52 peter
  673. * c style array of const generates callparanodes
  674. * varargs paraloc fixes
  675. Revision 1.43 2003/10/01 20:34:48 peter
  676. * procinfo unit contains tprocinfo
  677. * cginfo renamed to cgbase
  678. * moved cgmessage to verbose
  679. * fixed ppc and sparc compiles
  680. Revision 1.42 2003/09/10 08:31:47 marco
  681. * Patch from Peter for paraloc
  682. Revision 1.41 2003/09/07 22:09:35 peter
  683. * preparations for different default calling conventions
  684. * various RA fixes
  685. Revision 1.40 2003/09/03 15:55:00 peter
  686. * NEWRA branch merged
  687. Revision 1.39.2.1 2003/08/29 17:28:59 peter
  688. * next batch of updates
  689. Revision 1.39 2003/07/23 11:01:14 jonas
  690. * several rg.allocexplicitregistersint/rg.deallocexplicitregistersint
  691. pairs round calls to helpers
  692. Revision 1.38 2003/07/05 20:07:24 jonas
  693. * fixed range check errors
  694. Revision 1.37 2003/06/13 21:19:30 peter
  695. * current_procdef removed, use current_procinfo.procdef instead
  696. Revision 1.36 2003/06/07 18:57:04 jonas
  697. + added freeintparaloc
  698. * ppc get/freeintparaloc now check whether the parameter regs are
  699. properly allocated/deallocated (and get an extra list para)
  700. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  701. * fixed lot of missing pi_do_call's
  702. Revision 1.35 2003/06/03 21:11:09 peter
  703. * cg.a_load_* get a from and to size specifier
  704. * makeregsize only accepts newregister
  705. * i386 uses generic tcgnotnode,tcgunaryminus
  706. Revision 1.34 2003/06/01 21:38:06 peter
  707. * getregisterfpu size parameter added
  708. * op_const_reg size parameter added
  709. * sparc updates
  710. Revision 1.33 2003/05/24 17:15:59 jonas
  711. - removed bogus location_copy for include/exclude
  712. Revision 1.32 2003/05/23 21:10:38 jonas
  713. * fixed exclude
  714. Revision 1.31 2003/05/23 14:27:35 peter
  715. * remove some unit dependencies
  716. * current_procinfo changes to store more info
  717. Revision 1.30 2003/05/09 17:47:02 peter
  718. * self moved to hidden parameter
  719. * removed hdisposen,hnewn,selfn
  720. Revision 1.29 2003/05/01 12:27:08 jonas
  721. * fixed include/exclude for normalsets
  722. Revision 1.28 2003/04/27 11:21:33 peter
  723. * aktprocdef renamed to current_procinfo.procdef
  724. * procinfo renamed to current_procinfo
  725. * procinfo will now be stored in current_module so it can be
  726. cleaned up properly
  727. * gen_main_procsym changed to create_main_proc and release_main_proc
  728. to also generate a tprocinfo structure
  729. * fixed unit implicit initfinal
  730. Revision 1.27 2003/04/25 08:25:26 daniel
  731. * Ifdefs around a lot of calls to cleartempgen
  732. * Fixed registers that are allocated but not freed in several nodes
  733. * Tweak to register allocator to cause less spills
  734. * 8-bit registers now interfere with esi,edi and ebp
  735. Compiler can now compile rtl successfully when using new register
  736. allocator
  737. Revision 1.26 2003/04/24 22:29:57 florian
  738. * fixed a lot of PowerPC related stuff
  739. Revision 1.25 2003/04/22 23:50:22 peter
  740. * firstpass uses expectloc
  741. * checks if there are differences between the expectloc and
  742. location.loc from secondpass in EXTDEBUG
  743. Revision 1.24 2003/04/22 10:09:35 daniel
  744. + Implemented the actual register allocator
  745. + Scratch registers unavailable when new register allocator used
  746. + maybe_save/maybe_restore unavailable when new register allocator used
  747. Revision 1.23 2003/04/06 21:11:23 olle
  748. * changed newasmsymbol to newasmsymboldata for data symbols
  749. Revision 1.22 2003/03/28 19:16:56 peter
  750. * generic constructor working for i386
  751. * remove fixed self register
  752. * esi added as address register for i386
  753. Revision 1.21 2003/02/19 22:00:14 daniel
  754. * Code generator converted to new register notation
  755. - Horribily outdated todo.txt removed
  756. Revision 1.20 2003/01/31 22:47:27 peter
  757. * fix previous typeof change
  758. Revision 1.19 2003/01/30 21:46:57 peter
  759. * self fixes for static methods (merged)
  760. Revision 1.18 2003/01/08 18:43:56 daniel
  761. * Tregister changed into a record
  762. Revision 1.17 2002/11/25 17:43:18 peter
  763. * splitted defbase in defutil,symutil,defcmp
  764. * merged isconvertable and is_equal into compare_defs(_ext)
  765. * made operator search faster by walking the list only once
  766. Revision 1.16 2002/10/05 12:43:25 carl
  767. * fixes for Delphi 6 compilation
  768. (warning : Some features do not work under Delphi)
  769. Revision 1.15 2002/09/30 07:00:46 florian
  770. * fixes to common code to get the alpha compiler compiled applied
  771. Revision 1.14 2002/09/17 18:54:02 jonas
  772. * a_load_reg_reg() now has two size parameters: source and dest. This
  773. allows some optimizations on architectures that don't encode the
  774. register size in the register name.
  775. Revision 1.13 2002/08/13 18:01:52 carl
  776. * rename swatoperands to swapoperands
  777. + m68k first compilable version (still needs a lot of testing):
  778. assembler generator, system information , inline
  779. assembler reader.
  780. Revision 1.12 2002/08/11 14:32:26 peter
  781. * renamed current_library to objectlibrary
  782. Revision 1.11 2002/08/11 13:24:11 peter
  783. * saving of asmsymbols in ppu supported
  784. * asmsymbollist global is removed and moved into a new class
  785. tasmlibrarydata that will hold the info of a .a file which
  786. corresponds with a single module. Added librarydata to tmodule
  787. to keep the library info stored for the module. In the future the
  788. objectfiles will also be stored to the tasmlibrarydata class
  789. * all getlabel/newasmsymbol and friends are moved to the new class
  790. Revision 1.10 2002/08/05 18:27:48 carl
  791. + more more more documentation
  792. + first version include/exclude (can't test though, not enough scratch for i386 :()...
  793. Revision 1.9 2002/08/04 19:06:41 carl
  794. + added generic exception support (still does not work!)
  795. + more documentation
  796. Revision 1.8 2002/07/31 07:54:59 jonas
  797. * re-enabled second_assigned()
  798. Revision 1.7 2002/07/30 20:50:43 florian
  799. * the code generator knows now if parameters are in registers
  800. Revision 1.6 2002/07/29 21:23:42 florian
  801. * more fixes for the ppc
  802. + wrappers for the tcnvnode.first_* stuff introduced
  803. Revision 1.5 2002/07/28 20:45:22 florian
  804. + added direct assembler reader for PowerPC
  805. Revision 1.4 2002/07/26 09:45:20 florian
  806. * fixed a mistake in yesterday's commit, forgot to commit it
  807. Revision 1.3 2002/07/25 22:58:30 florian
  808. no message
  809. Revision 1.2 2002/07/25 17:55:41 carl
  810. + First working revision
  811. Revision 1.1 2002/07/24 04:07:49 carl
  812. + first revision (incomplete)
  813. }