defutil.pas 32 KB

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