defutil.pas 30 KB

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