defutil.pas 71 KB

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