Commit | Line | Data |
---|---|---|
fb7dd001 | 1 | /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2013, 2014 Free Software Foundation, Inc. |
476b894c AW |
2 | * |
3 | * This library is free software; you can redistribute it and/or | |
4 | * modify it under the terms of the GNU Lesser General Public License | |
5 | * as published by the Free Software Foundation; either version 3 of | |
6 | * the License, or (at your option) any later version. | |
7 | * | |
8 | * This library is distributed in the hope that it will be useful, but | |
9 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
11 | * Lesser General Public License for more details. | |
12 | * | |
13 | * You should have received a copy of the GNU Lesser General Public | |
14 | * License along with this library; if not, write to the Free Software | |
15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | |
16 | * 02110-1301 USA | |
17 | */ | |
18 | ||
19 | ||
20 | \f | |
21 | ||
22 | #ifdef HAVE_CONFIG_H | |
23 | # include <config.h> | |
24 | #endif | |
25 | ||
fb7dd001 AW |
26 | #define SCM_BUILDING_DEPRECATED_CODE |
27 | ||
476b894c AW |
28 | #include "libguile/_scm.h" |
29 | #include "libguile/__scm.h" | |
30 | ||
31 | #include "libguile/uniform.h" | |
fb7dd001 | 32 | #include "libguile/deprecation.h" |
476b894c AW |
33 | |
34 | ||
35 | const size_t scm_i_array_element_type_sizes[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = { | |
36 | 0, | |
37 | 0, | |
38 | 1, | |
39 | 8, | |
40 | 8, 8, | |
41 | 16, 16, | |
42 | 32, 32, | |
43 | 64, 64, | |
44 | 32, 64, | |
45 | 64, 128 | |
46 | }; | |
47 | ||
476b894c AW |
48 | size_t |
49 | scm_array_handle_uniform_element_size (scm_t_array_handle *h) | |
50 | { | |
51 | size_t ret = scm_i_array_element_type_sizes[h->element_type]; | |
52 | if (ret && ret % 8 == 0) | |
53 | return ret / 8; | |
f5a51cae AW |
54 | else if (ret) |
55 | scm_wrong_type_arg_msg (NULL, 0, h->array, "byte-aligned uniform array"); | |
56 | else | |
57 | scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array"); | |
58 | } | |
59 | ||
60 | size_t | |
61 | scm_array_handle_uniform_element_bit_size (scm_t_array_handle *h) | |
62 | { | |
63 | size_t ret = scm_i_array_element_type_sizes[h->element_type]; | |
64 | if (ret) | |
65 | return ret; | |
476b894c AW |
66 | else |
67 | scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array"); | |
68 | } | |
69 | ||
70 | const void * | |
71 | scm_array_handle_uniform_elements (scm_t_array_handle *h) | |
72 | { | |
73 | return scm_array_handle_uniform_writable_elements (h); | |
74 | } | |
75 | ||
76 | void * | |
77 | scm_array_handle_uniform_writable_elements (scm_t_array_handle *h) | |
78 | { | |
79 | size_t esize; | |
80 | scm_t_uint8 *ret; | |
81 | ||
82 | esize = scm_array_handle_uniform_element_size (h); | |
83 | ret = ((scm_t_uint8*) h->writable_elements) + h->base * esize; | |
84 | return ret; | |
85 | } | |
86 | ||
fb7dd001 AW |
87 | #if SCM_ENABLE_DEPRECATED |
88 | ||
476b894c AW |
89 | int |
90 | scm_is_uniform_vector (SCM obj) | |
91 | { | |
92 | scm_t_array_handle h; | |
93 | int ret = 0; | |
94 | ||
fb7dd001 AW |
95 | scm_c_issue_deprecation_warning |
96 | ("scm_is_uniform_vector is deprecated. " | |
97 | "Use scm_is_bytevector || scm_is_bitvector instead."); | |
98 | ||
476b894c AW |
99 | if (scm_is_generalized_vector (obj)) |
100 | { | |
101 | scm_generalized_vector_get_handle (obj, &h); | |
102 | ret = SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h.element_type); | |
103 | scm_array_handle_release (&h); | |
104 | } | |
105 | return ret; | |
106 | } | |
107 | ||
108 | size_t | |
109 | scm_c_uniform_vector_length (SCM uvec) | |
110 | { | |
fb7dd001 AW |
111 | scm_c_issue_deprecation_warning |
112 | ("scm_c_uniform_vector_length is deprecated. " | |
113 | "Use scm_c_array_length instead."); | |
114 | ||
0142d376 AW |
115 | if (!scm_is_uniform_vector (uvec)) |
116 | scm_wrong_type_arg_msg ("uniform-vector-length", 1, uvec, | |
117 | "uniform vector"); | |
118 | ||
119 | return scm_c_generalized_vector_length (uvec); | |
476b894c AW |
120 | } |
121 | ||
122 | SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0, | |
123 | (SCM obj), | |
124 | "Return @code{#t} if @var{obj} is a uniform vector.") | |
125 | #define FUNC_NAME s_scm_uniform_vector_p | |
126 | { | |
fb7dd001 AW |
127 | scm_c_issue_deprecation_warning |
128 | ("uniform-vector? is deprecated. Use bytevector? and bitvector?, or " | |
129 | "use array-type and array-rank instead."); | |
130 | ||
476b894c AW |
131 | return scm_from_bool (scm_is_uniform_vector (obj)); |
132 | } | |
133 | #undef FUNC_NAME | |
134 | ||
135 | SCM_DEFINE (scm_uniform_vector_element_type, "uniform-vector-element-type", 1, 0, 0, | |
136 | (SCM v), | |
f5a51cae | 137 | "Return the type of the elements in the uniform vector, @var{v}.") |
476b894c AW |
138 | #define FUNC_NAME s_scm_uniform_vector_element_type |
139 | { | |
140 | scm_t_array_handle h; | |
476b894c | 141 | SCM ret; |
f5a51cae | 142 | |
fb7dd001 AW |
143 | scm_c_issue_deprecation_warning |
144 | ("uniform-vector-element-type is deprecated. Use array-type instead."); | |
145 | ||
f5a51cae AW |
146 | if (!scm_is_uniform_vector (v)) |
147 | scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, v, "uniform vector"); | |
148 | scm_array_get_handle (v, &h); | |
476b894c AW |
149 | ret = scm_array_handle_element_type (&h); |
150 | scm_array_handle_release (&h); | |
151 | return ret; | |
152 | } | |
153 | #undef FUNC_NAME | |
154 | ||
155 | SCM_DEFINE (scm_uniform_vector_element_size, "uniform-vector-element-size", 1, 0, 0, | |
156 | (SCM v), | |
157 | "Return the number of bytes allocated to each element in the\n" | |
158 | "uniform vector, @var{v}.") | |
159 | #define FUNC_NAME s_scm_uniform_vector_element_size | |
160 | { | |
161 | scm_t_array_handle h; | |
162 | size_t len; | |
163 | ssize_t inc; | |
164 | SCM ret; | |
fb7dd001 AW |
165 | |
166 | scm_c_issue_deprecation_warning | |
167 | ("uniform-vector-element-size is deprecated. Instead, treat the " | |
168 | "uniform vector as a bytevector."); | |
169 | ||
476b894c AW |
170 | scm_uniform_vector_elements (v, &h, &len, &inc); |
171 | ret = scm_from_size_t (scm_array_handle_uniform_element_size (&h)); | |
172 | scm_array_handle_release (&h); | |
173 | return ret; | |
174 | } | |
175 | #undef FUNC_NAME | |
176 | ||
177 | SCM | |
178 | scm_c_uniform_vector_ref (SCM v, size_t idx) | |
179 | { | |
fb7dd001 AW |
180 | scm_c_issue_deprecation_warning |
181 | ("scm_c_uniform_vector_ref is deprecated. Use scm_c_array_ref_1 instead."); | |
182 | ||
f5a51cae AW |
183 | if (!scm_is_uniform_vector (v)) |
184 | scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector"); | |
185 | return scm_c_generalized_vector_ref (v, idx); | |
476b894c AW |
186 | } |
187 | ||
188 | SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, | |
189 | (SCM v, SCM idx), | |
190 | "Return the element at index @var{idx} of the\n" | |
ffb62a43 | 191 | "homogeneous numeric vector @var{v}.") |
476b894c AW |
192 | #define FUNC_NAME s_scm_uniform_vector_ref |
193 | { | |
fb7dd001 AW |
194 | scm_c_issue_deprecation_warning |
195 | ("uniform-vector-ref is deprecated. Use array-ref instead."); | |
196 | ||
476b894c AW |
197 | return scm_c_uniform_vector_ref (v, scm_to_size_t (idx)); |
198 | } | |
199 | #undef FUNC_NAME | |
200 | ||
201 | void | |
202 | scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val) | |
203 | { | |
fb7dd001 AW |
204 | scm_c_issue_deprecation_warning |
205 | ("scm_c_uniform_vector_set_x is deprecated. Instead, use " | |
206 | "scm_c_array_set_1_x, but note the change in the order of the arguments."); | |
207 | ||
f5a51cae AW |
208 | if (!scm_is_uniform_vector (v)) |
209 | scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector"); | |
210 | scm_c_generalized_vector_set_x (v, idx, val); | |
476b894c AW |
211 | } |
212 | ||
213 | SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0, | |
214 | (SCM v, SCM idx, SCM val), | |
215 | "Set the element at index @var{idx} of the\n" | |
ffb62a43 | 216 | "homogeneous numeric vector @var{v} to @var{val}.") |
476b894c AW |
217 | #define FUNC_NAME s_scm_uniform_vector_set_x |
218 | { | |
fb7dd001 AW |
219 | scm_c_issue_deprecation_warning |
220 | ("uniform-vector-set! is deprecated. Instead, use array-set!, " | |
221 | "but note the change in the order of the arguments."); | |
222 | ||
476b894c AW |
223 | scm_c_uniform_vector_set_x (v, scm_to_size_t (idx), val); |
224 | return SCM_UNSPECIFIED; | |
225 | } | |
226 | #undef FUNC_NAME | |
227 | ||
228 | SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0, | |
229 | (SCM uvec), | |
230 | "Convert the uniform numeric vector @var{uvec} to a list.") | |
231 | #define FUNC_NAME s_scm_uniform_vector_to_list | |
232 | { | |
fb7dd001 AW |
233 | scm_c_issue_deprecation_warning |
234 | ("uniform-vector->list is deprecated. Use array->list instead."); | |
235 | ||
f5a51cae AW |
236 | if (!scm_is_uniform_vector (uvec)) |
237 | scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, uvec, "uniform vector"); | |
118ff892 | 238 | return scm_array_to_list (uvec); |
476b894c AW |
239 | } |
240 | #undef FUNC_NAME | |
241 | ||
242 | const void * | |
243 | scm_uniform_vector_elements (SCM uvec, | |
244 | scm_t_array_handle *h, | |
245 | size_t *lenp, ssize_t *incp) | |
246 | { | |
fb7dd001 AW |
247 | scm_c_issue_deprecation_warning |
248 | ("scm_uniform_vector_elements is deprecated. Use " | |
249 | "scm_array_handle_uniform_elements instead."); | |
250 | ||
476b894c AW |
251 | return scm_uniform_vector_writable_elements (uvec, h, lenp, incp); |
252 | } | |
253 | ||
254 | void * | |
255 | scm_uniform_vector_writable_elements (SCM uvec, | |
256 | scm_t_array_handle *h, | |
257 | size_t *lenp, ssize_t *incp) | |
258 | { | |
259 | void *ret; | |
fb7dd001 AW |
260 | |
261 | scm_c_issue_deprecation_warning | |
262 | ("scm_uniform_vector_writable_elements is deprecated. Use " | |
263 | "scm_array_handle_uniform_writable_elements instead."); | |
264 | ||
476b894c AW |
265 | scm_generalized_vector_get_handle (uvec, h); |
266 | /* FIXME nonlocal exit */ | |
267 | ret = scm_array_handle_uniform_writable_elements (h); | |
268 | if (lenp) | |
269 | { | |
270 | scm_t_array_dim *dim = scm_array_handle_dims (h); | |
271 | *lenp = dim->ubnd - dim->lbnd + 1; | |
272 | *incp = dim->inc; | |
273 | } | |
274 | return ret; | |
275 | } | |
276 | ||
277 | SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, | |
278 | (SCM v), | |
279 | "Return the number of elements in the uniform vector @var{v}.") | |
280 | #define FUNC_NAME s_scm_uniform_vector_length | |
281 | { | |
fb7dd001 AW |
282 | scm_c_issue_deprecation_warning |
283 | ("uniform-vector-length is deprecated. Use array-length instead."); | |
284 | ||
476b894c AW |
285 | return scm_from_size_t (scm_c_uniform_vector_length (v)); |
286 | } | |
287 | #undef FUNC_NAME | |
288 | ||
289 | ||
fb7dd001 AW |
290 | #endif /* SCM_ENABLE_DEPRECATED */ |
291 | ||
292 | ||
476b894c AW |
293 | void |
294 | scm_init_uniform (void) | |
295 | { | |
296 | #include "libguile/uniform.x" | |
297 | } | |
298 | ||
299 | /* | |
300 | Local Variables: | |
301 | c-file-style: "gnu" | |
302 | End: | |
303 | */ |