defutil.pas 30 KB

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