ncginl.pas 33 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912
  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.newasmsymboldata(tobjectdef(left.resulttype.def).vmt_mangledname),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(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.55 2004-02-27 10:21:05 florian
  614. * top_symbol killed
  615. + refaddr to treference added
  616. + refsymbol to treference added
  617. * top_local stuff moved to an extra record to save memory
  618. + aint introduced
  619. * tppufile.get/putint64/aint implemented
  620. Revision 1.54 2004/02/05 16:58:43 florian
  621. * fixed (hopefully) the ansistring length bug
  622. Revision 1.53 2004/02/05 01:24:08 florian
  623. * several fixes to compile x86-64 system
  624. Revision 1.52 2004/02/02 20:41:59 florian
  625. + added prefetch(const mem) support
  626. Revision 1.51 2004/01/31 17:45:17 peter
  627. * Change several $ifdef i386 to x86
  628. * Change several OS_32 to OS_INT/OS_ADDR
  629. Revision 1.50 2003/12/31 20:47:02 jonas
  630. * properly fixed assigned() mess (by handling it separately in ncginl)
  631. -> all assigned()-related tests in the test suite work again
  632. Revision 1.49 2003/12/06 01:15:22 florian
  633. * reverted Peter's alloctemp patch; hopefully properly
  634. Revision 1.48 2003/12/03 23:13:20 peter
  635. * delayed paraloc allocation, a_param_*() gets extra parameter
  636. if it needs to allocate temp or real paralocation
  637. * optimized/simplified int-real loading
  638. Revision 1.47 2003/10/10 17:48:13 peter
  639. * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
  640. * tregisteralloctor renamed to trgobj
  641. * removed rgobj from a lot of units
  642. * moved location_* and reference_* to cgobj
  643. * first things for mmx register allocation
  644. Revision 1.46 2003/10/09 21:31:37 daniel
  645. * Register allocator splitted, ans abstract now
  646. Revision 1.45 2003/10/08 19:19:45 peter
  647. * set_varstate cleanup
  648. Revision 1.44 2003/10/05 21:21:52 peter
  649. * c style array of const generates callparanodes
  650. * varargs paraloc fixes
  651. Revision 1.43 2003/10/01 20:34:48 peter
  652. * procinfo unit contains tprocinfo
  653. * cginfo renamed to cgbase
  654. * moved cgmessage to verbose
  655. * fixed ppc and sparc compiles
  656. Revision 1.42 2003/09/10 08:31:47 marco
  657. * Patch from Peter for paraloc
  658. Revision 1.41 2003/09/07 22:09:35 peter
  659. * preparations for different default calling conventions
  660. * various RA fixes
  661. Revision 1.40 2003/09/03 15:55:00 peter
  662. * NEWRA branch merged
  663. Revision 1.39.2.1 2003/08/29 17:28:59 peter
  664. * next batch of updates
  665. Revision 1.39 2003/07/23 11:01:14 jonas
  666. * several rg.allocexplicitregistersint/rg.deallocexplicitregistersint
  667. pairs round calls to helpers
  668. Revision 1.38 2003/07/05 20:07:24 jonas
  669. * fixed range check errors
  670. Revision 1.37 2003/06/13 21:19:30 peter
  671. * current_procdef removed, use current_procinfo.procdef instead
  672. Revision 1.36 2003/06/07 18:57:04 jonas
  673. + added freeintparaloc
  674. * ppc get/freeintparaloc now check whether the parameter regs are
  675. properly allocated/deallocated (and get an extra list para)
  676. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  677. * fixed lot of missing pi_do_call's
  678. Revision 1.35 2003/06/03 21:11:09 peter
  679. * cg.a_load_* get a from and to size specifier
  680. * makeregsize only accepts newregister
  681. * i386 uses generic tcgnotnode,tcgunaryminus
  682. Revision 1.34 2003/06/01 21:38:06 peter
  683. * getregisterfpu size parameter added
  684. * op_const_reg size parameter added
  685. * sparc updates
  686. Revision 1.33 2003/05/24 17:15:59 jonas
  687. - removed bogus location_copy for include/exclude
  688. Revision 1.32 2003/05/23 21:10:38 jonas
  689. * fixed exclude
  690. Revision 1.31 2003/05/23 14:27:35 peter
  691. * remove some unit dependencies
  692. * current_procinfo changes to store more info
  693. Revision 1.30 2003/05/09 17:47:02 peter
  694. * self moved to hidden parameter
  695. * removed hdisposen,hnewn,selfn
  696. Revision 1.29 2003/05/01 12:27:08 jonas
  697. * fixed include/exclude for normalsets
  698. Revision 1.28 2003/04/27 11:21:33 peter
  699. * aktprocdef renamed to current_procinfo.procdef
  700. * procinfo renamed to current_procinfo
  701. * procinfo will now be stored in current_module so it can be
  702. cleaned up properly
  703. * gen_main_procsym changed to create_main_proc and release_main_proc
  704. to also generate a tprocinfo structure
  705. * fixed unit implicit initfinal
  706. Revision 1.27 2003/04/25 08:25:26 daniel
  707. * Ifdefs around a lot of calls to cleartempgen
  708. * Fixed registers that are allocated but not freed in several nodes
  709. * Tweak to register allocator to cause less spills
  710. * 8-bit registers now interfere with esi,edi and ebp
  711. Compiler can now compile rtl successfully when using new register
  712. allocator
  713. Revision 1.26 2003/04/24 22:29:57 florian
  714. * fixed a lot of PowerPC related stuff
  715. Revision 1.25 2003/04/22 23:50:22 peter
  716. * firstpass uses expectloc
  717. * checks if there are differences between the expectloc and
  718. location.loc from secondpass in EXTDEBUG
  719. Revision 1.24 2003/04/22 10:09:35 daniel
  720. + Implemented the actual register allocator
  721. + Scratch registers unavailable when new register allocator used
  722. + maybe_save/maybe_restore unavailable when new register allocator used
  723. Revision 1.23 2003/04/06 21:11:23 olle
  724. * changed newasmsymbol to newasmsymboldata for data symbols
  725. Revision 1.22 2003/03/28 19:16:56 peter
  726. * generic constructor working for i386
  727. * remove fixed self register
  728. * esi added as address register for i386
  729. Revision 1.21 2003/02/19 22:00:14 daniel
  730. * Code generator converted to new register notation
  731. - Horribily outdated todo.txt removed
  732. Revision 1.20 2003/01/31 22:47:27 peter
  733. * fix previous typeof change
  734. Revision 1.19 2003/01/30 21:46:57 peter
  735. * self fixes for static methods (merged)
  736. Revision 1.18 2003/01/08 18:43:56 daniel
  737. * Tregister changed into a record
  738. Revision 1.17 2002/11/25 17:43:18 peter
  739. * splitted defbase in defutil,symutil,defcmp
  740. * merged isconvertable and is_equal into compare_defs(_ext)
  741. * made operator search faster by walking the list only once
  742. Revision 1.16 2002/10/05 12:43:25 carl
  743. * fixes for Delphi 6 compilation
  744. (warning : Some features do not work under Delphi)
  745. Revision 1.15 2002/09/30 07:00:46 florian
  746. * fixes to common code to get the alpha compiler compiled applied
  747. Revision 1.14 2002/09/17 18:54:02 jonas
  748. * a_load_reg_reg() now has two size parameters: source and dest. This
  749. allows some optimizations on architectures that don't encode the
  750. register size in the register name.
  751. Revision 1.13 2002/08/13 18:01:52 carl
  752. * rename swatoperands to swapoperands
  753. + m68k first compilable version (still needs a lot of testing):
  754. assembler generator, system information , inline
  755. assembler reader.
  756. Revision 1.12 2002/08/11 14:32:26 peter
  757. * renamed current_library to objectlibrary
  758. Revision 1.11 2002/08/11 13:24:11 peter
  759. * saving of asmsymbols in ppu supported
  760. * asmsymbollist global is removed and moved into a new class
  761. tasmlibrarydata that will hold the info of a .a file which
  762. corresponds with a single module. Added librarydata to tmodule
  763. to keep the library info stored for the module. In the future the
  764. objectfiles will also be stored to the tasmlibrarydata class
  765. * all getlabel/newasmsymbol and friends are moved to the new class
  766. Revision 1.10 2002/08/05 18:27:48 carl
  767. + more more more documentation
  768. + first version include/exclude (can't test though, not enough scratch for i386 :()...
  769. Revision 1.9 2002/08/04 19:06:41 carl
  770. + added generic exception support (still does not work!)
  771. + more documentation
  772. Revision 1.8 2002/07/31 07:54:59 jonas
  773. * re-enabled second_assigned()
  774. Revision 1.7 2002/07/30 20:50:43 florian
  775. * the code generator knows now if parameters are in registers
  776. Revision 1.6 2002/07/29 21:23:42 florian
  777. * more fixes for the ppc
  778. + wrappers for the tcnvnode.first_* stuff introduced
  779. Revision 1.5 2002/07/28 20:45:22 florian
  780. + added direct assembler reader for PowerPC
  781. Revision 1.4 2002/07/26 09:45:20 florian
  782. * fixed a mistake in yesterday's commit, forgot to commit it
  783. Revision 1.3 2002/07/25 22:58:30 florian
  784. no message
  785. Revision 1.2 2002/07/25 17:55:41 carl
  786. + First working revision
  787. Revision 1.1 2002/07/24 04:07:49 carl
  788. + first revision (incomplete)
  789. }