defutil.pas 73 KB

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