2
0

defutil.pas 59 KB

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