defutil.pas 31 KB

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