HCoop / bpt / guile.git / blame
| Commit | Line | Data |
|---|---|---|
| bfd7932e MV |
1 | TYPE |
| 2 | SCM_TO_TYPE_PROTO (SCM val) | |
| 3 | { | |
| 4 | if (SCM_I_INUMP (val)) | |
| 5 | { | |
| 6 | scm_t_signed_bits n = SCM_I_INUM (val); | |
| 7 | if (n >= 0 | |
| 8 | && ((scm_t_uintmax)n) >= TYPE_MIN && ((scm_t_uintmax)n) <= TYPE_MAX) | |
| 9 | return n; | |
| 10 | else | |
| 11 | { | |
| 12 | out_of_range: | |
| 13 | scm_out_of_range (NULL, val); | |
| 14 | return 0; | |
| 15 | } | |
| 16 | } | |
| 17 | else if (SCM_BIGP (val)) | |
| 18 | { | |
| 19 | if (TYPE_MAX <= SCM_MOST_POSITIVE_FIXNUM) | |
| 20 | goto out_of_range; | |
| 21 | else if (TYPE_MAX <= ULONG_MAX) | |
| 22 | { | |
| 23 | if (mpz_fits_ulong_p (SCM_I_BIG_MPZ (val))) | |
| 24 | { | |
| 25 | unsigned long n = mpz_get_ui (SCM_I_BIG_MPZ (val)); | |
| 26 | #if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SCM_SIZEOF_LONG | |
| 27 | return n; | |
| 28 | #else | |
| 29 | if (n >= TYPE_MIN && n <= TYPE_MAX) | |
| 30 | return n; | |
| 31 | else | |
| 32 | goto out_of_range; | |
| 33 | #endif | |
| 34 | } | |
| 35 | else | |
| 36 | goto out_of_range; | |
| 37 | } | |
| 38 | else | |
| 39 | { | |
| 40 | scm_t_uintmax n; | |
| 41 | size_t count; | |
| 42 | ||
| 43 | if (mpz_sgn (SCM_I_BIG_MPZ (val)) < 0) | |
| 44 | goto out_of_range; | |
| 45 | ||
| 46 | if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) | |
| 47 | > CHAR_BIT*sizeof (TYPE)) | |
| 48 | goto out_of_range; | |
| 49 | ||
| 50 | mpz_export (&n, &count, 1, sizeof (TYPE), 0, 0, SCM_I_BIG_MPZ (val)); | |
| 51 | ||
| 52 | if (n >= TYPE_MIN && n <= TYPE_MAX) | |
| 53 | return n; | |
| 54 | else | |
| 55 | goto out_of_range; | |
| 56 | } | |
| 57 | } | |
| 58 | else | |
| 59 | { | |
| 60 | scm_wrong_type_arg_msg (NULL, 0, val, "exact integer"); | |
| 61 | return 0; | |
| 62 | } | |
| 63 | } | |
| 64 | ||
| 65 | SCM | |
| 66 | SCM_FROM_TYPE_PROTO (TYPE val) | |
| 67 | { | |
| 68 | #if SIZEOF_TYPE != 0 && SIZEOF_TYPE < SIZEOF_SCM_T_BITS | |
| 69 | return SCM_I_MAKINUM (val); | |
| 70 | #else | |
| 71 | if (SCM_POSFIXABLE (val)) | |
| 72 | return SCM_I_MAKINUM (val); | |
| 73 | else if (val <= ULONG_MAX) | |
| 74 | { | |
| 75 | SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); | |
| 76 | mpz_init_set_ui (SCM_I_BIG_MPZ (z), val); | |
| 77 | return z; | |
| 78 | } | |
| 79 | else | |
| 80 | { | |
| 81 | SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); | |
| 82 | mpz_init (SCM_I_BIG_MPZ (z)); | |
| 83 | mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (TYPE), 0, 0, &val); | |
| 84 | return z; | |
| 85 | } | |
| 86 | #endif | |
| 87 | } | |
| 88 | ||
| 89 | #undef TYPE | |
| 90 | #undef TYPE_MIN | |
| 91 | #undef TYPE_MAX | |
| 92 | #undef SIZEOF_TYPE | |
| 93 | #undef SCM_TO_TYPE_PROTO | |
| 94 | #undef SCM_FROM_TYPE_PROTO | |
| 95 |