ncginl.pas 31 KB

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