defutil.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978
  1. {
  2. Copyright (c) 1998-2006 by Florian Klaempfl
  3. This unit provides some help routines for type handling
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit defutil;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cclasses,
  22. globtype,globals,
  23. symconst,symbase,symtype,symdef,
  24. cgbase,cpubase;
  25. type
  26. tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
  27. mmxu32bit,mmxs32bit,mmxfixed16,mmxsingle);
  28. {*****************************************************************************
  29. Basic type functions
  30. *****************************************************************************}
  31. {# Returns true, if definition defines an ordinal type }
  32. function is_ordinal(def : tdef) : boolean;
  33. {# Returns the minimal integer value of the type }
  34. function get_min_value(def : tdef) : TConstExprInt;
  35. {# Returns the maximal integer value of the type }
  36. function get_max_value(def : tdef) : TConstExprInt;
  37. {# Returns basetype of the specified integer range }
  38. function range_to_basetype(l,h:TConstExprInt):tbasetype;
  39. procedure range_to_type(l,h:TConstExprInt;var tt:ttype);
  40. procedure int_to_type(v:TConstExprInt;var tt:ttype);
  41. {# Returns true, if definition defines an integer type }
  42. function is_integer(def : tdef) : boolean;
  43. {# Returns true if definition is a boolean }
  44. function is_boolean(def : tdef) : boolean;
  45. {# Returns true if definition is a char
  46. This excludes the unicode char.
  47. }
  48. function is_char(def : tdef) : boolean;
  49. {# Returns true if definition is a widechar }
  50. function is_widechar(def : tdef) : boolean;
  51. {# Returns true if definition is a void}
  52. function is_void(def : tdef) : boolean;
  53. {# Returns true if definition is a smallset}
  54. function is_smallset(p : tdef) : boolean;
  55. {# Returns true, if def defines a signed data type
  56. (only for ordinal types)
  57. }
  58. function is_signed(def : tdef) : boolean;
  59. {# Returns true whether def_from's range is comprised in def_to's if both are
  60. orddefs, false otherwise }
  61. function is_in_limit(def_from,def_to : tdef) : boolean;
  62. function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;
  63. {*****************************************************************************
  64. Array helper functions
  65. *****************************************************************************}
  66. {# Returns true, if p points to a zero based (non special like open or
  67. dynamic array def).
  68. This is mainly used to see if the array
  69. is convertable to a pointer
  70. }
  71. function is_zero_based_array(p : tdef) : boolean;
  72. {# Returns true if p points to an open array definition }
  73. function is_open_array(p : tdef) : boolean;
  74. {# Returns true if p points to a dynamic array definition }
  75. function is_dynamic_array(p : tdef) : boolean;
  76. {# Returns true, if p points to an array of const definition }
  77. function is_array_constructor(p : tdef) : boolean;
  78. {# Returns true, if p points to a variant array }
  79. function is_variant_array(p : tdef) : boolean;
  80. {# Returns true, if p points to an array of const }
  81. function is_array_of_const(p : tdef) : boolean;
  82. {# Returns true, if p points any kind of special array
  83. That is if the array is an open array, a variant
  84. array, an array constants constructor, or an
  85. array of const.
  86. Bitpacked arrays aren't special in this regard though.
  87. }
  88. function is_special_array(p : tdef) : boolean;
  89. {# Returns true if p is a bitpacked array }
  90. function is_packed_array(p: tdef) : boolean;
  91. {# Returns true if p is a bitpacked record }
  92. function is_packed_record_or_object(p: tdef) : boolean;
  93. {# Returns true if p is a char array def }
  94. function is_chararray(p : tdef) : boolean;
  95. {# Returns true if p is a wide char array def }
  96. function is_widechararray(p : tdef) : boolean;
  97. {# Returns true if p is a open char array def }
  98. function is_open_chararray(p : tdef) : boolean;
  99. {# Returns true if p is a open wide char array def }
  100. function is_open_widechararray(p : tdef) : boolean;
  101. {*****************************************************************************
  102. String helper functions
  103. *****************************************************************************}
  104. {# Returns true if p points to an open string type }
  105. function is_open_string(p : tdef) : boolean;
  106. {# Returns true if p is an ansi string type }
  107. function is_ansistring(p : tdef) : boolean;
  108. {# Returns true if p is a long string type }
  109. function is_longstring(p : tdef) : boolean;
  110. {# returns true if p is a wide string type }
  111. function is_widestring(p : tdef) : boolean;
  112. {# Returns true if p is a short string type }
  113. function is_shortstring(p : tdef) : boolean;
  114. {# Returns true if p is a pchar def }
  115. function is_pchar(p : tdef) : boolean;
  116. {# Returns true if p is a pwidechar def }
  117. function is_pwidechar(p : tdef) : boolean;
  118. {# Returns true if p is a voidpointer def }
  119. function is_voidpointer(p : tdef) : boolean;
  120. {# Returns true, if definition is a float }
  121. function is_fpu(def : tdef) : boolean;
  122. {# Returns true, if def is a currency type }
  123. function is_currency(def : tdef) : boolean;
  124. {# Returns true, if def is a single type }
  125. function is_single(def : tdef) : boolean;
  126. {# Returns true, if def is a double type }
  127. function is_double(def : tdef) : boolean;
  128. {# Returns true, if def is an extended type }
  129. function is_extended(def : tdef) : boolean;
  130. {# Returns true, if definition is a "real" real (i.e. single/double/extended) }
  131. function is_real(def : tdef) : boolean;
  132. {# Returns true, if def is a 32 bit integer type }
  133. function is_32bitint(def : tdef) : boolean;
  134. {# Returns true, if def is a 64 bit integer type }
  135. function is_64bitint(def : tdef) : boolean;
  136. {# Returns true, if def is a 64 bit type }
  137. function is_64bit(def : tdef) : boolean;
  138. {# If @var(l) isn't in the range of def a range check error (if not explicit) is generated and
  139. the value is placed within the range
  140. }
  141. procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
  142. {# Returns the range of def, where @var(l) is the low-range and @var(h) is
  143. the high-range.
  144. }
  145. procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
  146. { some type helper routines for MMX support }
  147. function is_mmx_able_array(p : tdef) : boolean;
  148. {# returns the mmx type }
  149. function mmx_type(p : tdef) : tmmxtype;
  150. {# From a definition return the abstract code generator size enum. It is
  151. to note that the value returned can be @var(OS_NO) }
  152. function def_cgsize(def: tdef): tcgsize;
  153. {# returns true, if the type passed is can be used with windows automation }
  154. function is_automatable(p : tdef) : boolean;
  155. {# returns true, if the type passed is a varset }
  156. function is_varset(p : tdef) : boolean;
  157. implementation
  158. uses
  159. systems,verbose;
  160. { returns true, if def uses FPU }
  161. function is_fpu(def : tdef) : boolean;
  162. begin
  163. is_fpu:=(def.deftype=floatdef);
  164. end;
  165. { returns true, if def is a currency type }
  166. function is_currency(def : tdef) : boolean;
  167. begin
  168. case s64currencytype.def.deftype of
  169. orddef :
  170. result:=(def.deftype=orddef) and
  171. (torddef(s64currencytype.def).typ=torddef(def).typ);
  172. floatdef :
  173. result:=(def.deftype=floatdef) and
  174. (tfloatdef(s64currencytype.def).typ=tfloatdef(def).typ);
  175. else
  176. internalerror(200304222);
  177. end;
  178. end;
  179. { returns true, if def is a single type }
  180. function is_single(def : tdef) : boolean;
  181. begin
  182. result:=(def.deftype=floatdef) and
  183. (tfloatdef(def).typ=s32real);
  184. end;
  185. { returns true, if def is a double type }
  186. function is_double(def : tdef) : boolean;
  187. begin
  188. result:=(def.deftype=floatdef) and
  189. (tfloatdef(def).typ=s64real);
  190. end;
  191. function is_extended(def : tdef) : boolean;
  192. begin
  193. result:=(def.deftype=floatdef) and
  194. (tfloatdef(def).typ=s80real);
  195. end;
  196. { returns true, if definition is a "real" real (i.e. single/double/extended) }
  197. function is_real(def : tdef) : boolean;
  198. begin
  199. result:=(def.deftype=floatdef) and
  200. (tfloatdef(def).typ in [s32real,s64real,s80real]);
  201. end;
  202. function range_to_basetype(l,h:TConstExprInt):tbasetype;
  203. begin
  204. { prefer signed over unsigned }
  205. if (l>=-128) and (h<=127) then
  206. range_to_basetype:=s8bit
  207. else if (l>=0) and (h<=255) then
  208. range_to_basetype:=u8bit
  209. else if (l>=-32768) and (h<=32767) then
  210. range_to_basetype:=s16bit
  211. else if (l>=0) and (h<=65535) then
  212. range_to_basetype:=u16bit
  213. else if (l>=low(longint)) and (h<=high(longint)) then
  214. range_to_basetype:=s32bit
  215. else if (l>=low(cardinal)) and (h<=high(cardinal)) then
  216. range_to_basetype:=u32bit
  217. else
  218. range_to_basetype:=s64bit;
  219. end;
  220. procedure range_to_type(l,h:TConstExprInt;var tt:ttype);
  221. begin
  222. { prefer signed over unsigned }
  223. if (l>=-128) and (h<=127) then
  224. tt:=s8inttype
  225. else if (l>=0) and (h<=255) then
  226. tt:=u8inttype
  227. else if (l>=-32768) and (h<=32767) then
  228. tt:=s16inttype
  229. else if (l>=0) and (h<=65535) then
  230. tt:=u16inttype
  231. else if (l>=low(longint)) and (h<=high(longint)) then
  232. tt:=s32inttype
  233. else if (l>=low(cardinal)) and (h<=high(cardinal)) then
  234. tt:=u32inttype
  235. else
  236. tt:=s64inttype;
  237. end;
  238. procedure int_to_type(v:TConstExprInt;var tt:ttype);
  239. begin
  240. range_to_type(v,v,tt);
  241. end;
  242. { true if p is an ordinal }
  243. function is_ordinal(def : tdef) : boolean;
  244. var
  245. dt : tbasetype;
  246. begin
  247. case def.deftype of
  248. orddef :
  249. begin
  250. dt:=torddef(def).typ;
  251. is_ordinal:=dt in [uchar,uwidechar,
  252. u8bit,u16bit,u32bit,u64bit,
  253. s8bit,s16bit,s32bit,s64bit,
  254. bool8bit,bool16bit,bool32bit,bool64bit];
  255. end;
  256. enumdef :
  257. is_ordinal:=true;
  258. else
  259. is_ordinal:=false;
  260. end;
  261. end;
  262. { returns the min. value of the type }
  263. function get_min_value(def : tdef) : TConstExprInt;
  264. begin
  265. case def.deftype of
  266. orddef:
  267. get_min_value:=torddef(def).low;
  268. enumdef:
  269. get_min_value:=tenumdef(def).min;
  270. else
  271. get_min_value:=0;
  272. end;
  273. end;
  274. { returns the max. value of the type }
  275. function get_max_value(def : tdef) : TConstExprInt;
  276. begin
  277. case def.deftype of
  278. orddef:
  279. get_max_value:=torddef(def).high;
  280. enumdef:
  281. get_max_value:=tenumdef(def).max;
  282. else
  283. get_max_value:=0;
  284. end;
  285. end;
  286. { true if p is an integer }
  287. function is_integer(def : tdef) : boolean;
  288. begin
  289. is_integer:=(def.deftype=orddef) and
  290. (torddef(def).typ in [u8bit,u16bit,u32bit,u64bit,
  291. s8bit,s16bit,s32bit,s64bit]);
  292. end;
  293. { true if p is a boolean }
  294. function is_boolean(def : tdef) : boolean;
  295. begin
  296. is_boolean:=(def.deftype=orddef) and
  297. (torddef(def).typ in [bool8bit,bool16bit,bool32bit,bool64bit]);
  298. end;
  299. { true if p is a void }
  300. function is_void(def : tdef) : boolean;
  301. begin
  302. is_void:=(def.deftype=orddef) and
  303. (torddef(def).typ=uvoid);
  304. end;
  305. { true if p is a char }
  306. function is_char(def : tdef) : boolean;
  307. begin
  308. is_char:=(def.deftype=orddef) and
  309. (torddef(def).typ=uchar);
  310. end;
  311. { true if p is a wchar }
  312. function is_widechar(def : tdef) : boolean;
  313. begin
  314. is_widechar:=(def.deftype=orddef) and
  315. (torddef(def).typ=uwidechar);
  316. end;
  317. { true if p is signed (integer) }
  318. function is_signed(def : tdef) : boolean;
  319. var
  320. dt : tbasetype;
  321. begin
  322. case def.deftype of
  323. orddef :
  324. begin
  325. dt:=torddef(def).typ;
  326. is_signed:=(dt in [s8bit,s16bit,s32bit,s64bit,scurrency]);
  327. end;
  328. enumdef :
  329. is_signed:=tenumdef(def).min < 0;
  330. arraydef :
  331. is_signed:=is_signed(tarraydef(def).rangetype.def);
  332. else
  333. is_signed:=false;
  334. end;
  335. end;
  336. function is_in_limit(def_from,def_to : tdef) : boolean;
  337. var
  338. fromqword, toqword: boolean;
  339. begin
  340. if (def_from.deftype <> orddef) or
  341. (def_to.deftype <> orddef) then
  342. begin
  343. is_in_limit := false;
  344. exit;
  345. end;
  346. fromqword := torddef(def_from).typ = u64bit;
  347. toqword := torddef(def_to).typ = u64bit;
  348. is_in_limit:=(toqword and is_signed(def_from)) or
  349. ((not fromqword) and
  350. (torddef(def_from).low>=torddef(def_to).low) and
  351. (torddef(def_from).high<=torddef(def_to).high));
  352. end;
  353. function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;
  354. begin
  355. if (def_from.deftype <> orddef) and
  356. (def_to.deftype <> orddef) then
  357. internalerror(200210062);
  358. if (torddef(def_to).typ = u64bit) then
  359. begin
  360. is_in_limit_value:=((TConstExprUInt(val_from)>=TConstExprUInt(torddef(def_to).low)) and
  361. (TConstExprUInt(val_from)<=TConstExprUInt(torddef(def_to).high)));
  362. end
  363. else
  364. begin;
  365. is_in_limit_value:=((val_from>=torddef(def_to).low) and
  366. (val_from<=torddef(def_to).high));
  367. end;
  368. end;
  369. { true, if p points to an open array def }
  370. function is_open_string(p : tdef) : boolean;
  371. begin
  372. is_open_string:=(p.deftype=stringdef) and
  373. (tstringdef(p).string_typ=st_shortstring) and
  374. (tstringdef(p).len=0);
  375. end;
  376. { true, if p points to a zero based array def }
  377. function is_zero_based_array(p : tdef) : boolean;
  378. begin
  379. result:=(p.deftype=arraydef) and
  380. (tarraydef(p).lowrange=0) and
  381. not(is_special_array(p));
  382. end;
  383. { true if p points to a dynamic array def }
  384. function is_dynamic_array(p : tdef) : boolean;
  385. begin
  386. result:=(p.deftype=arraydef) and
  387. (ado_IsDynamicArray in tarraydef(p).arrayoptions);
  388. end;
  389. { true, if p points to an open array def }
  390. function is_open_array(p : tdef) : boolean;
  391. begin
  392. { check for s32inttype is needed, because for u32bit the high
  393. range is also -1 ! (PFV) }
  394. result:=(p.deftype=arraydef) and
  395. (tarraydef(p).rangetype.def=s32inttype.def) and
  396. (tarraydef(p).lowrange=0) and
  397. (tarraydef(p).highrange=-1) and
  398. ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])=[]);
  399. end;
  400. { true, if p points to an array of const def }
  401. function is_array_constructor(p : tdef) : boolean;
  402. begin
  403. result:=(p.deftype=arraydef) and
  404. (ado_IsConstructor in tarraydef(p).arrayoptions);
  405. end;
  406. { true, if p points to a variant array }
  407. function is_variant_array(p : tdef) : boolean;
  408. begin
  409. result:=(p.deftype=arraydef) and
  410. (ado_IsVariant in tarraydef(p).arrayoptions);
  411. end;
  412. { true, if p points to an array of const }
  413. function is_array_of_const(p : tdef) : boolean;
  414. begin
  415. result:=(p.deftype=arraydef) and
  416. (ado_IsArrayOfConst in tarraydef(p).arrayoptions);
  417. end;
  418. { true, if p points to a special array, bitpacked arrays aren't special in this regard though }
  419. function is_special_array(p : tdef) : boolean;
  420. begin
  421. result:=(p.deftype=arraydef) and
  422. (
  423. ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])<>[]) or
  424. is_open_array(p)
  425. );
  426. end;
  427. { true if p is an ansi string def }
  428. function is_ansistring(p : tdef) : boolean;
  429. begin
  430. is_ansistring:=(p.deftype=stringdef) and
  431. (tstringdef(p).string_typ=st_ansistring);
  432. end;
  433. { true if p is an long string def }
  434. function is_longstring(p : tdef) : boolean;
  435. begin
  436. is_longstring:=(p.deftype=stringdef) and
  437. (tstringdef(p).string_typ=st_longstring);
  438. end;
  439. { true if p is an wide string def }
  440. function is_widestring(p : tdef) : boolean;
  441. begin
  442. is_widestring:=(p.deftype=stringdef) and
  443. (tstringdef(p).string_typ=st_widestring);
  444. end;
  445. { true if p is an short string def }
  446. function is_shortstring(p : tdef) : boolean;
  447. begin
  448. is_shortstring:=(p.deftype=stringdef) and
  449. (tstringdef(p).string_typ=st_shortstring);
  450. end;
  451. { true if p is bit packed array def }
  452. function is_packed_array(p: tdef) : boolean;
  453. begin
  454. is_packed_array :=
  455. (p.deftype = arraydef) and
  456. (ado_IsBitPacked in tarraydef(p).arrayoptions);
  457. end;
  458. { true if p is bit packed record def }
  459. function is_packed_record_or_object(p: tdef) : boolean;
  460. begin
  461. is_packed_record_or_object :=
  462. (p.deftype in [recorddef,objectdef]) and
  463. (tabstractrecorddef(p).is_packed);
  464. end;
  465. { true if p is a char array def }
  466. function is_chararray(p : tdef) : boolean;
  467. begin
  468. is_chararray:=(p.deftype=arraydef) and
  469. is_char(tarraydef(p).elementtype.def) and
  470. not(is_special_array(p));
  471. end;
  472. { true if p is a widechar array def }
  473. function is_widechararray(p : tdef) : boolean;
  474. begin
  475. is_widechararray:=(p.deftype=arraydef) and
  476. is_widechar(tarraydef(p).elementtype.def) and
  477. not(is_special_array(p));
  478. end;
  479. { true if p is a open char array def }
  480. function is_open_chararray(p : tdef) : boolean;
  481. begin
  482. is_open_chararray:= is_open_array(p) and
  483. is_char(tarraydef(p).elementtype.def);
  484. end;
  485. { true if p is a open wide char array def }
  486. function is_open_widechararray(p : tdef) : boolean;
  487. begin
  488. is_open_widechararray:= is_open_array(p) and
  489. is_widechar(tarraydef(p).elementtype.def);
  490. end;
  491. { true if p is a pchar def }
  492. function is_pchar(p : tdef) : boolean;
  493. begin
  494. is_pchar:=(p.deftype=pointerdef) and
  495. (is_char(tpointerdef(p).pointertype.def) or
  496. (is_zero_based_array(tpointerdef(p).pointertype.def) and
  497. is_chararray(tpointerdef(p).pointertype.def)));
  498. end;
  499. { true if p is a pchar def }
  500. function is_pwidechar(p : tdef) : boolean;
  501. begin
  502. is_pwidechar:=(p.deftype=pointerdef) and
  503. (is_widechar(tpointerdef(p).pointertype.def) or
  504. (is_zero_based_array(tpointerdef(p).pointertype.def) and
  505. is_widechararray(tpointerdef(p).pointertype.def)));
  506. end;
  507. { true if p is a voidpointer def }
  508. function is_voidpointer(p : tdef) : boolean;
  509. begin
  510. is_voidpointer:=(p.deftype=pointerdef) and
  511. (tpointerdef(p).pointertype.def.deftype=orddef) and
  512. (torddef(tpointerdef(p).pointertype.def).typ=uvoid);
  513. end;
  514. { true if p is a smallset def }
  515. function is_smallset(p : tdef) : boolean;
  516. begin
  517. is_smallset:=(p.deftype=setdef) and
  518. (tsetdef(p).settype=smallset);
  519. end;
  520. { true, if def is a 32 bit int type }
  521. function is_32bitint(def : tdef) : boolean;
  522. begin
  523. result:=(def.deftype=orddef) and (torddef(def).typ in [u32bit,s32bit])
  524. end;
  525. { true, if def is a 64 bit int type }
  526. function is_64bitint(def : tdef) : boolean;
  527. begin
  528. is_64bitint:=(def.deftype=orddef) and (torddef(def).typ in [u64bit,s64bit])
  529. end;
  530. { true, if def is a 64 bit type }
  531. function is_64bit(def : tdef) : boolean;
  532. begin
  533. is_64bit:=(def.deftype=orddef) and (torddef(def).typ in [u64bit,s64bit,scurrency])
  534. end;
  535. { if l isn't in the range of def a range check error (if not explicit) is generated and
  536. the value is placed within the range }
  537. procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
  538. var
  539. lv,hv: TConstExprInt;
  540. error: boolean;
  541. begin
  542. error := false;
  543. { for 64 bit types we need only to check if it is less than }
  544. { zero, if def is a qword node }
  545. if is_64bitint(def) then
  546. begin
  547. if (l<0) and (torddef(def).typ=u64bit) then
  548. begin
  549. { don't zero the result, because it may come from hex notation
  550. like $ffffffffffffffff! (JM)
  551. l:=0; }
  552. if not explicit then
  553. begin
  554. if (cs_check_range in aktlocalswitches) then
  555. Message(parser_e_range_check_error)
  556. else
  557. Message(parser_w_range_check_error);
  558. end;
  559. error := true;
  560. end;
  561. end
  562. else
  563. begin
  564. getrange(def,lv,hv);
  565. if (l<lv) or (l>hv) then
  566. begin
  567. if not explicit then
  568. begin
  569. if ((def.deftype=enumdef) and
  570. { delphi allows range check errors in
  571. enumeration type casts FK }
  572. not(m_delphi in aktmodeswitches)) or
  573. (cs_check_range in aktlocalswitches) then
  574. Message(parser_e_range_check_error)
  575. else
  576. Message(parser_w_range_check_error);
  577. end;
  578. error := true;
  579. end;
  580. end;
  581. if error then
  582. begin
  583. { Fix the value to fit in the allocated space for this type of variable }
  584. case longint(def.size) of
  585. 1: l := l and $ff;
  586. 2: l := l and $ffff;
  587. { work around sign extension bug (to be fixed) (JM) }
  588. 4: l := l and (int64($fffffff) shl 4 + $f);
  589. end;
  590. { do sign extension if necessary (JM) }
  591. if is_signed(def) then
  592. begin
  593. case longint(def.size) of
  594. 1: l := shortint(l);
  595. 2: l := smallint(l);
  596. 4: l := longint(l);
  597. end;
  598. end;
  599. end;
  600. end;
  601. { return the range from def in l and h }
  602. procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
  603. begin
  604. case def.deftype of
  605. orddef :
  606. begin
  607. l:=torddef(def).low;
  608. h:=torddef(def).high;
  609. end;
  610. enumdef :
  611. begin
  612. l:=tenumdef(def).min;
  613. h:=tenumdef(def).max;
  614. end;
  615. arraydef :
  616. begin
  617. l:=tarraydef(def).lowrange;
  618. h:=tarraydef(def).highrange;
  619. end;
  620. else
  621. internalerror(987);
  622. end;
  623. end;
  624. function mmx_type(p : tdef) : tmmxtype;
  625. begin
  626. mmx_type:=mmxno;
  627. if is_mmx_able_array(p) then
  628. begin
  629. if tarraydef(p).elementtype.def.deftype=floatdef then
  630. case tfloatdef(tarraydef(p).elementtype.def).typ of
  631. s32real:
  632. mmx_type:=mmxsingle;
  633. end
  634. else
  635. case torddef(tarraydef(p).elementtype.def).typ of
  636. u8bit:
  637. mmx_type:=mmxu8bit;
  638. s8bit:
  639. mmx_type:=mmxs8bit;
  640. u16bit:
  641. mmx_type:=mmxu16bit;
  642. s16bit:
  643. mmx_type:=mmxs16bit;
  644. u32bit:
  645. mmx_type:=mmxu32bit;
  646. s32bit:
  647. mmx_type:=mmxs32bit;
  648. end;
  649. end;
  650. end;
  651. function is_mmx_able_array(p : tdef) : boolean;
  652. begin
  653. {$ifdef SUPPORT_MMX}
  654. if (cs_mmx_saturation in aktlocalswitches) then
  655. begin
  656. is_mmx_able_array:=(p.deftype=arraydef) and
  657. not(is_special_array(p)) and
  658. (
  659. (
  660. (tarraydef(p).elementtype.def.deftype=orddef) and
  661. (
  662. (
  663. (tarraydef(p).lowrange=0) and
  664. (tarraydef(p).highrange=1) and
  665. (torddef(tarraydef(p).elementtype.def).typ in [u32bit,s32bit])
  666. )
  667. or
  668. (
  669. (tarraydef(p).lowrange=0) and
  670. (tarraydef(p).highrange=3) and
  671. (torddef(tarraydef(p).elementtype.def).typ in [u16bit,s16bit])
  672. )
  673. )
  674. )
  675. or
  676. (
  677. (
  678. (tarraydef(p).elementtype.def.deftype=floatdef) and
  679. (
  680. (tarraydef(p).lowrange=0) and
  681. (tarraydef(p).highrange=1) and
  682. (tfloatdef(tarraydef(p).elementtype.def).typ=s32real)
  683. )
  684. )
  685. )
  686. );
  687. end
  688. else
  689. begin
  690. is_mmx_able_array:=(p.deftype=arraydef) and
  691. (
  692. (
  693. (tarraydef(p).elementtype.def.deftype=orddef) and
  694. (
  695. (
  696. (tarraydef(p).lowrange=0) and
  697. (tarraydef(p).highrange=1) and
  698. (torddef(tarraydef(p).elementtype.def).typ in [u32bit,s32bit])
  699. )
  700. or
  701. (
  702. (tarraydef(p).lowrange=0) and
  703. (tarraydef(p).highrange=3) and
  704. (torddef(tarraydef(p).elementtype.def).typ in [u16bit,s16bit])
  705. )
  706. or
  707. (
  708. (tarraydef(p).lowrange=0) and
  709. (tarraydef(p).highrange=7) and
  710. (torddef(tarraydef(p).elementtype.def).typ in [u8bit,s8bit])
  711. )
  712. )
  713. )
  714. or
  715. (
  716. (tarraydef(p).elementtype.def.deftype=floatdef) and
  717. (
  718. (tarraydef(p).lowrange=0) and
  719. (tarraydef(p).highrange=1) and
  720. (tfloatdef(tarraydef(p).elementtype.def).typ=s32real)
  721. )
  722. )
  723. );
  724. end;
  725. {$else SUPPORT_MMX}
  726. is_mmx_able_array:=false;
  727. {$endif SUPPORT_MMX}
  728. end;
  729. function def_cgsize(def: tdef): tcgsize;
  730. begin
  731. case def.deftype of
  732. orddef,
  733. enumdef,
  734. setdef:
  735. begin
  736. result:=int_cgsize(def.size);
  737. if is_signed(def) then
  738. result:=tcgsize(ord(result)+(ord(OS_S8)-ord(OS_8)));
  739. end;
  740. classrefdef,
  741. pointerdef:
  742. result := OS_ADDR;
  743. procvardef:
  744. begin
  745. if tprocvardef(def).is_methodpointer and
  746. (not tprocvardef(def).is_addressonly) then
  747. result := OS_64
  748. else
  749. result := OS_ADDR;
  750. end;
  751. stringdef :
  752. begin
  753. if is_ansistring(def) or is_widestring(def) then
  754. result := OS_ADDR
  755. else
  756. result:=int_cgsize(def.size);
  757. end;
  758. objectdef :
  759. begin
  760. if is_class_or_interface(def) then
  761. result := OS_ADDR
  762. else
  763. result:=int_cgsize(def.size);
  764. end;
  765. floatdef:
  766. if cs_fp_emulation in aktmoduleswitches then
  767. result:=int_cgsize(def.size)
  768. else
  769. result:=tfloat2tcgsize[tfloatdef(def).typ];
  770. recorddef :
  771. result:=int_cgsize(def.size);
  772. arraydef :
  773. begin
  774. if not is_special_array(def) then
  775. result := int_cgsize(def.size)
  776. else
  777. begin
  778. if is_dynamic_array(def) then
  779. result := OS_ADDR
  780. else
  781. result := OS_NO;
  782. end;
  783. end;
  784. else
  785. begin
  786. { undefined size }
  787. result:=OS_NO;
  788. end;
  789. end;
  790. end;
  791. function is_automatable(p : tdef) : boolean;
  792. begin
  793. result:=false;
  794. case p.deftype of
  795. orddef:
  796. result:=torddef(p).typ in [u8bit,s32bit,s16bit,bool16bit];
  797. floatdef:
  798. result:=tfloatdef(p).typ in [s64currency,s64real,s32real];
  799. stringdef:
  800. result:=tstringdef(p).string_typ in [st_shortstring,st_ansistring];
  801. variantdef:
  802. result:=true;
  803. end;
  804. end;
  805. {# returns true, if the type passed is a varset }
  806. function is_varset(p : tdef) : boolean;
  807. begin
  808. result:=(p.deftype=setdef) and not(p.size=4) and not(p.size=32);
  809. end;
  810. end.