ncginl.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841
  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_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,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,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.36 2003-06-07 18:57:04 jonas
  627. + added freeintparaloc
  628. * ppc get/freeintparaloc now check whether the parameter regs are
  629. properly allocated/deallocated (and get an extra list para)
  630. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  631. * fixed lot of missing pi_do_call's
  632. Revision 1.35 2003/06/03 21:11:09 peter
  633. * cg.a_load_* get a from and to size specifier
  634. * makeregsize only accepts newregister
  635. * i386 uses generic tcgnotnode,tcgunaryminus
  636. Revision 1.34 2003/06/01 21:38:06 peter
  637. * getregisterfpu size parameter added
  638. * op_const_reg size parameter added
  639. * sparc updates
  640. Revision 1.33 2003/05/24 17:15:59 jonas
  641. - removed bogus location_copy for include/exclude
  642. Revision 1.32 2003/05/23 21:10:38 jonas
  643. * fixed exclude
  644. Revision 1.31 2003/05/23 14:27:35 peter
  645. * remove some unit dependencies
  646. * current_procinfo changes to store more info
  647. Revision 1.30 2003/05/09 17:47:02 peter
  648. * self moved to hidden parameter
  649. * removed hdisposen,hnewn,selfn
  650. Revision 1.29 2003/05/01 12:27:08 jonas
  651. * fixed include/exclude for normalsets
  652. Revision 1.28 2003/04/27 11:21:33 peter
  653. * aktprocdef renamed to current_procdef
  654. * procinfo renamed to current_procinfo
  655. * procinfo will now be stored in current_module so it can be
  656. cleaned up properly
  657. * gen_main_procsym changed to create_main_proc and release_main_proc
  658. to also generate a tprocinfo structure
  659. * fixed unit implicit initfinal
  660. Revision 1.27 2003/04/25 08:25:26 daniel
  661. * Ifdefs around a lot of calls to cleartempgen
  662. * Fixed registers that are allocated but not freed in several nodes
  663. * Tweak to register allocator to cause less spills
  664. * 8-bit registers now interfere with esi,edi and ebp
  665. Compiler can now compile rtl successfully when using new register
  666. allocator
  667. Revision 1.26 2003/04/24 22:29:57 florian
  668. * fixed a lot of PowerPC related stuff
  669. Revision 1.25 2003/04/22 23:50:22 peter
  670. * firstpass uses expectloc
  671. * checks if there are differences between the expectloc and
  672. location.loc from secondpass in EXTDEBUG
  673. Revision 1.24 2003/04/22 10:09:35 daniel
  674. + Implemented the actual register allocator
  675. + Scratch registers unavailable when new register allocator used
  676. + maybe_save/maybe_restore unavailable when new register allocator used
  677. Revision 1.23 2003/04/06 21:11:23 olle
  678. * changed newasmsymbol to newasmsymboldata for data symbols
  679. Revision 1.22 2003/03/28 19:16:56 peter
  680. * generic constructor working for i386
  681. * remove fixed self register
  682. * esi added as address register for i386
  683. Revision 1.21 2003/02/19 22:00:14 daniel
  684. * Code generator converted to new register notation
  685. - Horribily outdated todo.txt removed
  686. Revision 1.20 2003/01/31 22:47:27 peter
  687. * fix previous typeof change
  688. Revision 1.19 2003/01/30 21:46:57 peter
  689. * self fixes for static methods (merged)
  690. Revision 1.18 2003/01/08 18:43:56 daniel
  691. * Tregister changed into a record
  692. Revision 1.17 2002/11/25 17:43:18 peter
  693. * splitted defbase in defutil,symutil,defcmp
  694. * merged isconvertable and is_equal into compare_defs(_ext)
  695. * made operator search faster by walking the list only once
  696. Revision 1.16 2002/10/05 12:43:25 carl
  697. * fixes for Delphi 6 compilation
  698. (warning : Some features do not work under Delphi)
  699. Revision 1.15 2002/09/30 07:00:46 florian
  700. * fixes to common code to get the alpha compiler compiled applied
  701. Revision 1.14 2002/09/17 18:54:02 jonas
  702. * a_load_reg_reg() now has two size parameters: source and dest. This
  703. allows some optimizations on architectures that don't encode the
  704. register size in the register name.
  705. Revision 1.13 2002/08/13 18:01:52 carl
  706. * rename swatoperands to swapoperands
  707. + m68k first compilable version (still needs a lot of testing):
  708. assembler generator, system information , inline
  709. assembler reader.
  710. Revision 1.12 2002/08/11 14:32:26 peter
  711. * renamed current_library to objectlibrary
  712. Revision 1.11 2002/08/11 13:24:11 peter
  713. * saving of asmsymbols in ppu supported
  714. * asmsymbollist global is removed and moved into a new class
  715. tasmlibrarydata that will hold the info of a .a file which
  716. corresponds with a single module. Added librarydata to tmodule
  717. to keep the library info stored for the module. In the future the
  718. objectfiles will also be stored to the tasmlibrarydata class
  719. * all getlabel/newasmsymbol and friends are moved to the new class
  720. Revision 1.10 2002/08/05 18:27:48 carl
  721. + more more more documentation
  722. + first version include/exclude (can't test though, not enough scratch for i386 :()...
  723. Revision 1.9 2002/08/04 19:06:41 carl
  724. + added generic exception support (still does not work!)
  725. + more documentation
  726. Revision 1.8 2002/07/31 07:54:59 jonas
  727. * re-enabled second_assigned()
  728. Revision 1.7 2002/07/30 20:50:43 florian
  729. * the code generator knows now if parameters are in registers
  730. Revision 1.6 2002/07/29 21:23:42 florian
  731. * more fixes for the ppc
  732. + wrappers for the tcnvnode.first_* stuff introduced
  733. Revision 1.5 2002/07/28 20:45:22 florian
  734. + added direct assembler reader for PowerPC
  735. Revision 1.4 2002/07/26 09:45:20 florian
  736. * fixed a mistake in yesterday's commit, forgot to commit it
  737. Revision 1.3 2002/07/25 22:58:30 florian
  738. no message
  739. Revision 1.2 2002/07/25 17:55:41 carl
  740. + First working revision
  741. Revision 1.1 2002/07/24 04:07:49 carl
  742. + first revision (incomplete)
  743. }