defutil.pas 28 KB

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