2
0

defutil.pas 32 KB

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