defutil.pas 63 KB

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