defutil.pas 55 KB

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