defutil.pas 56 KB

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