defutil.pas 73 KB

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