defutil.pas 55 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714
  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,mmxs64bit,mmxu64bit);
  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(const l,h:TConstExprInt):tordtype;
  47. procedure range_to_type(const l,h:TConstExprInt;var def:tdef);
  48. procedure int_to_type(const 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 an unsigned integer type of the same size as def; def must be
  74. an ordinal or enum }
  75. function get_unsigned_inttype(def: tdef): torddef;
  76. {# Returns whether def_from's range is comprised in def_to's if both are
  77. orddefs, false otherwise }
  78. function is_in_limit(def_from,def_to : tdef) : boolean;
  79. {# Returns whether def is reference counted }
  80. function is_managed_type(def: tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
  81. { # Returns whether def is needs to load RTTI for reference counting }
  82. function is_rtti_managed_type(def: tdef) : boolean;
  83. { function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;}
  84. {*****************************************************************************
  85. Array helper functions
  86. *****************************************************************************}
  87. {# Returns true, if p points to a zero based (non special like open or
  88. dynamic array def).
  89. This is mainly used to see if the array
  90. is convertable to a pointer
  91. }
  92. function is_zero_based_array(p : tdef) : boolean;
  93. {# Returns true if p points to an open array definition }
  94. function is_open_array(p : tdef) : boolean;
  95. {# Returns true if p points to a dynamic array definition }
  96. function is_dynamic_array(p : tdef) : boolean;
  97. {# Returns true, if p points to an array of const definition }
  98. function is_array_constructor(p : tdef) : boolean;
  99. {# Returns true, if p points to a variant array }
  100. function is_variant_array(p : tdef) : boolean;
  101. {# Returns true, if p points to an array of const }
  102. function is_array_of_const(p : tdef) : boolean;
  103. {# Returns true, if p points any kind of special array
  104. That is if the array is an open array, a variant
  105. array, an array constants constructor, or an
  106. array of const.
  107. Bitpacked arrays aren't special in this regard though.
  108. }
  109. function is_special_array(p : tdef) : boolean;
  110. {# Returns true, if p points to a normal array, bitpacked arrays are included }
  111. function is_normal_array(p : tdef) : boolean;
  112. {# Returns true if p is a bitpacked array }
  113. function is_packed_array(p: tdef) : boolean;
  114. {# Returns true if p is a bitpacked record }
  115. function is_packed_record_or_object(p: tdef) : boolean;
  116. {# Returns true if p is a char array def }
  117. function is_chararray(p : tdef) : boolean;
  118. {# Returns true if p is a wide char array def }
  119. function is_widechararray(p : tdef) : boolean;
  120. {# Returns true if p is a open char array def }
  121. function is_open_chararray(p : tdef) : boolean;
  122. {# Returns true if p is a open wide char array def }
  123. function is_open_widechararray(p : tdef) : boolean;
  124. {*****************************************************************************
  125. String helper functions
  126. *****************************************************************************}
  127. {# Returns true if p points to an open string type }
  128. function is_open_string(p : tdef) : boolean;
  129. {# Returns true if p is an ansi string type }
  130. function is_ansistring(p : tdef) : boolean;
  131. {# Returns true if p is an ansi string type with codepage 0 }
  132. function is_rawbytestring(p : tdef) : boolean;
  133. {# Returns true if p is a long string type }
  134. function is_longstring(p : tdef) : boolean;
  135. {# returns true if p is a wide string type }
  136. function is_widestring(p : tdef) : boolean;
  137. {# true if p is an unicode string def }
  138. function is_unicodestring(p : tdef) : boolean;
  139. {# true if p is an unicode/wide/ansistring string def }
  140. function is_dynamicstring(p : tdef) : boolean;
  141. {# returns true if p is a wide or unicode string type }
  142. function is_wide_or_unicode_string(p : tdef) : boolean;
  143. {# Returns true if p is a short string type }
  144. function is_shortstring(p : tdef) : boolean;
  145. {# Returns true if p is any pointer def }
  146. function is_pointer(p : tdef) : boolean;
  147. {# Returns true if p is a pchar def }
  148. function is_pchar(p : tdef) : boolean;
  149. {# Returns true if p is a pwidechar def }
  150. function is_pwidechar(p : tdef) : boolean;
  151. {# Returns true if p is a voidpointer def }
  152. function is_voidpointer(p : tdef) : boolean;
  153. {# Returns true, if definition is a float }
  154. function is_fpu(def : tdef) : boolean;
  155. {# Returns true, if def is a currency type }
  156. function is_currency(def : tdef) : boolean;
  157. {# Returns true, if def is a single type }
  158. function is_single(def : tdef) : boolean;
  159. {# Returns true, if def is a double type }
  160. function is_double(def : tdef) : boolean;
  161. {# Returns true, if def is an extended type }
  162. function is_extended(def : tdef) : boolean;
  163. {# Returns true, if definition is a "real" real (i.e. single/double/extended) }
  164. function is_real(def : tdef) : boolean;
  165. {# Returns true for single,double,extended and cextended }
  166. function is_real_or_cextended(def : tdef) : boolean;
  167. { true, if def is a 8 bit int type }
  168. function is_8bitint(def : tdef) : boolean;
  169. { true, if def is a 8 bit ordinal type }
  170. function is_8bit(def : tdef) : boolean;
  171. { true, if def is a 16 bit int type }
  172. function is_16bitint(def : tdef) : boolean;
  173. { true, if def is a 16 bit ordinal type }
  174. function is_16bit(def : tdef) : boolean;
  175. {# Returns true, if def is a 32 bit integer type }
  176. function is_32bitint(def : tdef) : boolean;
  177. {# Returns true, if def is a 32 bit ordinal type }
  178. function is_32bit(def : tdef) : boolean;
  179. {# Returns true, if def is a 64 bit integer type }
  180. function is_64bitint(def : tdef) : boolean;
  181. {# Returns true, if def is a 64 bit type }
  182. function is_64bit(def : tdef) : boolean;
  183. { true, if def1 and def2 are both integers of the same bit size and sign }
  184. function are_equal_ints(def1, def2: tdef): boolean;
  185. { true, if def is an int type, larger than the processor's native int size }
  186. function is_oversizedint(def : tdef) : boolean;
  187. { true, if def is an ordinal type, larger than the processor's native int size }
  188. function is_oversizedord(def : tdef) : boolean;
  189. { true, if def is an int type, equal in size to the processor's native int size }
  190. function is_nativeint(def : tdef) : boolean;
  191. { true, if def is an ordinal type, equal in size to the processor's native int size }
  192. function is_nativeord(def : tdef) : boolean;
  193. { true, if def is an unsigned int type, equal in size to the processor's native int size }
  194. function is_nativeuint(def : tdef) : boolean;
  195. { true, if def is a signed int type, equal in size to the processor's native int size }
  196. function is_nativesint(def : tdef) : boolean;
  197. {# If @var(l) isn't in the range of todef a range check error (if not explicit) is generated and
  198. the value is placed within the range
  199. }
  200. procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
  201. {# Returns the range of def, where @var(l) is the low-range and @var(h) is
  202. the high-range.
  203. }
  204. procedure getrange(def : tdef;out l, h : TConstExprInt);
  205. { Returns the range type of an ordinal type in the sense of ISO-10206 }
  206. function get_iso_range_type(def: tdef): tdef;
  207. { type being a vector? }
  208. function is_vector(p : tdef) : boolean;
  209. { some type helper routines for MMX support }
  210. function is_mmx_able_array(p : tdef) : boolean;
  211. {# returns the mmx type }
  212. function mmx_type(p : tdef) : tmmxtype;
  213. { returns if the passed type (array) fits into an mm register }
  214. function fits_in_mm_register(p : tdef) : boolean;
  215. {# From a definition return the abstract code generator size enum. It is
  216. to note that the value returned can be @var(OS_NO) }
  217. function def_cgsize(def: tdef): tcgsize;
  218. { #Return an orddef (integer) correspondig to a tcgsize }
  219. function cgsize_orddef(size: tcgsize): torddef;
  220. {# Same as def_cgsize, except that it will interpret certain arrays as
  221. vectors and return OS_M* sizes for them }
  222. function def_cgmmsize(def: tdef): tcgsize;
  223. {# returns true, if the type passed is can be used with windows automation }
  224. function is_automatable(p : tdef) : boolean;
  225. { # returns true if the procdef has no parameters and no specified return type }
  226. function is_bareprocdef(pd : tprocdef): boolean;
  227. { returns true if the procdef is a C-style variadic function }
  228. function is_c_variadic(pd: tabstractprocdef): boolean; {$ifdef USEINLINE}inline;{$endif}
  229. { # returns the smallest base integer type whose range encompasses that of
  230. both ld and rd; if keep_sign_if_equal, then if ld and rd have the same
  231. signdness, the result will also get that signdness }
  232. function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
  233. { # returns whether the type is potentially a valid type of/for an "univ" parameter
  234. (basically: it must have a compile-time size) }
  235. function is_valid_univ_para_type(def: tdef): boolean;
  236. { # returns whether the procdef/procvardef represents a nested procedure
  237. or not }
  238. function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif}
  239. { # returns whether def is a type parameter of a generic }
  240. function is_typeparam(def : tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
  241. { returns true of def is a methodpointer }
  242. function is_methodpointer(def : tdef) : boolean;
  243. { returns true if def is a C "block" }
  244. function is_block(def: tdef): boolean;
  245. { returns the TTypeKind value of the def }
  246. function get_typekind(def: tdef): byte;
  247. implementation
  248. uses
  249. verbose,cutils;
  250. { returns true, if def uses FPU }
  251. function is_fpu(def : tdef) : boolean;
  252. begin
  253. is_fpu:=(def.typ=floatdef);
  254. end;
  255. { returns true, if def is a currency type }
  256. function is_currency(def : tdef) : boolean;
  257. begin
  258. case s64currencytype.typ of
  259. orddef :
  260. result:=(def.typ=orddef) and
  261. (torddef(s64currencytype).ordtype=torddef(def).ordtype);
  262. floatdef :
  263. result:=(def.typ=floatdef) and
  264. (tfloatdef(s64currencytype).floattype=tfloatdef(def).floattype);
  265. else
  266. internalerror(200304222);
  267. end;
  268. end;
  269. { returns true, if def is a single type }
  270. function is_single(def : tdef) : boolean;
  271. begin
  272. result:=(def.typ=floatdef) and
  273. (tfloatdef(def).floattype=s32real);
  274. end;
  275. { returns true, if def is a double type }
  276. function is_double(def : tdef) : boolean;
  277. begin
  278. result:=(def.typ=floatdef) and
  279. (tfloatdef(def).floattype=s64real);
  280. end;
  281. function is_extended(def : tdef) : boolean;
  282. begin
  283. result:=(def.typ=floatdef) and
  284. (tfloatdef(def).floattype in [s80real,sc80real]);
  285. end;
  286. { returns true, if definition is a "real" real (i.e. single/double/extended) }
  287. function is_real(def : tdef) : boolean;
  288. begin
  289. result:=(def.typ=floatdef) and
  290. (tfloatdef(def).floattype in [s32real,s64real,s80real]);
  291. end;
  292. function is_real_or_cextended(def: tdef): boolean;
  293. begin
  294. result:=(def.typ=floatdef) and
  295. (tfloatdef(def).floattype in [s32real,s64real,s80real,sc80real]);
  296. end;
  297. function range_to_basetype(const l,h:TConstExprInt):tordtype;
  298. begin
  299. { prefer signed over unsigned }
  300. if (l>=int64(-128)) and (h<=127) then
  301. range_to_basetype:=s8bit
  302. else if (l>=0) and (h<=255) then
  303. range_to_basetype:=u8bit
  304. else if (l>=int64(-32768)) and (h<=32767) then
  305. range_to_basetype:=s16bit
  306. else if (l>=0) and (h<=65535) then
  307. range_to_basetype:=u16bit
  308. else if (l>=int64(low(longint))) and (h<=high(longint)) then
  309. range_to_basetype:=s32bit
  310. else if (l>=low(cardinal)) and (h<=high(cardinal)) then
  311. range_to_basetype:=u32bit
  312. else if (l>=low(int64)) and (h<=high(int64)) then
  313. range_to_basetype:=s64bit
  314. else
  315. range_to_basetype:=u64bit;
  316. end;
  317. procedure range_to_type(const l,h:TConstExprInt;var def:tdef);
  318. begin
  319. { prefer signed over unsigned }
  320. if (l>=int64(-128)) and (h<=127) then
  321. def:=s8inttype
  322. else if (l>=0) and (h<=255) then
  323. def:=u8inttype
  324. else if (l>=int64(-32768)) and (h<=32767) then
  325. def:=s16inttype
  326. else if (l>=0) and (h<=65535) then
  327. def:=u16inttype
  328. else if (l>=int64(low(longint))) and (h<=high(longint)) then
  329. def:=s32inttype
  330. else if (l>=low(cardinal)) and (h<=high(cardinal)) then
  331. def:=u32inttype
  332. else if (l>=low(int64)) and (h<=high(int64)) then
  333. def:=s64inttype
  334. else
  335. def:=u64inttype;
  336. end;
  337. procedure int_to_type(const v:TConstExprInt;var def:tdef);
  338. begin
  339. range_to_type(v,v,def);
  340. end;
  341. { true if p is an ordinal }
  342. function is_ordinal(def : tdef) : boolean;
  343. var
  344. dt : tordtype;
  345. begin
  346. case def.typ of
  347. orddef :
  348. begin
  349. dt:=torddef(def).ordtype;
  350. is_ordinal:=dt in [uchar,uwidechar,
  351. u8bit,u16bit,u32bit,u64bit,
  352. s8bit,s16bit,s32bit,s64bit,
  353. pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
  354. bool8bit,bool16bit,bool32bit,bool64bit,customint];
  355. end;
  356. enumdef :
  357. is_ordinal:=true;
  358. else
  359. is_ordinal:=false;
  360. end;
  361. end;
  362. { true if p is a string }
  363. function is_string(def : tdef) : boolean;
  364. begin
  365. is_string := (assigned(def) and (def.typ = stringdef));
  366. end;
  367. function is_stringlike(def : tdef) : boolean;
  368. begin
  369. result := is_string(def) or
  370. is_anychar(def) or
  371. is_pchar(def) or
  372. is_pwidechar(def) or
  373. is_chararray(def) or
  374. is_widechararray(def) or
  375. is_open_chararray(def) or
  376. is_open_widechararray(def) or
  377. (def=java_jlstring);
  378. end;
  379. function is_enum(def : tdef) : boolean;
  380. begin
  381. result:=def.typ=enumdef;
  382. end;
  383. function is_set(def : tdef) : boolean;
  384. begin
  385. result:=def.typ=setdef;
  386. end;
  387. { returns the min. value of the type }
  388. function get_min_value(def : tdef) : TConstExprInt;
  389. begin
  390. case def.typ of
  391. orddef:
  392. result:=torddef(def).low;
  393. enumdef:
  394. result:=int64(tenumdef(def).min);
  395. else
  396. result:=0;
  397. end;
  398. end;
  399. { returns the max. value of the type }
  400. function get_max_value(def : tdef) : TConstExprInt;
  401. begin
  402. case def.typ of
  403. orddef:
  404. result:=torddef(def).high;
  405. enumdef:
  406. result:=tenumdef(def).max;
  407. else
  408. result:=0;
  409. end;
  410. end;
  411. { true if p is an integer }
  412. function is_integer(def : tdef) : boolean;
  413. begin
  414. result:=(def.typ=orddef) and
  415. (torddef(def).ordtype in [u8bit,u16bit,u32bit,u64bit,
  416. s8bit,s16bit,s32bit,s64bit,
  417. customint]);
  418. end;
  419. { true if p is a boolean }
  420. function is_boolean(def : tdef) : boolean;
  421. begin
  422. result:=(def.typ=orddef) and
  423. (torddef(def).ordtype in [pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]);
  424. end;
  425. function is_pasbool(def : tdef) : boolean;
  426. begin
  427. result:=(def.typ=orddef) and
  428. (torddef(def).ordtype in [pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]);
  429. end;
  430. { true if def is a C-style boolean (non-zero value = true, zero = false) }
  431. function is_cbool(def : tdef) : boolean;
  432. begin
  433. result:=(def.typ=orddef) and
  434. (torddef(def).ordtype in [bool8bit,bool16bit,bool32bit,bool64bit]);
  435. end;
  436. { true if p is a void }
  437. function is_void(def : tdef) : boolean;
  438. begin
  439. result:=(def.typ=orddef) and
  440. (torddef(def).ordtype=uvoid);
  441. end;
  442. { true if p is a char }
  443. function is_char(def : tdef) : boolean;
  444. begin
  445. result:=(def.typ=orddef) and
  446. (torddef(def).ordtype=uchar);
  447. end;
  448. { true if p is a wchar }
  449. function is_widechar(def : tdef) : boolean;
  450. begin
  451. result:=(def.typ=orddef) and
  452. (torddef(def).ordtype=uwidechar);
  453. end;
  454. { true if p is a char or wchar }
  455. function is_anychar(def : tdef) : boolean;
  456. begin
  457. result:=(def.typ=orddef) and
  458. (torddef(def).ordtype in [uchar,uwidechar])
  459. end;
  460. { true if p is signed (integer) }
  461. function is_signed(def : tdef) : boolean;
  462. begin
  463. case def.typ of
  464. orddef :
  465. result:=torddef(def).low < 0;
  466. enumdef :
  467. result:=tenumdef(def).min < 0;
  468. arraydef :
  469. result:=is_signed(tarraydef(def).rangedef);
  470. else
  471. result:=false;
  472. end;
  473. end;
  474. function get_unsigned_inttype(def: tdef): torddef;
  475. begin
  476. case def.typ of
  477. orddef,
  478. enumdef:
  479. result:=cgsize_orddef(tcgsize2unsigned[def_cgsize(def)]);
  480. else
  481. internalerror(2016062001);
  482. end;
  483. end;
  484. function is_in_limit(def_from,def_to : tdef) : boolean;
  485. begin
  486. if (def_from.typ<>def_to.typ) or
  487. not(def_from.typ in [orddef,enumdef,setdef]) then
  488. begin
  489. is_in_limit := false;
  490. exit;
  491. end;
  492. case def_from.typ of
  493. orddef:
  494. is_in_limit:=(torddef(def_from).low>=torddef(def_to).low) and
  495. (torddef(def_from).high<=torddef(def_to).high);
  496. enumdef:
  497. is_in_limit:=(tenumdef(def_from).min>=tenumdef(def_to).min) and
  498. (tenumdef(def_from).max<=tenumdef(def_to).max);
  499. setdef:
  500. is_in_limit:=(tsetdef(def_from).setbase>=tsetdef(def_to).setbase) and
  501. (tsetdef(def_from).setmax<=tsetdef(def_to).setmax);
  502. else
  503. is_in_limit:=false;
  504. end;
  505. end;
  506. function is_managed_type(def: tdef): boolean;{$ifdef USEINLINE}inline;{$endif}
  507. begin
  508. result:=def.needs_inittable;
  509. end;
  510. function is_rtti_managed_type(def: tdef): boolean;
  511. begin
  512. result:=def.needs_inittable and not (
  513. is_interfacecom_or_dispinterface(def) or
  514. (def.typ=variantdef) or
  515. (
  516. (def.typ=stringdef) and
  517. (tstringdef(def).stringtype in [st_ansistring,st_widestring,st_unicodestring])
  518. )
  519. );
  520. end;
  521. { true, if p points to an open array def }
  522. function is_open_string(p : tdef) : boolean;
  523. begin
  524. is_open_string:=(p.typ=stringdef) and
  525. (tstringdef(p).stringtype=st_shortstring) and
  526. (tstringdef(p).len=0);
  527. end;
  528. { true, if p points to a zero based array def }
  529. function is_zero_based_array(p : tdef) : boolean;
  530. begin
  531. result:=(p.typ=arraydef) and
  532. (tarraydef(p).lowrange=0) and
  533. not(is_special_array(p));
  534. end;
  535. { true if p points to a dynamic array def }
  536. function is_dynamic_array(p : tdef) : boolean;
  537. begin
  538. result:=(p.typ=arraydef) and
  539. (ado_IsDynamicArray in tarraydef(p).arrayoptions);
  540. end;
  541. { true, if p points to an open array def }
  542. function is_open_array(p : tdef) : boolean;
  543. begin
  544. { check for sizesinttype is needed, because for unsigned the high
  545. range is also -1 ! (PFV) }
  546. result:=(p.typ=arraydef) and
  547. (tarraydef(p).rangedef=sizesinttype) and
  548. (tarraydef(p).lowrange=0) and
  549. (tarraydef(p).highrange=-1) and
  550. ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])=[]);
  551. end;
  552. { true, if p points to an array of const def }
  553. function is_array_constructor(p : tdef) : boolean;
  554. begin
  555. result:=(p.typ=arraydef) and
  556. (ado_IsConstructor in tarraydef(p).arrayoptions);
  557. end;
  558. { true, if p points to a variant array }
  559. function is_variant_array(p : tdef) : boolean;
  560. begin
  561. result:=(p.typ=arraydef) and
  562. (ado_IsVariant in tarraydef(p).arrayoptions);
  563. end;
  564. { true, if p points to an array of const }
  565. function is_array_of_const(p : tdef) : boolean;
  566. begin
  567. result:=(p.typ=arraydef) and
  568. (ado_IsArrayOfConst in tarraydef(p).arrayoptions);
  569. end;
  570. { true, if p points to a special array, bitpacked arrays aren't special in this regard though }
  571. function is_special_array(p : tdef) : boolean;
  572. begin
  573. result:=(p.typ=arraydef) and
  574. (
  575. ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])<>[]) or
  576. is_open_array(p)
  577. );
  578. end;
  579. { true, if p points to a normal array, bitpacked arrays are included }
  580. function is_normal_array(p : tdef) : boolean;
  581. begin
  582. result:=(p.typ=arraydef) and
  583. ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])=[]) and
  584. not(is_open_array(p));
  585. end;
  586. { true if p is an ansi string def }
  587. function is_ansistring(p : tdef) : boolean;
  588. begin
  589. is_ansistring:=(p.typ=stringdef) and
  590. (tstringdef(p).stringtype=st_ansistring);
  591. end;
  592. { true if p is an ansi string def with codepage CP_NONE }
  593. function is_rawbytestring(p : tdef) : boolean;
  594. begin
  595. is_rawbytestring:=(p.typ=stringdef) and
  596. (tstringdef(p).stringtype=st_ansistring) and
  597. (tstringdef(p).encoding=globals.CP_NONE);
  598. end;
  599. { true if p is an long string def }
  600. function is_longstring(p : tdef) : boolean;
  601. begin
  602. is_longstring:=(p.typ=stringdef) and
  603. (tstringdef(p).stringtype=st_longstring);
  604. end;
  605. { true if p is an wide string def }
  606. function is_widestring(p : tdef) : boolean;
  607. begin
  608. is_widestring:=(p.typ=stringdef) and
  609. (tstringdef(p).stringtype=st_widestring);
  610. end;
  611. function is_dynamicstring(p: tdef): boolean;
  612. begin
  613. is_dynamicstring:=(p.typ=stringdef) and
  614. (tstringdef(p).stringtype in [st_ansistring,st_widestring,st_unicodestring]);
  615. end;
  616. { true if p is an wide string def }
  617. function is_wide_or_unicode_string(p : tdef) : boolean;
  618. begin
  619. is_wide_or_unicode_string:=(p.typ=stringdef) and
  620. (tstringdef(p).stringtype in [st_widestring,st_unicodestring]);
  621. end;
  622. { true if p is an unicode string def }
  623. function is_unicodestring(p : tdef) : boolean;
  624. begin
  625. is_unicodestring:=(p.typ=stringdef) and
  626. (tstringdef(p).stringtype=st_unicodestring);
  627. end;
  628. { true if p is an short string def }
  629. function is_shortstring(p : tdef) : boolean;
  630. begin
  631. is_shortstring:=(p.typ=stringdef) and
  632. (tstringdef(p).stringtype=st_shortstring);
  633. end;
  634. { true if p is bit packed array def }
  635. function is_packed_array(p: tdef) : boolean;
  636. begin
  637. is_packed_array :=
  638. (p.typ = arraydef) and
  639. (ado_IsBitPacked in tarraydef(p).arrayoptions);
  640. end;
  641. { true if p is bit packed record def }
  642. function is_packed_record_or_object(p: tdef) : boolean;
  643. begin
  644. is_packed_record_or_object :=
  645. (p.typ in [recorddef,objectdef]) and
  646. (tabstractrecorddef(p).is_packed);
  647. end;
  648. { true if p is a char array def }
  649. function is_chararray(p : tdef) : boolean;
  650. begin
  651. is_chararray:=(p.typ=arraydef) and
  652. is_char(tarraydef(p).elementdef) and
  653. not(is_special_array(p));
  654. end;
  655. { true if p is a widechar array def }
  656. function is_widechararray(p : tdef) : boolean;
  657. begin
  658. is_widechararray:=(p.typ=arraydef) and
  659. is_widechar(tarraydef(p).elementdef) and
  660. not(is_special_array(p));
  661. end;
  662. { true if p is a open char array def }
  663. function is_open_chararray(p : tdef) : boolean;
  664. begin
  665. is_open_chararray:= is_open_array(p) and
  666. is_char(tarraydef(p).elementdef);
  667. end;
  668. { true if p is a open wide char array def }
  669. function is_open_widechararray(p : tdef) : boolean;
  670. begin
  671. is_open_widechararray:= is_open_array(p) and
  672. is_widechar(tarraydef(p).elementdef);
  673. end;
  674. { true if p is any pointer def }
  675. function is_pointer(p : tdef) : boolean;
  676. begin
  677. is_pointer:=(p.typ=pointerdef);
  678. end;
  679. { true if p is a pchar def }
  680. function is_pchar(p : tdef) : boolean;
  681. begin
  682. is_pchar:=(p.typ=pointerdef) and
  683. (is_char(tpointerdef(p).pointeddef) or
  684. (is_zero_based_array(tpointerdef(p).pointeddef) and
  685. is_chararray(tpointerdef(p).pointeddef)));
  686. end;
  687. { true if p is a pchar def }
  688. function is_pwidechar(p : tdef) : boolean;
  689. begin
  690. is_pwidechar:=(p.typ=pointerdef) and
  691. (is_widechar(tpointerdef(p).pointeddef) or
  692. (is_zero_based_array(tpointerdef(p).pointeddef) and
  693. is_widechararray(tpointerdef(p).pointeddef)));
  694. end;
  695. { true if p is a voidpointer def }
  696. function is_voidpointer(p : tdef) : boolean;
  697. begin
  698. is_voidpointer:=(p.typ=pointerdef) and
  699. (tpointerdef(p).pointeddef.typ=orddef) and
  700. (torddef(tpointerdef(p).pointeddef).ordtype=uvoid);
  701. end;
  702. { true, if def is a 8 bit int type }
  703. function is_8bitint(def : tdef) : boolean;
  704. begin
  705. result:=(def.typ=orddef) and (torddef(def).ordtype in [u8bit,s8bit])
  706. end;
  707. { true, if def is a 8 bit ordinal type }
  708. function is_8bit(def : tdef) : boolean;
  709. begin
  710. result:=(def.typ=orddef) and (torddef(def).ordtype in [u8bit,s8bit,pasbool1,pasbool8,bool8bit,uchar])
  711. end;
  712. { true, if def is a 16 bit int type }
  713. function is_16bitint(def : tdef) : boolean;
  714. begin
  715. result:=(def.typ=orddef) and (torddef(def).ordtype in [u16bit,s16bit])
  716. end;
  717. { true, if def is a 16 bit ordinal type }
  718. function is_16bit(def : tdef) : boolean;
  719. begin
  720. result:=(def.typ=orddef) and (torddef(def).ordtype in [u16bit,s16bit,pasbool16,bool16bit,uwidechar])
  721. end;
  722. { true, if def is a 32 bit int type }
  723. function is_32bitint(def : tdef) : boolean;
  724. begin
  725. result:=(def.typ=orddef) and (torddef(def).ordtype in [u32bit,s32bit])
  726. end;
  727. { true, if def is a 32 bit ordinal type }
  728. function is_32bit(def: tdef): boolean;
  729. begin
  730. result:=(def.typ=orddef) and (torddef(def).ordtype in [u32bit,s32bit,pasbool32,bool32bit])
  731. end;
  732. { true, if def is a 64 bit int type }
  733. function is_64bitint(def : tdef) : boolean;
  734. begin
  735. is_64bitint:=(def.typ=orddef) and (torddef(def).ordtype in [u64bit,s64bit])
  736. end;
  737. { true, if def is a 64 bit type }
  738. function is_64bit(def : tdef) : boolean;
  739. begin
  740. is_64bit:=(def.typ=orddef) and (torddef(def).ordtype in [u64bit,s64bit,scurrency,pasbool64,bool64bit])
  741. end;
  742. { true, if def1 and def2 are both integers of the same bit size and sign }
  743. function are_equal_ints(def1, def2: tdef): boolean;
  744. begin
  745. result:=(def1.typ=orddef) and (def2.typ=orddef) and
  746. (torddef(def1).ordtype in [u8bit,u16bit,u32bit,u64bit,
  747. s8bit,s16bit,s32bit,s64bit,customint]) and
  748. (torddef(def1).ordtype=torddef(def2).ordtype) and
  749. ((torddef(def1).ordtype<>customint) or
  750. ((torddef(def1).low=torddef(def2).low) and
  751. (torddef(def1).high=torddef(def2).high)));
  752. end;
  753. { true, if def is an int type, larger than the processor's native int size }
  754. function is_oversizedint(def : tdef) : boolean;
  755. begin
  756. {$if defined(cpu8bitalu)}
  757. result:=is_64bitint(def) or is_32bitint(def) or is_16bitint(def);
  758. {$elseif defined(cpu16bitalu)}
  759. result:=is_64bitint(def) or is_32bitint(def);
  760. {$elseif defined(cpu32bitaddr)}
  761. result:=is_64bitint(def);
  762. {$elseif defined(cpu64bitaddr)}
  763. result:=false;
  764. {$endif}
  765. end;
  766. { true, if def is an ordinal type, larger than the processor's native int size }
  767. function is_oversizedord(def : tdef) : boolean;
  768. begin
  769. {$if defined(cpu8bitalu)}
  770. result:=is_64bit(def) or is_32bit(def) or is_16bit(def);
  771. {$elseif defined(cpu16bitalu)}
  772. result:=is_64bit(def) or is_32bit(def);
  773. {$elseif defined(cpu32bitaddr)}
  774. result:=is_64bit(def);
  775. {$elseif defined(cpu64bitaddr)}
  776. result:=false;
  777. {$endif}
  778. end;
  779. { true, if def is an int type, equal in size to the processor's native int size }
  780. function is_nativeint(def: tdef): boolean;
  781. begin
  782. {$if defined(cpu8bitalu)}
  783. result:=is_8bitint(def);
  784. {$elseif defined(cpu16bitalu)}
  785. result:=is_16bitint(def);
  786. {$elseif defined(cpu32bitaddr)}
  787. result:=is_32bitint(def);
  788. {$elseif defined(cpu64bitaddr)}
  789. result:=is_64bitint(def);
  790. {$endif}
  791. end;
  792. { true, if def is an ordinal type, equal in size to the processor's native int size }
  793. function is_nativeord(def: tdef): boolean;
  794. begin
  795. {$if defined(cpu8bitalu)}
  796. result:=is_8bit(def);
  797. {$elseif defined(cpu16bitalu)}
  798. result:=is_16bit(def);
  799. {$elseif defined(cpu32bitaddr)}
  800. result:=is_32bit(def);
  801. {$elseif defined(cpu64bitaddr)}
  802. result:=is_64bit(def);
  803. {$endif}
  804. end;
  805. { true, if def is an unsigned int type, equal in size to the processor's native int size }
  806. function is_nativeuint(def: tdef): boolean;
  807. begin
  808. result:=is_nativeint(def) and (def.typ=orddef) and (torddef(def).ordtype in [u64bit,u32bit,u16bit,u8bit]);
  809. end;
  810. { true, if def is a signed int type, equal in size to the processor's native int size }
  811. function is_nativesint(def: tdef): boolean;
  812. begin
  813. result:=is_nativeint(def) and (def.typ=orddef) and (torddef(def).ordtype in [s64bit,s32bit,s16bit,s8bit]);
  814. end;
  815. { if l isn't in the range of todef a range check error (if not explicit) is generated and
  816. the value is placed within the range }
  817. procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
  818. var
  819. lv,hv: TConstExprInt;
  820. begin
  821. { for 64 bit types we need only to check if it is less than }
  822. { zero, if def is a qword node }
  823. getrange(todef,lv,hv);
  824. if (l<lv) or (l>hv) then
  825. begin
  826. if not explicit then
  827. begin
  828. if ((todef.typ=enumdef) and
  829. { delphi allows range check errors in
  830. enumeration type casts FK }
  831. not(m_delphi in current_settings.modeswitches)) or
  832. (cs_check_range in current_settings.localswitches) or
  833. forcerangecheck then
  834. Message3(type_e_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv))
  835. else
  836. Message3(type_w_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv));
  837. end;
  838. { Fix the value to fit in the allocated space for this type of variable }
  839. case longint(todef.size) of
  840. 1: l := l and $ff;
  841. 2: l := l and $ffff;
  842. 4: l := l and $ffffffff;
  843. else
  844. ;
  845. end;
  846. {reset sign, i.e. converting -1 to qword changes the value to high(qword)}
  847. l.signed:=false;
  848. { do sign extension if necessary (JM) }
  849. if is_signed(todef) then
  850. begin
  851. case longint(todef.size) of
  852. 1: l.svalue := shortint(l.svalue);
  853. 2: l.svalue := smallint(l.svalue);
  854. 4: l.svalue := longint(l.svalue);
  855. else
  856. ;
  857. end;
  858. l.signed:=true;
  859. end;
  860. end;
  861. end;
  862. { return the range from def in l and h }
  863. procedure getrange(def : tdef;out l, h : TConstExprInt);
  864. begin
  865. case def.typ of
  866. orddef :
  867. begin
  868. l:=torddef(def).low;
  869. h:=torddef(def).high;
  870. end;
  871. enumdef :
  872. begin
  873. l:=int64(tenumdef(def).min);
  874. h:=int64(tenumdef(def).max);
  875. end;
  876. arraydef :
  877. begin
  878. l:=int64(tarraydef(def).lowrange);
  879. h:=int64(tarraydef(def).highrange);
  880. end;
  881. undefineddef:
  882. begin
  883. l:=torddef(sizesinttype).low;
  884. h:=torddef(sizesinttype).high;
  885. end;
  886. else
  887. internalerror(200611054);
  888. end;
  889. end;
  890. function mmx_type(p : tdef) : tmmxtype;
  891. begin
  892. mmx_type:=mmxno;
  893. if is_mmx_able_array(p) then
  894. begin
  895. if tarraydef(p).elementdef.typ=floatdef then
  896. case tfloatdef(tarraydef(p).elementdef).floattype of
  897. s32real:
  898. mmx_type:=mmxsingle;
  899. else
  900. ;
  901. end
  902. else
  903. case torddef(tarraydef(p).elementdef).ordtype of
  904. u8bit:
  905. mmx_type:=mmxu8bit;
  906. s8bit:
  907. mmx_type:=mmxs8bit;
  908. u16bit:
  909. mmx_type:=mmxu16bit;
  910. s16bit:
  911. mmx_type:=mmxs16bit;
  912. u32bit:
  913. mmx_type:=mmxu32bit;
  914. s32bit:
  915. mmx_type:=mmxs32bit;
  916. else
  917. ;
  918. end;
  919. end;
  920. end;
  921. { The range-type of an ordinal-type that is a subrange-type shall be the host-type (see 6.4.2.4) of the subrange-type.
  922. The range-type of an ordinal-type that is not a subrange-type shall be the ordinal-type.
  923. The subrange-bounds shall be of compatible ordinal-types, and the range-type (see 6.4.2.1) of the ordinal-types shall
  924. be designated the host-type of the subrange-type. }
  925. function get_iso_range_type(def: tdef): tdef;
  926. begin
  927. result:=nil;
  928. case def.typ of
  929. orddef:
  930. begin
  931. if is_integer(def) then
  932. begin
  933. if (torddef(def).low>=torddef(sinttype).low) and
  934. (torddef(def).high<=torddef(sinttype).high) then
  935. result:=sinttype
  936. else
  937. range_to_type(torddef(def).low,torddef(def).high,result);
  938. end
  939. else case torddef(def).ordtype of
  940. pasbool1:
  941. result:=pasbool1type;
  942. pasbool8:
  943. result:=pasbool8type;
  944. pasbool16:
  945. result:=pasbool16type;
  946. pasbool32:
  947. result:=pasbool32type;
  948. pasbool64:
  949. result:=pasbool64type;
  950. bool8bit:
  951. result:=bool8type;
  952. bool16bit:
  953. result:=bool16type;
  954. bool32bit:
  955. result:=bool32type;
  956. bool64bit:
  957. result:=bool64type;
  958. uchar:
  959. result:=cansichartype;
  960. uwidechar:
  961. result:=cwidechartype;
  962. scurrency:
  963. result:=s64currencytype;
  964. else
  965. internalerror(2018010901);
  966. end;
  967. end;
  968. enumdef:
  969. begin
  970. while assigned(tenumdef(def).basedef) do
  971. def:=tenumdef(def).basedef;
  972. result:=def;
  973. end
  974. else
  975. internalerror(2018010701);
  976. end;
  977. end;
  978. function is_vector(p : tdef) : boolean;
  979. begin
  980. result:=(p.typ=arraydef) and
  981. not(is_special_array(p)) and
  982. (tarraydef(p).elementdef.typ=floatdef) and
  983. (tfloatdef(tarraydef(p).elementdef).floattype in [s32real,s64real]);
  984. end;
  985. { returns if the passed type (array) fits into an mm register }
  986. function fits_in_mm_register(p : tdef) : boolean;
  987. begin
  988. {$ifdef x86}
  989. result:= is_vector(p) and
  990. (
  991. (tarraydef(p).elementdef.typ=floatdef) and
  992. (
  993. (tarraydef(p).lowrange=0) and
  994. (tarraydef(p).highrange=3) and
  995. (tfloatdef(tarraydef(p).elementdef).floattype=s32real)
  996. )
  997. ) or
  998. (
  999. (tarraydef(p).elementdef.typ=floatdef) and
  1000. (
  1001. (tarraydef(p).lowrange=0) and
  1002. (tarraydef(p).highrange=1) and
  1003. (tfloatdef(tarraydef(p).elementdef).floattype=s64real)
  1004. )
  1005. );
  1006. {$else x86}
  1007. result:=false;
  1008. {$endif x86}
  1009. end;
  1010. function is_mmx_able_array(p : tdef) : boolean;
  1011. begin
  1012. {$ifdef SUPPORT_MMX}
  1013. if (cs_mmx_saturation in current_settings.localswitches) then
  1014. begin
  1015. is_mmx_able_array:=(p.typ=arraydef) and
  1016. not(is_special_array(p)) and
  1017. (
  1018. (
  1019. (tarraydef(p).elementdef.typ=orddef) and
  1020. (
  1021. (
  1022. (tarraydef(p).lowrange=0) and
  1023. (tarraydef(p).highrange=1) and
  1024. (torddef(tarraydef(p).elementdef).ordtype in [u32bit,s32bit])
  1025. )
  1026. or
  1027. (
  1028. (tarraydef(p).lowrange=0) and
  1029. (tarraydef(p).highrange=3) and
  1030. (torddef(tarraydef(p).elementdef).ordtype in [u16bit,s16bit])
  1031. )
  1032. )
  1033. )
  1034. or
  1035. (
  1036. (
  1037. (tarraydef(p).elementdef.typ=floatdef) and
  1038. (
  1039. (tarraydef(p).lowrange=0) and
  1040. (tarraydef(p).highrange=1) and
  1041. (tfloatdef(tarraydef(p).elementdef).floattype=s32real)
  1042. )
  1043. )
  1044. )
  1045. );
  1046. end
  1047. else
  1048. begin
  1049. is_mmx_able_array:=(p.typ=arraydef) and
  1050. (
  1051. (
  1052. (tarraydef(p).elementdef.typ=orddef) and
  1053. (
  1054. (
  1055. (tarraydef(p).lowrange=0) and
  1056. (tarraydef(p).highrange=1) and
  1057. (torddef(tarraydef(p).elementdef).ordtype in [u32bit,s32bit])
  1058. )
  1059. or
  1060. (
  1061. (tarraydef(p).lowrange=0) and
  1062. (tarraydef(p).highrange=3) and
  1063. (torddef(tarraydef(p).elementdef).ordtype in [u16bit,s16bit])
  1064. )
  1065. or
  1066. (
  1067. (tarraydef(p).lowrange=0) and
  1068. (tarraydef(p).highrange=7) and
  1069. (torddef(tarraydef(p).elementdef).ordtype in [u8bit,s8bit])
  1070. )
  1071. )
  1072. )
  1073. or
  1074. (
  1075. (tarraydef(p).elementdef.typ=floatdef) and
  1076. (
  1077. (tarraydef(p).lowrange=0) and
  1078. (tarraydef(p).highrange=1) and
  1079. (tfloatdef(tarraydef(p).elementdef).floattype=s32real)
  1080. )
  1081. )
  1082. );
  1083. end;
  1084. {$else SUPPORT_MMX}
  1085. is_mmx_able_array:=false;
  1086. {$endif SUPPORT_MMX}
  1087. end;
  1088. function def_cgsize(def: tdef): tcgsize;
  1089. begin
  1090. case def.typ of
  1091. orddef,
  1092. enumdef,
  1093. setdef:
  1094. begin
  1095. result:=int_cgsize(def.size);
  1096. if is_signed(def) then
  1097. result:=tcgsize(ord(result)+(ord(OS_S8)-ord(OS_8)));
  1098. end;
  1099. classrefdef,
  1100. pointerdef:
  1101. begin
  1102. result:=int_cgsize(def.size);
  1103. { can happen for far/huge pointers on non-i8086 }
  1104. if result=OS_NO then
  1105. internalerror(2013052201);
  1106. end;
  1107. formaldef:
  1108. result := int_cgsize(voidpointertype.size);
  1109. procvardef:
  1110. result:=int_cgsize(def.size);
  1111. stringdef :
  1112. result:=int_cgsize(def.size);
  1113. objectdef :
  1114. result:=int_cgsize(def.size);
  1115. floatdef:
  1116. if cs_fp_emulation in current_settings.moduleswitches then
  1117. result:=int_cgsize(def.size)
  1118. else
  1119. result:=tfloat2tcgsize[tfloatdef(def).floattype];
  1120. recorddef :
  1121. result:=int_cgsize(def.size);
  1122. arraydef :
  1123. begin
  1124. if is_dynamic_array(def) or not is_special_array(def) then
  1125. begin
  1126. if (cs_support_vectors in current_settings.globalswitches) and is_vector(def) and ((TArrayDef(def).elementdef.typ = floatdef) and not (cs_fp_emulation in current_settings.moduleswitches)) then
  1127. begin
  1128. { Determine if, based on the floating-point type and the size
  1129. of the array, if it can be made into a vector }
  1130. case TFloatDef(def).floattype of
  1131. s32real:
  1132. result := float_array_cgsize(def.size);
  1133. s64real:
  1134. result := double_array_cgsize(def.size);
  1135. else
  1136. { If not, fall back }
  1137. result := int_cgsize(def.size);
  1138. end;
  1139. end
  1140. else
  1141. result := int_cgsize(def.size);
  1142. end
  1143. else
  1144. result := OS_NO;
  1145. end;
  1146. else
  1147. begin
  1148. { undefined size }
  1149. result:=OS_NO;
  1150. end;
  1151. end;
  1152. end;
  1153. function cgsize_orddef(size: tcgsize): torddef;
  1154. begin
  1155. case size of
  1156. OS_8:
  1157. result:=torddef(u8inttype);
  1158. OS_S8:
  1159. result:=torddef(s8inttype);
  1160. OS_16:
  1161. result:=torddef(u16inttype);
  1162. OS_S16:
  1163. result:=torddef(s16inttype);
  1164. OS_32:
  1165. result:=torddef(u32inttype);
  1166. OS_S32:
  1167. result:=torddef(s32inttype);
  1168. OS_64:
  1169. result:=torddef(u64inttype);
  1170. OS_S64:
  1171. result:=torddef(s64inttype);
  1172. else
  1173. internalerror(2012050401);
  1174. end;
  1175. end;
  1176. function def_cgmmsize(def: tdef): tcgsize;
  1177. begin
  1178. case def.typ of
  1179. arraydef:
  1180. begin
  1181. case tarraydef(def).elementdef.typ of
  1182. orddef:
  1183. begin
  1184. { this is not correct, OS_MX normally mean that the vector
  1185. contains elements of size X. However, vectors themselves
  1186. can also have different sizes (e.g. a vector of 2 singles on
  1187. SSE) and the total size is currently more important }
  1188. case def.size of
  1189. 1: result:=OS_M8;
  1190. 2: result:=OS_M16;
  1191. 4: result:=OS_M32;
  1192. 8: result:=OS_M64;
  1193. 16: result:=OS_M128;
  1194. 32: result:=OS_M256;
  1195. 64: result:=OS_M512;
  1196. else
  1197. internalerror(2013060103);
  1198. end;
  1199. end;
  1200. floatdef:
  1201. begin
  1202. case TFloatDef(tarraydef(def).elementdef).floattype of
  1203. s32real:
  1204. case def.size of
  1205. 4: result:=OS_MF32;
  1206. 16: result:=OS_MF128;
  1207. 32: result:=OS_MF256;
  1208. 64: result:=OS_MF512;
  1209. else
  1210. internalerror(2017121400);
  1211. end;
  1212. s64real:
  1213. case def.size of
  1214. 8: result:=OS_MD64;
  1215. 16: result:=OS_MD128;
  1216. 32: result:=OS_MD256;
  1217. 64: result:=OS_MD512;
  1218. else
  1219. internalerror(2017121401);
  1220. end;
  1221. else
  1222. internalerror(2017121402);
  1223. end;
  1224. end;
  1225. else
  1226. result:=def_cgsize(def);
  1227. end;
  1228. end
  1229. else
  1230. result:=def_cgsize(def);
  1231. end;
  1232. end;
  1233. { In Windows 95 era, ordinals were restricted to [u8bit,s32bit,s16bit,bool16bit]
  1234. As of today, both signed and unsigned types from 8 to 64 bits are supported. }
  1235. function is_automatable(p : tdef) : boolean;
  1236. begin
  1237. case p.typ of
  1238. orddef:
  1239. result:=torddef(p).ordtype in [u8bit,s8bit,u16bit,s16bit,u32bit,s32bit,
  1240. u64bit,s64bit,bool16bit,scurrency];
  1241. floatdef:
  1242. result:=tfloatdef(p).floattype in [s64currency,s64real,s32real];
  1243. stringdef:
  1244. result:=tstringdef(p).stringtype in [st_ansistring,st_widestring,st_unicodestring];
  1245. variantdef:
  1246. result:=true;
  1247. objectdef:
  1248. result:=tobjectdef(p).objecttype in [odt_interfacecom,odt_dispinterface,odt_interfacecorba];
  1249. else
  1250. result:=false;
  1251. end;
  1252. end;
  1253. {# returns true, if the type passed is a varset }
  1254. function is_smallset(p : tdef) : boolean;
  1255. begin
  1256. {$if defined(cpu8bitalu)}
  1257. result:=(p.typ=setdef) and (p.size = 1)
  1258. {$elseif defined(cpu16bitalu)}
  1259. result:=(p.typ=setdef) and (p.size in [1,2])
  1260. {$else}
  1261. result:=(p.typ=setdef) and (p.size in [1,2,4])
  1262. {$endif}
  1263. end;
  1264. function is_bareprocdef(pd : tprocdef): boolean;
  1265. begin
  1266. result:=(pd.maxparacount=0) and
  1267. (is_void(pd.returndef) or
  1268. (pd.proctypeoption = potype_constructor));
  1269. end;
  1270. function is_c_variadic(pd: tabstractprocdef): boolean;
  1271. begin
  1272. result:=
  1273. (po_varargs in pd.procoptions) or
  1274. (po_variadic in pd.procoptions);
  1275. end;
  1276. function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
  1277. var
  1278. llow, lhigh: tconstexprint;
  1279. begin
  1280. llow:=min(ld.low,rd.low);
  1281. lhigh:=max(ld.high,rd.high);
  1282. case range_to_basetype(llow,lhigh) of
  1283. s8bit:
  1284. result:=torddef(s8inttype);
  1285. u8bit:
  1286. result:=torddef(u8inttype);
  1287. s16bit:
  1288. result:=torddef(s16inttype);
  1289. u16bit:
  1290. result:=torddef(u16inttype);
  1291. s32bit:
  1292. result:=torddef(s32inttype);
  1293. u32bit:
  1294. result:=torddef(u32inttype);
  1295. s64bit:
  1296. result:=torddef(s64inttype);
  1297. u64bit:
  1298. result:=torddef(u64inttype);
  1299. else
  1300. begin
  1301. { avoid warning }
  1302. result:=nil;
  1303. internalerror(200802291);
  1304. end;
  1305. end;
  1306. if keep_sign_if_equal and
  1307. (is_signed(ld)=is_signed(rd)) and
  1308. (is_signed(result)<>is_signed(ld)) then
  1309. case result.ordtype of
  1310. s8bit:
  1311. result:=torddef(u8inttype);
  1312. u8bit:
  1313. result:=torddef(s16inttype);
  1314. s16bit:
  1315. result:=torddef(u16inttype);
  1316. u16bit:
  1317. result:=torddef(s32inttype);
  1318. s32bit:
  1319. result:=torddef(u32inttype);
  1320. u32bit:
  1321. result:=torddef(s64inttype);
  1322. s64bit:
  1323. result:=torddef(u64inttype);
  1324. else
  1325. ;
  1326. end;
  1327. end;
  1328. function is_valid_univ_para_type(def: tdef): boolean;
  1329. begin
  1330. result:=
  1331. not is_open_array(def) and
  1332. not is_void(def) and
  1333. (def.typ<>formaldef);
  1334. end;
  1335. function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif}
  1336. begin
  1337. result:=def.parast.symtablelevel>normal_function_level;
  1338. end;
  1339. function is_typeparam(def : tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
  1340. begin
  1341. result:=(def.typ=undefineddef);
  1342. end;
  1343. function is_methodpointer(def: tdef): boolean;
  1344. begin
  1345. result:=(def.typ=procvardef) and (po_methodpointer in tprocvardef(def).procoptions);
  1346. end;
  1347. function is_block(def: tdef): boolean;
  1348. begin
  1349. result:=(def.typ=procvardef) and (po_is_block in tprocvardef(def).procoptions)
  1350. end;
  1351. function get_typekind(def:tdef):byte;
  1352. begin
  1353. case def.typ of
  1354. arraydef:
  1355. if ado_IsDynamicArray in tarraydef(def).arrayoptions then
  1356. result:=tkDynArray
  1357. else
  1358. result:=tkArray;
  1359. recorddef:
  1360. result:=tkRecord;
  1361. pointerdef:
  1362. result:=tkPointer;
  1363. orddef:
  1364. case torddef(def).ordtype of
  1365. u8bit,
  1366. u16bit,
  1367. u32bit,
  1368. s8bit,
  1369. s16bit,
  1370. s32bit:
  1371. result:=tkInteger;
  1372. u64bit:
  1373. result:=tkQWord;
  1374. s64bit:
  1375. result:=tkInt64;
  1376. pasbool1,
  1377. pasbool8,
  1378. pasbool16,
  1379. pasbool32,
  1380. pasbool64,
  1381. bool8bit,
  1382. bool16bit,
  1383. bool32bit,
  1384. bool64bit:
  1385. result:=tkBool;
  1386. uchar:
  1387. result:=tkChar;
  1388. uwidechar:
  1389. result:=tkWChar;
  1390. scurrency:
  1391. result:=tkFloat;
  1392. else
  1393. result:=tkUnknown;
  1394. end;
  1395. stringdef:
  1396. case tstringdef(def).stringtype of
  1397. st_shortstring:
  1398. result:=tkSString;
  1399. st_longstring:
  1400. result:=tkLString;
  1401. st_ansistring:
  1402. result:=tkAString;
  1403. st_widestring:
  1404. result:=tkWString;
  1405. st_unicodestring:
  1406. result:=tkUString;
  1407. end;
  1408. enumdef:
  1409. result:=tkEnumeration;
  1410. objectdef:
  1411. case tobjectdef(def).objecttype of
  1412. odt_class,
  1413. odt_javaclass:
  1414. result:=tkClass;
  1415. odt_object:
  1416. result:=tkObject;
  1417. odt_interfacecom,
  1418. odt_dispinterface,
  1419. odt_interfacejava:
  1420. result:=tkInterface;
  1421. odt_interfacecorba:
  1422. result:=tkInterfaceCorba;
  1423. odt_helper:
  1424. result:=tkHelper;
  1425. else
  1426. result:=tkUnknown;
  1427. end;
  1428. { currently tkFile is not used }
  1429. {filedef:
  1430. result:=tkFile;}
  1431. setdef:
  1432. result:=tkSet;
  1433. procvardef:
  1434. if tprocvardef(def).is_methodpointer then
  1435. result:=tkMethod
  1436. else
  1437. result:=tkProcVar;
  1438. floatdef:
  1439. result:=tkFloat;
  1440. classrefdef:
  1441. result:=tkClassRef;
  1442. variantdef:
  1443. result:=tkVariant;
  1444. else
  1445. result:=tkUnknown;
  1446. end;
  1447. end;
  1448. end.