defutil.pas 28 KB

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