defutil.pas 32 KB

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