ncginl.pas 33 KB

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