defutil.pas 66 KB

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