defutil.pas 32 KB

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