ncginl.pas 34 KB

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