ncginl.pas 31 KB

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