defutil.pas 69 KB

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