defutil.pas 72 KB

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