defutil.pas 39 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216
  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. globtype,globals,constexp,
  22. symconst,symtype,symdef,
  23. cgbase,cpubase;
  24. type
  25. tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
  26. mmxu32bit,mmxs32bit,mmxfixed16,mmxsingle);
  27. {*****************************************************************************
  28. Basic type functions
  29. *****************************************************************************}
  30. {# Returns true, if definition defines an ordinal type }
  31. function is_ordinal(def : tdef) : boolean;
  32. {# Returns true, if definition defines a string type }
  33. function is_string(def : tdef): boolean;
  34. {# Returns True, if definition defines a type that behaves like a string,
  35. namely that can be joined and compared with another string-like type }
  36. function is_stringlike(def : tdef) : boolean;
  37. {# Returns True, if definition defines an enumeration type }
  38. function is_enum(def : tdef) : boolean;
  39. {# Returns True, if definition defines a set type }
  40. function is_set(def : tdef) : boolean;
  41. {# Returns the minimal integer value of the type }
  42. function get_min_value(def : tdef) : TConstExprInt;
  43. {# Returns the maximal integer value of the type }
  44. function get_max_value(def : tdef) : TConstExprInt;
  45. {# Returns basetype of the specified integer range }
  46. function range_to_basetype(l,h:TConstExprInt):tordtype;
  47. procedure range_to_type(l,h:TConstExprInt;var def:tdef);
  48. procedure int_to_type(v:TConstExprInt;var def:tdef);
  49. {# Returns true, if definition defines an integer type }
  50. function is_integer(def : tdef) : boolean;
  51. {# Returns true if definition is a boolean }
  52. function is_boolean(def : tdef) : boolean;
  53. {# Returns true if definition is a Pascal-style boolean (1 = true, zero = false) }
  54. function is_pasbool(def : tdef) : boolean;
  55. {# Returns true if definition is a C-style boolean (non-zero value = true, zero = false) }
  56. function is_cbool(def : tdef) : boolean;
  57. {# Returns true if definition is a char
  58. This excludes the unicode char.
  59. }
  60. function is_char(def : tdef) : boolean;
  61. {# Returns true if definition is a widechar }
  62. function is_widechar(def : tdef) : boolean;
  63. {# Returns true if definition is either an AnsiChar or a WideChar }
  64. function is_anychar(def : tdef) : boolean;
  65. {# Returns true if definition is a void}
  66. function is_void(def : tdef) : boolean;
  67. {# Returns true if definition is a smallset}
  68. function is_smallset(p : tdef) : boolean;
  69. {# Returns true, if def defines a signed data type
  70. (only for ordinal types)
  71. }
  72. function is_signed(def : tdef) : boolean;
  73. {# Returns whether def_from's range is comprised in def_to's if both are
  74. orddefs, false otherwise }
  75. function is_in_limit(def_from,def_to : tdef) : boolean;
  76. {# Returns whether def is reference counted }
  77. function is_managed_type(def: tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
  78. { function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;}
  79. {*****************************************************************************
  80. Array helper functions
  81. *****************************************************************************}
  82. {# Returns true, if p points to a zero based (non special like open or
  83. dynamic array def).
  84. This is mainly used to see if the array
  85. is convertable to a pointer
  86. }
  87. function is_zero_based_array(p : tdef) : boolean;
  88. {# Returns true if p points to an open array definition }
  89. function is_open_array(p : tdef) : boolean;
  90. {# Returns true if p points to a dynamic array definition }
  91. function is_dynamic_array(p : tdef) : boolean;
  92. {# Returns true, if p points to an array of const definition }
  93. function is_array_constructor(p : tdef) : boolean;
  94. {# Returns true, if p points to a variant array }
  95. function is_variant_array(p : tdef) : boolean;
  96. {# Returns true, if p points to an array of const }
  97. function is_array_of_const(p : tdef) : boolean;
  98. {# Returns true, if p points any kind of special array
  99. That is if the array is an open array, a variant
  100. array, an array constants constructor, or an
  101. array of const.
  102. Bitpacked arrays aren't special in this regard though.
  103. }
  104. function is_special_array(p : tdef) : boolean;
  105. {# Returns true if p is a bitpacked array }
  106. function is_packed_array(p: tdef) : boolean;
  107. {# Returns true if p is a bitpacked record }
  108. function is_packed_record_or_object(p: tdef) : boolean;
  109. {# Returns true if p is a char array def }
  110. function is_chararray(p : tdef) : boolean;
  111. {# Returns true if p is a wide char array def }
  112. function is_widechararray(p : tdef) : boolean;
  113. {# Returns true if p is a open char array def }
  114. function is_open_chararray(p : tdef) : boolean;
  115. {# Returns true if p is a open wide char array def }
  116. function is_open_widechararray(p : tdef) : boolean;
  117. {*****************************************************************************
  118. String helper functions
  119. *****************************************************************************}
  120. {# Returns true if p points to an open string type }
  121. function is_open_string(p : tdef) : boolean;
  122. {# Returns true if p is an ansi string type }
  123. function is_ansistring(p : tdef) : boolean;
  124. {# Returns true if p is an ansi string type with codepage 0 }
  125. function is_rawbytestring(p : tdef) : boolean;
  126. {# Returns true if p is a long string type }
  127. function is_longstring(p : tdef) : boolean;
  128. {# returns true if p is a wide string type }
  129. function is_widestring(p : tdef) : boolean;
  130. {# true if p is an unicode string def }
  131. function is_unicodestring(p : tdef) : boolean;
  132. {# true if p is an unicode/wide/ansistring string def }
  133. function is_dynamicstring(p : tdef) : boolean;
  134. {# returns true if p is a wide or unicode string type }
  135. function is_wide_or_unicode_string(p : tdef) : boolean;
  136. {# Returns true if p is a short string type }
  137. function is_shortstring(p : tdef) : boolean;
  138. {# Returns true if p is a pchar def }
  139. function is_pchar(p : tdef) : boolean;
  140. {# Returns true if p is a pwidechar def }
  141. function is_pwidechar(p : tdef) : boolean;
  142. {# Returns true if p is a voidpointer def }
  143. function is_voidpointer(p : tdef) : boolean;
  144. {# Returns true, if definition is a float }
  145. function is_fpu(def : tdef) : boolean;
  146. {# Returns true, if def is a currency type }
  147. function is_currency(def : tdef) : boolean;
  148. {# Returns true, if def is a single type }
  149. function is_single(def : tdef) : boolean;
  150. {# Returns true, if def is a double type }
  151. function is_double(def : tdef) : boolean;
  152. {# Returns true, if def is an extended type }
  153. function is_extended(def : tdef) : boolean;
  154. {# Returns true, if definition is a "real" real (i.e. single/double/extended) }
  155. function is_real(def : tdef) : boolean;
  156. {# Returns true, if def is a 32 bit integer type }
  157. function is_32bitint(def : tdef) : boolean;
  158. {# Returns true, if def is a 64 bit integer type }
  159. function is_64bitint(def : tdef) : boolean;
  160. {# Returns true, if def is a 64 bit type }
  161. function is_64bit(def : tdef) : boolean;
  162. {# If @var(l) isn't in the range of todef a range check error (if not explicit) is generated and
  163. the value is placed within the range
  164. }
  165. procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
  166. {# Returns the range of def, where @var(l) is the low-range and @var(h) is
  167. the high-range.
  168. }
  169. procedure getrange(def : tdef;out l, h : TConstExprInt);
  170. { type being a vector? }
  171. function is_vector(p : tdef) : boolean;
  172. { some type helper routines for MMX support }
  173. function is_mmx_able_array(p : tdef) : boolean;
  174. {# returns the mmx type }
  175. function mmx_type(p : tdef) : tmmxtype;
  176. { returns if the passed type (array) fits into an mm register }
  177. function fits_in_mm_register(p : tdef) : boolean;
  178. {# From a definition return the abstract code generator size enum. It is
  179. to note that the value returned can be @var(OS_NO) }
  180. function def_cgsize(def: tdef): tcgsize;
  181. {# returns true, if the type passed is can be used with windows automation }
  182. function is_automatable(p : tdef) : boolean;
  183. { # returns true if the procdef has no parameters and no specified return type }
  184. function is_bareprocdef(pd : tprocdef): boolean;
  185. { # returns the smallest base integer type whose range encompasses that of
  186. both ld and rd; if keep_sign_if_equal, then if ld and rd have the same
  187. signdness, the result will also get that signdness }
  188. function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
  189. { # returns whether the type is potentially a valid type of/for an "univ" parameter
  190. (basically: it must have a compile-time size) }
  191. function is_valid_univ_para_type(def: tdef): boolean;
  192. { # returns whether the procdef/procvardef represents a nested procedure
  193. or not }
  194. function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif}
  195. { # returns whether def is a type parameter of a generic }
  196. function is_typeparam(def : tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
  197. { returns true of def is a methodpointer }
  198. function is_methodpointer(def : tdef) : boolean;
  199. implementation
  200. uses
  201. verbose;
  202. { returns true, if def uses FPU }
  203. function is_fpu(def : tdef) : boolean;
  204. begin
  205. is_fpu:=(def.typ=floatdef);
  206. end;
  207. { returns true, if def is a currency type }
  208. function is_currency(def : tdef) : boolean;
  209. begin
  210. case s64currencytype.typ of
  211. orddef :
  212. result:=(def.typ=orddef) and
  213. (torddef(s64currencytype).ordtype=torddef(def).ordtype);
  214. floatdef :
  215. result:=(def.typ=floatdef) and
  216. (tfloatdef(s64currencytype).floattype=tfloatdef(def).floattype);
  217. else
  218. internalerror(200304222);
  219. end;
  220. end;
  221. { returns true, if def is a single type }
  222. function is_single(def : tdef) : boolean;
  223. begin
  224. result:=(def.typ=floatdef) and
  225. (tfloatdef(def).floattype=s32real);
  226. end;
  227. { returns true, if def is a double type }
  228. function is_double(def : tdef) : boolean;
  229. begin
  230. result:=(def.typ=floatdef) and
  231. (tfloatdef(def).floattype=s64real);
  232. end;
  233. function is_extended(def : tdef) : boolean;
  234. begin
  235. result:=(def.typ=floatdef) and
  236. (tfloatdef(def).floattype in [s80real,sc80real]);
  237. end;
  238. { returns true, if definition is a "real" real (i.e. single/double/extended) }
  239. function is_real(def : tdef) : boolean;
  240. begin
  241. result:=(def.typ=floatdef) and
  242. (tfloatdef(def).floattype in [s32real,s64real,s80real]);
  243. end;
  244. function range_to_basetype(l,h:TConstExprInt):tordtype;
  245. begin
  246. { prefer signed over unsigned }
  247. if (l>=int64(-128)) and (h<=127) then
  248. range_to_basetype:=s8bit
  249. else if (l>=0) and (h<=255) then
  250. range_to_basetype:=u8bit
  251. else if (l>=int64(-32768)) and (h<=32767) then
  252. range_to_basetype:=s16bit
  253. else if (l>=0) and (h<=65535) then
  254. range_to_basetype:=u16bit
  255. else if (l>=int64(low(longint))) and (h<=high(longint)) then
  256. range_to_basetype:=s32bit
  257. else if (l>=low(cardinal)) and (h<=high(cardinal)) then
  258. range_to_basetype:=u32bit
  259. else
  260. range_to_basetype:=s64bit;
  261. end;
  262. procedure range_to_type(l,h:TConstExprInt;var def:tdef);
  263. begin
  264. { prefer signed over unsigned }
  265. if (l>=int64(-128)) and (h<=127) then
  266. def:=s8inttype
  267. else if (l>=0) and (h<=255) then
  268. def:=u8inttype
  269. else if (l>=int64(-32768)) and (h<=32767) then
  270. def:=s16inttype
  271. else if (l>=0) and (h<=65535) then
  272. def:=u16inttype
  273. else if (l>=int64(low(longint))) and (h<=high(longint)) then
  274. def:=s32inttype
  275. else if (l>=low(cardinal)) and (h<=high(cardinal)) then
  276. def:=u32inttype
  277. else if (l>=low(int64)) and (h<=high(int64)) then
  278. def:=s64inttype
  279. else
  280. def:=u64inttype;
  281. end;
  282. procedure int_to_type(v:TConstExprInt;var def:tdef);
  283. begin
  284. range_to_type(v,v,def);
  285. end;
  286. { true if p is an ordinal }
  287. function is_ordinal(def : tdef) : boolean;
  288. var
  289. dt : tordtype;
  290. begin
  291. case def.typ of
  292. orddef :
  293. begin
  294. dt:=torddef(def).ordtype;
  295. is_ordinal:=dt in [uchar,uwidechar,
  296. u8bit,u16bit,u32bit,u64bit,
  297. s8bit,s16bit,s32bit,s64bit,
  298. pasbool8,pasbool16,pasbool32,pasbool64,
  299. bool8bit,bool16bit,bool32bit,bool64bit];
  300. end;
  301. enumdef :
  302. is_ordinal:=true;
  303. else
  304. is_ordinal:=false;
  305. end;
  306. end;
  307. { true if p is a string }
  308. function is_string(def : tdef) : boolean;
  309. begin
  310. is_string := (assigned(def) and (def.typ = stringdef));
  311. end;
  312. function is_stringlike(def : tdef) : boolean;
  313. begin
  314. result := is_string(def) or
  315. is_anychar(def) or
  316. is_pchar(def) or
  317. is_pwidechar(def) or
  318. is_chararray(def) or
  319. is_widechararray(def) or
  320. is_open_chararray(def) or
  321. is_open_widechararray(def) or
  322. (def=java_jlstring);
  323. end;
  324. function is_enum(def : tdef) : boolean;
  325. begin
  326. result:=def.typ=enumdef;
  327. end;
  328. function is_set(def : tdef) : boolean;
  329. begin
  330. result:=def.typ=setdef;
  331. end;
  332. { returns the min. value of the type }
  333. function get_min_value(def : tdef) : TConstExprInt;
  334. begin
  335. case def.typ of
  336. orddef:
  337. result:=torddef(def).low;
  338. enumdef:
  339. result:=int64(tenumdef(def).min);
  340. else
  341. result:=0;
  342. end;
  343. end;
  344. { returns the max. value of the type }
  345. function get_max_value(def : tdef) : TConstExprInt;
  346. begin
  347. case def.typ of
  348. orddef:
  349. result:=torddef(def).high;
  350. enumdef:
  351. result:=tenumdef(def).max;
  352. else
  353. result:=0;
  354. end;
  355. end;
  356. { true if p is an integer }
  357. function is_integer(def : tdef) : boolean;
  358. begin
  359. result:=(def.typ=orddef) and
  360. (torddef(def).ordtype in [u8bit,u16bit,u32bit,u64bit,
  361. s8bit,s16bit,s32bit,s64bit]);
  362. end;
  363. { true if p is a boolean }
  364. function is_boolean(def : tdef) : boolean;
  365. begin
  366. result:=(def.typ=orddef) and
  367. (torddef(def).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]);
  368. end;
  369. function is_pasbool(def : tdef) : boolean;
  370. begin
  371. result:=(def.typ=orddef) and
  372. (torddef(def).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64]);
  373. end;
  374. { true if def is a C-style boolean (non-zero value = true, zero = false) }
  375. function is_cbool(def : tdef) : boolean;
  376. begin
  377. result:=(def.typ=orddef) and
  378. (torddef(def).ordtype in [bool8bit,bool16bit,bool32bit,bool64bit]);
  379. end;
  380. { true if p is a void }
  381. function is_void(def : tdef) : boolean;
  382. begin
  383. result:=(def.typ=orddef) and
  384. (torddef(def).ordtype=uvoid);
  385. end;
  386. { true if p is a char }
  387. function is_char(def : tdef) : boolean;
  388. begin
  389. result:=(def.typ=orddef) and
  390. (torddef(def).ordtype=uchar);
  391. end;
  392. { true if p is a wchar }
  393. function is_widechar(def : tdef) : boolean;
  394. begin
  395. result:=(def.typ=orddef) and
  396. (torddef(def).ordtype=uwidechar);
  397. end;
  398. { true if p is a char or wchar }
  399. function is_anychar(def : tdef) : boolean;
  400. begin
  401. result:=(def.typ=orddef) and
  402. (torddef(def).ordtype in [uchar,uwidechar])
  403. end;
  404. { true if p is signed (integer) }
  405. function is_signed(def : tdef) : boolean;
  406. begin
  407. case def.typ of
  408. orddef :
  409. result:=torddef(def).low < 0;
  410. enumdef :
  411. result:=tenumdef(def).min < 0;
  412. arraydef :
  413. result:=is_signed(tarraydef(def).rangedef);
  414. else
  415. result:=false;
  416. end;
  417. end;
  418. function is_in_limit(def_from,def_to : tdef) : boolean;
  419. begin
  420. if (def_from.typ<>def_to.typ) or
  421. not(def_from.typ in [orddef,enumdef,setdef]) then
  422. begin
  423. is_in_limit := false;
  424. exit;
  425. end;
  426. case def_from.typ of
  427. orddef:
  428. is_in_limit:=(torddef(def_from).low>=torddef(def_to).low) and
  429. (torddef(def_from).high<=torddef(def_to).high);
  430. enumdef:
  431. is_in_limit:=(tenumdef(def_from).min>=tenumdef(def_to).min) and
  432. (tenumdef(def_from).max<=tenumdef(def_to).max);
  433. setdef:
  434. is_in_limit:=(tsetdef(def_from).setbase>=tsetdef(def_to).setbase) and
  435. (tsetdef(def_from).setmax<=tsetdef(def_to).setmax);
  436. else
  437. is_in_limit:=false;
  438. end;
  439. end;
  440. function is_managed_type(def: tdef): boolean;{$ifdef USEINLINE}inline;{$endif}
  441. begin
  442. result:=def.needs_inittable;
  443. end;
  444. { true, if p points to an open array def }
  445. function is_open_string(p : tdef) : boolean;
  446. begin
  447. is_open_string:=(p.typ=stringdef) and
  448. (tstringdef(p).stringtype=st_shortstring) and
  449. (tstringdef(p).len=0);
  450. end;
  451. { true, if p points to a zero based array def }
  452. function is_zero_based_array(p : tdef) : boolean;
  453. begin
  454. result:=(p.typ=arraydef) and
  455. (tarraydef(p).lowrange=0) and
  456. not(is_special_array(p));
  457. end;
  458. { true if p points to a dynamic array def }
  459. function is_dynamic_array(p : tdef) : boolean;
  460. begin
  461. result:=(p.typ=arraydef) and
  462. (ado_IsDynamicArray in tarraydef(p).arrayoptions);
  463. end;
  464. { true, if p points to an open array def }
  465. function is_open_array(p : tdef) : boolean;
  466. begin
  467. { check for s32inttype is needed, because for u32bit the high
  468. range is also -1 ! (PFV) }
  469. result:=(p.typ=arraydef) and
  470. (tarraydef(p).rangedef=s32inttype) and
  471. (tarraydef(p).lowrange=0) and
  472. (tarraydef(p).highrange=-1) and
  473. ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])=[]);
  474. end;
  475. { true, if p points to an array of const def }
  476. function is_array_constructor(p : tdef) : boolean;
  477. begin
  478. result:=(p.typ=arraydef) and
  479. (ado_IsConstructor in tarraydef(p).arrayoptions);
  480. end;
  481. { true, if p points to a variant array }
  482. function is_variant_array(p : tdef) : boolean;
  483. begin
  484. result:=(p.typ=arraydef) and
  485. (ado_IsVariant in tarraydef(p).arrayoptions);
  486. end;
  487. { true, if p points to an array of const }
  488. function is_array_of_const(p : tdef) : boolean;
  489. begin
  490. result:=(p.typ=arraydef) and
  491. (ado_IsArrayOfConst in tarraydef(p).arrayoptions);
  492. end;
  493. { true, if p points to a special array, bitpacked arrays aren't special in this regard though }
  494. function is_special_array(p : tdef) : boolean;
  495. begin
  496. result:=(p.typ=arraydef) and
  497. (
  498. ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])<>[]) or
  499. is_open_array(p)
  500. );
  501. end;
  502. { true if p is an ansi string def }
  503. function is_ansistring(p : tdef) : boolean;
  504. begin
  505. is_ansistring:=(p.typ=stringdef) and
  506. (tstringdef(p).stringtype=st_ansistring);
  507. end;
  508. { true if p is an ansi string def with codepage CP_NONE }
  509. function is_rawbytestring(p : tdef) : boolean;
  510. begin
  511. is_rawbytestring:=(p.typ=stringdef) and
  512. (tstringdef(p).stringtype=st_ansistring) and
  513. (tstringdef(p).encoding=globals.CP_NONE);
  514. end;
  515. { true if p is an long string def }
  516. function is_longstring(p : tdef) : boolean;
  517. begin
  518. is_longstring:=(p.typ=stringdef) and
  519. (tstringdef(p).stringtype=st_longstring);
  520. end;
  521. { true if p is an wide string def }
  522. function is_widestring(p : tdef) : boolean;
  523. begin
  524. is_widestring:=(p.typ=stringdef) and
  525. (tstringdef(p).stringtype=st_widestring);
  526. end;
  527. function is_dynamicstring(p: tdef): boolean;
  528. begin
  529. is_dynamicstring:=(p.typ=stringdef) and
  530. (tstringdef(p).stringtype in [st_ansistring,st_widestring,st_unicodestring]);
  531. end;
  532. { true if p is an wide string def }
  533. function is_wide_or_unicode_string(p : tdef) : boolean;
  534. begin
  535. is_wide_or_unicode_string:=(p.typ=stringdef) and
  536. (tstringdef(p).stringtype in [st_widestring,st_unicodestring]);
  537. end;
  538. { true if p is an unicode string def }
  539. function is_unicodestring(p : tdef) : boolean;
  540. begin
  541. is_unicodestring:=(p.typ=stringdef) and
  542. (tstringdef(p).stringtype=st_unicodestring);
  543. end;
  544. { true if p is an short string def }
  545. function is_shortstring(p : tdef) : boolean;
  546. begin
  547. is_shortstring:=(p.typ=stringdef) and
  548. (tstringdef(p).stringtype=st_shortstring);
  549. end;
  550. { true if p is bit packed array def }
  551. function is_packed_array(p: tdef) : boolean;
  552. begin
  553. is_packed_array :=
  554. (p.typ = arraydef) and
  555. (ado_IsBitPacked in tarraydef(p).arrayoptions);
  556. end;
  557. { true if p is bit packed record def }
  558. function is_packed_record_or_object(p: tdef) : boolean;
  559. begin
  560. is_packed_record_or_object :=
  561. (p.typ in [recorddef,objectdef]) and
  562. (tabstractrecorddef(p).is_packed);
  563. end;
  564. { true if p is a char array def }
  565. function is_chararray(p : tdef) : boolean;
  566. begin
  567. is_chararray:=(p.typ=arraydef) and
  568. is_char(tarraydef(p).elementdef) and
  569. not(is_special_array(p));
  570. end;
  571. { true if p is a widechar array def }
  572. function is_widechararray(p : tdef) : boolean;
  573. begin
  574. is_widechararray:=(p.typ=arraydef) and
  575. is_widechar(tarraydef(p).elementdef) and
  576. not(is_special_array(p));
  577. end;
  578. { true if p is a open char array def }
  579. function is_open_chararray(p : tdef) : boolean;
  580. begin
  581. is_open_chararray:= is_open_array(p) and
  582. is_char(tarraydef(p).elementdef);
  583. end;
  584. { true if p is a open wide char array def }
  585. function is_open_widechararray(p : tdef) : boolean;
  586. begin
  587. is_open_widechararray:= is_open_array(p) and
  588. is_widechar(tarraydef(p).elementdef);
  589. end;
  590. { true if p is a pchar def }
  591. function is_pchar(p : tdef) : boolean;
  592. begin
  593. is_pchar:=(p.typ=pointerdef) and
  594. (is_char(tpointerdef(p).pointeddef) or
  595. (is_zero_based_array(tpointerdef(p).pointeddef) and
  596. is_chararray(tpointerdef(p).pointeddef)));
  597. end;
  598. { true if p is a pchar def }
  599. function is_pwidechar(p : tdef) : boolean;
  600. begin
  601. is_pwidechar:=(p.typ=pointerdef) and
  602. (is_widechar(tpointerdef(p).pointeddef) or
  603. (is_zero_based_array(tpointerdef(p).pointeddef) and
  604. is_widechararray(tpointerdef(p).pointeddef)));
  605. end;
  606. { true if p is a voidpointer def }
  607. function is_voidpointer(p : tdef) : boolean;
  608. begin
  609. is_voidpointer:=(p.typ=pointerdef) and
  610. (tpointerdef(p).pointeddef.typ=orddef) and
  611. (torddef(tpointerdef(p).pointeddef).ordtype=uvoid);
  612. end;
  613. { true, if def is a 32 bit int type }
  614. function is_32bitint(def : tdef) : boolean;
  615. begin
  616. result:=(def.typ=orddef) and (torddef(def).ordtype in [u32bit,s32bit])
  617. end;
  618. { true, if def is a 64 bit int type }
  619. function is_64bitint(def : tdef) : boolean;
  620. begin
  621. is_64bitint:=(def.typ=orddef) and (torddef(def).ordtype in [u64bit,s64bit])
  622. end;
  623. { true, if def is a 64 bit type }
  624. function is_64bit(def : tdef) : boolean;
  625. begin
  626. is_64bit:=(def.typ=orddef) and (torddef(def).ordtype in [u64bit,s64bit,scurrency,pasbool64,bool64bit])
  627. end;
  628. { if l isn't in the range of todef a range check error (if not explicit) is generated and
  629. the value is placed within the range }
  630. procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
  631. var
  632. lv,hv: TConstExprInt;
  633. begin
  634. { for 64 bit types we need only to check if it is less than }
  635. { zero, if def is a qword node }
  636. getrange(todef,lv,hv);
  637. if (l<lv) or (l>hv) then
  638. begin
  639. if not explicit then
  640. begin
  641. if ((todef.typ=enumdef) and
  642. { delphi allows range check errors in
  643. enumeration type casts FK }
  644. not(m_delphi in current_settings.modeswitches)) or
  645. (cs_check_range in current_settings.localswitches) or
  646. forcerangecheck then
  647. Message3(type_e_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv))
  648. else
  649. Message3(type_w_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv));
  650. end;
  651. { Fix the value to fit in the allocated space for this type of variable }
  652. case longint(todef.size) of
  653. 1: l := l and $ff;
  654. 2: l := l and $ffff;
  655. 4: l := l and $ffffffff;
  656. end;
  657. {reset sign, i.e. converting -1 to qword changes the value to high(qword)}
  658. l.signed:=false;
  659. { do sign extension if necessary (JM) }
  660. if is_signed(todef) then
  661. begin
  662. case longint(todef.size) of
  663. 1: l.svalue := shortint(l.svalue);
  664. 2: l.svalue := smallint(l.svalue);
  665. 4: l.svalue := longint(l.svalue);
  666. end;
  667. l.signed:=true;
  668. end;
  669. end;
  670. end;
  671. { return the range from def in l and h }
  672. procedure getrange(def : tdef;out l, h : TConstExprInt);
  673. begin
  674. case def.typ of
  675. orddef :
  676. begin
  677. l:=torddef(def).low;
  678. h:=torddef(def).high;
  679. end;
  680. enumdef :
  681. begin
  682. l:=int64(tenumdef(def).min);
  683. h:=int64(tenumdef(def).max);
  684. end;
  685. arraydef :
  686. begin
  687. l:=int64(tarraydef(def).lowrange);
  688. h:=int64(tarraydef(def).highrange);
  689. end;
  690. else
  691. internalerror(200611054);
  692. end;
  693. end;
  694. function mmx_type(p : tdef) : tmmxtype;
  695. begin
  696. mmx_type:=mmxno;
  697. if is_mmx_able_array(p) then
  698. begin
  699. if tarraydef(p).elementdef.typ=floatdef then
  700. case tfloatdef(tarraydef(p).elementdef).floattype of
  701. s32real:
  702. mmx_type:=mmxsingle;
  703. end
  704. else
  705. case torddef(tarraydef(p).elementdef).ordtype of
  706. u8bit:
  707. mmx_type:=mmxu8bit;
  708. s8bit:
  709. mmx_type:=mmxs8bit;
  710. u16bit:
  711. mmx_type:=mmxu16bit;
  712. s16bit:
  713. mmx_type:=mmxs16bit;
  714. u32bit:
  715. mmx_type:=mmxu32bit;
  716. s32bit:
  717. mmx_type:=mmxs32bit;
  718. end;
  719. end;
  720. end;
  721. function is_vector(p : tdef) : boolean;
  722. begin
  723. result:=(p.typ=arraydef) and
  724. not(is_special_array(p)) and
  725. (tarraydef(p).elementdef.typ=floatdef) and
  726. (tfloatdef(tarraydef(p).elementdef).floattype in [s32real,s64real]);
  727. end;
  728. { returns if the passed type (array) fits into an mm register }
  729. function fits_in_mm_register(p : tdef) : boolean;
  730. begin
  731. {$ifdef x86}
  732. result:= is_vector(p) and
  733. (
  734. (tarraydef(p).elementdef.typ=floatdef) and
  735. (
  736. (tarraydef(p).lowrange=0) and
  737. (tarraydef(p).highrange=3) and
  738. (tfloatdef(tarraydef(p).elementdef).floattype=s32real)
  739. )
  740. ) or
  741. (
  742. (tarraydef(p).elementdef.typ=floatdef) and
  743. (
  744. (tarraydef(p).lowrange=0) and
  745. (tarraydef(p).highrange=1) and
  746. (tfloatdef(tarraydef(p).elementdef).floattype=s64real)
  747. )
  748. );
  749. {$else x86}
  750. result:=false;
  751. {$endif x86}
  752. end;
  753. function is_mmx_able_array(p : tdef) : boolean;
  754. begin
  755. {$ifdef SUPPORT_MMX}
  756. if (cs_mmx_saturation in current_settings.localswitches) then
  757. begin
  758. is_mmx_able_array:=(p.typ=arraydef) and
  759. not(is_special_array(p)) and
  760. (
  761. (
  762. (tarraydef(p).elementdef.typ=orddef) and
  763. (
  764. (
  765. (tarraydef(p).lowrange=0) and
  766. (tarraydef(p).highrange=1) and
  767. (torddef(tarraydef(p).elementdef).ordtype in [u32bit,s32bit])
  768. )
  769. or
  770. (
  771. (tarraydef(p).lowrange=0) and
  772. (tarraydef(p).highrange=3) and
  773. (torddef(tarraydef(p).elementdef).ordtype in [u16bit,s16bit])
  774. )
  775. )
  776. )
  777. or
  778. (
  779. (
  780. (tarraydef(p).elementdef.typ=floatdef) and
  781. (
  782. (tarraydef(p).lowrange=0) and
  783. (tarraydef(p).highrange=1) and
  784. (tfloatdef(tarraydef(p).elementdef).floattype=s32real)
  785. )
  786. )
  787. )
  788. );
  789. end
  790. else
  791. begin
  792. is_mmx_able_array:=(p.typ=arraydef) and
  793. (
  794. (
  795. (tarraydef(p).elementdef.typ=orddef) and
  796. (
  797. (
  798. (tarraydef(p).lowrange=0) and
  799. (tarraydef(p).highrange=1) and
  800. (torddef(tarraydef(p).elementdef).ordtype in [u32bit,s32bit])
  801. )
  802. or
  803. (
  804. (tarraydef(p).lowrange=0) and
  805. (tarraydef(p).highrange=3) and
  806. (torddef(tarraydef(p).elementdef).ordtype in [u16bit,s16bit])
  807. )
  808. or
  809. (
  810. (tarraydef(p).lowrange=0) and
  811. (tarraydef(p).highrange=7) and
  812. (torddef(tarraydef(p).elementdef).ordtype in [u8bit,s8bit])
  813. )
  814. )
  815. )
  816. or
  817. (
  818. (tarraydef(p).elementdef.typ=floatdef) and
  819. (
  820. (tarraydef(p).lowrange=0) and
  821. (tarraydef(p).highrange=1) and
  822. (tfloatdef(tarraydef(p).elementdef).floattype=s32real)
  823. )
  824. )
  825. );
  826. end;
  827. {$else SUPPORT_MMX}
  828. is_mmx_able_array:=false;
  829. {$endif SUPPORT_MMX}
  830. end;
  831. function def_cgsize(def: tdef): tcgsize;
  832. begin
  833. case def.typ of
  834. orddef,
  835. enumdef,
  836. setdef:
  837. begin
  838. result:=int_cgsize(def.size);
  839. if is_signed(def) then
  840. result:=tcgsize(ord(result)+(ord(OS_S8)-ord(OS_8)));
  841. end;
  842. classrefdef,
  843. pointerdef:
  844. result := OS_ADDR;
  845. procvardef:
  846. begin
  847. if not tprocvardef(def).is_addressonly then
  848. {$if sizeof(pint) = 2}
  849. result:=OS_32
  850. {$elseif sizeof(pint) = 4}
  851. result:=OS_64
  852. {$elseif sizeof(pint) = 8}
  853. result:=OS_128
  854. {$else}
  855. internalerror(200707141)
  856. {$endif}
  857. else
  858. result:=OS_ADDR;
  859. end;
  860. stringdef :
  861. begin
  862. if is_ansistring(def) or is_wide_or_unicode_string(def) then
  863. result := OS_ADDR
  864. else
  865. result:=int_cgsize(def.size);
  866. end;
  867. objectdef :
  868. begin
  869. if is_implicit_pointer_object_type(def) then
  870. result := OS_ADDR
  871. else
  872. result:=int_cgsize(def.size);
  873. end;
  874. floatdef:
  875. if cs_fp_emulation in current_settings.moduleswitches then
  876. result:=int_cgsize(def.size)
  877. else
  878. result:=tfloat2tcgsize[tfloatdef(def).floattype];
  879. recorddef :
  880. result:=int_cgsize(def.size);
  881. arraydef :
  882. begin
  883. if not is_special_array(def) then
  884. result := int_cgsize(def.size)
  885. else
  886. begin
  887. if is_dynamic_array(def) then
  888. result := OS_ADDR
  889. else
  890. result := OS_NO;
  891. end;
  892. end;
  893. else
  894. begin
  895. { undefined size }
  896. result:=OS_NO;
  897. end;
  898. end;
  899. end;
  900. { In Windows 95 era, ordinals were restricted to [u8bit,s32bit,s16bit,bool16bit]
  901. As of today, both signed and unsigned types from 8 to 64 bits are supported. }
  902. function is_automatable(p : tdef) : boolean;
  903. begin
  904. result:=false;
  905. case p.typ of
  906. orddef:
  907. result:=torddef(p).ordtype in [u8bit,s8bit,u16bit,s16bit,u32bit,s32bit,
  908. u64bit,s64bit,bool16bit,scurrency];
  909. floatdef:
  910. result:=tfloatdef(p).floattype in [s64currency,s64real,s32real];
  911. stringdef:
  912. result:=tstringdef(p).stringtype in [st_ansistring,st_widestring,st_unicodestring];
  913. variantdef:
  914. result:=true;
  915. objectdef:
  916. result:=tobjectdef(p).objecttype in [odt_interfacecom,odt_dispinterface,odt_interfacecorba];
  917. end;
  918. end;
  919. {# returns true, if the type passed is a varset }
  920. function is_smallset(p : tdef) : boolean;
  921. begin
  922. result:=(p.typ=setdef) and (p.size in [1,2,4])
  923. end;
  924. function is_bareprocdef(pd : tprocdef): boolean;
  925. begin
  926. result:=(pd.maxparacount=0) and
  927. (is_void(pd.returndef) or
  928. (pd.proctypeoption = potype_constructor));
  929. end;
  930. function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
  931. var
  932. llow, lhigh: tconstexprint;
  933. begin
  934. llow:=rd.low;
  935. if llow<ld.low then
  936. llow:=ld.low;
  937. lhigh:=rd.high;
  938. if lhigh<ld.high then
  939. lhigh:=ld.high;
  940. case range_to_basetype(llow,lhigh) of
  941. s8bit:
  942. result:=torddef(s8inttype);
  943. u8bit:
  944. result:=torddef(u8inttype);
  945. s16bit:
  946. result:=torddef(s16inttype);
  947. u16bit:
  948. result:=torddef(u16inttype);
  949. s32bit:
  950. result:=torddef(s32inttype);
  951. u32bit:
  952. result:=torddef(u32inttype);
  953. s64bit:
  954. result:=torddef(s64inttype);
  955. u64bit:
  956. result:=torddef(u64inttype);
  957. else
  958. begin
  959. { avoid warning }
  960. result:=nil;
  961. internalerror(200802291);
  962. end;
  963. end;
  964. if keep_sign_if_equal and
  965. (is_signed(ld)=is_signed(rd)) and
  966. (is_signed(result)<>is_signed(ld)) then
  967. case result.ordtype of
  968. s8bit:
  969. result:=torddef(u8inttype);
  970. u8bit:
  971. result:=torddef(s16inttype);
  972. s16bit:
  973. result:=torddef(u16inttype);
  974. u16bit:
  975. result:=torddef(s32inttype);
  976. s32bit:
  977. result:=torddef(u32inttype);
  978. u32bit:
  979. result:=torddef(s64inttype);
  980. s64bit:
  981. result:=torddef(u64inttype);
  982. end;
  983. end;
  984. function is_valid_univ_para_type(def: tdef): boolean;
  985. begin
  986. result:=
  987. not is_open_array(def) and
  988. not is_void(def) and
  989. (def.typ<>formaldef);
  990. end;
  991. function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif}
  992. begin
  993. result:=def.parast.symtablelevel>normal_function_level;
  994. end;
  995. function is_typeparam(def : tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
  996. begin
  997. result:=(def.typ=undefineddef);
  998. end;
  999. function is_methodpointer(def: tdef): boolean;
  1000. begin
  1001. result:=(def.typ=procvardef) and (po_methodpointer in tprocvardef(def).procoptions);
  1002. end;
  1003. end.