Commit | Line | Data |
---|---|---|
9d3ebce4 MV |
1 | /* This code in included by number.s.c to generate integer conversion |
2 | functions like scm_to_int and scm_from_int. It is only for signed | |
3 | types, see conv-uinteger.i.c for the unsigned variant. | |
4 | */ | |
5 | ||
6 | /* You need to define the following macros before including this | |
7 | template. They are undefined at the end of this file to giove a | |
8 | clean slate for the next inclusion. | |
9 | ||
10 | TYPE - the integral type to be converted | |
11 | TYPE_MIN - the smallest representable number of TYPE | |
12 | TYPE_MAX - the largest representable number of TYPE | |
13 | SIZEOF_TYPE - the size of TYPE, equal to "sizeof (TYPE)" but | |
14 | in a form that can be computed by the preprocessor. | |
15 | When this number is 0, the preprocessor is not used | |
16 | to select which code to compile; the most general | |
17 | code is always used. | |
18 | ||
19 | SCM_TO_TYPE_PROTO(arg), SCM_FROM_TYPE_PROTO(arg) | |
20 | - These two macros should expand into the prototype | |
21 | for the two defined functions, without the return | |
22 | type. | |
23 | ||
24 | */ | |
25 | ||
bfd7932e MV |
26 | TYPE |
27 | SCM_TO_TYPE_PROTO (SCM val) | |
28 | { | |
29 | if (SCM_I_INUMP (val)) | |
30 | { | |
31 | scm_t_signed_bits n = SCM_I_INUM (val); | |
32 | #if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SIZEOF_SCM_T_BITS | |
33 | return n; | |
34 | #else | |
35 | if (n >= TYPE_MIN && n <= TYPE_MAX) | |
36 | return n; | |
37 | else | |
38 | { | |
39 | goto out_of_range; | |
40 | } | |
41 | #endif | |
42 | } | |
43 | else if (SCM_BIGP (val)) | |
44 | { | |
45 | if (TYPE_MIN >= SCM_MOST_NEGATIVE_FIXNUM | |
46 | && TYPE_MAX <= SCM_MOST_POSITIVE_FIXNUM) | |
47 | goto out_of_range; | |
48 | else if (TYPE_MIN >= LONG_MIN && TYPE_MAX <= LONG_MAX) | |
49 | { | |
50 | if (mpz_fits_slong_p (SCM_I_BIG_MPZ (val))) | |
51 | { | |
52 | long n = mpz_get_si (SCM_I_BIG_MPZ (val)); | |
53 | #if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SCM_SIZEOF_LONG | |
54 | return n; | |
55 | #else | |
56 | if (n >= TYPE_MIN && n <= TYPE_MAX) | |
57 | return n; | |
58 | else | |
59 | goto out_of_range; | |
60 | #endif | |
61 | } | |
62 | else | |
63 | goto out_of_range; | |
64 | } | |
65 | else | |
66 | { | |
67 | scm_t_intmax n; | |
68 | size_t count; | |
69 | ||
70 | if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) | |
71 | > CHAR_BIT*sizeof (scm_t_uintmax)) | |
72 | goto out_of_range; | |
73 | ||
74 | mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0, | |
75 | SCM_I_BIG_MPZ (val)); | |
76 | ||
77 | if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0) | |
78 | { | |
79 | if (n < 0) | |
80 | goto out_of_range; | |
81 | } | |
82 | else | |
83 | { | |
84 | n = -n; | |
85 | if (n >= 0) | |
86 | goto out_of_range; | |
87 | } | |
88 | ||
89 | if (n >= TYPE_MIN && n <= TYPE_MAX) | |
90 | return n; | |
91 | else | |
92 | { | |
93 | out_of_range: | |
94 | scm_out_of_range (NULL, val); | |
95 | return 0; | |
96 | } | |
97 | } | |
98 | } | |
99 | else | |
100 | { | |
101 | scm_wrong_type_arg_msg (NULL, 0, val, "exact integer"); | |
102 | return 0; | |
103 | } | |
104 | } | |
105 | ||
106 | SCM | |
107 | SCM_FROM_TYPE_PROTO (TYPE val) | |
108 | { | |
109 | #if SIZEOF_TYPE != 0 && SIZEOF_TYPE < SIZEOF_SCM_T_BITS | |
110 | return SCM_I_MAKINUM (val); | |
111 | #else | |
112 | if (SCM_FIXABLE (val)) | |
113 | return SCM_I_MAKINUM (val); | |
114 | else if (val >= LONG_MIN && val <= LONG_MAX) | |
c71b0706 | 115 | return scm_i_long2big (val); |
bfd7932e MV |
116 | else |
117 | { | |
118 | SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); | |
119 | mpz_init (SCM_I_BIG_MPZ (z)); | |
120 | if (val < 0) | |
121 | { | |
122 | val = -val; | |
123 | mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (TYPE), 0, 0, | |
124 | &val); | |
125 | mpz_neg (SCM_I_BIG_MPZ (z), SCM_I_BIG_MPZ (z)); | |
126 | } | |
127 | else | |
128 | mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (TYPE), 0, 0, | |
129 | &val); | |
130 | return z; | |
131 | } | |
132 | #endif | |
133 | } | |
134 | ||
135 | /* clean up */ | |
136 | #undef TYPE | |
137 | #undef TYPE_MIN | |
138 | #undef TYPE_MAX | |
139 | #undef SIZEOF_TYPE | |
140 | #undef SCM_TO_TYPE_PROTO | |
141 | #undef SCM_FROM_TYPE_PROTO | |
142 | ||
143 | /* | |
144 | Local Variables: | |
145 | c-file-style: "gnu" | |
146 | End: | |
147 | */ |