defutil.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. This unit provides some help routines for type handling
  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 defutil;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. cclasses,
  23. cpuinfo,
  24. globals,
  25. node,
  26. symconst,symbase,symtype,symdef;
  27. type
  28. tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
  29. mmxu32bit,mmxs32bit,mmxfixed16,mmxsingle);
  30. const
  31. {# true if we must never copy this parameter }
  32. never_copy_const_param : boolean = false;
  33. {*****************************************************************************
  34. Basic type functions
  35. *****************************************************************************}
  36. {# Returns true, if definition defines an ordinal type }
  37. function is_ordinal(def : tdef) : boolean;
  38. {# Returns the minimal integer value of the type }
  39. function get_min_value(def : tdef) : TConstExprInt;
  40. {# Returns basetype of the specified integer range }
  41. function range_to_basetype(low,high:TConstExprInt):tbasetype;
  42. {# Returns true, if definition defines an integer type }
  43. function is_integer(def : tdef) : boolean;
  44. {# Returns true if definition is a boolean }
  45. function is_boolean(def : tdef) : boolean;
  46. {# Returns true if definition is a char
  47. This excludes the unicode char.
  48. }
  49. function is_char(def : tdef) : boolean;
  50. {# Returns true if definition is a widechar }
  51. function is_widechar(def : tdef) : boolean;
  52. {# Returns true if definition is a void}
  53. function is_void(def : tdef) : boolean;
  54. {# Returns true if definition is a smallset}
  55. function is_smallset(p : tdef) : boolean;
  56. {# Returns true, if def defines a signed data type
  57. (only for ordinal types)
  58. }
  59. function is_signed(def : tdef) : boolean;
  60. {# Returns true whether def_from's range is comprised in def_to's if both are
  61. orddefs, false otherwise }
  62. function is_in_limit(def_from,def_to : tdef) : boolean;
  63. function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;
  64. {*****************************************************************************
  65. Array helper functions
  66. *****************************************************************************}
  67. {# Returns true, if p points to a zero based (non special like open or
  68. dynamic array def).
  69. This is mainly used to see if the array
  70. is convertable to a pointer
  71. }
  72. function is_zero_based_array(p : tdef) : boolean;
  73. {# Returns true if p points to an open array definition }
  74. function is_open_array(p : tdef) : boolean;
  75. {# Returns true if p points to a dynamic array definition }
  76. function is_dynamic_array(p : tdef) : boolean;
  77. {# Returns true, if p points to an array of const definition }
  78. function is_array_constructor(p : tdef) : boolean;
  79. {# Returns true, if p points to a variant array }
  80. function is_variant_array(p : tdef) : boolean;
  81. {# Returns true, if p points to an array of const }
  82. function is_array_of_const(p : tdef) : boolean;
  83. {# Returns true, if p points any kind of special array
  84. That is if the array is an open array, a variant
  85. array, an array constants constructor, or an
  86. array of const.
  87. }
  88. function is_special_array(p : tdef) : boolean;
  89. {# Returns true if p is a char array def }
  90. function is_chararray(p : tdef) : boolean;
  91. {# Returns true if p is a wide char array def }
  92. function is_widechararray(p : tdef) : boolean;
  93. {*****************************************************************************
  94. String helper functions
  95. *****************************************************************************}
  96. {# Returns true if p points to an open string type }
  97. function is_open_string(p : tdef) : boolean;
  98. {# Returns true if p is an ansi string type }
  99. function is_ansistring(p : tdef) : boolean;
  100. {# Returns true if p is a long string type }
  101. function is_longstring(p : tdef) : boolean;
  102. {# returns true if p is a wide string type }
  103. function is_widestring(p : tdef) : boolean;
  104. {# Returns true if p is a short string type }
  105. function is_shortstring(p : tdef) : boolean;
  106. {# Returns true if p is a pchar def }
  107. function is_pchar(p : tdef) : boolean;
  108. {# Returns true if p is a pwidechar def }
  109. function is_pwidechar(p : tdef) : boolean;
  110. {# Returns true if p is a voidpointer def }
  111. function is_voidpointer(p : tdef) : boolean;
  112. {# Returns true, if definition is a float }
  113. function is_fpu(def : tdef) : boolean;
  114. {# Returns true, if def is a currency type }
  115. function is_currency(def : tdef) : boolean;
  116. {# Returns true, if def is a 64 bit integer type }
  117. function is_64bitint(def : tdef) : boolean;
  118. {# If @var(l) isn't in the range of def a range check error (if not explicit) is generated and
  119. the value is placed within the range
  120. }
  121. procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
  122. {# Returns the range of def, where @var(l) is the low-range and @var(h) is
  123. the high-range.
  124. }
  125. procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
  126. { some type helper routines for MMX support }
  127. function is_mmx_able_array(p : tdef) : boolean;
  128. {# returns the mmx type }
  129. function mmx_type(p : tdef) : tmmxtype;
  130. implementation
  131. uses
  132. globtype,tokens,systems,verbose,
  133. symtable;
  134. { returns true, if def uses FPU }
  135. function is_fpu(def : tdef) : boolean;
  136. begin
  137. is_fpu:=(def.deftype=floatdef);
  138. end;
  139. { returns true, if def is a currency type }
  140. function is_currency(def : tdef) : boolean;
  141. begin
  142. is_currency:=(def.deftype=floatdef) and (tfloatdef(def).typ=s64currency);
  143. end;
  144. function range_to_basetype(low,high:TConstExprInt):tbasetype;
  145. begin
  146. { generate a unsigned range if high<0 and low>=0 }
  147. if (low>=0) and (high<0) then
  148. range_to_basetype:=u32bit
  149. else if (low>=0) and (high<=255) then
  150. range_to_basetype:=u8bit
  151. else if (low>=-128) and (high<=127) then
  152. range_to_basetype:=s8bit
  153. else if (low>=0) and (high<=65536) then
  154. range_to_basetype:=u16bit
  155. else if (low>=-32768) and (high<=32767) then
  156. range_to_basetype:=s16bit
  157. else
  158. range_to_basetype:=s32bit;
  159. end;
  160. { true if p is an ordinal }
  161. function is_ordinal(def : tdef) : boolean;
  162. var
  163. dt : tbasetype;
  164. begin
  165. case def.deftype of
  166. orddef :
  167. begin
  168. dt:=torddef(def).typ;
  169. is_ordinal:=dt in [uchar,uwidechar,
  170. u8bit,u16bit,u32bit,u64bit,
  171. s8bit,s16bit,s32bit,s64bit,
  172. bool8bit,bool16bit,bool32bit];
  173. end;
  174. enumdef :
  175. is_ordinal:=true;
  176. else
  177. is_ordinal:=false;
  178. end;
  179. end;
  180. { returns the min. value of the type }
  181. function get_min_value(def : tdef) : TConstExprInt;
  182. begin
  183. case def.deftype of
  184. orddef:
  185. get_min_value:=torddef(def).low;
  186. enumdef:
  187. get_min_value:=tenumdef(def).min;
  188. else
  189. get_min_value:=0;
  190. end;
  191. end;
  192. { true if p is an integer }
  193. function is_integer(def : tdef) : boolean;
  194. begin
  195. is_integer:=(def.deftype=orddef) and
  196. (torddef(def).typ in [u8bit,u16bit,u32bit,u64bit,
  197. s8bit,s16bit,s32bit,s64bit]);
  198. end;
  199. { true if p is a boolean }
  200. function is_boolean(def : tdef) : boolean;
  201. begin
  202. is_boolean:=(def.deftype=orddef) and
  203. (torddef(def).typ in [bool8bit,bool16bit,bool32bit]);
  204. end;
  205. { true if p is a void }
  206. function is_void(def : tdef) : boolean;
  207. begin
  208. is_void:=(def.deftype=orddef) and
  209. (torddef(def).typ=uvoid);
  210. end;
  211. { true if p is a char }
  212. function is_char(def : tdef) : boolean;
  213. begin
  214. is_char:=(def.deftype=orddef) and
  215. (torddef(def).typ=uchar);
  216. end;
  217. { true if p is a wchar }
  218. function is_widechar(def : tdef) : boolean;
  219. begin
  220. is_widechar:=(def.deftype=orddef) and
  221. (torddef(def).typ=uwidechar);
  222. end;
  223. { true if p is signed (integer) }
  224. function is_signed(def : tdef) : boolean;
  225. var
  226. dt : tbasetype;
  227. begin
  228. case def.deftype of
  229. orddef :
  230. begin
  231. dt:=torddef(def).typ;
  232. is_signed:=(dt in [s8bit,s16bit,s32bit,s64bit]);
  233. end;
  234. enumdef :
  235. is_signed:=tenumdef(def).min < 0;
  236. arraydef :
  237. is_signed:=is_signed(tarraydef(def).rangetype.def);
  238. else
  239. is_signed:=false;
  240. end;
  241. end;
  242. function is_in_limit(def_from,def_to : tdef) : boolean;
  243. var
  244. fromqword, toqword: boolean;
  245. begin
  246. if (def_from.deftype <> orddef) or
  247. (def_to.deftype <> orddef) then
  248. begin
  249. is_in_limit := false;
  250. exit;
  251. end;
  252. fromqword := torddef(def_from).typ = u64bit;
  253. toqword := torddef(def_to).typ = u64bit;
  254. is_in_limit:=(toqword and is_signed(def_from)) or
  255. ((not fromqword) and
  256. (torddef(def_from).low>=torddef(def_to).low) and
  257. (torddef(def_from).high<=torddef(def_to).high));
  258. end;
  259. function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;
  260. begin
  261. if (def_from.deftype <> orddef) and
  262. (def_to.deftype <> orddef) then
  263. internalerror(200210062);
  264. if (torddef(def_to).typ = u64bit) then
  265. begin
  266. is_in_limit_value:=((TConstExprUInt(val_from)>=TConstExprUInt(torddef(def_to).low)) and
  267. (TConstExprUInt(val_from)<=TConstExprUInt(torddef(def_to).high)));
  268. end
  269. else
  270. begin;
  271. is_in_limit_value:=((val_from>=torddef(def_to).low) and
  272. (val_from<=torddef(def_to).high));
  273. end;
  274. end;
  275. { true, if p points to an open array def }
  276. function is_open_string(p : tdef) : boolean;
  277. begin
  278. is_open_string:=(p.deftype=stringdef) and
  279. (tstringdef(p).string_typ=st_shortstring) and
  280. (tstringdef(p).len=0);
  281. end;
  282. { true, if p points to a zero based array def }
  283. function is_zero_based_array(p : tdef) : boolean;
  284. begin
  285. is_zero_based_array:=(p.deftype=arraydef) and
  286. (tarraydef(p).lowrange=0) and
  287. not(is_special_array(p));
  288. end;
  289. { true if p points to a dynamic array def }
  290. function is_dynamic_array(p : tdef) : boolean;
  291. begin
  292. is_dynamic_array:=(p.deftype=arraydef) and
  293. tarraydef(p).IsDynamicArray;
  294. end;
  295. { true, if p points to an open array def }
  296. function is_open_array(p : tdef) : boolean;
  297. begin
  298. { check for s32bittype is needed, because for u32bit the high
  299. range is also -1 ! (PFV) }
  300. is_open_array:=(p.deftype=arraydef) and
  301. (tarraydef(p).rangetype.def=s32bittype.def) and
  302. (tarraydef(p).lowrange=0) and
  303. (tarraydef(p).highrange=-1) and
  304. not(tarraydef(p).IsConstructor) and
  305. not(tarraydef(p).IsVariant) and
  306. not(tarraydef(p).IsArrayOfConst) and
  307. not(tarraydef(p).IsDynamicArray);
  308. end;
  309. { true, if p points to an array of const def }
  310. function is_array_constructor(p : tdef) : boolean;
  311. begin
  312. is_array_constructor:=(p.deftype=arraydef) and
  313. (tarraydef(p).IsConstructor);
  314. end;
  315. { true, if p points to a variant array }
  316. function is_variant_array(p : tdef) : boolean;
  317. begin
  318. is_variant_array:=(p.deftype=arraydef) and
  319. (tarraydef(p).IsVariant);
  320. end;
  321. { true, if p points to an array of const }
  322. function is_array_of_const(p : tdef) : boolean;
  323. begin
  324. is_array_of_const:=(p.deftype=arraydef) and
  325. (tarraydef(p).IsArrayOfConst);
  326. end;
  327. { true, if p points to a special array }
  328. function is_special_array(p : tdef) : boolean;
  329. begin
  330. is_special_array:=(p.deftype=arraydef) and
  331. ((tarraydef(p).IsVariant) or
  332. (tarraydef(p).IsArrayOfConst) or
  333. (tarraydef(p).IsConstructor) or
  334. is_open_array(p)
  335. );
  336. end;
  337. { true if p is an ansi string def }
  338. function is_ansistring(p : tdef) : boolean;
  339. begin
  340. is_ansistring:=(p.deftype=stringdef) and
  341. (tstringdef(p).string_typ=st_ansistring);
  342. end;
  343. { true if p is an long string def }
  344. function is_longstring(p : tdef) : boolean;
  345. begin
  346. is_longstring:=(p.deftype=stringdef) and
  347. (tstringdef(p).string_typ=st_longstring);
  348. end;
  349. { true if p is an wide string def }
  350. function is_widestring(p : tdef) : boolean;
  351. begin
  352. is_widestring:=(p.deftype=stringdef) and
  353. (tstringdef(p).string_typ=st_widestring);
  354. end;
  355. { true if p is an short string def }
  356. function is_shortstring(p : tdef) : boolean;
  357. begin
  358. is_shortstring:=(p.deftype=stringdef) and
  359. (tstringdef(p).string_typ=st_shortstring);
  360. end;
  361. { true if p is a char array def }
  362. function is_chararray(p : tdef) : boolean;
  363. begin
  364. is_chararray:=(p.deftype=arraydef) and
  365. is_char(tarraydef(p).elementtype.def) and
  366. not(is_special_array(p));
  367. end;
  368. { true if p is a widechar array def }
  369. function is_widechararray(p : tdef) : boolean;
  370. begin
  371. is_widechararray:=(p.deftype=arraydef) and
  372. is_widechar(tarraydef(p).elementtype.def) and
  373. not(is_special_array(p));
  374. end;
  375. { true if p is a pchar def }
  376. function is_pchar(p : tdef) : boolean;
  377. begin
  378. is_pchar:=(p.deftype=pointerdef) and
  379. (is_char(tpointerdef(p).pointertype.def) or
  380. (is_zero_based_array(tpointerdef(p).pointertype.def) and
  381. is_chararray(tpointerdef(p).pointertype.def)));
  382. end;
  383. { true if p is a pchar def }
  384. function is_pwidechar(p : tdef) : boolean;
  385. begin
  386. is_pwidechar:=(p.deftype=pointerdef) and
  387. (is_widechar(tpointerdef(p).pointertype.def) or
  388. (is_zero_based_array(tpointerdef(p).pointertype.def) and
  389. is_widechararray(tpointerdef(p).pointertype.def)));
  390. end;
  391. { true if p is a voidpointer def }
  392. function is_voidpointer(p : tdef) : boolean;
  393. begin
  394. is_voidpointer:=(p.deftype=pointerdef) and
  395. (tpointerdef(p).pointertype.def.deftype=orddef) and
  396. (torddef(tpointerdef(p).pointertype.def).typ=uvoid);
  397. end;
  398. { true if p is a smallset def }
  399. function is_smallset(p : tdef) : boolean;
  400. begin
  401. is_smallset:=(p.deftype=setdef) and
  402. (tsetdef(p).settype=smallset);
  403. end;
  404. { true, if def is a 64 bit int type }
  405. function is_64bitint(def : tdef) : boolean;
  406. begin
  407. is_64bitint:=(def.deftype=orddef) and (torddef(def).typ in [u64bit,s64bit])
  408. end;
  409. { if l isn't in the range of def a range check error (if not explicit) is generated and
  410. the value is placed within the range }
  411. procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
  412. var
  413. lv,hv: TConstExprInt;
  414. error: boolean;
  415. begin
  416. error := false;
  417. { for 64 bit types we need only to check if it is less than }
  418. { zero, if def is a qword node }
  419. if is_64bitint(def) then
  420. begin
  421. if (l<0) and (torddef(def).typ=u64bit) then
  422. begin
  423. { don't zero the result, because it may come from hex notation
  424. like $ffffffffffffffff! (JM)
  425. l:=0; }
  426. if not explicit then
  427. begin
  428. if (cs_check_range in aktlocalswitches) then
  429. Message(parser_e_range_check_error)
  430. else
  431. Message(parser_w_range_check_error);
  432. end;
  433. error := true;
  434. end;
  435. end
  436. else
  437. begin
  438. getrange(def,lv,hv);
  439. if (def.deftype=orddef) and
  440. (torddef(def).typ=u32bit) then
  441. begin
  442. if (l < cardinal(lv)) or
  443. (l > cardinal(hv)) then
  444. begin
  445. if not explicit then
  446. begin
  447. if (cs_check_range in aktlocalswitches) then
  448. Message(parser_e_range_check_error)
  449. else
  450. Message(parser_w_range_check_error);
  451. end;
  452. error := true;
  453. end;
  454. end
  455. else if (l<lv) or (l>hv) then
  456. begin
  457. if not explicit then
  458. begin
  459. if ((def.deftype=enumdef) and
  460. { delphi allows range check errors in
  461. enumeration type casts FK }
  462. not(m_delphi in aktmodeswitches)) or
  463. (cs_check_range in aktlocalswitches) then
  464. Message(parser_e_range_check_error)
  465. else
  466. Message(parser_w_range_check_error);
  467. end;
  468. error := true;
  469. end;
  470. end;
  471. if error then
  472. begin
  473. { Fix the value to fit in the allocated space for this type of variable }
  474. case def.size of
  475. 1: l := l and $ff;
  476. 2: l := l and $ffff;
  477. { work around sign extension bug (to be fixed) (JM) }
  478. 4: l := l and (int64($fffffff) shl 4 + $f);
  479. end;
  480. { do sign extension if necessary (JM) }
  481. if is_signed(def) then
  482. begin
  483. case def.size of
  484. 1: l := shortint(l);
  485. 2: l := smallint(l);
  486. 4: l := longint(l);
  487. end;
  488. end;
  489. end;
  490. end;
  491. { return the range from def in l and h }
  492. procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
  493. begin
  494. case def.deftype of
  495. orddef :
  496. begin
  497. l:=torddef(def).low;
  498. h:=torddef(def).high;
  499. end;
  500. enumdef :
  501. begin
  502. l:=tenumdef(def).min;
  503. h:=tenumdef(def).max;
  504. end;
  505. arraydef :
  506. begin
  507. l:=tarraydef(def).lowrange;
  508. h:=tarraydef(def).highrange;
  509. end;
  510. else
  511. internalerror(987);
  512. end;
  513. end;
  514. function mmx_type(p : tdef) : tmmxtype;
  515. begin
  516. mmx_type:=mmxno;
  517. if is_mmx_able_array(p) then
  518. begin
  519. if tarraydef(p).elementtype.def.deftype=floatdef then
  520. case tfloatdef(tarraydef(p).elementtype.def).typ of
  521. s32real:
  522. mmx_type:=mmxsingle;
  523. end
  524. else
  525. case torddef(tarraydef(p).elementtype.def).typ of
  526. u8bit:
  527. mmx_type:=mmxu8bit;
  528. s8bit:
  529. mmx_type:=mmxs8bit;
  530. u16bit:
  531. mmx_type:=mmxu16bit;
  532. s16bit:
  533. mmx_type:=mmxs16bit;
  534. u32bit:
  535. mmx_type:=mmxu32bit;
  536. s32bit:
  537. mmx_type:=mmxs32bit;
  538. end;
  539. end;
  540. end;
  541. function is_mmx_able_array(p : tdef) : boolean;
  542. begin
  543. {$ifdef SUPPORT_MMX}
  544. if (cs_mmx_saturation in aktlocalswitches) then
  545. begin
  546. is_mmx_able_array:=(p.deftype=arraydef) and
  547. not(is_special_array(p)) and
  548. (
  549. (
  550. (tarraydef(p).elementtype.def.deftype=orddef) and
  551. (
  552. (
  553. (tarraydef(p).lowrange=0) and
  554. (tarraydef(p).highrange=1) and
  555. (torddef(tarraydef(p).elementtype.def).typ in [u32bit,s32bit])
  556. )
  557. or
  558. (
  559. (tarraydef(p).lowrange=0) and
  560. (tarraydef(p).highrange=3) and
  561. (torddef(tarraydef(p).elementtype.def).typ in [u16bit,s16bit])
  562. )
  563. )
  564. )
  565. or
  566. (
  567. (
  568. (tarraydef(p).elementtype.def.deftype=floatdef) and
  569. (
  570. (tarraydef(p).lowrange=0) and
  571. (tarraydef(p).highrange=1) and
  572. (tfloatdef(tarraydef(p).elementtype.def).typ=s32real)
  573. )
  574. )
  575. )
  576. );
  577. end
  578. else
  579. begin
  580. is_mmx_able_array:=(p.deftype=arraydef) and
  581. (
  582. (
  583. (tarraydef(p).elementtype.def.deftype=orddef) and
  584. (
  585. (
  586. (tarraydef(p).lowrange=0) and
  587. (tarraydef(p).highrange=1) and
  588. (torddef(tarraydef(p).elementtype.def).typ in [u32bit,s32bit])
  589. )
  590. or
  591. (
  592. (tarraydef(p).lowrange=0) and
  593. (tarraydef(p).highrange=3) and
  594. (torddef(tarraydef(p).elementtype.def).typ in [u16bit,s16bit])
  595. )
  596. or
  597. (
  598. (tarraydef(p).lowrange=0) and
  599. (tarraydef(p).highrange=7) and
  600. (torddef(tarraydef(p).elementtype.def).typ in [u8bit,s8bit])
  601. )
  602. )
  603. )
  604. or
  605. (
  606. (tarraydef(p).elementtype.def.deftype=floatdef) and
  607. (
  608. (tarraydef(p).lowrange=0) and
  609. (tarraydef(p).highrange=1) and
  610. (tfloatdef(tarraydef(p).elementtype.def).typ=s32real)
  611. )
  612. )
  613. );
  614. end;
  615. {$else SUPPORT_MMX}
  616. is_mmx_able_array:=false;
  617. {$endif SUPPORT_MMX}
  618. end;
  619. end.
  620. {
  621. $Log$
  622. Revision 1.1 2002-11-25 17:43:17 peter
  623. * splitted defbase in defutil,symutil,defcmp
  624. * merged isconvertable and is_equal into compare_defs(_ext)
  625. * made operator search faster by walking the list only once
  626. Revision 1.26 2002/11/17 16:31:55 carl
  627. * memory optimization (3-4%) : cleanup of tai fields,
  628. cleanup of tdef and tsym fields.
  629. * make it work for m68k
  630. Revision 1.25 2002/11/16 18:00:53 peter
  631. * fix merged proc-procvar check
  632. Revision 1.24 2002/11/15 01:58:46 peter
  633. * merged changes from 1.0.7 up to 04-11
  634. - -V option for generating bug report tracing
  635. - more tracing for option parsing
  636. - errors for cdecl and high()
  637. - win32 import stabs
  638. - win32 records<=8 are returned in eax:edx (turned off by default)
  639. - heaptrc update
  640. - more info for temp management in .s file with EXTDEBUG
  641. Revision 1.23 2002/10/20 15:34:16 peter
  642. * removed df_unique flag. It breaks code. For a good type=type <id>
  643. a def copy is required
  644. Revision 1.22 2002/10/10 16:07:57 florian
  645. + several widestring/pwidechar related stuff added
  646. Revision 1.21 2002/10/09 21:01:41 florian
  647. * variants aren't compatible with nil
  648. Revision 1.20 2002/10/07 09:49:42 florian
  649. * overloaded :=-operator is now searched when looking for possible
  650. variant type conversions
  651. Revision 1.19 2002/10/06 21:02:17 peter
  652. * fixed limit checking for qword
  653. Revision 1.18 2002/10/06 15:08:59 peter
  654. * only check for forwarddefs the definitions that really belong to
  655. the current procsym
  656. Revision 1.17 2002/10/06 12:25:04 florian
  657. + proper support of type <id> = type <another id>;
  658. Revision 1.16 2002/10/05 12:43:24 carl
  659. * fixes for Delphi 6 compilation
  660. (warning : Some features do not work under Delphi)
  661. Revision 1.15 2002/10/05 00:50:01 peter
  662. * check parameters from left to right in equal_paras, so default
  663. parameters are checked at the end
  664. Revision 1.14 2002/09/30 07:00:44 florian
  665. * fixes to common code to get the alpha compiler compiled applied
  666. Revision 1.13 2002/09/22 14:02:34 carl
  667. * stack checking cannot be called before system unit is initialized
  668. * MC68020 define
  669. Revision 1.12 2002/09/16 14:11:12 peter
  670. * add argument to equal_paras() to support default values or not
  671. Revision 1.11 2002/09/15 17:54:46 peter
  672. * allow default parameters in equal_paras
  673. Revision 1.10 2002/09/08 11:10:17 carl
  674. * bugfix 2109 (bad imho, but only way)
  675. Revision 1.9 2002/09/07 15:25:02 peter
  676. * old logs removed and tabs fixed
  677. Revision 1.8 2002/09/07 09:16:55 carl
  678. * fix my stupid copy and paste bug
  679. Revision 1.7 2002/09/06 19:58:31 carl
  680. * start bugfix 1996
  681. * 64-bit typed constant now work correctly and fully (bugfix 2001)
  682. Revision 1.6 2002/08/20 10:31:26 daniel
  683. * Tcallnode.det_resulttype rewritten
  684. Revision 1.5 2002/08/12 20:39:17 florian
  685. * casting of classes to interface fixed when the interface was
  686. implemented by a parent class
  687. Revision 1.4 2002/08/12 14:17:56 florian
  688. * nil is now recognized as being compatible with a dynamic array
  689. Revision 1.3 2002/08/05 18:27:48 carl
  690. + more more more documentation
  691. + first version include/exclude (can't test though, not enough scratch for i386 :()...
  692. Revision 1.2 2002/07/23 09:51:22 daniel
  693. * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
  694. are worth comitting.
  695. Revision 1.1 2002/07/20 11:57:53 florian
  696. * types.pas renamed to defbase.pas because D6 contains a types
  697. unit so this would conflicts if D6 programms are compiled
  698. + Willamette/SSE2 instructions to assembler added
  699. Revision 1.75 2002/07/11 14:41:32 florian
  700. * start of the new generic parameter handling
  701. Revision 1.74 2002/07/01 16:23:54 peter
  702. * cg64 patch
  703. * basics for currency
  704. * asnode updates for class and interface (not finished)
  705. Revision 1.73 2002/05/18 13:34:21 peter
  706. * readded missing revisions
  707. Revision 1.72 2002/05/16 19:46:47 carl
  708. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  709. + try to fix temp allocation (still in ifdef)
  710. + generic constructor calls
  711. + start of tassembler / tmodulebase class cleanup
  712. Revision 1.70 2002/05/12 16:53:16 peter
  713. * moved entry and exitcode to ncgutil and cgobj
  714. * foreach gets extra argument for passing local data to the
  715. iterator function
  716. * -CR checks also class typecasts at runtime by changing them
  717. into as
  718. * fixed compiler to cycle with the -CR option
  719. * fixed stabs with elf writer, finally the global variables can
  720. be watched
  721. * removed a lot of routines from cga unit and replaced them by
  722. calls to cgobj
  723. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  724. u32bit then the other is typecasted also to u32bit without giving
  725. a rangecheck warning/error.
  726. * fixed pascal calling method with reversing also the high tree in
  727. the parast, detected by tcalcst3 test
  728. Revision 1.69 2002/04/25 20:16:39 peter
  729. * moved more routines from cga/n386util
  730. Revision 1.68 2002/04/15 19:08:22 carl
  731. + target_info.size_of_pointer -> pointer_size
  732. + some cleanup of unused types/variables
  733. Revision 1.67 2002/04/07 13:40:29 carl
  734. + update documentation
  735. Revision 1.66 2002/04/02 17:11:32 peter
  736. * tlocation,treference update
  737. * LOC_CONSTANT added for better constant handling
  738. * secondadd splitted in multiple routines
  739. * location_force_reg added for loading a location to a register
  740. of a specified size
  741. * secondassignment parses now first the right and then the left node
  742. (this is compatible with Kylix). This saves a lot of push/pop especially
  743. with string operations
  744. * adapted some routines to use the new cg methods
  745. Revision 1.65 2002/04/01 20:57:14 jonas
  746. * fixed web bug 1907
  747. * fixed some other procvar related bugs (all related to accepting procvar
  748. constructs with either too many or too little parameters)
  749. (both merged, includes second typo fix of pexpr.pas)
  750. Revision 1.64 2002/01/24 18:25:53 peter
  751. * implicit result variable generation for assembler routines
  752. * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
  753. Revision 1.63 2002/01/24 12:33:53 jonas
  754. * adapted ranges of native types to int64 (e.g. high cardinal is no
  755. longer longint($ffffffff), but just $fffffff in psystem)
  756. * small additional fix in 64bit rangecheck code generation for 32 bit
  757. processors
  758. * adaption of ranges required the matching talgorithm used for selecting
  759. which overloaded procedure to call to be adapted. It should now always
  760. select the closest match for ordinal parameters.
  761. + inttostr(qword) in sysstr.inc/sysstrh.inc
  762. + abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous
  763. fixes were required to be able to add them)
  764. * is_in_limit() moved from ncal to types unit, should always be used
  765. instead of direct comparisons of low/high values of orddefs because
  766. qword is a special case
  767. }