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. {*****************************************************************************
  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. is_open_array(p)
  332. );
  333. end;
  334. { true if p is an ansi string def }
  335. function is_ansistring(p : tdef) : boolean;
  336. begin
  337. is_ansistring:=(p.deftype=stringdef) and
  338. (tstringdef(p).string_typ=st_ansistring);
  339. end;
  340. { true if p is an long string def }
  341. function is_longstring(p : tdef) : boolean;
  342. begin
  343. is_longstring:=(p.deftype=stringdef) and
  344. (tstringdef(p).string_typ=st_longstring);
  345. end;
  346. { true if p is an wide string def }
  347. function is_widestring(p : tdef) : boolean;
  348. begin
  349. is_widestring:=(p.deftype=stringdef) and
  350. (tstringdef(p).string_typ=st_widestring);
  351. end;
  352. { true if p is an short string def }
  353. function is_shortstring(p : tdef) : boolean;
  354. begin
  355. is_shortstring:=(p.deftype=stringdef) and
  356. (tstringdef(p).string_typ=st_shortstring);
  357. end;
  358. { true if p is a char array def }
  359. function is_chararray(p : tdef) : boolean;
  360. begin
  361. is_chararray:=(p.deftype=arraydef) and
  362. is_char(tarraydef(p).elementtype.def) and
  363. not(is_special_array(p));
  364. end;
  365. { true if p is a widechar array def }
  366. function is_widechararray(p : tdef) : boolean;
  367. begin
  368. is_widechararray:=(p.deftype=arraydef) and
  369. is_widechar(tarraydef(p).elementtype.def) and
  370. not(is_special_array(p));
  371. end;
  372. { true if p is a pchar def }
  373. function is_pchar(p : tdef) : boolean;
  374. begin
  375. is_pchar:=(p.deftype=pointerdef) and
  376. (is_char(tpointerdef(p).pointertype.def) or
  377. (is_zero_based_array(tpointerdef(p).pointertype.def) and
  378. is_chararray(tpointerdef(p).pointertype.def)));
  379. end;
  380. { true if p is a pchar def }
  381. function is_pwidechar(p : tdef) : boolean;
  382. begin
  383. is_pwidechar:=(p.deftype=pointerdef) and
  384. (is_widechar(tpointerdef(p).pointertype.def) or
  385. (is_zero_based_array(tpointerdef(p).pointertype.def) and
  386. is_widechararray(tpointerdef(p).pointertype.def)));
  387. end;
  388. { true if p is a voidpointer def }
  389. function is_voidpointer(p : tdef) : boolean;
  390. begin
  391. is_voidpointer:=(p.deftype=pointerdef) and
  392. (tpointerdef(p).pointertype.def.deftype=orddef) and
  393. (torddef(tpointerdef(p).pointertype.def).typ=uvoid);
  394. end;
  395. { true if p is a smallset def }
  396. function is_smallset(p : tdef) : boolean;
  397. begin
  398. is_smallset:=(p.deftype=setdef) and
  399. (tsetdef(p).settype=smallset);
  400. end;
  401. { true, if def is a 64 bit int type }
  402. function is_64bitint(def : tdef) : boolean;
  403. begin
  404. is_64bitint:=(def.deftype=orddef) and (torddef(def).typ in [u64bit,s64bit])
  405. end;
  406. { if l isn't in the range of def a range check error (if not explicit) is generated and
  407. the value is placed within the range }
  408. procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
  409. var
  410. lv,hv: TConstExprInt;
  411. error: boolean;
  412. begin
  413. error := false;
  414. { for 64 bit types we need only to check if it is less than }
  415. { zero, if def is a qword node }
  416. if is_64bitint(def) then
  417. begin
  418. if (l<0) and (torddef(def).typ=u64bit) then
  419. begin
  420. { don't zero the result, because it may come from hex notation
  421. like $ffffffffffffffff! (JM)
  422. l:=0; }
  423. if not explicit then
  424. begin
  425. if (cs_check_range in aktlocalswitches) then
  426. Message(parser_e_range_check_error)
  427. else
  428. Message(parser_w_range_check_error);
  429. end;
  430. error := true;
  431. end;
  432. end
  433. else
  434. begin
  435. getrange(def,lv,hv);
  436. if (def.deftype=orddef) and
  437. (torddef(def).typ=u32bit) then
  438. begin
  439. if (l < cardinal(lv)) or
  440. (l > cardinal(hv)) then
  441. begin
  442. if not explicit then
  443. begin
  444. if (cs_check_range in aktlocalswitches) then
  445. Message(parser_e_range_check_error)
  446. else
  447. Message(parser_w_range_check_error);
  448. end;
  449. error := true;
  450. end;
  451. end
  452. else if (l<lv) or (l>hv) then
  453. begin
  454. if not explicit then
  455. begin
  456. if ((def.deftype=enumdef) and
  457. { delphi allows range check errors in
  458. enumeration type casts FK }
  459. not(m_delphi in aktmodeswitches)) or
  460. (cs_check_range in aktlocalswitches) then
  461. Message(parser_e_range_check_error)
  462. else
  463. Message(parser_w_range_check_error);
  464. end;
  465. error := true;
  466. end;
  467. end;
  468. if error then
  469. begin
  470. { Fix the value to fit in the allocated space for this type of variable }
  471. case def.size of
  472. 1: l := l and $ff;
  473. 2: l := l and $ffff;
  474. { work around sign extension bug (to be fixed) (JM) }
  475. 4: l := l and (int64($fffffff) shl 4 + $f);
  476. end;
  477. { do sign extension if necessary (JM) }
  478. if is_signed(def) then
  479. begin
  480. case def.size of
  481. 1: l := shortint(l);
  482. 2: l := smallint(l);
  483. 4: l := longint(l);
  484. end;
  485. end;
  486. end;
  487. end;
  488. { return the range from def in l and h }
  489. procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
  490. begin
  491. case def.deftype of
  492. orddef :
  493. begin
  494. l:=torddef(def).low;
  495. h:=torddef(def).high;
  496. end;
  497. enumdef :
  498. begin
  499. l:=tenumdef(def).min;
  500. h:=tenumdef(def).max;
  501. end;
  502. arraydef :
  503. begin
  504. l:=tarraydef(def).lowrange;
  505. h:=tarraydef(def).highrange;
  506. end;
  507. else
  508. internalerror(987);
  509. end;
  510. end;
  511. function mmx_type(p : tdef) : tmmxtype;
  512. begin
  513. mmx_type:=mmxno;
  514. if is_mmx_able_array(p) then
  515. begin
  516. if tarraydef(p).elementtype.def.deftype=floatdef then
  517. case tfloatdef(tarraydef(p).elementtype.def).typ of
  518. s32real:
  519. mmx_type:=mmxsingle;
  520. end
  521. else
  522. case torddef(tarraydef(p).elementtype.def).typ of
  523. u8bit:
  524. mmx_type:=mmxu8bit;
  525. s8bit:
  526. mmx_type:=mmxs8bit;
  527. u16bit:
  528. mmx_type:=mmxu16bit;
  529. s16bit:
  530. mmx_type:=mmxs16bit;
  531. u32bit:
  532. mmx_type:=mmxu32bit;
  533. s32bit:
  534. mmx_type:=mmxs32bit;
  535. end;
  536. end;
  537. end;
  538. function is_mmx_able_array(p : tdef) : boolean;
  539. begin
  540. {$ifdef SUPPORT_MMX}
  541. if (cs_mmx_saturation in aktlocalswitches) then
  542. begin
  543. is_mmx_able_array:=(p.deftype=arraydef) and
  544. not(is_special_array(p)) and
  545. (
  546. (
  547. (tarraydef(p).elementtype.def.deftype=orddef) and
  548. (
  549. (
  550. (tarraydef(p).lowrange=0) and
  551. (tarraydef(p).highrange=1) and
  552. (torddef(tarraydef(p).elementtype.def).typ in [u32bit,s32bit])
  553. )
  554. or
  555. (
  556. (tarraydef(p).lowrange=0) and
  557. (tarraydef(p).highrange=3) and
  558. (torddef(tarraydef(p).elementtype.def).typ in [u16bit,s16bit])
  559. )
  560. )
  561. )
  562. or
  563. (
  564. (
  565. (tarraydef(p).elementtype.def.deftype=floatdef) and
  566. (
  567. (tarraydef(p).lowrange=0) and
  568. (tarraydef(p).highrange=1) and
  569. (tfloatdef(tarraydef(p).elementtype.def).typ=s32real)
  570. )
  571. )
  572. )
  573. );
  574. end
  575. else
  576. begin
  577. is_mmx_able_array:=(p.deftype=arraydef) and
  578. (
  579. (
  580. (tarraydef(p).elementtype.def.deftype=orddef) and
  581. (
  582. (
  583. (tarraydef(p).lowrange=0) and
  584. (tarraydef(p).highrange=1) and
  585. (torddef(tarraydef(p).elementtype.def).typ in [u32bit,s32bit])
  586. )
  587. or
  588. (
  589. (tarraydef(p).lowrange=0) and
  590. (tarraydef(p).highrange=3) and
  591. (torddef(tarraydef(p).elementtype.def).typ in [u16bit,s16bit])
  592. )
  593. or
  594. (
  595. (tarraydef(p).lowrange=0) and
  596. (tarraydef(p).highrange=7) and
  597. (torddef(tarraydef(p).elementtype.def).typ in [u8bit,s8bit])
  598. )
  599. )
  600. )
  601. or
  602. (
  603. (tarraydef(p).elementtype.def.deftype=floatdef) and
  604. (
  605. (tarraydef(p).lowrange=0) and
  606. (tarraydef(p).highrange=1) and
  607. (tfloatdef(tarraydef(p).elementtype.def).typ=s32real)
  608. )
  609. )
  610. );
  611. end;
  612. {$else SUPPORT_MMX}
  613. is_mmx_able_array:=false;
  614. {$endif SUPPORT_MMX}
  615. end;
  616. end.
  617. {
  618. $Log$
  619. Revision 1.2 2002-12-23 20:58:03 peter
  620. * remove unused global var
  621. Revision 1.1 2002/11/25 17:43:17 peter
  622. * splitted defbase in defutil,symutil,defcmp
  623. * merged isconvertable and is_equal into compare_defs(_ext)
  624. * made operator search faster by walking the list only once
  625. Revision 1.26 2002/11/17 16:31:55 carl
  626. * memory optimization (3-4%) : cleanup of tai fields,
  627. cleanup of tdef and tsym fields.
  628. * make it work for m68k
  629. Revision 1.25 2002/11/16 18:00:53 peter
  630. * fix merged proc-procvar check
  631. Revision 1.24 2002/11/15 01:58:46 peter
  632. * merged changes from 1.0.7 up to 04-11
  633. - -V option for generating bug report tracing
  634. - more tracing for option parsing
  635. - errors for cdecl and high()
  636. - win32 import stabs
  637. - win32 records<=8 are returned in eax:edx (turned off by default)
  638. - heaptrc update
  639. - more info for temp management in .s file with EXTDEBUG
  640. Revision 1.23 2002/10/20 15:34:16 peter
  641. * removed df_unique flag. It breaks code. For a good type=type <id>
  642. a def copy is required
  643. Revision 1.22 2002/10/10 16:07:57 florian
  644. + several widestring/pwidechar related stuff added
  645. Revision 1.21 2002/10/09 21:01:41 florian
  646. * variants aren't compatible with nil
  647. Revision 1.20 2002/10/07 09:49:42 florian
  648. * overloaded :=-operator is now searched when looking for possible
  649. variant type conversions
  650. Revision 1.19 2002/10/06 21:02:17 peter
  651. * fixed limit checking for qword
  652. Revision 1.18 2002/10/06 15:08:59 peter
  653. * only check for forwarddefs the definitions that really belong to
  654. the current procsym
  655. Revision 1.17 2002/10/06 12:25:04 florian
  656. + proper support of type <id> = type <another id>;
  657. Revision 1.16 2002/10/05 12:43:24 carl
  658. * fixes for Delphi 6 compilation
  659. (warning : Some features do not work under Delphi)
  660. Revision 1.15 2002/10/05 00:50:01 peter
  661. * check parameters from left to right in equal_paras, so default
  662. parameters are checked at the end
  663. Revision 1.14 2002/09/30 07:00:44 florian
  664. * fixes to common code to get the alpha compiler compiled applied
  665. Revision 1.13 2002/09/22 14:02:34 carl
  666. * stack checking cannot be called before system unit is initialized
  667. * MC68020 define
  668. Revision 1.12 2002/09/16 14:11:12 peter
  669. * add argument to equal_paras() to support default values or not
  670. Revision 1.11 2002/09/15 17:54:46 peter
  671. * allow default parameters in equal_paras
  672. Revision 1.10 2002/09/08 11:10:17 carl
  673. * bugfix 2109 (bad imho, but only way)
  674. Revision 1.9 2002/09/07 15:25:02 peter
  675. * old logs removed and tabs fixed
  676. Revision 1.8 2002/09/07 09:16:55 carl
  677. * fix my stupid copy and paste bug
  678. Revision 1.7 2002/09/06 19:58:31 carl
  679. * start bugfix 1996
  680. * 64-bit typed constant now work correctly and fully (bugfix 2001)
  681. Revision 1.6 2002/08/20 10:31:26 daniel
  682. * Tcallnode.det_resulttype rewritten
  683. Revision 1.5 2002/08/12 20:39:17 florian
  684. * casting of classes to interface fixed when the interface was
  685. implemented by a parent class
  686. Revision 1.4 2002/08/12 14:17:56 florian
  687. * nil is now recognized as being compatible with a dynamic array
  688. Revision 1.3 2002/08/05 18:27:48 carl
  689. + more more more documentation
  690. + first version include/exclude (can't test though, not enough scratch for i386 :()...
  691. Revision 1.2 2002/07/23 09:51:22 daniel
  692. * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
  693. are worth comitting.
  694. Revision 1.1 2002/07/20 11:57:53 florian
  695. * types.pas renamed to defbase.pas because D6 contains a types
  696. unit so this would conflicts if D6 programms are compiled
  697. + Willamette/SSE2 instructions to assembler added
  698. Revision 1.75 2002/07/11 14:41:32 florian
  699. * start of the new generic parameter handling
  700. Revision 1.74 2002/07/01 16:23:54 peter
  701. * cg64 patch
  702. * basics for currency
  703. * asnode updates for class and interface (not finished)
  704. Revision 1.73 2002/05/18 13:34:21 peter
  705. * readded missing revisions
  706. Revision 1.72 2002/05/16 19:46:47 carl
  707. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  708. + try to fix temp allocation (still in ifdef)
  709. + generic constructor calls
  710. + start of tassembler / tmodulebase class cleanup
  711. Revision 1.70 2002/05/12 16:53:16 peter
  712. * moved entry and exitcode to ncgutil and cgobj
  713. * foreach gets extra argument for passing local data to the
  714. iterator function
  715. * -CR checks also class typecasts at runtime by changing them
  716. into as
  717. * fixed compiler to cycle with the -CR option
  718. * fixed stabs with elf writer, finally the global variables can
  719. be watched
  720. * removed a lot of routines from cga unit and replaced them by
  721. calls to cgobj
  722. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  723. u32bit then the other is typecasted also to u32bit without giving
  724. a rangecheck warning/error.
  725. * fixed pascal calling method with reversing also the high tree in
  726. the parast, detected by tcalcst3 test
  727. Revision 1.69 2002/04/25 20:16:39 peter
  728. * moved more routines from cga/n386util
  729. Revision 1.68 2002/04/15 19:08:22 carl
  730. + target_info.size_of_pointer -> pointer_size
  731. + some cleanup of unused types/variables
  732. Revision 1.67 2002/04/07 13:40:29 carl
  733. + update documentation
  734. Revision 1.66 2002/04/02 17:11:32 peter
  735. * tlocation,treference update
  736. * LOC_CONSTANT added for better constant handling
  737. * secondadd splitted in multiple routines
  738. * location_force_reg added for loading a location to a register
  739. of a specified size
  740. * secondassignment parses now first the right and then the left node
  741. (this is compatible with Kylix). This saves a lot of push/pop especially
  742. with string operations
  743. * adapted some routines to use the new cg methods
  744. Revision 1.65 2002/04/01 20:57:14 jonas
  745. * fixed web bug 1907
  746. * fixed some other procvar related bugs (all related to accepting procvar
  747. constructs with either too many or too little parameters)
  748. (both merged, includes second typo fix of pexpr.pas)
  749. Revision 1.64 2002/01/24 18:25:53 peter
  750. * implicit result variable generation for assembler routines
  751. * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
  752. Revision 1.63 2002/01/24 12:33:53 jonas
  753. * adapted ranges of native types to int64 (e.g. high cardinal is no
  754. longer longint($ffffffff), but just $fffffff in psystem)
  755. * small additional fix in 64bit rangecheck code generation for 32 bit
  756. processors
  757. * adaption of ranges required the matching talgorithm used for selecting
  758. which overloaded procedure to call to be adapted. It should now always
  759. select the closest match for ordinal parameters.
  760. + inttostr(qword) in sysstr.inc/sysstrh.inc
  761. + abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous
  762. fixes were required to be able to add them)
  763. * is_in_limit() moved from ncal to types unit, should always be used
  764. instead of direct comparisons of low/high values of orddefs because
  765. qword is a special case
  766. }