2
0

defutil.pas 36 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145
  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. cclasses,
  22. globtype,globals,constexp,node,
  23. symconst,symbase,symtype,symdef,
  24. cgbase,cpubase;
  25. type
  26. tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
  27. mmxu32bit,mmxs32bit,mmxfixed16,mmxsingle);
  28. {*****************************************************************************
  29. Basic type functions
  30. *****************************************************************************}
  31. {# Returns true, if definition defines an ordinal type }
  32. function is_ordinal(def : tdef) : boolean;
  33. {# Returns true, if definition defines a string type }
  34. function is_string(def : tdef): boolean;
  35. {# Returns the minimal integer value of the type }
  36. function get_min_value(def : tdef) : TConstExprInt;
  37. {# Returns the maximal integer value of the type }
  38. function get_max_value(def : tdef) : TConstExprInt;
  39. {# Returns basetype of the specified integer range }
  40. function range_to_basetype(l,h:TConstExprInt):tordtype;
  41. procedure range_to_type(l,h:TConstExprInt;var def:tdef);
  42. procedure int_to_type(v:TConstExprInt;var def:tdef);
  43. {# Returns true, if definition defines an integer type }
  44. function is_integer(def : tdef) : boolean;
  45. {# Returns true if definition is a boolean }
  46. function is_boolean(def : tdef) : boolean;
  47. {# Returns true if definition is a Pascal-style boolean (1 = true, zero = false) }
  48. function is_pasbool(def : tdef) : boolean;
  49. {# Returns true if definition is a C-style boolean (non-zero value = true, zero = false) }
  50. function is_cbool(def : tdef) : boolean;
  51. {# Returns true if definition is a char
  52. This excludes the unicode char.
  53. }
  54. function is_char(def : tdef) : boolean;
  55. {# Returns true if definition is a widechar }
  56. function is_widechar(def : tdef) : boolean;
  57. {# Returns true if definition is either an AnsiChar or a WideChar }
  58. function is_anychar(def : tdef) : boolean;
  59. {# Returns true if definition is a void}
  60. function is_void(def : tdef) : boolean;
  61. {# Returns true if definition is a smallset}
  62. function is_smallset(p : tdef) : boolean;
  63. {# Returns true, if def defines a signed data type
  64. (only for ordinal types)
  65. }
  66. function is_signed(def : tdef) : boolean;
  67. {# Returns whether def_from's range is comprised in def_to's if both are
  68. orddefs, false otherwise }
  69. function is_in_limit(def_from,def_to : tdef) : boolean;
  70. {# Returns whether def is reference counted }
  71. function is_managed_type(def: tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
  72. { function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;}
  73. {*****************************************************************************
  74. Array helper functions
  75. *****************************************************************************}
  76. {# Returns true, if p points to a zero based (non special like open or
  77. dynamic array def).
  78. This is mainly used to see if the array
  79. is convertable to a pointer
  80. }
  81. function is_zero_based_array(p : tdef) : boolean;
  82. {# Returns true if p points to an open array definition }
  83. function is_open_array(p : tdef) : boolean;
  84. {# Returns true if p points to a dynamic array definition }
  85. function is_dynamic_array(p : tdef) : boolean;
  86. {# Returns true, if p points to an array of const definition }
  87. function is_array_constructor(p : tdef) : boolean;
  88. {# Returns true, if p points to a variant array }
  89. function is_variant_array(p : tdef) : boolean;
  90. {# Returns true, if p points to an array of const }
  91. function is_array_of_const(p : tdef) : boolean;
  92. {# Returns true, if p points any kind of special array
  93. That is if the array is an open array, a variant
  94. array, an array constants constructor, or an
  95. array of const.
  96. Bitpacked arrays aren't special in this regard though.
  97. }
  98. function is_special_array(p : tdef) : boolean;
  99. {# Returns true if p is a bitpacked array }
  100. function is_packed_array(p: tdef) : boolean;
  101. {# Returns true if p is a bitpacked record }
  102. function is_packed_record_or_object(p: tdef) : boolean;
  103. {# Returns true if p is a char array def }
  104. function is_chararray(p : tdef) : boolean;
  105. {# Returns true if p is a wide char array def }
  106. function is_widechararray(p : tdef) : boolean;
  107. {# Returns true if p is a open char array def }
  108. function is_open_chararray(p : tdef) : boolean;
  109. {# Returns true if p is a open wide char array def }
  110. function is_open_widechararray(p : tdef) : boolean;
  111. {*****************************************************************************
  112. String helper functions
  113. *****************************************************************************}
  114. {# Returns true if p points to an open string type }
  115. function is_open_string(p : tdef) : boolean;
  116. {# Returns true if p is an ansi string type }
  117. function is_ansistring(p : tdef) : boolean;
  118. {# Returns true if p is a long string type }
  119. function is_longstring(p : tdef) : boolean;
  120. {# returns true if p is a wide string type }
  121. function is_widestring(p : tdef) : boolean;
  122. {# true if p is an unicode string def }
  123. function is_unicodestring(p : tdef) : boolean;
  124. {# returns true if p is a wide or unicode string type }
  125. function is_wide_or_unicode_string(p : tdef) : boolean;
  126. {# Returns true if p is a short string type }
  127. function is_shortstring(p : tdef) : boolean;
  128. {# Returns true if p is a pchar def }
  129. function is_pchar(p : tdef) : boolean;
  130. {# Returns true if p is a pwidechar def }
  131. function is_pwidechar(p : tdef) : boolean;
  132. {# Returns true if p is a voidpointer def }
  133. function is_voidpointer(p : tdef) : boolean;
  134. {# Returns true, if definition is a float }
  135. function is_fpu(def : tdef) : boolean;
  136. {# Returns true, if def is a currency type }
  137. function is_currency(def : tdef) : boolean;
  138. {# Returns true, if def is a single type }
  139. function is_single(def : tdef) : boolean;
  140. {# Returns true, if def is a double type }
  141. function is_double(def : tdef) : boolean;
  142. {# Returns true, if def is an extended type }
  143. function is_extended(def : tdef) : boolean;
  144. {# Returns true, if definition is a "real" real (i.e. single/double/extended) }
  145. function is_real(def : tdef) : boolean;
  146. {# Returns true, if def is a 32 bit integer type }
  147. function is_32bitint(def : tdef) : boolean;
  148. {# Returns true, if def is a 64 bit integer type }
  149. function is_64bitint(def : tdef) : boolean;
  150. {# Returns true, if def is a 64 bit type }
  151. function is_64bit(def : tdef) : boolean;
  152. {# If @var(l) isn't in the range of todef a range check error (if not explicit) is generated and
  153. the value is placed within the range
  154. }
  155. procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
  156. {# Returns the range of def, where @var(l) is the low-range and @var(h) is
  157. the high-range.
  158. }
  159. procedure getrange(def : tdef;out l, h : TConstExprInt);
  160. { type being a vector? }
  161. function is_vector(p : tdef) : boolean;
  162. { some type helper routines for MMX support }
  163. function is_mmx_able_array(p : tdef) : boolean;
  164. {# returns the mmx type }
  165. function mmx_type(p : tdef) : tmmxtype;
  166. { returns if the passed type (array) fits into an mm register }
  167. function fits_in_mm_register(p : tdef) : boolean;
  168. {# From a definition return the abstract code generator size enum. It is
  169. to note that the value returned can be @var(OS_NO) }
  170. function def_cgsize(def: tdef): tcgsize;
  171. {# returns true, if the type passed is can be used with windows automation }
  172. function is_automatable(p : tdef) : boolean;
  173. { # returns true if the procdef has no parameters and no specified return type }
  174. function is_bareprocdef(pd : tprocdef): boolean;
  175. { # returns the smallest base integer type whose range encompasses that of
  176. both ld and rd; if keep_sign_if_equal, then if ld and rd have the same
  177. signdness, the result will also get that signdness }
  178. function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
  179. { # returns whether the type is potentially a valid type of/for an "univ" parameter
  180. (basically: it must have a compile-time size) }
  181. function is_valid_univ_para_type(def: tdef): boolean;
  182. { # returns whether the procdef/procvardef represents a nested procedure
  183. or not }
  184. function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif}
  185. implementation
  186. uses
  187. systems,verbose;
  188. { returns true, if def uses FPU }
  189. function is_fpu(def : tdef) : boolean;
  190. begin
  191. is_fpu:=(def.typ=floatdef);
  192. end;
  193. { returns true, if def is a currency type }
  194. function is_currency(def : tdef) : boolean;
  195. begin
  196. case s64currencytype.typ of
  197. orddef :
  198. result:=(def.typ=orddef) and
  199. (torddef(s64currencytype).ordtype=torddef(def).ordtype);
  200. floatdef :
  201. result:=(def.typ=floatdef) and
  202. (tfloatdef(s64currencytype).floattype=tfloatdef(def).floattype);
  203. else
  204. internalerror(200304222);
  205. end;
  206. end;
  207. { returns true, if def is a single type }
  208. function is_single(def : tdef) : boolean;
  209. begin
  210. result:=(def.typ=floatdef) and
  211. (tfloatdef(def).floattype=s32real);
  212. end;
  213. { returns true, if def is a double type }
  214. function is_double(def : tdef) : boolean;
  215. begin
  216. result:=(def.typ=floatdef) and
  217. (tfloatdef(def).floattype=s64real);
  218. end;
  219. function is_extended(def : tdef) : boolean;
  220. begin
  221. result:=(def.typ=floatdef) and
  222. (tfloatdef(def).floattype in [s80real,sc80real]);
  223. end;
  224. { returns true, if definition is a "real" real (i.e. single/double/extended) }
  225. function is_real(def : tdef) : boolean;
  226. begin
  227. result:=(def.typ=floatdef) and
  228. (tfloatdef(def).floattype in [s32real,s64real,s80real]);
  229. end;
  230. function range_to_basetype(l,h:TConstExprInt):tordtype;
  231. begin
  232. { prefer signed over unsigned }
  233. if (l>=int64(-128)) and (h<=127) then
  234. range_to_basetype:=s8bit
  235. else if (l>=0) and (h<=255) then
  236. range_to_basetype:=u8bit
  237. else if (l>=int64(-32768)) and (h<=32767) then
  238. range_to_basetype:=s16bit
  239. else if (l>=0) and (h<=65535) then
  240. range_to_basetype:=u16bit
  241. else if (l>=int64(low(longint))) and (h<=high(longint)) then
  242. range_to_basetype:=s32bit
  243. else if (l>=low(cardinal)) and (h<=high(cardinal)) then
  244. range_to_basetype:=u32bit
  245. else
  246. range_to_basetype:=s64bit;
  247. end;
  248. procedure range_to_type(l,h:TConstExprInt;var def:tdef);
  249. begin
  250. { prefer signed over unsigned }
  251. if (l>=int64(-128)) and (h<=127) then
  252. def:=s8inttype
  253. else if (l>=0) and (h<=255) then
  254. def:=u8inttype
  255. else if (l>=int64(-32768)) and (h<=32767) then
  256. def:=s16inttype
  257. else if (l>=0) and (h<=65535) then
  258. def:=u16inttype
  259. else if (l>=int64(low(longint))) and (h<=high(longint)) then
  260. def:=s32inttype
  261. else if (l>=low(cardinal)) and (h<=high(cardinal)) then
  262. def:=u32inttype
  263. else if (l>=low(int64)) and (h<=high(int64)) then
  264. def:=s64inttype
  265. else
  266. def:=u64inttype;
  267. end;
  268. procedure int_to_type(v:TConstExprInt;var def:tdef);
  269. begin
  270. range_to_type(v,v,def);
  271. end;
  272. { true if p is an ordinal }
  273. function is_ordinal(def : tdef) : boolean;
  274. var
  275. dt : tordtype;
  276. begin
  277. case def.typ of
  278. orddef :
  279. begin
  280. dt:=torddef(def).ordtype;
  281. is_ordinal:=dt in [uchar,uwidechar,
  282. u8bit,u16bit,u32bit,u64bit,
  283. s8bit,s16bit,s32bit,s64bit,
  284. pasbool,bool8bit,bool16bit,bool32bit,bool64bit];
  285. end;
  286. enumdef :
  287. is_ordinal:=true;
  288. else
  289. is_ordinal:=false;
  290. end;
  291. end;
  292. { true if p is a string }
  293. function is_string(def : tdef) : boolean;
  294. begin
  295. is_string := (assigned(def) and (def.typ = stringdef));
  296. end;
  297. { returns the min. value of the type }
  298. function get_min_value(def : tdef) : TConstExprInt;
  299. begin
  300. case def.typ of
  301. orddef:
  302. result:=torddef(def).low;
  303. enumdef:
  304. result:=int64(tenumdef(def).min);
  305. else
  306. result:=0;
  307. end;
  308. end;
  309. { returns the max. value of the type }
  310. function get_max_value(def : tdef) : TConstExprInt;
  311. begin
  312. case def.typ of
  313. orddef:
  314. result:=torddef(def).high;
  315. enumdef:
  316. result:=tenumdef(def).max;
  317. else
  318. result:=0;
  319. end;
  320. end;
  321. { true if p is an integer }
  322. function is_integer(def : tdef) : boolean;
  323. begin
  324. result:=(def.typ=orddef) and
  325. (torddef(def).ordtype in [u8bit,u16bit,u32bit,u64bit,
  326. s8bit,s16bit,s32bit,s64bit]);
  327. end;
  328. { true if p is a boolean }
  329. function is_boolean(def : tdef) : boolean;
  330. begin
  331. result:=(def.typ=orddef) and
  332. (torddef(def).ordtype in [pasbool,bool8bit,bool16bit,bool32bit,bool64bit]);
  333. end;
  334. function is_pasbool(def : tdef) : boolean;
  335. begin
  336. result:=(def.typ=orddef) and
  337. (torddef(def).ordtype = pasbool);
  338. end;
  339. { true if def is a C-style boolean (non-zero value = true, zero = false) }
  340. function is_cbool(def : tdef) : boolean;
  341. begin
  342. result:=(def.typ=orddef) and
  343. (torddef(def).ordtype in [bool8bit,bool16bit,bool32bit,bool64bit]);
  344. end;
  345. { true if p is a void }
  346. function is_void(def : tdef) : boolean;
  347. begin
  348. result:=(def.typ=orddef) and
  349. (torddef(def).ordtype=uvoid);
  350. end;
  351. { true if p is a char }
  352. function is_char(def : tdef) : boolean;
  353. begin
  354. result:=(def.typ=orddef) and
  355. (torddef(def).ordtype=uchar);
  356. end;
  357. { true if p is a wchar }
  358. function is_widechar(def : tdef) : boolean;
  359. begin
  360. result:=(def.typ=orddef) and
  361. (torddef(def).ordtype=uwidechar);
  362. end;
  363. { true if p is a char or wchar }
  364. function is_anychar(def : tdef) : boolean;
  365. begin
  366. result:=(def.typ=orddef) and
  367. (torddef(def).ordtype in [uchar,uwidechar])
  368. end;
  369. { true if p is signed (integer) }
  370. function is_signed(def : tdef) : boolean;
  371. begin
  372. case def.typ of
  373. orddef :
  374. result:=torddef(def).low < 0;
  375. enumdef :
  376. result:=tenumdef(def).min < 0;
  377. arraydef :
  378. result:=is_signed(tarraydef(def).rangedef);
  379. else
  380. result:=false;
  381. end;
  382. end;
  383. function is_in_limit(def_from,def_to : tdef) : boolean;
  384. begin
  385. if (def_from.typ<>def_to.typ) or
  386. not(def_from.typ in [orddef,enumdef,setdef]) then
  387. begin
  388. is_in_limit := false;
  389. exit;
  390. end;
  391. case def_from.typ of
  392. orddef:
  393. is_in_limit:=(torddef(def_from).low>=torddef(def_to).low) and
  394. (torddef(def_from).high<=torddef(def_to).high);
  395. enumdef:
  396. is_in_limit:=(tenumdef(def_from).min>=tenumdef(def_to).min) and
  397. (tenumdef(def_from).max<=tenumdef(def_to).max);
  398. setdef:
  399. is_in_limit:=(tsetdef(def_from).setbase>=tsetdef(def_to).setbase) and
  400. (tsetdef(def_from).setmax<=tsetdef(def_to).setmax);
  401. else
  402. is_in_limit:=false;
  403. end;
  404. end;
  405. function is_managed_type(def: tdef): boolean;{$ifdef USEINLINE}inline;{$endif}
  406. begin
  407. result:=def.needs_inittable;
  408. end;
  409. { true, if p points to an open array def }
  410. function is_open_string(p : tdef) : boolean;
  411. begin
  412. is_open_string:=(p.typ=stringdef) and
  413. (tstringdef(p).stringtype=st_shortstring) and
  414. (tstringdef(p).len=0);
  415. end;
  416. { true, if p points to a zero based array def }
  417. function is_zero_based_array(p : tdef) : boolean;
  418. begin
  419. result:=(p.typ=arraydef) and
  420. (tarraydef(p).lowrange=0) and
  421. not(is_special_array(p));
  422. end;
  423. { true if p points to a dynamic array def }
  424. function is_dynamic_array(p : tdef) : boolean;
  425. begin
  426. result:=(p.typ=arraydef) and
  427. (ado_IsDynamicArray in tarraydef(p).arrayoptions);
  428. end;
  429. { true, if p points to an open array def }
  430. function is_open_array(p : tdef) : boolean;
  431. begin
  432. { check for s32inttype is needed, because for u32bit the high
  433. range is also -1 ! (PFV) }
  434. result:=(p.typ=arraydef) and
  435. (tarraydef(p).rangedef=s32inttype) and
  436. (tarraydef(p).lowrange=0) and
  437. (tarraydef(p).highrange=-1) and
  438. ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])=[]);
  439. end;
  440. { true, if p points to an array of const def }
  441. function is_array_constructor(p : tdef) : boolean;
  442. begin
  443. result:=(p.typ=arraydef) and
  444. (ado_IsConstructor in tarraydef(p).arrayoptions);
  445. end;
  446. { true, if p points to a variant array }
  447. function is_variant_array(p : tdef) : boolean;
  448. begin
  449. result:=(p.typ=arraydef) and
  450. (ado_IsVariant in tarraydef(p).arrayoptions);
  451. end;
  452. { true, if p points to an array of const }
  453. function is_array_of_const(p : tdef) : boolean;
  454. begin
  455. result:=(p.typ=arraydef) and
  456. (ado_IsArrayOfConst in tarraydef(p).arrayoptions);
  457. end;
  458. { true, if p points to a special array, bitpacked arrays aren't special in this regard though }
  459. function is_special_array(p : tdef) : boolean;
  460. begin
  461. result:=(p.typ=arraydef) and
  462. (
  463. ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])<>[]) or
  464. is_open_array(p)
  465. );
  466. end;
  467. { true if p is an ansi string def }
  468. function is_ansistring(p : tdef) : boolean;
  469. begin
  470. is_ansistring:=(p.typ=stringdef) and
  471. (tstringdef(p).stringtype=st_ansistring);
  472. end;
  473. { true if p is an long string def }
  474. function is_longstring(p : tdef) : boolean;
  475. begin
  476. is_longstring:=(p.typ=stringdef) and
  477. (tstringdef(p).stringtype=st_longstring);
  478. end;
  479. { true if p is an wide string def }
  480. function is_widestring(p : tdef) : boolean;
  481. begin
  482. is_widestring:=(p.typ=stringdef) and
  483. (tstringdef(p).stringtype=st_widestring);
  484. end;
  485. { true if p is an wide string def }
  486. function is_wide_or_unicode_string(p : tdef) : boolean;
  487. begin
  488. is_wide_or_unicode_string:=(p.typ=stringdef) and
  489. (tstringdef(p).stringtype in [st_widestring,st_unicodestring]);
  490. end;
  491. { true if p is an unicode string def }
  492. function is_unicodestring(p : tdef) : boolean;
  493. begin
  494. is_unicodestring:=(p.typ=stringdef) and
  495. (tstringdef(p).stringtype=st_unicodestring);
  496. end;
  497. { true if p is an short string def }
  498. function is_shortstring(p : tdef) : boolean;
  499. begin
  500. is_shortstring:=(p.typ=stringdef) and
  501. (tstringdef(p).stringtype=st_shortstring);
  502. end;
  503. { true if p is bit packed array def }
  504. function is_packed_array(p: tdef) : boolean;
  505. begin
  506. is_packed_array :=
  507. (p.typ = arraydef) and
  508. (ado_IsBitPacked in tarraydef(p).arrayoptions);
  509. end;
  510. { true if p is bit packed record def }
  511. function is_packed_record_or_object(p: tdef) : boolean;
  512. begin
  513. is_packed_record_or_object :=
  514. (p.typ in [recorddef,objectdef]) and
  515. (tabstractrecorddef(p).is_packed);
  516. end;
  517. { true if p is a char array def }
  518. function is_chararray(p : tdef) : boolean;
  519. begin
  520. is_chararray:=(p.typ=arraydef) and
  521. is_char(tarraydef(p).elementdef) and
  522. not(is_special_array(p));
  523. end;
  524. { true if p is a widechar array def }
  525. function is_widechararray(p : tdef) : boolean;
  526. begin
  527. is_widechararray:=(p.typ=arraydef) and
  528. is_widechar(tarraydef(p).elementdef) and
  529. not(is_special_array(p));
  530. end;
  531. { true if p is a open char array def }
  532. function is_open_chararray(p : tdef) : boolean;
  533. begin
  534. is_open_chararray:= is_open_array(p) and
  535. is_char(tarraydef(p).elementdef);
  536. end;
  537. { true if p is a open wide char array def }
  538. function is_open_widechararray(p : tdef) : boolean;
  539. begin
  540. is_open_widechararray:= is_open_array(p) and
  541. is_widechar(tarraydef(p).elementdef);
  542. end;
  543. { true if p is a pchar def }
  544. function is_pchar(p : tdef) : boolean;
  545. begin
  546. is_pchar:=(p.typ=pointerdef) and
  547. (is_char(tpointerdef(p).pointeddef) or
  548. (is_zero_based_array(tpointerdef(p).pointeddef) and
  549. is_chararray(tpointerdef(p).pointeddef)));
  550. end;
  551. { true if p is a pchar def }
  552. function is_pwidechar(p : tdef) : boolean;
  553. begin
  554. is_pwidechar:=(p.typ=pointerdef) and
  555. (is_widechar(tpointerdef(p).pointeddef) or
  556. (is_zero_based_array(tpointerdef(p).pointeddef) and
  557. is_widechararray(tpointerdef(p).pointeddef)));
  558. end;
  559. { true if p is a voidpointer def }
  560. function is_voidpointer(p : tdef) : boolean;
  561. begin
  562. is_voidpointer:=(p.typ=pointerdef) and
  563. (tpointerdef(p).pointeddef.typ=orddef) and
  564. (torddef(tpointerdef(p).pointeddef).ordtype=uvoid);
  565. end;
  566. { true, if def is a 32 bit int type }
  567. function is_32bitint(def : tdef) : boolean;
  568. begin
  569. result:=(def.typ=orddef) and (torddef(def).ordtype in [u32bit,s32bit])
  570. end;
  571. { true, if def is a 64 bit int type }
  572. function is_64bitint(def : tdef) : boolean;
  573. begin
  574. is_64bitint:=(def.typ=orddef) and (torddef(def).ordtype in [u64bit,s64bit])
  575. end;
  576. { true, if def is a 64 bit type }
  577. function is_64bit(def : tdef) : boolean;
  578. begin
  579. is_64bit:=(def.typ=orddef) and (torddef(def).ordtype in [u64bit,s64bit,scurrency])
  580. end;
  581. { if l isn't in the range of todef a range check error (if not explicit) is generated and
  582. the value is placed within the range }
  583. procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
  584. var
  585. lv,hv: TConstExprInt;
  586. begin
  587. { for 64 bit types we need only to check if it is less than }
  588. { zero, if def is a qword node }
  589. getrange(todef,lv,hv);
  590. if (l<lv) or (l>hv) then
  591. begin
  592. if not explicit then
  593. begin
  594. if ((todef.typ=enumdef) and
  595. { delphi allows range check errors in
  596. enumeration type casts FK }
  597. not(m_delphi in current_settings.modeswitches)) or
  598. (cs_check_range in current_settings.localswitches) or
  599. forcerangecheck then
  600. Message(parser_e_range_check_error)
  601. else
  602. Message(parser_w_range_check_error);
  603. end;
  604. { Fix the value to fit in the allocated space for this type of variable }
  605. case longint(todef.size) of
  606. 1: l := l and $ff;
  607. 2: l := l and $ffff;
  608. 4: l := l and $ffffffff;
  609. end;
  610. {reset sign, i.e. converting -1 to qword changes the value to high(qword)}
  611. l.signed:=false;
  612. { do sign extension if necessary (JM) }
  613. if is_signed(todef) then
  614. begin
  615. case longint(todef.size) of
  616. 1: l.svalue := shortint(l.svalue);
  617. 2: l.svalue := smallint(l.svalue);
  618. 4: l.svalue := longint(l.svalue);
  619. end;
  620. l.signed:=true;
  621. end;
  622. end;
  623. end;
  624. { return the range from def in l and h }
  625. procedure getrange(def : tdef;out l, h : TConstExprInt);
  626. begin
  627. case def.typ of
  628. orddef :
  629. begin
  630. l:=torddef(def).low;
  631. h:=torddef(def).high;
  632. end;
  633. enumdef :
  634. begin
  635. l:=int64(tenumdef(def).min);
  636. h:=int64(tenumdef(def).max);
  637. end;
  638. arraydef :
  639. begin
  640. l:=int64(tarraydef(def).lowrange);
  641. h:=int64(tarraydef(def).highrange);
  642. end;
  643. else
  644. internalerror(200611054);
  645. end;
  646. end;
  647. function mmx_type(p : tdef) : tmmxtype;
  648. begin
  649. mmx_type:=mmxno;
  650. if is_mmx_able_array(p) then
  651. begin
  652. if tarraydef(p).elementdef.typ=floatdef then
  653. case tfloatdef(tarraydef(p).elementdef).floattype of
  654. s32real:
  655. mmx_type:=mmxsingle;
  656. end
  657. else
  658. case torddef(tarraydef(p).elementdef).ordtype of
  659. u8bit:
  660. mmx_type:=mmxu8bit;
  661. s8bit:
  662. mmx_type:=mmxs8bit;
  663. u16bit:
  664. mmx_type:=mmxu16bit;
  665. s16bit:
  666. mmx_type:=mmxs16bit;
  667. u32bit:
  668. mmx_type:=mmxu32bit;
  669. s32bit:
  670. mmx_type:=mmxs32bit;
  671. end;
  672. end;
  673. end;
  674. function is_vector(p : tdef) : boolean;
  675. begin
  676. result:=(p.typ=arraydef) and
  677. not(is_special_array(p)) and
  678. (tarraydef(p).elementdef.typ=floatdef) and
  679. (tfloatdef(tarraydef(p).elementdef).floattype in [s32real,s64real]);
  680. end;
  681. { returns if the passed type (array) fits into an mm register }
  682. function fits_in_mm_register(p : tdef) : boolean;
  683. begin
  684. {$ifdef x86}
  685. result:= is_vector(p) and
  686. (
  687. (tarraydef(p).elementdef.typ=floatdef) and
  688. (
  689. (tarraydef(p).lowrange=0) and
  690. (tarraydef(p).highrange=3) and
  691. (tfloatdef(tarraydef(p).elementdef).floattype=s32real)
  692. )
  693. ) or
  694. (
  695. (tarraydef(p).elementdef.typ=floatdef) and
  696. (
  697. (tarraydef(p).lowrange=0) and
  698. (tarraydef(p).highrange=1) and
  699. (tfloatdef(tarraydef(p).elementdef).floattype=s64real)
  700. )
  701. );
  702. {$else x86}
  703. result:=false;
  704. {$endif x86}
  705. end;
  706. function is_mmx_able_array(p : tdef) : boolean;
  707. begin
  708. {$ifdef SUPPORT_MMX}
  709. if (cs_mmx_saturation in current_settings.localswitches) then
  710. begin
  711. is_mmx_able_array:=(p.typ=arraydef) and
  712. not(is_special_array(p)) and
  713. (
  714. (
  715. (tarraydef(p).elementdef.typ=orddef) and
  716. (
  717. (
  718. (tarraydef(p).lowrange=0) and
  719. (tarraydef(p).highrange=1) and
  720. (torddef(tarraydef(p).elementdef).ordtype in [u32bit,s32bit])
  721. )
  722. or
  723. (
  724. (tarraydef(p).lowrange=0) and
  725. (tarraydef(p).highrange=3) and
  726. (torddef(tarraydef(p).elementdef).ordtype in [u16bit,s16bit])
  727. )
  728. )
  729. )
  730. or
  731. (
  732. (
  733. (tarraydef(p).elementdef.typ=floatdef) and
  734. (
  735. (tarraydef(p).lowrange=0) and
  736. (tarraydef(p).highrange=1) and
  737. (tfloatdef(tarraydef(p).elementdef).floattype=s32real)
  738. )
  739. )
  740. )
  741. );
  742. end
  743. else
  744. begin
  745. is_mmx_able_array:=(p.typ=arraydef) and
  746. (
  747. (
  748. (tarraydef(p).elementdef.typ=orddef) and
  749. (
  750. (
  751. (tarraydef(p).lowrange=0) and
  752. (tarraydef(p).highrange=1) and
  753. (torddef(tarraydef(p).elementdef).ordtype in [u32bit,s32bit])
  754. )
  755. or
  756. (
  757. (tarraydef(p).lowrange=0) and
  758. (tarraydef(p).highrange=3) and
  759. (torddef(tarraydef(p).elementdef).ordtype in [u16bit,s16bit])
  760. )
  761. or
  762. (
  763. (tarraydef(p).lowrange=0) and
  764. (tarraydef(p).highrange=7) and
  765. (torddef(tarraydef(p).elementdef).ordtype in [u8bit,s8bit])
  766. )
  767. )
  768. )
  769. or
  770. (
  771. (tarraydef(p).elementdef.typ=floatdef) and
  772. (
  773. (tarraydef(p).lowrange=0) and
  774. (tarraydef(p).highrange=1) and
  775. (tfloatdef(tarraydef(p).elementdef).floattype=s32real)
  776. )
  777. )
  778. );
  779. end;
  780. {$else SUPPORT_MMX}
  781. is_mmx_able_array:=false;
  782. {$endif SUPPORT_MMX}
  783. end;
  784. function def_cgsize(def: tdef): tcgsize;
  785. begin
  786. case def.typ of
  787. orddef,
  788. enumdef,
  789. setdef:
  790. begin
  791. result:=int_cgsize(def.size);
  792. if is_signed(def) then
  793. result:=tcgsize(ord(result)+(ord(OS_S8)-ord(OS_8)));
  794. end;
  795. classrefdef,
  796. pointerdef:
  797. result := OS_ADDR;
  798. procvardef:
  799. begin
  800. if not tprocvardef(def).is_addressonly then
  801. {$if sizeof(pint) = 4}
  802. result:=OS_64
  803. {$else} {$if sizeof(pint) = 8}
  804. result:=OS_128
  805. {$else}
  806. internalerror(200707141)
  807. {$endif} {$endif}
  808. else
  809. result:=OS_ADDR;
  810. end;
  811. stringdef :
  812. begin
  813. if is_ansistring(def) or is_wide_or_unicode_string(def) then
  814. result := OS_ADDR
  815. else
  816. result:=int_cgsize(def.size);
  817. end;
  818. objectdef :
  819. begin
  820. if is_implicit_pointer_object_type(def) then
  821. result := OS_ADDR
  822. else
  823. result:=int_cgsize(def.size);
  824. end;
  825. floatdef:
  826. if cs_fp_emulation in current_settings.moduleswitches then
  827. result:=int_cgsize(def.size)
  828. else
  829. result:=tfloat2tcgsize[tfloatdef(def).floattype];
  830. recorddef :
  831. result:=int_cgsize(def.size);
  832. arraydef :
  833. begin
  834. if not is_special_array(def) then
  835. result := int_cgsize(def.size)
  836. else
  837. begin
  838. if is_dynamic_array(def) then
  839. result := OS_ADDR
  840. else
  841. result := OS_NO;
  842. end;
  843. end;
  844. else
  845. begin
  846. { undefined size }
  847. result:=OS_NO;
  848. end;
  849. end;
  850. end;
  851. { In Windows 95 era, ordinals were restricted to [u8bit,s32bit,s16bit,bool16bit]
  852. As of today, both signed and unsigned types from 8 to 64 bits are supported. }
  853. function is_automatable(p : tdef) : boolean;
  854. begin
  855. result:=false;
  856. case p.typ of
  857. orddef:
  858. result:=torddef(p).ordtype in [u8bit,s8bit,u16bit,s16bit,u32bit,s32bit,
  859. u64bit,s64bit,bool16bit];
  860. floatdef:
  861. result:=tfloatdef(p).floattype in [s64currency,s64real,s32real];
  862. stringdef:
  863. result:=tstringdef(p).stringtype in [st_ansistring,st_widestring,st_unicodestring];
  864. variantdef:
  865. result:=true;
  866. objectdef:
  867. result:=tobjectdef(p).objecttype in [odt_interfacecom,odt_dispinterface,odt_interfacecorba];
  868. end;
  869. end;
  870. {# returns true, if the type passed is a varset }
  871. function is_smallset(p : tdef) : boolean;
  872. begin
  873. result:=(p.typ=setdef) and (p.size in [1,2,4])
  874. end;
  875. function is_bareprocdef(pd : tprocdef): boolean;
  876. begin
  877. result:=(pd.maxparacount=0) and
  878. (is_void(pd.returndef) or
  879. (pd.proctypeoption = potype_constructor));
  880. end;
  881. function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
  882. var
  883. llow, lhigh: tconstexprint;
  884. begin
  885. llow:=rd.low;
  886. if llow<ld.low then
  887. llow:=ld.low;
  888. lhigh:=rd.high;
  889. if lhigh<ld.high then
  890. lhigh:=ld.high;
  891. case range_to_basetype(llow,lhigh) of
  892. s8bit:
  893. result:=torddef(s8inttype);
  894. u8bit:
  895. result:=torddef(u8inttype);
  896. s16bit:
  897. result:=torddef(s16inttype);
  898. u16bit:
  899. result:=torddef(u16inttype);
  900. s32bit:
  901. result:=torddef(s32inttype);
  902. u32bit:
  903. result:=torddef(u32inttype);
  904. s64bit:
  905. result:=torddef(s64inttype);
  906. u64bit:
  907. result:=torddef(u64inttype);
  908. else
  909. begin
  910. { avoid warning }
  911. result:=nil;
  912. internalerror(200802291);
  913. end;
  914. end;
  915. if keep_sign_if_equal and
  916. (is_signed(ld)=is_signed(rd)) and
  917. (is_signed(result)<>is_signed(ld)) then
  918. case result.ordtype of
  919. s8bit:
  920. result:=torddef(u8inttype);
  921. u8bit:
  922. result:=torddef(s16inttype);
  923. s16bit:
  924. result:=torddef(u16inttype);
  925. u16bit:
  926. result:=torddef(s32inttype);
  927. s32bit:
  928. result:=torddef(u32inttype);
  929. u32bit:
  930. result:=torddef(s64inttype);
  931. s64bit:
  932. result:=torddef(u64inttype);
  933. end;
  934. end;
  935. function is_valid_univ_para_type(def: tdef): boolean;
  936. begin
  937. result:=
  938. not is_open_array(def) and
  939. not is_void(def) and
  940. (def.typ<>formaldef);
  941. end;
  942. function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif}
  943. begin
  944. result:=def.parast.symtablelevel>normal_function_level;
  945. end;
  946. end.