defutil.pas 54 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678
  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);
  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. {# Returns true, if definition defines an integer type }
  50. function is_integer(def : tdef) : boolean;
  51. {# Returns true if definition is a boolean }
  52. function is_boolean(def : tdef) : boolean;
  53. {# Returns true if definition is a Pascal-style boolean (1 = true, zero = false) }
  54. function is_pasbool(def : tdef) : boolean;
  55. {# Returns true if definition is a C-style boolean (non-zero value = true, zero = false) }
  56. function is_cbool(def : tdef) : boolean;
  57. {# Returns true if definition is a char
  58. This excludes the unicode char.
  59. }
  60. function is_char(def : tdef) : boolean;
  61. {# Returns true if definition is a widechar }
  62. function is_widechar(def : tdef) : boolean;
  63. {# Returns true if definition is either an AnsiChar or a WideChar }
  64. function is_anychar(def : tdef) : boolean;
  65. {# Returns true if definition is a void}
  66. function is_void(def : tdef) : boolean;
  67. {# Returns true if definition is a smallset}
  68. function is_smallset(p : tdef) : boolean;
  69. {# Returns true, if def defines a signed data type
  70. (only for ordinal types)
  71. }
  72. function is_signed(def : tdef) : boolean;
  73. {# Returns an unsigned integer type of the same size as def; def must be
  74. an ordinal or enum }
  75. function get_unsigned_inttype(def: tdef): torddef;
  76. {# Returns whether def_from's range is comprised in def_to's if both are
  77. orddefs, false otherwise }
  78. function is_in_limit(def_from,def_to : tdef) : boolean;
  79. {# Returns whether def is reference counted }
  80. function is_managed_type(def: tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
  81. { # Returns whether def is needs to load RTTI for reference counting }
  82. function is_rtti_managed_type(def: tdef) : boolean;
  83. { function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;}
  84. {*****************************************************************************
  85. Array helper functions
  86. *****************************************************************************}
  87. {# Returns true, if p points to a zero based (non special like open or
  88. dynamic array def).
  89. This is mainly used to see if the array
  90. is convertable to a pointer
  91. }
  92. function is_zero_based_array(p : tdef) : boolean;
  93. {# Returns true if p points to an open array definition }
  94. function is_open_array(p : tdef) : boolean;
  95. {# Returns true if p points to a dynamic array definition }
  96. function is_dynamic_array(p : tdef) : boolean;
  97. {# Returns true, if p points to an array of const definition }
  98. function is_array_constructor(p : tdef) : boolean;
  99. {# Returns true, if p points to a variant array }
  100. function is_variant_array(p : tdef) : boolean;
  101. {# Returns true, if p points to an array of const }
  102. function is_array_of_const(p : tdef) : boolean;
  103. {# Returns true, if p points any kind of special array
  104. That is if the array is an open array, a variant
  105. array, an array constants constructor, or an
  106. array of const.
  107. Bitpacked arrays aren't special in this regard though.
  108. }
  109. function is_special_array(p : tdef) : boolean;
  110. {# Returns true if p is a bitpacked array }
  111. function is_packed_array(p: tdef) : boolean;
  112. {# Returns true if p is a bitpacked record }
  113. function is_packed_record_or_object(p: tdef) : boolean;
  114. {# Returns true if p is a char array def }
  115. function is_chararray(p : tdef) : boolean;
  116. {# Returns true if p is a wide char array def }
  117. function is_widechararray(p : tdef) : boolean;
  118. {# Returns true if p is a open char array def }
  119. function is_open_chararray(p : tdef) : boolean;
  120. {# Returns true if p is a open wide char array def }
  121. function is_open_widechararray(p : tdef) : boolean;
  122. {*****************************************************************************
  123. String helper functions
  124. *****************************************************************************}
  125. {# Returns true if p points to an open string type }
  126. function is_open_string(p : tdef) : boolean;
  127. {# Returns true if p is an ansi string type }
  128. function is_ansistring(p : tdef) : boolean;
  129. {# Returns true if p is an ansi string type with codepage 0 }
  130. function is_rawbytestring(p : tdef) : boolean;
  131. {# Returns true if p is a long string type }
  132. function is_longstring(p : tdef) : boolean;
  133. {# returns true if p is a wide string type }
  134. function is_widestring(p : tdef) : boolean;
  135. {# true if p is an unicode string def }
  136. function is_unicodestring(p : tdef) : boolean;
  137. {# true if p is an unicode/wide/ansistring string def }
  138. function is_dynamicstring(p : tdef) : boolean;
  139. {# returns true if p is a wide or unicode string type }
  140. function is_wide_or_unicode_string(p : tdef) : boolean;
  141. {# Returns true if p is a short string type }
  142. function is_shortstring(p : tdef) : boolean;
  143. {# Returns true if p is any pointer def }
  144. function is_pointer(p : tdef) : boolean;
  145. {# Returns true if p is a pchar def }
  146. function is_pchar(p : tdef) : boolean;
  147. {# Returns true if p is a pwidechar def }
  148. function is_pwidechar(p : tdef) : boolean;
  149. {# Returns true if p is a voidpointer def }
  150. function is_voidpointer(p : tdef) : boolean;
  151. {# Returns true, if definition is a float }
  152. function is_fpu(def : tdef) : boolean;
  153. {# Returns true, if def is a currency type }
  154. function is_currency(def : tdef) : boolean;
  155. {# Returns true, if def is a single type }
  156. function is_single(def : tdef) : boolean;
  157. {# Returns true, if def is a double type }
  158. function is_double(def : tdef) : boolean;
  159. {# Returns true, if def is an extended type }
  160. function is_extended(def : tdef) : boolean;
  161. {# Returns true, if definition is a "real" real (i.e. single/double/extended) }
  162. function is_real(def : tdef) : boolean;
  163. {# Returns true for single,double,extended and cextended }
  164. function is_real_or_cextended(def : tdef) : boolean;
  165. { true, if def is a 8 bit int type }
  166. function is_8bitint(def : tdef) : boolean;
  167. { true, if def is a 8 bit ordinal type }
  168. function is_8bit(def : tdef) : boolean;
  169. { true, if def is a 16 bit int type }
  170. function is_16bitint(def : tdef) : boolean;
  171. { true, if def is a 16 bit ordinal type }
  172. function is_16bit(def : tdef) : boolean;
  173. {# Returns true, if def is a 32 bit integer type }
  174. function is_32bitint(def : tdef) : boolean;
  175. {# Returns true, if def is a 32 bit ordinal type }
  176. function is_32bit(def : tdef) : boolean;
  177. {# Returns true, if def is a 64 bit integer type }
  178. function is_64bitint(def : tdef) : boolean;
  179. {# Returns true, if def is a 64 bit type }
  180. function is_64bit(def : tdef) : boolean;
  181. { true, if def1 and def2 are both integers of the same bit size and sign }
  182. function are_equal_ints(def1, def2: tdef): boolean;
  183. { true, if def is an int type, larger than the processor's native int size }
  184. function is_oversizedint(def : tdef) : boolean;
  185. { true, if def is an ordinal type, larger than the processor's native int size }
  186. function is_oversizedord(def : tdef) : boolean;
  187. { true, if def is an int type, equal in size to the processor's native int size }
  188. function is_nativeint(def : tdef) : boolean;
  189. { true, if def is an ordinal type, equal in size to the processor's native int size }
  190. function is_nativeord(def : tdef) : boolean;
  191. { true, if def is an unsigned int type, equal in size to the processor's native int size }
  192. function is_nativeuint(def : tdef) : boolean;
  193. { true, if def is a signed int type, equal in size to the processor's native int size }
  194. function is_nativesint(def : tdef) : boolean;
  195. {# If @var(l) isn't in the range of todef a range check error (if not explicit) is generated and
  196. the value is placed within the range
  197. }
  198. procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
  199. {# Returns the range of def, where @var(l) is the low-range and @var(h) is
  200. the high-range.
  201. }
  202. procedure getrange(def : tdef;out l, h : TConstExprInt);
  203. { Returns the range type of an ordinal type in the sense of ISO-10206 }
  204. function get_iso_range_type(def: tdef): tdef;
  205. { type being a vector? }
  206. function is_vector(p : tdef) : boolean;
  207. { some type helper routines for MMX support }
  208. function is_mmx_able_array(p : tdef) : boolean;
  209. {# returns the mmx type }
  210. function mmx_type(p : tdef) : tmmxtype;
  211. { returns if the passed type (array) fits into an mm register }
  212. function fits_in_mm_register(p : tdef) : boolean;
  213. {# From a definition return the abstract code generator size enum. It is
  214. to note that the value returned can be @var(OS_NO) }
  215. function def_cgsize(def: tdef): tcgsize;
  216. { #Return an orddef (integer) correspondig to a tcgsize }
  217. function cgsize_orddef(size: tcgsize): torddef;
  218. {# Same as def_cgsize, except that it will interpret certain arrays as
  219. vectors and return OS_M* sizes for them }
  220. function def_cgmmsize(def: tdef): tcgsize;
  221. {# returns true, if the type passed is can be used with windows automation }
  222. function is_automatable(p : tdef) : boolean;
  223. { # returns true if the procdef has no parameters and no specified return type }
  224. function is_bareprocdef(pd : tprocdef): boolean;
  225. { # returns the smallest base integer type whose range encompasses that of
  226. both ld and rd; if keep_sign_if_equal, then if ld and rd have the same
  227. signdness, the result will also get that signdness }
  228. function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
  229. { # returns whether the type is potentially a valid type of/for an "univ" parameter
  230. (basically: it must have a compile-time size) }
  231. function is_valid_univ_para_type(def: tdef): boolean;
  232. { # returns whether the procdef/procvardef represents a nested procedure
  233. or not }
  234. function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif}
  235. { # returns whether def is a type parameter of a generic }
  236. function is_typeparam(def : tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
  237. { returns true of def is a methodpointer }
  238. function is_methodpointer(def : tdef) : boolean;
  239. { returns true if def is a C "block" }
  240. function is_block(def: tdef): boolean;
  241. { returns the TTypeKind value of the def }
  242. function get_typekind(def: tdef): byte;
  243. implementation
  244. uses
  245. verbose,cutils;
  246. { returns true, if def uses FPU }
  247. function is_fpu(def : tdef) : boolean;
  248. begin
  249. is_fpu:=(def.typ=floatdef);
  250. end;
  251. { returns true, if def is a currency type }
  252. function is_currency(def : tdef) : boolean;
  253. begin
  254. case s64currencytype.typ of
  255. orddef :
  256. result:=(def.typ=orddef) and
  257. (torddef(s64currencytype).ordtype=torddef(def).ordtype);
  258. floatdef :
  259. result:=(def.typ=floatdef) and
  260. (tfloatdef(s64currencytype).floattype=tfloatdef(def).floattype);
  261. else
  262. internalerror(200304222);
  263. end;
  264. end;
  265. { returns true, if def is a single type }
  266. function is_single(def : tdef) : boolean;
  267. begin
  268. result:=(def.typ=floatdef) and
  269. (tfloatdef(def).floattype=s32real);
  270. end;
  271. { returns true, if def is a double type }
  272. function is_double(def : tdef) : boolean;
  273. begin
  274. result:=(def.typ=floatdef) and
  275. (tfloatdef(def).floattype=s64real);
  276. end;
  277. function is_extended(def : tdef) : boolean;
  278. begin
  279. result:=(def.typ=floatdef) and
  280. (tfloatdef(def).floattype in [s80real,sc80real]);
  281. end;
  282. { returns true, if definition is a "real" real (i.e. single/double/extended) }
  283. function is_real(def : tdef) : boolean;
  284. begin
  285. result:=(def.typ=floatdef) and
  286. (tfloatdef(def).floattype in [s32real,s64real,s80real]);
  287. end;
  288. function is_real_or_cextended(def: tdef): boolean;
  289. begin
  290. result:=(def.typ=floatdef) and
  291. (tfloatdef(def).floattype in [s32real,s64real,s80real,sc80real]);
  292. end;
  293. function range_to_basetype(const l,h:TConstExprInt):tordtype;
  294. begin
  295. { prefer signed over unsigned }
  296. if (l>=int64(-128)) and (h<=127) then
  297. range_to_basetype:=s8bit
  298. else if (l>=0) and (h<=255) then
  299. range_to_basetype:=u8bit
  300. else if (l>=int64(-32768)) and (h<=32767) then
  301. range_to_basetype:=s16bit
  302. else if (l>=0) and (h<=65535) then
  303. range_to_basetype:=u16bit
  304. else if (l>=int64(low(longint))) and (h<=high(longint)) then
  305. range_to_basetype:=s32bit
  306. else if (l>=low(cardinal)) and (h<=high(cardinal)) then
  307. range_to_basetype:=u32bit
  308. else if (l>=low(int64)) and (h<=high(int64)) then
  309. range_to_basetype:=s64bit
  310. else
  311. range_to_basetype:=u64bit;
  312. end;
  313. procedure range_to_type(const l,h:TConstExprInt;var def:tdef);
  314. begin
  315. { prefer signed over unsigned }
  316. if (l>=int64(-128)) and (h<=127) then
  317. def:=s8inttype
  318. else if (l>=0) and (h<=255) then
  319. def:=u8inttype
  320. else if (l>=int64(-32768)) and (h<=32767) then
  321. def:=s16inttype
  322. else if (l>=0) and (h<=65535) then
  323. def:=u16inttype
  324. else if (l>=int64(low(longint))) and (h<=high(longint)) then
  325. def:=s32inttype
  326. else if (l>=low(cardinal)) and (h<=high(cardinal)) then
  327. def:=u32inttype
  328. else if (l>=low(int64)) and (h<=high(int64)) then
  329. def:=s64inttype
  330. else
  331. def:=u64inttype;
  332. end;
  333. procedure int_to_type(const v:TConstExprInt;var def:tdef);
  334. begin
  335. range_to_type(v,v,def);
  336. end;
  337. { true if p is an ordinal }
  338. function is_ordinal(def : tdef) : boolean;
  339. var
  340. dt : tordtype;
  341. begin
  342. case def.typ of
  343. orddef :
  344. begin
  345. dt:=torddef(def).ordtype;
  346. is_ordinal:=dt in [uchar,uwidechar,
  347. u8bit,u16bit,u32bit,u64bit,
  348. s8bit,s16bit,s32bit,s64bit,
  349. pasbool8,pasbool16,pasbool32,pasbool64,
  350. bool8bit,bool16bit,bool32bit,bool64bit];
  351. end;
  352. enumdef :
  353. is_ordinal:=true;
  354. else
  355. is_ordinal:=false;
  356. end;
  357. end;
  358. { true if p is a string }
  359. function is_string(def : tdef) : boolean;
  360. begin
  361. is_string := (assigned(def) and (def.typ = stringdef));
  362. end;
  363. function is_stringlike(def : tdef) : boolean;
  364. begin
  365. result := is_string(def) or
  366. is_anychar(def) or
  367. is_pchar(def) or
  368. is_pwidechar(def) or
  369. is_chararray(def) or
  370. is_widechararray(def) or
  371. is_open_chararray(def) or
  372. is_open_widechararray(def) or
  373. (def=java_jlstring);
  374. end;
  375. function is_enum(def : tdef) : boolean;
  376. begin
  377. result:=def.typ=enumdef;
  378. end;
  379. function is_set(def : tdef) : boolean;
  380. begin
  381. result:=def.typ=setdef;
  382. end;
  383. { returns the min. value of the type }
  384. function get_min_value(def : tdef) : TConstExprInt;
  385. begin
  386. case def.typ of
  387. orddef:
  388. result:=torddef(def).low;
  389. enumdef:
  390. result:=int64(tenumdef(def).min);
  391. else
  392. result:=0;
  393. end;
  394. end;
  395. { returns the max. value of the type }
  396. function get_max_value(def : tdef) : TConstExprInt;
  397. begin
  398. case def.typ of
  399. orddef:
  400. result:=torddef(def).high;
  401. enumdef:
  402. result:=tenumdef(def).max;
  403. else
  404. result:=0;
  405. end;
  406. end;
  407. { true if p is an integer }
  408. function is_integer(def : tdef) : boolean;
  409. begin
  410. result:=(def.typ=orddef) and
  411. (torddef(def).ordtype in [u8bit,u16bit,u32bit,u64bit,
  412. s8bit,s16bit,s32bit,s64bit]);
  413. end;
  414. { true if p is a boolean }
  415. function is_boolean(def : tdef) : boolean;
  416. begin
  417. result:=(def.typ=orddef) and
  418. (torddef(def).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]);
  419. end;
  420. function is_pasbool(def : tdef) : boolean;
  421. begin
  422. result:=(def.typ=orddef) and
  423. (torddef(def).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64]);
  424. end;
  425. { true if def is a C-style boolean (non-zero value = true, zero = false) }
  426. function is_cbool(def : tdef) : boolean;
  427. begin
  428. result:=(def.typ=orddef) and
  429. (torddef(def).ordtype in [bool8bit,bool16bit,bool32bit,bool64bit]);
  430. end;
  431. { true if p is a void }
  432. function is_void(def : tdef) : boolean;
  433. begin
  434. result:=(def.typ=orddef) and
  435. (torddef(def).ordtype=uvoid);
  436. end;
  437. { true if p is a char }
  438. function is_char(def : tdef) : boolean;
  439. begin
  440. result:=(def.typ=orddef) and
  441. (torddef(def).ordtype=uchar);
  442. end;
  443. { true if p is a wchar }
  444. function is_widechar(def : tdef) : boolean;
  445. begin
  446. result:=(def.typ=orddef) and
  447. (torddef(def).ordtype=uwidechar);
  448. end;
  449. { true if p is a char or wchar }
  450. function is_anychar(def : tdef) : boolean;
  451. begin
  452. result:=(def.typ=orddef) and
  453. (torddef(def).ordtype in [uchar,uwidechar])
  454. end;
  455. { true if p is signed (integer) }
  456. function is_signed(def : tdef) : boolean;
  457. begin
  458. case def.typ of
  459. orddef :
  460. result:=torddef(def).low < 0;
  461. enumdef :
  462. result:=tenumdef(def).min < 0;
  463. arraydef :
  464. result:=is_signed(tarraydef(def).rangedef);
  465. else
  466. result:=false;
  467. end;
  468. end;
  469. function get_unsigned_inttype(def: tdef): torddef;
  470. begin
  471. case def.typ of
  472. orddef,
  473. enumdef:
  474. result:=cgsize_orddef(tcgsize2unsigned[def_cgsize(def)]);
  475. else
  476. internalerror(2016062001);
  477. end;
  478. end;
  479. function is_in_limit(def_from,def_to : tdef) : boolean;
  480. begin
  481. if (def_from.typ<>def_to.typ) or
  482. not(def_from.typ in [orddef,enumdef,setdef]) then
  483. begin
  484. is_in_limit := false;
  485. exit;
  486. end;
  487. case def_from.typ of
  488. orddef:
  489. is_in_limit:=(torddef(def_from).low>=torddef(def_to).low) and
  490. (torddef(def_from).high<=torddef(def_to).high);
  491. enumdef:
  492. is_in_limit:=(tenumdef(def_from).min>=tenumdef(def_to).min) and
  493. (tenumdef(def_from).max<=tenumdef(def_to).max);
  494. setdef:
  495. is_in_limit:=(tsetdef(def_from).setbase>=tsetdef(def_to).setbase) and
  496. (tsetdef(def_from).setmax<=tsetdef(def_to).setmax);
  497. else
  498. is_in_limit:=false;
  499. end;
  500. end;
  501. function is_managed_type(def: tdef): boolean;{$ifdef USEINLINE}inline;{$endif}
  502. begin
  503. result:=def.needs_inittable;
  504. end;
  505. function is_rtti_managed_type(def: tdef): boolean;
  506. begin
  507. result:=def.needs_inittable and not (
  508. is_interfacecom_or_dispinterface(def) or
  509. (def.typ=variantdef) or
  510. (
  511. (def.typ=stringdef) and
  512. (tstringdef(def).stringtype in [st_ansistring,st_widestring,st_unicodestring])
  513. )
  514. );
  515. end;
  516. { true, if p points to an open array def }
  517. function is_open_string(p : tdef) : boolean;
  518. begin
  519. is_open_string:=(p.typ=stringdef) and
  520. (tstringdef(p).stringtype=st_shortstring) and
  521. (tstringdef(p).len=0);
  522. end;
  523. { true, if p points to a zero based array def }
  524. function is_zero_based_array(p : tdef) : boolean;
  525. begin
  526. result:=(p.typ=arraydef) and
  527. (tarraydef(p).lowrange=0) and
  528. not(is_special_array(p));
  529. end;
  530. { true if p points to a dynamic array def }
  531. function is_dynamic_array(p : tdef) : boolean;
  532. begin
  533. result:=(p.typ=arraydef) and
  534. (ado_IsDynamicArray in tarraydef(p).arrayoptions);
  535. end;
  536. { true, if p points to an open array def }
  537. function is_open_array(p : tdef) : boolean;
  538. begin
  539. { check for sizesinttype is needed, because for unsigned the high
  540. range is also -1 ! (PFV) }
  541. result:=(p.typ=arraydef) and
  542. (tarraydef(p).rangedef=sizesinttype) and
  543. (tarraydef(p).lowrange=0) and
  544. (tarraydef(p).highrange=-1) and
  545. ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])=[]);
  546. end;
  547. { true, if p points to an array of const def }
  548. function is_array_constructor(p : tdef) : boolean;
  549. begin
  550. result:=(p.typ=arraydef) and
  551. (ado_IsConstructor in tarraydef(p).arrayoptions);
  552. end;
  553. { true, if p points to a variant array }
  554. function is_variant_array(p : tdef) : boolean;
  555. begin
  556. result:=(p.typ=arraydef) and
  557. (ado_IsVariant in tarraydef(p).arrayoptions);
  558. end;
  559. { true, if p points to an array of const }
  560. function is_array_of_const(p : tdef) : boolean;
  561. begin
  562. result:=(p.typ=arraydef) and
  563. (ado_IsArrayOfConst in tarraydef(p).arrayoptions);
  564. end;
  565. { true, if p points to a special array, bitpacked arrays aren't special in this regard though }
  566. function is_special_array(p : tdef) : boolean;
  567. begin
  568. result:=(p.typ=arraydef) and
  569. (
  570. ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])<>[]) or
  571. is_open_array(p)
  572. );
  573. end;
  574. { true if p is an ansi string def }
  575. function is_ansistring(p : tdef) : boolean;
  576. begin
  577. is_ansistring:=(p.typ=stringdef) and
  578. (tstringdef(p).stringtype=st_ansistring);
  579. end;
  580. { true if p is an ansi string def with codepage CP_NONE }
  581. function is_rawbytestring(p : tdef) : boolean;
  582. begin
  583. is_rawbytestring:=(p.typ=stringdef) and
  584. (tstringdef(p).stringtype=st_ansistring) and
  585. (tstringdef(p).encoding=globals.CP_NONE);
  586. end;
  587. { true if p is an long string def }
  588. function is_longstring(p : tdef) : boolean;
  589. begin
  590. is_longstring:=(p.typ=stringdef) and
  591. (tstringdef(p).stringtype=st_longstring);
  592. end;
  593. { true if p is an wide string def }
  594. function is_widestring(p : tdef) : boolean;
  595. begin
  596. is_widestring:=(p.typ=stringdef) and
  597. (tstringdef(p).stringtype=st_widestring);
  598. end;
  599. function is_dynamicstring(p: tdef): boolean;
  600. begin
  601. is_dynamicstring:=(p.typ=stringdef) and
  602. (tstringdef(p).stringtype in [st_ansistring,st_widestring,st_unicodestring]);
  603. end;
  604. { true if p is an wide string def }
  605. function is_wide_or_unicode_string(p : tdef) : boolean;
  606. begin
  607. is_wide_or_unicode_string:=(p.typ=stringdef) and
  608. (tstringdef(p).stringtype in [st_widestring,st_unicodestring]);
  609. end;
  610. { true if p is an unicode string def }
  611. function is_unicodestring(p : tdef) : boolean;
  612. begin
  613. is_unicodestring:=(p.typ=stringdef) and
  614. (tstringdef(p).stringtype=st_unicodestring);
  615. end;
  616. { true if p is an short string def }
  617. function is_shortstring(p : tdef) : boolean;
  618. begin
  619. is_shortstring:=(p.typ=stringdef) and
  620. (tstringdef(p).stringtype=st_shortstring);
  621. end;
  622. { true if p is bit packed array def }
  623. function is_packed_array(p: tdef) : boolean;
  624. begin
  625. is_packed_array :=
  626. (p.typ = arraydef) and
  627. (ado_IsBitPacked in tarraydef(p).arrayoptions);
  628. end;
  629. { true if p is bit packed record def }
  630. function is_packed_record_or_object(p: tdef) : boolean;
  631. begin
  632. is_packed_record_or_object :=
  633. (p.typ in [recorddef,objectdef]) and
  634. (tabstractrecorddef(p).is_packed);
  635. end;
  636. { true if p is a char array def }
  637. function is_chararray(p : tdef) : boolean;
  638. begin
  639. is_chararray:=(p.typ=arraydef) and
  640. is_char(tarraydef(p).elementdef) and
  641. not(is_special_array(p));
  642. end;
  643. { true if p is a widechar array def }
  644. function is_widechararray(p : tdef) : boolean;
  645. begin
  646. is_widechararray:=(p.typ=arraydef) and
  647. is_widechar(tarraydef(p).elementdef) and
  648. not(is_special_array(p));
  649. end;
  650. { true if p is a open char array def }
  651. function is_open_chararray(p : tdef) : boolean;
  652. begin
  653. is_open_chararray:= is_open_array(p) and
  654. is_char(tarraydef(p).elementdef);
  655. end;
  656. { true if p is a open wide char array def }
  657. function is_open_widechararray(p : tdef) : boolean;
  658. begin
  659. is_open_widechararray:= is_open_array(p) and
  660. is_widechar(tarraydef(p).elementdef);
  661. end;
  662. { true if p is any pointer def }
  663. function is_pointer(p : tdef) : boolean;
  664. begin
  665. is_pointer:=(p.typ=pointerdef);
  666. end;
  667. { true if p is a pchar def }
  668. function is_pchar(p : tdef) : boolean;
  669. begin
  670. is_pchar:=(p.typ=pointerdef) and
  671. (is_char(tpointerdef(p).pointeddef) or
  672. (is_zero_based_array(tpointerdef(p).pointeddef) and
  673. is_chararray(tpointerdef(p).pointeddef)));
  674. end;
  675. { true if p is a pchar def }
  676. function is_pwidechar(p : tdef) : boolean;
  677. begin
  678. is_pwidechar:=(p.typ=pointerdef) and
  679. (is_widechar(tpointerdef(p).pointeddef) or
  680. (is_zero_based_array(tpointerdef(p).pointeddef) and
  681. is_widechararray(tpointerdef(p).pointeddef)));
  682. end;
  683. { true if p is a voidpointer def }
  684. function is_voidpointer(p : tdef) : boolean;
  685. begin
  686. is_voidpointer:=(p.typ=pointerdef) and
  687. (tpointerdef(p).pointeddef.typ=orddef) and
  688. (torddef(tpointerdef(p).pointeddef).ordtype=uvoid);
  689. end;
  690. { true, if def is a 8 bit int type }
  691. function is_8bitint(def : tdef) : boolean;
  692. begin
  693. result:=(def.typ=orddef) and (torddef(def).ordtype in [u8bit,s8bit])
  694. end;
  695. { true, if def is a 8 bit ordinal type }
  696. function is_8bit(def : tdef) : boolean;
  697. begin
  698. result:=(def.typ=orddef) and (torddef(def).ordtype in [u8bit,s8bit,pasbool8,bool8bit,uchar])
  699. end;
  700. { true, if def is a 16 bit int type }
  701. function is_16bitint(def : tdef) : boolean;
  702. begin
  703. result:=(def.typ=orddef) and (torddef(def).ordtype in [u16bit,s16bit])
  704. end;
  705. { true, if def is a 16 bit ordinal type }
  706. function is_16bit(def : tdef) : boolean;
  707. begin
  708. result:=(def.typ=orddef) and (torddef(def).ordtype in [u16bit,s16bit,pasbool16,bool16bit,uwidechar])
  709. end;
  710. { true, if def is a 32 bit int type }
  711. function is_32bitint(def : tdef) : boolean;
  712. begin
  713. result:=(def.typ=orddef) and (torddef(def).ordtype in [u32bit,s32bit])
  714. end;
  715. { true, if def is a 32 bit ordinal type }
  716. function is_32bit(def: tdef): boolean;
  717. begin
  718. result:=(def.typ=orddef) and (torddef(def).ordtype in [u32bit,s32bit,pasbool32,bool32bit])
  719. end;
  720. { true, if def is a 64 bit int type }
  721. function is_64bitint(def : tdef) : boolean;
  722. begin
  723. is_64bitint:=(def.typ=orddef) and (torddef(def).ordtype in [u64bit,s64bit])
  724. end;
  725. { true, if def is a 64 bit type }
  726. function is_64bit(def : tdef) : boolean;
  727. begin
  728. is_64bit:=(def.typ=orddef) and (torddef(def).ordtype in [u64bit,s64bit,scurrency,pasbool64,bool64bit])
  729. end;
  730. { true, if def1 and def2 are both integers of the same bit size and sign }
  731. function are_equal_ints(def1, def2: tdef): boolean;
  732. begin
  733. result:=(def1.typ=orddef) and (def2.typ=orddef) and
  734. (torddef(def1).ordtype in [u8bit,u16bit,u32bit,u64bit,
  735. s8bit,s16bit,s32bit,s64bit]) and
  736. (torddef(def1).ordtype=torddef(def2).ordtype);
  737. end;
  738. { true, if def is an int type, larger than the processor's native int size }
  739. function is_oversizedint(def : tdef) : boolean;
  740. begin
  741. {$if defined(cpu8bitalu)}
  742. result:=is_64bitint(def) or is_32bitint(def) or is_16bitint(def);
  743. {$elseif defined(cpu16bitalu)}
  744. result:=is_64bitint(def) or is_32bitint(def);
  745. {$elseif defined(cpu32bitaddr)}
  746. result:=is_64bitint(def);
  747. {$elseif defined(cpu64bitaddr)}
  748. result:=false;
  749. {$endif}
  750. end;
  751. { true, if def is an ordinal type, larger than the processor's native int size }
  752. function is_oversizedord(def : tdef) : boolean;
  753. begin
  754. {$if defined(cpu8bitalu)}
  755. result:=is_64bit(def) or is_32bit(def) or is_16bit(def);
  756. {$elseif defined(cpu16bitalu)}
  757. result:=is_64bit(def) or is_32bit(def);
  758. {$elseif defined(cpu32bitaddr)}
  759. result:=is_64bit(def);
  760. {$elseif defined(cpu64bitaddr)}
  761. result:=false;
  762. {$endif}
  763. end;
  764. { true, if def is an int type, equal in size to the processor's native int size }
  765. function is_nativeint(def: tdef): boolean;
  766. begin
  767. {$if defined(cpu8bitalu)}
  768. result:=is_8bitint(def);
  769. {$elseif defined(cpu16bitalu)}
  770. result:=is_16bitint(def);
  771. {$elseif defined(cpu32bitaddr)}
  772. result:=is_32bitint(def);
  773. {$elseif defined(cpu64bitaddr)}
  774. result:=is_64bitint(def);
  775. {$endif}
  776. end;
  777. { true, if def is an ordinal type, equal in size to the processor's native int size }
  778. function is_nativeord(def: tdef): boolean;
  779. begin
  780. {$if defined(cpu8bitalu)}
  781. result:=is_8bit(def);
  782. {$elseif defined(cpu16bitalu)}
  783. result:=is_16bit(def);
  784. {$elseif defined(cpu32bitaddr)}
  785. result:=is_32bit(def);
  786. {$elseif defined(cpu64bitaddr)}
  787. result:=is_64bit(def);
  788. {$endif}
  789. end;
  790. { true, if def is an unsigned int type, equal in size to the processor's native int size }
  791. function is_nativeuint(def: tdef): boolean;
  792. begin
  793. result:=is_nativeint(def) and (def.typ=orddef) and (torddef(def).ordtype in [u64bit,u32bit,u16bit,u8bit]);
  794. end;
  795. { true, if def is a signed int type, equal in size to the processor's native int size }
  796. function is_nativesint(def: tdef): boolean;
  797. begin
  798. result:=is_nativeint(def) and (def.typ=orddef) and (torddef(def).ordtype in [s64bit,s32bit,s16bit,s8bit]);
  799. end;
  800. { if l isn't in the range of todef a range check error (if not explicit) is generated and
  801. the value is placed within the range }
  802. procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
  803. var
  804. lv,hv: TConstExprInt;
  805. begin
  806. { for 64 bit types we need only to check if it is less than }
  807. { zero, if def is a qword node }
  808. getrange(todef,lv,hv);
  809. if (l<lv) or (l>hv) then
  810. begin
  811. if not explicit then
  812. begin
  813. if ((todef.typ=enumdef) and
  814. { delphi allows range check errors in
  815. enumeration type casts FK }
  816. not(m_delphi in current_settings.modeswitches)) or
  817. (cs_check_range in current_settings.localswitches) or
  818. forcerangecheck then
  819. Message3(type_e_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv))
  820. else
  821. Message3(type_w_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv));
  822. end;
  823. { Fix the value to fit in the allocated space for this type of variable }
  824. case longint(todef.size) of
  825. 1: l := l and $ff;
  826. 2: l := l and $ffff;
  827. 4: l := l and $ffffffff;
  828. end;
  829. {reset sign, i.e. converting -1 to qword changes the value to high(qword)}
  830. l.signed:=false;
  831. { do sign extension if necessary (JM) }
  832. if is_signed(todef) then
  833. begin
  834. case longint(todef.size) of
  835. 1: l.svalue := shortint(l.svalue);
  836. 2: l.svalue := smallint(l.svalue);
  837. 4: l.svalue := longint(l.svalue);
  838. end;
  839. l.signed:=true;
  840. end;
  841. end;
  842. end;
  843. { return the range from def in l and h }
  844. procedure getrange(def : tdef;out l, h : TConstExprInt);
  845. begin
  846. case def.typ of
  847. orddef :
  848. begin
  849. l:=torddef(def).low;
  850. h:=torddef(def).high;
  851. end;
  852. enumdef :
  853. begin
  854. l:=int64(tenumdef(def).min);
  855. h:=int64(tenumdef(def).max);
  856. end;
  857. arraydef :
  858. begin
  859. l:=int64(tarraydef(def).lowrange);
  860. h:=int64(tarraydef(def).highrange);
  861. end;
  862. undefineddef:
  863. begin
  864. l:=torddef(sizesinttype).low;
  865. h:=torddef(sizesinttype).high;
  866. end;
  867. else
  868. internalerror(200611054);
  869. end;
  870. end;
  871. function mmx_type(p : tdef) : tmmxtype;
  872. begin
  873. mmx_type:=mmxno;
  874. if is_mmx_able_array(p) then
  875. begin
  876. if tarraydef(p).elementdef.typ=floatdef then
  877. case tfloatdef(tarraydef(p).elementdef).floattype of
  878. s32real:
  879. mmx_type:=mmxsingle;
  880. end
  881. else
  882. case torddef(tarraydef(p).elementdef).ordtype of
  883. u8bit:
  884. mmx_type:=mmxu8bit;
  885. s8bit:
  886. mmx_type:=mmxs8bit;
  887. u16bit:
  888. mmx_type:=mmxu16bit;
  889. s16bit:
  890. mmx_type:=mmxs16bit;
  891. u32bit:
  892. mmx_type:=mmxu32bit;
  893. s32bit:
  894. mmx_type:=mmxs32bit;
  895. end;
  896. end;
  897. end;
  898. { 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.
  899. The range-type of an ordinal-type that is not a subrange-type shall be the ordinal-type.
  900. The subrange-bounds shall be of compatible ordinal-types, and the range-type (see 6.4.2.1) of the ordinal-types shall
  901. be designated the host-type of the subrange-type. }
  902. function get_iso_range_type(def: tdef): tdef;
  903. begin
  904. result:=nil;
  905. case def.typ of
  906. orddef:
  907. begin
  908. if is_integer(def) then
  909. begin
  910. if (torddef(def).low>=torddef(sinttype).low) and
  911. (torddef(def).high<=torddef(sinttype).high) then
  912. result:=sinttype
  913. else
  914. range_to_type(torddef(def).low,torddef(def).high,result);
  915. end
  916. else case torddef(def).ordtype of
  917. pasbool8:
  918. result:=pasbool8type;
  919. pasbool16:
  920. result:=pasbool16type;
  921. pasbool32:
  922. result:=pasbool32type;
  923. pasbool64:
  924. result:=pasbool64type;
  925. bool8bit:
  926. result:=bool8type;
  927. bool16bit:
  928. result:=bool16type;
  929. bool32bit:
  930. result:=bool32type;
  931. bool64bit:
  932. result:=bool64type;
  933. uchar:
  934. result:=cansichartype;
  935. uwidechar:
  936. result:=cwidechartype;
  937. scurrency:
  938. result:=s64currencytype;
  939. else
  940. internalerror(2018010901);
  941. end;
  942. end;
  943. enumdef:
  944. begin
  945. while assigned(tenumdef(def).basedef) do
  946. def:=tenumdef(def).basedef;
  947. result:=def;
  948. end
  949. else
  950. internalerror(2018010701);
  951. end;
  952. end;
  953. function is_vector(p : tdef) : boolean;
  954. begin
  955. result:=(p.typ=arraydef) and
  956. not(is_special_array(p)) and
  957. (tarraydef(p).elementdef.typ=floatdef) and
  958. (tfloatdef(tarraydef(p).elementdef).floattype in [s32real,s64real]);
  959. end;
  960. { returns if the passed type (array) fits into an mm register }
  961. function fits_in_mm_register(p : tdef) : boolean;
  962. begin
  963. {$ifdef x86}
  964. result:= is_vector(p) and
  965. (
  966. (tarraydef(p).elementdef.typ=floatdef) and
  967. (
  968. (tarraydef(p).lowrange=0) and
  969. (tarraydef(p).highrange=3) and
  970. (tfloatdef(tarraydef(p).elementdef).floattype=s32real)
  971. )
  972. ) or
  973. (
  974. (tarraydef(p).elementdef.typ=floatdef) and
  975. (
  976. (tarraydef(p).lowrange=0) and
  977. (tarraydef(p).highrange=1) and
  978. (tfloatdef(tarraydef(p).elementdef).floattype=s64real)
  979. )
  980. );
  981. {$else x86}
  982. result:=false;
  983. {$endif x86}
  984. end;
  985. function is_mmx_able_array(p : tdef) : boolean;
  986. begin
  987. {$ifdef SUPPORT_MMX}
  988. if (cs_mmx_saturation in current_settings.localswitches) then
  989. begin
  990. is_mmx_able_array:=(p.typ=arraydef) and
  991. not(is_special_array(p)) and
  992. (
  993. (
  994. (tarraydef(p).elementdef.typ=orddef) and
  995. (
  996. (
  997. (tarraydef(p).lowrange=0) and
  998. (tarraydef(p).highrange=1) and
  999. (torddef(tarraydef(p).elementdef).ordtype in [u32bit,s32bit])
  1000. )
  1001. or
  1002. (
  1003. (tarraydef(p).lowrange=0) and
  1004. (tarraydef(p).highrange=3) and
  1005. (torddef(tarraydef(p).elementdef).ordtype in [u16bit,s16bit])
  1006. )
  1007. )
  1008. )
  1009. or
  1010. (
  1011. (
  1012. (tarraydef(p).elementdef.typ=floatdef) and
  1013. (
  1014. (tarraydef(p).lowrange=0) and
  1015. (tarraydef(p).highrange=1) and
  1016. (tfloatdef(tarraydef(p).elementdef).floattype=s32real)
  1017. )
  1018. )
  1019. )
  1020. );
  1021. end
  1022. else
  1023. begin
  1024. is_mmx_able_array:=(p.typ=arraydef) and
  1025. (
  1026. (
  1027. (tarraydef(p).elementdef.typ=orddef) and
  1028. (
  1029. (
  1030. (tarraydef(p).lowrange=0) and
  1031. (tarraydef(p).highrange=1) and
  1032. (torddef(tarraydef(p).elementdef).ordtype in [u32bit,s32bit])
  1033. )
  1034. or
  1035. (
  1036. (tarraydef(p).lowrange=0) and
  1037. (tarraydef(p).highrange=3) and
  1038. (torddef(tarraydef(p).elementdef).ordtype in [u16bit,s16bit])
  1039. )
  1040. or
  1041. (
  1042. (tarraydef(p).lowrange=0) and
  1043. (tarraydef(p).highrange=7) and
  1044. (torddef(tarraydef(p).elementdef).ordtype in [u8bit,s8bit])
  1045. )
  1046. )
  1047. )
  1048. or
  1049. (
  1050. (tarraydef(p).elementdef.typ=floatdef) and
  1051. (
  1052. (tarraydef(p).lowrange=0) and
  1053. (tarraydef(p).highrange=1) and
  1054. (tfloatdef(tarraydef(p).elementdef).floattype=s32real)
  1055. )
  1056. )
  1057. );
  1058. end;
  1059. {$else SUPPORT_MMX}
  1060. is_mmx_able_array:=false;
  1061. {$endif SUPPORT_MMX}
  1062. end;
  1063. function def_cgsize(def: tdef): tcgsize;
  1064. begin
  1065. case def.typ of
  1066. orddef,
  1067. enumdef,
  1068. setdef:
  1069. begin
  1070. result:=int_cgsize(def.size);
  1071. if is_signed(def) then
  1072. result:=tcgsize(ord(result)+(ord(OS_S8)-ord(OS_8)));
  1073. end;
  1074. classrefdef,
  1075. pointerdef:
  1076. begin
  1077. result:=int_cgsize(def.size);
  1078. { can happen for far/huge pointers on non-i8086 }
  1079. if result=OS_NO then
  1080. internalerror(2013052201);
  1081. end;
  1082. formaldef:
  1083. result := int_cgsize(voidpointertype.size);
  1084. procvardef:
  1085. result:=int_cgsize(def.size);
  1086. stringdef :
  1087. result:=int_cgsize(def.size);
  1088. objectdef :
  1089. result:=int_cgsize(def.size);
  1090. floatdef:
  1091. if cs_fp_emulation in current_settings.moduleswitches then
  1092. result:=int_cgsize(def.size)
  1093. else
  1094. result:=tfloat2tcgsize[tfloatdef(def).floattype];
  1095. recorddef :
  1096. result:=int_cgsize(def.size);
  1097. arraydef :
  1098. begin
  1099. if is_dynamic_array(def) or not is_special_array(def) then
  1100. begin
  1101. if (cs_support_vectors in current_settings.globalswitches) and is_vector(def) and ((TArrayDef(def).elementdef.typ = floatdef) and not (cs_fp_emulation in current_settings.moduleswitches)) then
  1102. begin
  1103. { Determine if, based on the floating-point type and the size
  1104. of the array, if it can be made into a vector }
  1105. case TFloatDef(def).floattype of
  1106. s32real:
  1107. result := float_array_cgsize(def.size);
  1108. s64real:
  1109. result := double_array_cgsize(def.size);
  1110. else
  1111. { If not, fall back }
  1112. result := int_cgsize(def.size);
  1113. end;
  1114. end
  1115. else
  1116. result := int_cgsize(def.size);
  1117. end
  1118. else
  1119. result := OS_NO;
  1120. end;
  1121. else
  1122. begin
  1123. { undefined size }
  1124. result:=OS_NO;
  1125. end;
  1126. end;
  1127. end;
  1128. function cgsize_orddef(size: tcgsize): torddef;
  1129. begin
  1130. case size of
  1131. OS_8:
  1132. result:=torddef(u8inttype);
  1133. OS_S8:
  1134. result:=torddef(s8inttype);
  1135. OS_16:
  1136. result:=torddef(u16inttype);
  1137. OS_S16:
  1138. result:=torddef(s16inttype);
  1139. OS_32:
  1140. result:=torddef(u32inttype);
  1141. OS_S32:
  1142. result:=torddef(s32inttype);
  1143. OS_64:
  1144. result:=torddef(u64inttype);
  1145. OS_S64:
  1146. result:=torddef(s64inttype);
  1147. else
  1148. internalerror(2012050401);
  1149. end;
  1150. end;
  1151. function def_cgmmsize(def: tdef): tcgsize;
  1152. begin
  1153. case def.typ of
  1154. arraydef:
  1155. begin
  1156. case tarraydef(def).elementdef.typ of
  1157. orddef:
  1158. begin
  1159. { this is not correct, OS_MX normally mean that the vector
  1160. contains elements of size X. However, vectors themselves
  1161. can also have different sizes (e.g. a vector of 2 singles on
  1162. SSE) and the total size is currently more important }
  1163. case def.size of
  1164. 1: result:=OS_M8;
  1165. 2: result:=OS_M16;
  1166. 4: result:=OS_M32;
  1167. 8: result:=OS_M64;
  1168. 16: result:=OS_M128;
  1169. 32: result:=OS_M256;
  1170. 64: result:=OS_M512;
  1171. else
  1172. internalerror(2013060103);
  1173. end;
  1174. end;
  1175. floatdef:
  1176. begin
  1177. case TFloatDef(tarraydef(def).elementdef).floattype of
  1178. s32real:
  1179. case def.size of
  1180. 4: result:=OS_MF32;
  1181. 16: result:=OS_MF128;
  1182. 32: result:=OS_MF256;
  1183. 64: result:=OS_MF512;
  1184. else
  1185. internalerror(2017121400);
  1186. end;
  1187. s64real:
  1188. case def.size of
  1189. 8: result:=OS_MD64;
  1190. 16: result:=OS_MD128;
  1191. 32: result:=OS_MD256;
  1192. 64: result:=OS_MD512;
  1193. else
  1194. internalerror(2017121401);
  1195. end;
  1196. else
  1197. internalerror(2017121402);
  1198. end;
  1199. end;
  1200. else
  1201. result:=def_cgsize(def);
  1202. end;
  1203. end
  1204. else
  1205. result:=def_cgsize(def);
  1206. end;
  1207. end;
  1208. { In Windows 95 era, ordinals were restricted to [u8bit,s32bit,s16bit,bool16bit]
  1209. As of today, both signed and unsigned types from 8 to 64 bits are supported. }
  1210. function is_automatable(p : tdef) : boolean;
  1211. begin
  1212. result:=false;
  1213. case p.typ of
  1214. orddef:
  1215. result:=torddef(p).ordtype in [u8bit,s8bit,u16bit,s16bit,u32bit,s32bit,
  1216. u64bit,s64bit,bool16bit,scurrency];
  1217. floatdef:
  1218. result:=tfloatdef(p).floattype in [s64currency,s64real,s32real];
  1219. stringdef:
  1220. result:=tstringdef(p).stringtype in [st_ansistring,st_widestring,st_unicodestring];
  1221. variantdef:
  1222. result:=true;
  1223. objectdef:
  1224. result:=tobjectdef(p).objecttype in [odt_interfacecom,odt_dispinterface,odt_interfacecorba];
  1225. end;
  1226. end;
  1227. {# returns true, if the type passed is a varset }
  1228. function is_smallset(p : tdef) : boolean;
  1229. begin
  1230. {$if defined(cpu8bitalu)}
  1231. result:=(p.typ=setdef) and (p.size = 1)
  1232. {$elseif defined(cpu16bitalu)}
  1233. result:=(p.typ=setdef) and (p.size in [1,2])
  1234. {$else}
  1235. result:=(p.typ=setdef) and (p.size in [1,2,4])
  1236. {$endif}
  1237. end;
  1238. function is_bareprocdef(pd : tprocdef): boolean;
  1239. begin
  1240. result:=(pd.maxparacount=0) and
  1241. (is_void(pd.returndef) or
  1242. (pd.proctypeoption = potype_constructor));
  1243. end;
  1244. function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
  1245. var
  1246. llow, lhigh: tconstexprint;
  1247. begin
  1248. llow:=min(ld.low,rd.low);
  1249. lhigh:=max(ld.high,rd.high);
  1250. case range_to_basetype(llow,lhigh) of
  1251. s8bit:
  1252. result:=torddef(s8inttype);
  1253. u8bit:
  1254. result:=torddef(u8inttype);
  1255. s16bit:
  1256. result:=torddef(s16inttype);
  1257. u16bit:
  1258. result:=torddef(u16inttype);
  1259. s32bit:
  1260. result:=torddef(s32inttype);
  1261. u32bit:
  1262. result:=torddef(u32inttype);
  1263. s64bit:
  1264. result:=torddef(s64inttype);
  1265. u64bit:
  1266. result:=torddef(u64inttype);
  1267. else
  1268. begin
  1269. { avoid warning }
  1270. result:=nil;
  1271. internalerror(200802291);
  1272. end;
  1273. end;
  1274. if keep_sign_if_equal and
  1275. (is_signed(ld)=is_signed(rd)) and
  1276. (is_signed(result)<>is_signed(ld)) then
  1277. case result.ordtype of
  1278. s8bit:
  1279. result:=torddef(u8inttype);
  1280. u8bit:
  1281. result:=torddef(s16inttype);
  1282. s16bit:
  1283. result:=torddef(u16inttype);
  1284. u16bit:
  1285. result:=torddef(s32inttype);
  1286. s32bit:
  1287. result:=torddef(u32inttype);
  1288. u32bit:
  1289. result:=torddef(s64inttype);
  1290. s64bit:
  1291. result:=torddef(u64inttype);
  1292. end;
  1293. end;
  1294. function is_valid_univ_para_type(def: tdef): boolean;
  1295. begin
  1296. result:=
  1297. not is_open_array(def) and
  1298. not is_void(def) and
  1299. (def.typ<>formaldef);
  1300. end;
  1301. function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif}
  1302. begin
  1303. result:=def.parast.symtablelevel>normal_function_level;
  1304. end;
  1305. function is_typeparam(def : tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
  1306. begin
  1307. result:=(def.typ=undefineddef);
  1308. end;
  1309. function is_methodpointer(def: tdef): boolean;
  1310. begin
  1311. result:=(def.typ=procvardef) and (po_methodpointer in tprocvardef(def).procoptions);
  1312. end;
  1313. function is_block(def: tdef): boolean;
  1314. begin
  1315. result:=(def.typ=procvardef) and (po_is_block in tprocvardef(def).procoptions)
  1316. end;
  1317. function get_typekind(def:tdef):byte;
  1318. begin
  1319. case def.typ of
  1320. arraydef:
  1321. if ado_IsDynamicArray in tarraydef(def).arrayoptions then
  1322. result:=tkDynArray
  1323. else
  1324. result:=tkArray;
  1325. recorddef:
  1326. result:=tkRecord;
  1327. pointerdef:
  1328. result:=tkPointer;
  1329. orddef:
  1330. case torddef(def).ordtype of
  1331. u8bit,
  1332. u16bit,
  1333. u32bit,
  1334. s8bit,
  1335. s16bit,
  1336. s32bit:
  1337. result:=tkInteger;
  1338. u64bit:
  1339. result:=tkQWord;
  1340. s64bit:
  1341. result:=tkInt64;
  1342. pasbool8,
  1343. pasbool16,
  1344. pasbool32,
  1345. pasbool64,
  1346. bool8bit,
  1347. bool16bit,
  1348. bool32bit,
  1349. bool64bit:
  1350. result:=tkBool;
  1351. uchar:
  1352. result:=tkChar;
  1353. uwidechar:
  1354. result:=tkWChar;
  1355. scurrency:
  1356. result:=tkFloat;
  1357. else
  1358. result:=tkUnknown;
  1359. end;
  1360. stringdef:
  1361. case tstringdef(def).stringtype of
  1362. st_shortstring:
  1363. result:=tkSString;
  1364. st_longstring:
  1365. result:=tkLString;
  1366. st_ansistring:
  1367. result:=tkAString;
  1368. st_widestring:
  1369. result:=tkWString;
  1370. st_unicodestring:
  1371. result:=tkUString;
  1372. else
  1373. result:=tkUnknown;
  1374. end;
  1375. enumdef:
  1376. result:=tkEnumeration;
  1377. objectdef:
  1378. case tobjectdef(def).objecttype of
  1379. odt_class,
  1380. odt_javaclass:
  1381. result:=tkClass;
  1382. odt_object:
  1383. result:=tkObject;
  1384. odt_interfacecom,
  1385. odt_dispinterface,
  1386. odt_interfacejava:
  1387. result:=tkInterface;
  1388. odt_interfacecorba:
  1389. result:=tkInterfaceCorba;
  1390. odt_helper:
  1391. result:=tkHelper;
  1392. else
  1393. result:=tkUnknown;
  1394. end;
  1395. { currently tkFile is not used }
  1396. {filedef:
  1397. result:=tkFile;}
  1398. setdef:
  1399. result:=tkSet;
  1400. procvardef:
  1401. if tprocvardef(def).is_methodpointer then
  1402. result:=tkMethod
  1403. else
  1404. result:=tkProcVar;
  1405. floatdef:
  1406. result:=tkFloat;
  1407. classrefdef:
  1408. result:=tkClassRef;
  1409. variantdef:
  1410. result:=tkVariant;
  1411. else
  1412. result:=tkUnknown;
  1413. end;
  1414. end;
  1415. end.