defutil.pas 64 KB

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