Commit | Line | Data |
---|---|---|
71ca65d9 MG |
1 | /* srfi-4.c --- Homogeneous numeric vector datatypes. |
2 | * | |
3 | * Copyright (C) 2001 Free Software Foundation, Inc. | |
645f5e0e | 4 | * |
71ca65d9 MG |
5 | * This program is free software; you can redistribute it and/or |
6 | * modify it under the terms of the GNU General Public License as | |
7 | * published by the Free Software Foundation; either version 2, or (at | |
8 | * your option) any later version. | |
645f5e0e | 9 | * |
71ca65d9 MG |
10 | * This program is distributed in the hope that it will be useful, but |
11 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | * General Public License for more details. | |
645f5e0e | 14 | * |
71ca65d9 MG |
15 | * You should have received a copy of the GNU General Public License |
16 | * along with this software; see the file COPYING. If not, write to | |
17 | * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, | |
18 | * Boston, MA 02111-1307 USA | |
19 | * | |
20 | * As a special exception, the Free Software Foundation gives | |
21 | * permission for additional uses of the text contained in its release | |
22 | * of GUILE. | |
23 | * | |
24 | * The exception is that, if you link the GUILE library with other | |
25 | * files to produce an executable, this does not by itself cause the | |
26 | * resulting executable to be covered by the GNU General Public | |
27 | * License. Your use of that executable is in no way restricted on | |
28 | * account of linking the GUILE library code into it. | |
29 | * | |
30 | * This exception does not however invalidate any other reasons why | |
31 | * the executable file might be covered by the GNU General Public | |
32 | * License. | |
33 | * | |
34 | * This exception applies only to the code released by the Free | |
35 | * Software Foundation under the name GUILE. If you copy code from | |
36 | * other Free Software Foundation releases into a copy of GUILE, as | |
37 | * the General Public License permits, the exception does not apply to | |
38 | * the code that you add in this way. To avoid misleading anyone as | |
39 | * to the status of such modified files, you must delete this | |
40 | * exception notice from them. | |
41 | * | |
42 | * If you write modifications of your own for GUILE, it is your choice | |
43 | * whether to permit this exception to apply to your modifications. | |
44 | * If you do not wish that, delete this exception notice. */ | |
45 | ||
46 | #include <libguile.h> | |
47 | ||
48 | #include "srfi-4.h" | |
49 | ||
50 | ||
51 | /* For brevity and maintainability, we define our own types for the | |
52 | various integer and floating point types. */ | |
53 | typedef unsigned char int_u8; | |
54 | typedef signed char int_s8; | |
55 | typedef unsigned short int_u16; | |
56 | typedef signed short int_s16; | |
57 | typedef unsigned int int_u32; | |
58 | typedef signed int int_s32; | |
1f537655 | 59 | #ifdef HAVE_LONG_LONG |
71ca65d9 MG |
60 | #if SIZEOF_LONG == 8 |
61 | typedef unsigned long int_u64; | |
62 | typedef signed long int_s64; | |
63 | #else | |
64 | typedef unsigned long long int_u64; | |
65 | typedef signed long long int_s64; | |
66 | #endif /* SIZEOF_LONG */ | |
1f537655 | 67 | #endif /* HAVE_LONG_LONG */ |
71ca65d9 MG |
68 | typedef float float_f32; |
69 | typedef double float_f64; | |
70 | ||
2c4df451 | 71 | |
71ca65d9 MG |
72 | /* Smob type code for homogeneous numeric vectors. */ |
73 | int scm_tc16_uvec = 0; | |
74 | ||
75 | ||
76 | /* Accessor macros for the three components of a homogeneous numeric | |
77 | vector: | |
78 | - The type tag (one of the symbolic constants below). | |
79 | - The vector's length (counted in elements). | |
80 | - The address of the data area (holding the elements of the | |
81 | vector). */ | |
82 | #define SCM_UVEC_TYPE(u) (SCM_CELL_WORD_1(u)) | |
83 | #define SCM_UVEC_LENGTH(u) (SCM_CELL_WORD_2(u)) | |
84 | #define SCM_UVEC_BASE(u) (SCM_CELL_OBJECT_3(u)) | |
85 | ||
86 | ||
87 | /* Symbolic constants encoding the various types of homogeneous | |
88 | numeric vectors. */ | |
89 | #define SCM_UVEC_U8 0 | |
90 | #define SCM_UVEC_S8 1 | |
91 | #define SCM_UVEC_U16 2 | |
92 | #define SCM_UVEC_S16 3 | |
93 | #define SCM_UVEC_U32 4 | |
94 | #define SCM_UVEC_S32 5 | |
95 | #define SCM_UVEC_U64 6 | |
96 | #define SCM_UVEC_S64 7 | |
97 | #define SCM_UVEC_F32 8 | |
98 | #define SCM_UVEC_F64 9 | |
99 | ||
100 | ||
101 | /* This array maps type tags to the size of the elements. */ | |
102 | static int uvec_sizes[10] = {1, 1, 2, 2, 4, 4, 8, 8, 4, 8}; | |
103 | ||
104 | ||
105 | /* ================================================================ */ | |
106 | /* SMOB procedures. */ | |
107 | /* ================================================================ */ | |
108 | ||
109 | ||
110 | /* Smob print hook for homogeneous vectors. */ | |
111 | static int | |
112 | uvec_print (SCM uvec, SCM port, scm_print_state *pstate SCM_UNUSED) | |
113 | { | |
114 | switch (SCM_UVEC_TYPE (uvec)) | |
115 | { | |
116 | case SCM_UVEC_U8: | |
117 | { | |
118 | int_u8 * p = (int_u8 *) SCM_UVEC_BASE (uvec); | |
119 | int i = 0; | |
120 | ||
121 | scm_puts ("#u8(", port); | |
122 | if (SCM_UVEC_LENGTH (uvec) > 0) | |
123 | { | |
124 | scm_intprint (*p, 10, port); | |
125 | p++; | |
126 | i++; | |
127 | for (; i < SCM_UVEC_LENGTH (uvec); i++) | |
128 | { | |
129 | scm_puts (" ", port); | |
130 | scm_intprint (*p, 10, port); | |
131 | p++; | |
132 | } | |
133 | } | |
134 | scm_puts (")", port); | |
135 | break; | |
136 | } | |
137 | ||
138 | case SCM_UVEC_S8: | |
139 | { | |
140 | int_s8 * p = (int_s8 *) SCM_UVEC_BASE (uvec); | |
141 | int i = 0; | |
142 | ||
143 | scm_puts ("#s8(", port); | |
144 | if (SCM_UVEC_LENGTH (uvec) > 0) | |
145 | { | |
146 | scm_intprint (*p, 10, port); | |
147 | p++; | |
148 | i++; | |
149 | for (; i < SCM_UVEC_LENGTH (uvec); i++) | |
150 | { | |
151 | scm_puts (" ", port); | |
152 | scm_intprint (*p, 10, port); | |
153 | p++; | |
154 | } | |
155 | } | |
156 | scm_puts (")", port); | |
157 | break; | |
158 | } | |
159 | ||
160 | case SCM_UVEC_U16: | |
161 | { | |
162 | int_u16 * p = (int_u16 *) SCM_UVEC_BASE (uvec); | |
163 | int i = 0; | |
164 | ||
165 | scm_puts ("#u16(", port); | |
166 | if (SCM_UVEC_LENGTH (uvec) > 0) | |
167 | { | |
168 | scm_intprint (*p, 10, port); | |
169 | p++; | |
170 | i++; | |
171 | for (; i < SCM_UVEC_LENGTH (uvec); i++) | |
172 | { | |
173 | scm_puts (" ", port); | |
174 | scm_intprint (*p, 10, port); | |
175 | p++; | |
176 | } | |
177 | } | |
178 | scm_puts (")", port); | |
179 | break; | |
180 | } | |
181 | ||
182 | case SCM_UVEC_S16: | |
183 | { | |
184 | int_s16 * p = (int_s16 *) SCM_UVEC_BASE (uvec); | |
185 | int i = 0; | |
186 | ||
187 | scm_puts ("#s16(", port); | |
188 | if (SCM_UVEC_LENGTH (uvec) > 0) | |
189 | { | |
190 | scm_intprint (*p, 10, port); | |
191 | p++; | |
192 | i++; | |
193 | for (; i < SCM_UVEC_LENGTH (uvec); i++) | |
194 | { | |
195 | scm_puts (" ", port); | |
196 | scm_intprint (*p, 10, port); | |
197 | p++; | |
198 | } | |
199 | } | |
200 | scm_puts (")", port); | |
201 | break; | |
202 | } | |
203 | ||
204 | case SCM_UVEC_U32: | |
205 | { | |
206 | int_u32 * p = (int_u32 *) SCM_UVEC_BASE (uvec); | |
207 | int i = 0; | |
208 | ||
209 | scm_puts ("#u32(", port); | |
210 | if (SCM_UVEC_LENGTH (uvec) > 0) | |
211 | { | |
212 | scm_intprint (*p, 10, port); | |
213 | p++; | |
214 | i++; | |
215 | for (; i < SCM_UVEC_LENGTH (uvec); i++) | |
216 | { | |
217 | scm_puts (" ", port); | |
218 | scm_intprint (*p, 10, port); | |
219 | p++; | |
220 | } | |
221 | } | |
222 | scm_puts (")", port); | |
223 | break; | |
224 | } | |
225 | ||
226 | case SCM_UVEC_S32: | |
227 | { | |
228 | int_s32 * p = (int_s32 *) SCM_UVEC_BASE (uvec); | |
229 | int i = 0; | |
230 | ||
231 | scm_puts ("#s32(", port); | |
232 | if (SCM_UVEC_LENGTH (uvec) > 0) | |
233 | { | |
234 | scm_intprint (*p, 10, port); | |
235 | p++; | |
236 | i++; | |
237 | for (; i < SCM_UVEC_LENGTH (uvec); i++) | |
238 | { | |
239 | scm_puts (" ", port); | |
240 | scm_intprint (*p, 10, port); | |
241 | p++; | |
242 | } | |
243 | } | |
244 | scm_puts (")", port); | |
245 | break; | |
246 | } | |
247 | ||
1f537655 | 248 | #ifdef HAVE_LONG_LONG |
71ca65d9 MG |
249 | case SCM_UVEC_U64: |
250 | { | |
251 | int_u64 * p = (int_u64 *) SCM_UVEC_BASE (uvec); | |
252 | int i = 0; | |
253 | ||
254 | scm_puts ("#u64(", port); | |
255 | if (SCM_UVEC_LENGTH (uvec) > 0) | |
256 | { | |
257 | scm_intprint (*p, 10, port); | |
258 | p++; | |
259 | i++; | |
260 | for (; i < SCM_UVEC_LENGTH (uvec); i++) | |
261 | { | |
262 | scm_puts (" ", port); | |
263 | scm_intprint (*p, 10, port); | |
264 | p++; | |
265 | } | |
266 | } | |
267 | scm_puts (")", port); | |
268 | break; | |
269 | } | |
270 | ||
271 | case SCM_UVEC_S64: | |
272 | { | |
273 | int_s64 * p = (int_s64 *) SCM_UVEC_BASE (uvec); | |
274 | int i = 0; | |
275 | ||
276 | scm_puts ("#s64(", port); | |
277 | if (SCM_UVEC_LENGTH (uvec) > 0) | |
278 | { | |
279 | scm_intprint (*p, 10, port); | |
280 | p++; | |
281 | i++; | |
282 | for (; i < SCM_UVEC_LENGTH (uvec); i++) | |
283 | { | |
284 | scm_puts (" ", port); | |
285 | scm_intprint (*p, 10, port); | |
286 | p++; | |
287 | } | |
288 | } | |
289 | scm_puts (")", port); | |
290 | break; | |
291 | } | |
292 | #endif | |
293 | ||
294 | case SCM_UVEC_F32: | |
295 | { | |
296 | float_f32 * p = (float_f32 *) SCM_UVEC_BASE (uvec); | |
297 | int i = 0; | |
298 | ||
299 | scm_puts ("#f32(", port); | |
300 | if (SCM_UVEC_LENGTH (uvec) > 0) | |
301 | { | |
302 | scm_iprin1 (scm_make_real (*p), port, pstate); | |
303 | p++; | |
304 | i++; | |
305 | for (; i < SCM_UVEC_LENGTH (uvec); i++) | |
306 | { | |
307 | scm_puts (" ", port); | |
308 | scm_iprin1 (scm_make_real (*p), port, pstate); | |
309 | p++; | |
310 | } | |
311 | } | |
312 | scm_puts (")", port); | |
313 | break; | |
314 | } | |
315 | ||
316 | case SCM_UVEC_F64: | |
317 | { | |
318 | float_f64 * p = (float_f64 *) SCM_UVEC_BASE (uvec); | |
319 | int i = 0; | |
320 | ||
321 | scm_puts ("#f64(", port); | |
322 | if (SCM_UVEC_LENGTH (uvec) > 0) | |
323 | { | |
324 | scm_iprin1 (scm_make_real (*p), port, pstate); | |
325 | p++; | |
326 | i++; | |
327 | for (; i < SCM_UVEC_LENGTH (uvec); i++) | |
328 | { | |
329 | scm_puts (" ", port); | |
330 | scm_iprin1 (scm_make_real (*p), port, pstate); | |
331 | p++; | |
332 | } | |
333 | } | |
334 | scm_puts (")", port); | |
335 | break; | |
336 | } | |
337 | ||
338 | default: | |
339 | abort (); /* Sanity check. */ | |
340 | } | |
341 | return 1; | |
342 | } | |
343 | ||
344 | ||
345 | /* Smob free hook for homogeneous numeric vectors. */ | |
346 | static size_t | |
347 | uvec_free (SCM uvec) | |
348 | { | |
6c70aef1 MV |
349 | scm_gc_free (SCM_UVEC_BASE (uvec), |
350 | SCM_UVEC_LENGTH (uvec) * uvec_sizes[SCM_UVEC_TYPE (uvec)], | |
351 | "uvec"); | |
352 | return 0; | |
71ca65d9 MG |
353 | } |
354 | ||
355 | ||
356 | /* ================================================================ */ | |
357 | /* Utility procedures. */ | |
358 | /* ================================================================ */ | |
359 | ||
360 | ||
361 | /* Create a new, uninitialized homogeneous numeric vector of type TYPE | |
362 | with space for LEN elements. */ | |
363 | static SCM | |
364 | make_uvec (const char * func_name, int type, int len) | |
365 | { | |
366 | void * p; | |
645f5e0e | 367 | |
6c70aef1 | 368 | p = scm_gc_malloc (len * uvec_sizes[type], "uvec"); |
71ca65d9 MG |
369 | SCM_RETURN_NEWSMOB3 (scm_tc16_uvec, type, len, p); |
370 | } | |
371 | ||
372 | ||
373 | /* ================================================================ */ | |
374 | /* U8 procedures. */ | |
375 | /* ================================================================ */ | |
376 | ||
377 | ||
645f5e0e | 378 | SCM_DEFINE (scm_u8vector_p, "u8vector?", 1, 0, 0, |
71ca65d9 MG |
379 | (SCM obj), |
380 | "Return @code{#t} if @var{obj} is a vector of type u8,\n" | |
381 | "@code{#f} otherwise.") | |
382 | #define FUNC_NAME s_scm_u8vector_p | |
383 | { | |
384 | return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && | |
385 | SCM_UVEC_TYPE (obj) == SCM_UVEC_U8); | |
386 | } | |
387 | #undef FUNC_NAME | |
388 | ||
389 | ||
645f5e0e | 390 | SCM_DEFINE (scm_make_u8vector, "make-u8vector", 1, 1, 0, |
71ca65d9 MG |
391 | (SCM n, SCM fill), |
392 | "Create a newly allocated homogeneous numeric vector which can\n" | |
393 | "hold @var{len} elements. If @var{fill} is given, it is used to\n" | |
394 | "initialize the elements, otherwise the contents of the vector\n" | |
395 | "is unspecified.") | |
396 | #define FUNC_NAME s_scm_make_u8vector | |
397 | { | |
398 | SCM uvec; | |
399 | int_u8 * p; | |
400 | int_u8 f; | |
401 | int count; | |
402 | ||
403 | SCM_VALIDATE_INUM (1, n); | |
404 | count = SCM_INUM (n); | |
405 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_U8, count); | |
406 | if (SCM_UNBNDP (fill)) | |
407 | f = 0; | |
408 | else | |
409 | { | |
410 | unsigned int s = scm_num2uint (fill, 2, FUNC_NAME); | |
411 | f = s; | |
412 | if ((unsigned int) f != s) | |
413 | scm_out_of_range_pos (FUNC_NAME, fill, SCM_MAKINUM (2)); | |
414 | } | |
415 | p = (int_u8 *) SCM_UVEC_BASE (uvec); | |
416 | while (count-- > 0) | |
417 | *p++ = f; | |
418 | return uvec; | |
419 | } | |
420 | #undef FUNC_NAME | |
421 | ||
422 | ||
645f5e0e | 423 | SCM_DEFINE (scm_u8vector, "u8vector", 0, 0, 1, |
71ca65d9 MG |
424 | (SCM l), |
425 | "Create a newly allocated homogeneous numeric vector containing\n" | |
426 | "all argument values.") | |
427 | #define FUNC_NAME s_scm_u8vector | |
428 | { | |
429 | SCM_VALIDATE_REST_ARGUMENT (l); | |
430 | return scm_list_to_u8vector (l); | |
431 | } | |
432 | #undef FUNC_NAME | |
433 | ||
434 | ||
645f5e0e | 435 | SCM_DEFINE (scm_u8vector_length, "u8vector-length", 1, 0, 0, |
71ca65d9 MG |
436 | (SCM uvec), |
437 | "Return the number of elements in the homogeneous numeric vector\n" | |
438 | "@var{uvec}.") | |
439 | #define FUNC_NAME s_scm_u8vector_length | |
440 | { | |
441 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
442 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U8) | |
443 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
444 | return scm_int2num (SCM_UVEC_LENGTH (uvec)); | |
445 | } | |
446 | #undef FUNC_NAME | |
447 | ||
448 | ||
645f5e0e | 449 | SCM_DEFINE (scm_u8vector_ref, "u8vector-ref", 2, 0, 0, |
71ca65d9 MG |
450 | (SCM uvec, SCM index), |
451 | "Return the element at @var{index} in the homogeneous numeric\n" | |
452 | "vector @var{uvec}.") | |
453 | #define FUNC_NAME s_scm_u8vector_ref | |
454 | { | |
455 | int idx; | |
456 | ||
457 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
458 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U8) | |
459 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
460 | ||
461 | idx = scm_num2int (index, 2, FUNC_NAME); | |
462 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
463 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
464 | ||
465 | return scm_short2num (((int_u8 *) SCM_UVEC_BASE (uvec))[idx]); | |
466 | } | |
467 | #undef FUNC_NAME | |
468 | ||
469 | ||
645f5e0e | 470 | SCM_DEFINE (scm_u8vector_set_x, "u8vector-set!", 3, 0, 0, |
71ca65d9 MG |
471 | (SCM uvec, SCM index, SCM value), |
472 | "Set the element at @var{index} in the homogeneous numeric\n" | |
473 | "vector @var{uvec} to @var{value}. The return value is not\n" | |
474 | "specified.") | |
475 | #define FUNC_NAME s_scm_u8vector_ref | |
476 | { | |
477 | int idx; | |
478 | int_u8 f; | |
479 | unsigned int s; | |
480 | ||
481 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
482 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U8) | |
483 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
484 | ||
485 | idx = scm_num2int (index, 2, FUNC_NAME); | |
486 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
487 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
488 | ||
489 | s = scm_num2uint (value, 3, FUNC_NAME); | |
490 | f = s; | |
491 | if ((unsigned int) f != s) | |
492 | scm_out_of_range_pos (FUNC_NAME, value, SCM_MAKINUM (3)); | |
493 | ||
494 | ((int_u8 *) SCM_UVEC_BASE (uvec))[idx] = f; | |
495 | return SCM_UNSPECIFIED; | |
496 | } | |
497 | #undef FUNC_NAME | |
498 | ||
499 | ||
645f5e0e | 500 | SCM_DEFINE (scm_u8vector_to_list, "u8vector->list", 1, 0, 0, |
71ca65d9 MG |
501 | (SCM uvec), |
502 | "Convert the homogeneous numeric vector @var{uvec} to a list.") | |
503 | #define FUNC_NAME s_scm_u8vector_to_list | |
504 | { | |
505 | int idx; | |
506 | int_u8 * p; | |
507 | SCM res = SCM_EOL; | |
508 | ||
509 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
510 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U8) | |
511 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
512 | ||
513 | idx = SCM_UVEC_LENGTH (uvec); | |
514 | p = (int_u8 *) SCM_UVEC_BASE (uvec) + idx; | |
515 | while (idx-- > 0) | |
516 | { | |
517 | p--; | |
518 | res = scm_cons (SCM_MAKINUM (*p), res); | |
519 | } | |
520 | return res; | |
521 | } | |
522 | #undef FUNC_NAME | |
523 | ||
524 | ||
525 | SCM_DEFINE (scm_list_to_u8vector, "list->u8vector", 1, 0, 0, | |
526 | (SCM l), | |
527 | "Convert the list @var{l}, which must only contain unsigned\n" | |
528 | "8-bit values, to a numeric homogeneous vector.") | |
529 | #define FUNC_NAME s_scm_list_to_u8vector | |
530 | { | |
531 | SCM uvec; | |
532 | SCM tmp; | |
533 | int_u8 * p; | |
534 | int n; | |
535 | int arg_pos = 1; | |
536 | ||
537 | SCM_VALIDATE_LIST_COPYLEN (1, l, n); | |
538 | ||
539 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_U8, n); | |
540 | p = (int_u8 *) SCM_UVEC_BASE (uvec); | |
541 | tmp = l; | |
542 | while (SCM_CONSP (tmp)) | |
543 | { | |
544 | int_u8 f; | |
545 | unsigned int s = scm_num2uint (SCM_CAR (tmp), 2, FUNC_NAME); | |
546 | f = s; | |
547 | if ((unsigned int) f != s) | |
548 | scm_out_of_range (FUNC_NAME, SCM_CAR (tmp)); | |
549 | *p++ = f; | |
550 | tmp = SCM_CDR (tmp); | |
551 | arg_pos++; | |
552 | } | |
553 | scm_remember_upto_here_1 (l); | |
554 | return uvec; | |
555 | } | |
556 | #undef FUNC_NAME | |
557 | ||
558 | ||
559 | /* ================================================================ */ | |
560 | /* S8 procedures. */ | |
561 | /* ================================================================ */ | |
562 | ||
563 | ||
645f5e0e | 564 | SCM_DEFINE (scm_s8vector_p, "s8vector?", 1, 0, 0, |
71ca65d9 MG |
565 | (SCM obj), |
566 | "Return @code{#t} if @var{obj} is a vector of type s8,\n" | |
567 | "@code{#f} otherwise.") | |
568 | #define FUNC_NAME s_scm_s8vector_p | |
569 | { | |
570 | return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && | |
571 | SCM_UVEC_TYPE (obj) == SCM_UVEC_S8); | |
572 | } | |
573 | #undef FUNC_NAME | |
574 | ||
575 | ||
645f5e0e | 576 | SCM_DEFINE (scm_make_s8vector, "make-s8vector", 1, 1, 0, |
71ca65d9 MG |
577 | (SCM n, SCM fill), |
578 | "Create a newly allocated homogeneous numeric vector which can\n" | |
579 | "hold @var{len} elements. If @var{fill} is given, it is used to\n" | |
580 | "initialize the elements, otherwise the contents of the vector\n" | |
581 | "is unspecified.") | |
582 | #define FUNC_NAME s_scm_make_s8vector | |
583 | { | |
584 | SCM uvec; | |
585 | int_s8 * p; | |
586 | int_s8 f; | |
587 | int count; | |
588 | ||
589 | SCM_VALIDATE_INUM (1, n); | |
590 | count = SCM_INUM (n); | |
591 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_S8, count); | |
592 | if (SCM_UNBNDP (fill)) | |
593 | f = 0; | |
594 | else | |
595 | { | |
596 | signed int s = scm_num2int (fill, 2, FUNC_NAME); | |
597 | f = s; | |
598 | if ((signed int) f != s) | |
599 | scm_out_of_range_pos (FUNC_NAME, fill, SCM_MAKINUM (2)); | |
600 | } | |
601 | p = (int_s8 *) SCM_UVEC_BASE (uvec); | |
602 | while (count-- > 0) | |
603 | *p++ = f; | |
604 | return uvec; | |
605 | } | |
606 | #undef FUNC_NAME | |
607 | ||
608 | ||
645f5e0e | 609 | SCM_DEFINE (scm_s8vector, "s8vector", 0, 0, 1, |
71ca65d9 MG |
610 | (SCM l), |
611 | "Create a newly allocated homogeneous numeric vector containing\n" | |
612 | "all argument values.") | |
613 | #define FUNC_NAME s_scm_s8vector | |
614 | { | |
615 | SCM_VALIDATE_REST_ARGUMENT (l); | |
616 | return scm_list_to_s8vector (l); | |
617 | } | |
618 | #undef FUNC_NAME | |
619 | ||
620 | ||
645f5e0e | 621 | SCM_DEFINE (scm_s8vector_length, "s8vector-length", 1, 0, 0, |
71ca65d9 MG |
622 | (SCM uvec), |
623 | "Return the number of elements in the homogeneous numeric vector\n" | |
624 | "@var{uvec}.") | |
625 | #define FUNC_NAME s_scm_s8vector_length | |
626 | { | |
627 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
628 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S8) | |
629 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
630 | return scm_int2num (SCM_UVEC_LENGTH (uvec)); | |
631 | } | |
632 | #undef FUNC_NAME | |
633 | ||
634 | ||
645f5e0e | 635 | SCM_DEFINE (scm_s8vector_ref, "s8vector-ref", 2, 0, 0, |
71ca65d9 MG |
636 | (SCM uvec, SCM index), |
637 | "Return the element at @var{index} in the homogeneous numeric\n" | |
638 | "vector @var{uvec}.") | |
639 | #define FUNC_NAME s_scm_s8vector_ref | |
640 | { | |
641 | int idx; | |
642 | ||
643 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
644 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S8) | |
645 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
646 | ||
647 | idx = scm_num2int (index, 2, FUNC_NAME); | |
648 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
649 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
650 | ||
651 | return scm_short2num (((int_s8 *) SCM_UVEC_BASE (uvec))[idx]); | |
652 | } | |
653 | #undef FUNC_NAME | |
654 | ||
655 | ||
645f5e0e | 656 | SCM_DEFINE (scm_s8vector_set_x, "s8vector-set!", 3, 0, 0, |
71ca65d9 MG |
657 | (SCM uvec, SCM index, SCM value), |
658 | "Set the element at @var{index} in the homogeneous numeric\n" | |
659 | "vector @var{uvec} to @var{value}. The return value is not\n" | |
660 | "specified.") | |
661 | #define FUNC_NAME s_scm_s8vector_ref | |
662 | { | |
663 | int idx; | |
664 | int_s8 f; | |
665 | signed int s; | |
666 | ||
667 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
668 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S8) | |
669 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
670 | ||
671 | idx = scm_num2int (index, 2, FUNC_NAME); | |
672 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
673 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
674 | ||
675 | s = scm_num2int (value, 3, FUNC_NAME); | |
676 | f = s; | |
677 | if ((signed int) f != s) | |
678 | scm_out_of_range_pos (FUNC_NAME, value, SCM_MAKINUM (3)); | |
679 | ||
680 | ((int_s8 *) SCM_UVEC_BASE (uvec))[idx] = f; | |
681 | return SCM_UNSPECIFIED; | |
682 | } | |
683 | #undef FUNC_NAME | |
684 | ||
685 | ||
645f5e0e | 686 | SCM_DEFINE (scm_s8vector_to_list, "s8vector->list", 1, 0, 0, |
71ca65d9 MG |
687 | (SCM uvec), |
688 | "Convert the homogeneous numeric vector @var{uvec} to a list.") | |
689 | #define FUNC_NAME s_scm_s8vector_to_list | |
690 | { | |
691 | int idx; | |
692 | int_s8 * p; | |
693 | SCM res = SCM_EOL; | |
694 | ||
695 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
696 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S8) | |
697 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
698 | ||
699 | idx = SCM_UVEC_LENGTH (uvec); | |
700 | p = (int_s8 *) SCM_UVEC_BASE (uvec) + idx; | |
701 | while (idx-- > 0) | |
702 | { | |
703 | p--; | |
704 | res = scm_cons (SCM_MAKINUM (*p), res); | |
705 | } | |
706 | return res; | |
707 | } | |
708 | #undef FUNC_NAME | |
709 | ||
710 | ||
711 | SCM_DEFINE (scm_list_to_s8vector, "list->s8vector", 1, 0, 0, | |
712 | (SCM l), | |
713 | "Convert the list @var{l}, which must only contain signed\n" | |
714 | "8-bit values, to a numeric homogeneous vector.") | |
715 | #define FUNC_NAME s_scm_list_to_s8vector | |
716 | { | |
717 | SCM uvec; | |
718 | SCM tmp; | |
719 | int_s8 * p; | |
720 | int n; | |
721 | int arg_pos = 1; | |
722 | ||
723 | SCM_VALIDATE_LIST_COPYLEN (1, l, n); | |
724 | ||
725 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_S8, n); | |
726 | p = (int_s8 *) SCM_UVEC_BASE (uvec); | |
727 | tmp = l; | |
728 | while (SCM_CONSP (tmp)) | |
729 | { | |
730 | int_s8 f; | |
731 | signed int s; | |
732 | ||
733 | s = scm_num2int (SCM_CAR (tmp), 2, FUNC_NAME); | |
734 | f = s; | |
735 | if ((signed int) f != s) | |
736 | scm_out_of_range (FUNC_NAME, SCM_CAR (tmp)); | |
737 | *p++ = f; | |
738 | tmp = SCM_CDR (tmp); | |
739 | arg_pos++; | |
740 | } | |
741 | scm_remember_upto_here_1 (l); | |
742 | return uvec; | |
743 | } | |
744 | #undef FUNC_NAME | |
745 | ||
746 | ||
747 | /* ================================================================ */ | |
748 | /* U16 procedures. */ | |
749 | /* ================================================================ */ | |
750 | ||
751 | ||
645f5e0e | 752 | SCM_DEFINE (scm_u16vector_p, "u16vector?", 1, 0, 0, |
71ca65d9 MG |
753 | (SCM obj), |
754 | "Return @code{#t} if @var{obj} is a vector of type u16,\n" | |
755 | "@code{#f} otherwise.") | |
756 | #define FUNC_NAME s_scm_u16vector_p | |
757 | { | |
758 | return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && | |
759 | SCM_UVEC_TYPE (obj) == SCM_UVEC_U16); | |
760 | } | |
761 | #undef FUNC_NAME | |
762 | ||
763 | ||
645f5e0e | 764 | SCM_DEFINE (scm_make_u16vector, "make-u16vector", 1, 1, 0, |
71ca65d9 MG |
765 | (SCM n, SCM fill), |
766 | "Create a newly allocated homogeneous numeric vector which can\n" | |
767 | "hold @var{len} elements. If @var{fill} is given, it is used to\n" | |
768 | "initialize the elements, otherwise the contents of the vector\n" | |
769 | "is unspecified.") | |
770 | #define FUNC_NAME s_scm_make_u16vector | |
771 | { | |
772 | SCM uvec; | |
773 | int_u16 * p; | |
774 | int_u16 f; | |
775 | int count; | |
776 | ||
777 | SCM_VALIDATE_INUM (1, n); | |
778 | count = SCM_INUM (n); | |
779 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_U16, count); | |
780 | if (SCM_UNBNDP (fill)) | |
781 | f = 0; | |
782 | else | |
783 | f = scm_num2ushort (fill, 2, FUNC_NAME); | |
784 | p = (int_u16 *) SCM_UVEC_BASE (uvec); | |
785 | while (count-- > 0) | |
786 | *p++ = f; | |
787 | return uvec; | |
788 | } | |
789 | #undef FUNC_NAME | |
790 | ||
791 | ||
645f5e0e | 792 | SCM_DEFINE (scm_u16vector, "u16vector", 0, 0, 1, |
71ca65d9 MG |
793 | (SCM l), |
794 | "Create a newly allocated homogeneous numeric vector containing\n" | |
795 | "all argument values.") | |
796 | #define FUNC_NAME s_scm_u16vector | |
797 | { | |
798 | SCM_VALIDATE_REST_ARGUMENT (l); | |
799 | return scm_list_to_u16vector (l); | |
800 | } | |
801 | #undef FUNC_NAME | |
802 | ||
803 | ||
645f5e0e | 804 | SCM_DEFINE (scm_u16vector_length, "u16vector-length", 1, 0, 0, |
71ca65d9 MG |
805 | (SCM uvec), |
806 | "Return the number of elements in the homogeneous numeric vector\n" | |
807 | "@var{uvec}.") | |
808 | #define FUNC_NAME s_scm_u16vector_length | |
809 | { | |
810 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
811 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U16) | |
812 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
813 | return scm_int2num (SCM_UVEC_LENGTH (uvec)); | |
814 | } | |
815 | #undef FUNC_NAME | |
816 | ||
817 | ||
645f5e0e | 818 | SCM_DEFINE (scm_u16vector_ref, "u16vector-ref", 2, 0, 0, |
71ca65d9 MG |
819 | (SCM uvec, SCM index), |
820 | "Return the element at @var{index} in the homogeneous numeric\n" | |
821 | "vector @var{uvec}.") | |
822 | #define FUNC_NAME s_scm_u16vector_ref | |
823 | { | |
824 | int idx; | |
825 | ||
826 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
827 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U16) | |
828 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
829 | ||
830 | idx = scm_num2int (index, 2, FUNC_NAME); | |
831 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
832 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
833 | ||
834 | return scm_ushort2num (((int_u16 *) SCM_UVEC_BASE (uvec))[idx]); | |
835 | } | |
836 | #undef FUNC_NAME | |
837 | ||
838 | ||
645f5e0e | 839 | SCM_DEFINE (scm_u16vector_set_x, "u16vector-set!", 3, 0, 0, |
71ca65d9 MG |
840 | (SCM uvec, SCM index, SCM value), |
841 | "Set the element at @var{index} in the homogeneous numeric\n" | |
842 | "vector @var{uvec} to @var{value}. The return value is not\n" | |
843 | "specified.") | |
844 | #define FUNC_NAME s_scm_u16vector_ref | |
845 | { | |
846 | int idx; | |
847 | int_u16 f; | |
848 | ||
849 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
850 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U16) | |
851 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
852 | ||
853 | idx = scm_num2int (index, 2, FUNC_NAME); | |
854 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
855 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
856 | ||
857 | f = scm_num2ushort (value, 3, FUNC_NAME); | |
858 | ||
859 | ((int_u16 *) SCM_UVEC_BASE (uvec))[idx] = f; | |
860 | return SCM_UNSPECIFIED; | |
861 | } | |
862 | #undef FUNC_NAME | |
863 | ||
864 | ||
645f5e0e | 865 | SCM_DEFINE (scm_u16vector_to_list, "u16vector->list", 1, 0, 0, |
71ca65d9 MG |
866 | (SCM uvec), |
867 | "Convert the homogeneous numeric vector @var{uvec} to a list.") | |
868 | #define FUNC_NAME s_scm_u16vector_to_list | |
869 | { | |
870 | int idx; | |
871 | int_u16 * p; | |
872 | SCM res = SCM_EOL; | |
873 | ||
874 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
875 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U16) | |
876 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
877 | ||
878 | idx = SCM_UVEC_LENGTH (uvec); | |
879 | p = (int_u16 *) SCM_UVEC_BASE (uvec) + idx; | |
880 | while (idx-- > 0) | |
881 | { | |
882 | p--; | |
883 | res = scm_cons (SCM_MAKINUM (*p), res); | |
884 | } | |
885 | return res; | |
886 | } | |
887 | #undef FUNC_NAME | |
888 | ||
889 | ||
890 | SCM_DEFINE (scm_list_to_u16vector, "list->u16vector", 1, 0, 0, | |
891 | (SCM l), | |
892 | "Convert the list @var{l}, which must only contain unsigned\n" | |
893 | "16-bit values, to a numeric homogeneous vector.") | |
894 | #define FUNC_NAME s_scm_list_to_u16vector | |
895 | { | |
896 | SCM uvec; | |
897 | int_u16 * p; | |
898 | int n; | |
899 | int arg_pos = 1; | |
900 | ||
901 | SCM_VALIDATE_LIST_COPYLEN (1, l, n); | |
902 | ||
903 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_U16, n); | |
904 | p = (int_u16 *) SCM_UVEC_BASE (uvec); | |
905 | while (SCM_CONSP (l)) | |
906 | { | |
907 | int_u16 f = scm_num2ushort (SCM_CAR (l), 2, FUNC_NAME); | |
908 | *p++ = f; | |
909 | l = SCM_CDR (l); | |
910 | arg_pos++; | |
911 | } | |
912 | return uvec; | |
913 | } | |
914 | #undef FUNC_NAME | |
915 | ||
916 | ||
917 | /* ================================================================ */ | |
918 | /* S16 procedures. */ | |
919 | /* ================================================================ */ | |
920 | ||
921 | ||
645f5e0e | 922 | SCM_DEFINE (scm_s16vector_p, "s16vector?", 1, 0, 0, |
71ca65d9 MG |
923 | (SCM obj), |
924 | "Return @code{#t} if @var{obj} is a vector of type s16,\n" | |
925 | "@code{#f} otherwise.") | |
926 | #define FUNC_NAME s_scm_s16vector_p | |
927 | { | |
928 | return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && | |
929 | SCM_UVEC_TYPE (obj) == SCM_UVEC_S16); | |
930 | } | |
931 | #undef FUNC_NAME | |
932 | ||
933 | ||
645f5e0e | 934 | SCM_DEFINE (scm_make_s16vector, "make-s16vector", 1, 1, 0, |
71ca65d9 MG |
935 | (SCM n, SCM fill), |
936 | "Create a newly allocated homogeneous numeric vector which can\n" | |
937 | "hold @var{len} elements. If @var{fill} is given, it is used to\n" | |
938 | "initialize the elements, otherwise the contents of the vector\n" | |
939 | "is unspecified.") | |
940 | #define FUNC_NAME s_scm_make_s16vector | |
941 | { | |
942 | SCM uvec; | |
943 | int_s16 * p; | |
944 | int_s16 f; | |
945 | int count; | |
946 | ||
947 | SCM_VALIDATE_INUM (1, n); | |
948 | count = SCM_INUM (n); | |
949 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_S16, count); | |
950 | if (SCM_UNBNDP (fill)) | |
951 | f = 0; | |
952 | else | |
953 | f = scm_num2short (fill, 2, FUNC_NAME); | |
954 | p = (int_s16 *) SCM_UVEC_BASE (uvec); | |
955 | while (count-- > 0) | |
956 | *p++ = f; | |
957 | return uvec; | |
958 | } | |
959 | #undef FUNC_NAME | |
960 | ||
961 | ||
645f5e0e | 962 | SCM_DEFINE (scm_s16vector, "s16vector", 0, 0, 1, |
71ca65d9 MG |
963 | (SCM l), |
964 | "Create a newly allocated homogeneous numeric vector containing\n" | |
965 | "all argument values.") | |
966 | #define FUNC_NAME s_scm_s16vector | |
967 | { | |
968 | SCM_VALIDATE_REST_ARGUMENT (l); | |
969 | return scm_list_to_s16vector (l); | |
970 | } | |
971 | #undef FUNC_NAME | |
972 | ||
973 | ||
645f5e0e | 974 | SCM_DEFINE (scm_s16vector_length, "s16vector-length", 1, 0, 0, |
71ca65d9 MG |
975 | (SCM uvec), |
976 | "Return the number of elements in the homogeneous numeric vector\n" | |
977 | "@var{uvec}.") | |
978 | #define FUNC_NAME s_scm_s16vector_length | |
979 | { | |
980 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
981 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S16) | |
982 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
983 | return scm_int2num (SCM_UVEC_LENGTH (uvec)); | |
984 | } | |
985 | #undef FUNC_NAME | |
986 | ||
987 | ||
645f5e0e | 988 | SCM_DEFINE (scm_s16vector_ref, "s16vector-ref", 2, 0, 0, |
71ca65d9 MG |
989 | (SCM uvec, SCM index), |
990 | "Return the element at @var{index} in the homogeneous numeric\n" | |
991 | "vector @var{uvec}.") | |
992 | #define FUNC_NAME s_scm_s16vector_ref | |
993 | { | |
994 | int idx; | |
995 | ||
996 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
997 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S16) | |
998 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
999 | ||
1000 | idx = scm_num2int (index, 2, FUNC_NAME); | |
1001 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
1002 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
1003 | ||
1004 | return scm_short2num (((int_s16 *) SCM_UVEC_BASE (uvec))[idx]); | |
1005 | } | |
1006 | #undef FUNC_NAME | |
1007 | ||
1008 | ||
645f5e0e | 1009 | SCM_DEFINE (scm_s16vector_set_x, "s16vector-set!", 3, 0, 0, |
71ca65d9 MG |
1010 | (SCM uvec, SCM index, SCM value), |
1011 | "Set the element at @var{index} in the homogeneous numeric\n" | |
1012 | "vector @var{uvec} to @var{value}. The return value is not\n" | |
1013 | "specified.") | |
1014 | #define FUNC_NAME s_scm_s16vector_ref | |
1015 | { | |
1016 | int idx; | |
1017 | int_s16 f; | |
1018 | ||
1019 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1020 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S16) | |
1021 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1022 | ||
1023 | idx = scm_num2int (index, 2, FUNC_NAME); | |
1024 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
1025 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
1026 | ||
1027 | f = scm_num2short (value, 3, FUNC_NAME); | |
1028 | ||
1029 | ((int_s16 *) SCM_UVEC_BASE (uvec))[idx] = f; | |
1030 | return SCM_UNSPECIFIED; | |
1031 | } | |
1032 | #undef FUNC_NAME | |
1033 | ||
1034 | ||
645f5e0e | 1035 | SCM_DEFINE (scm_s16vector_to_list, "s16vector->list", 1, 0, 0, |
71ca65d9 MG |
1036 | (SCM uvec), |
1037 | "Convert the homogeneous numeric vector @var{uvec} to a list.") | |
1038 | #define FUNC_NAME s_scm_s16vector_to_list | |
1039 | { | |
1040 | int idx; | |
1041 | int_s16 * p; | |
1042 | SCM res = SCM_EOL; | |
1043 | ||
1044 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1045 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S16) | |
1046 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1047 | ||
1048 | idx = SCM_UVEC_LENGTH (uvec); | |
1049 | p = (int_s16 *) SCM_UVEC_BASE (uvec) + idx; | |
1050 | while (idx-- > 0) | |
1051 | { | |
1052 | p--; | |
1053 | res = scm_cons (SCM_MAKINUM (*p), res); | |
1054 | } | |
1055 | return res; | |
1056 | } | |
1057 | #undef FUNC_NAME | |
1058 | ||
1059 | ||
1060 | SCM_DEFINE (scm_list_to_s16vector, "list->s16vector", 1, 0, 0, | |
1061 | (SCM l), | |
1062 | "Convert the list @var{l}, which must only contain signed\n" | |
1063 | "16-bit values, to a numeric homogeneous vector.") | |
1064 | #define FUNC_NAME s_scm_list_to_s16vector | |
1065 | { | |
1066 | SCM uvec; | |
1067 | SCM tmp; | |
1068 | int_s16 * p; | |
1069 | int n; | |
1070 | int arg_pos = 1; | |
1071 | ||
1072 | SCM_VALIDATE_LIST_COPYLEN (1, l, n); | |
1073 | ||
1074 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_S16, n); | |
1075 | p = (int_s16 *) SCM_UVEC_BASE (uvec); | |
1076 | tmp = l; | |
1077 | while (SCM_CONSP (tmp)) | |
1078 | { | |
1079 | int_s16 f = scm_num2short (SCM_CAR (tmp), 2, FUNC_NAME); | |
1080 | *p++ = f; | |
1081 | tmp = SCM_CDR (tmp); | |
1082 | arg_pos++; | |
1083 | } | |
1084 | scm_remember_upto_here_1 (l); | |
1085 | return uvec; | |
1086 | } | |
1087 | #undef FUNC_NAME | |
1088 | ||
1089 | ||
1090 | /* ================================================================ */ | |
1091 | /* U32 procedures. */ | |
1092 | /* ================================================================ */ | |
1093 | ||
1094 | ||
645f5e0e | 1095 | SCM_DEFINE (scm_u32vector_p, "u32vector?", 1, 0, 0, |
71ca65d9 MG |
1096 | (SCM obj), |
1097 | "Return @code{#t} if @var{obj} is a vector of type u32,\n" | |
1098 | "@code{#f} otherwise.") | |
1099 | #define FUNC_NAME s_scm_u32vector_p | |
1100 | { | |
1101 | return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && | |
1102 | SCM_UVEC_TYPE (obj) == SCM_UVEC_U32); | |
1103 | } | |
1104 | #undef FUNC_NAME | |
1105 | ||
1106 | ||
645f5e0e | 1107 | SCM_DEFINE (scm_make_u32vector, "make-u32vector", 1, 1, 0, |
71ca65d9 MG |
1108 | (SCM n, SCM fill), |
1109 | "Create a newly allocated homogeneous numeric vector which can\n" | |
1110 | "hold @var{len} elements. If @var{fill} is given, it is used to\n" | |
1111 | "initialize the elements, otherwise the contents of the vector\n" | |
1112 | "is unspecified.") | |
1113 | #define FUNC_NAME s_scm_make_u32vector | |
1114 | { | |
1115 | SCM uvec; | |
1116 | int_u32 * p; | |
1117 | int_u32 f; | |
1118 | int count; | |
1119 | ||
1120 | SCM_VALIDATE_INUM (1, n); | |
1121 | count = SCM_INUM (n); | |
1122 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_U32, count); | |
1123 | if (SCM_UNBNDP (fill)) | |
1124 | f = 0; | |
1125 | else | |
1126 | f = scm_num2uint (fill, 2, FUNC_NAME); | |
1127 | p = (int_u32 *) SCM_UVEC_BASE (uvec); | |
1128 | while (count-- > 0) | |
1129 | *p++ = f; | |
1130 | return uvec; | |
1131 | } | |
1132 | #undef FUNC_NAME | |
1133 | ||
1134 | ||
645f5e0e | 1135 | SCM_DEFINE (scm_u32vector, "u32vector", 0, 0, 1, |
71ca65d9 MG |
1136 | (SCM l), |
1137 | "Create a newly allocated homogeneous numeric vector containing\n" | |
1138 | "all argument values.") | |
1139 | #define FUNC_NAME s_scm_u32vector | |
1140 | { | |
1141 | SCM_VALIDATE_REST_ARGUMENT (l); | |
1142 | return scm_list_to_u32vector (l); | |
1143 | } | |
1144 | #undef FUNC_NAME | |
1145 | ||
1146 | ||
645f5e0e | 1147 | SCM_DEFINE (scm_u32vector_length, "u32vector-length", 1, 0, 0, |
71ca65d9 MG |
1148 | (SCM uvec), |
1149 | "Return the number of elements in the homogeneous numeric vector\n" | |
1150 | "@var{uvec}.") | |
1151 | #define FUNC_NAME s_scm_u32vector_length | |
1152 | { | |
1153 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1154 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U32) | |
1155 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1156 | return scm_int2num (SCM_UVEC_LENGTH (uvec)); | |
1157 | } | |
1158 | #undef FUNC_NAME | |
1159 | ||
1160 | ||
645f5e0e | 1161 | SCM_DEFINE (scm_u32vector_ref, "u32vector-ref", 2, 0, 0, |
71ca65d9 MG |
1162 | (SCM uvec, SCM index), |
1163 | "Return the element at @var{index} in the homogeneous numeric\n" | |
1164 | "vector @var{uvec}.") | |
1165 | #define FUNC_NAME s_scm_u32vector_ref | |
1166 | { | |
1167 | int idx; | |
1168 | ||
1169 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1170 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U32) | |
1171 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1172 | ||
1173 | idx = scm_num2int (index, 2, FUNC_NAME); | |
1174 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
1175 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
1176 | ||
1177 | return scm_uint2num (((int_u32 *) SCM_UVEC_BASE (uvec))[idx]); | |
1178 | } | |
1179 | #undef FUNC_NAME | |
1180 | ||
1181 | ||
645f5e0e | 1182 | SCM_DEFINE (scm_u32vector_set_x, "u32vector-set!", 3, 0, 0, |
71ca65d9 MG |
1183 | (SCM uvec, SCM index, SCM value), |
1184 | "Set the element at @var{index} in the homogeneous numeric\n" | |
1185 | "vector @var{uvec} to @var{value}. The return value is not\n" | |
1186 | "specified.") | |
1187 | #define FUNC_NAME s_scm_u32vector_ref | |
1188 | { | |
1189 | int idx; | |
1190 | int_u32 f; | |
1191 | ||
1192 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1193 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U32) | |
1194 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1195 | ||
1196 | idx = scm_num2int (index, 2, FUNC_NAME); | |
1197 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
1198 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
1199 | ||
1200 | f = scm_num2uint (value, 3, FUNC_NAME); | |
1201 | ||
1202 | ((int_u32 *) SCM_UVEC_BASE (uvec))[idx] = f; | |
1203 | return SCM_UNSPECIFIED; | |
1204 | } | |
1205 | #undef FUNC_NAME | |
1206 | ||
1207 | ||
645f5e0e | 1208 | SCM_DEFINE (scm_u32vector_to_list, "u32vector->list", 1, 0, 0, |
71ca65d9 MG |
1209 | (SCM uvec), |
1210 | "Convert the homogeneous numeric vector @var{uvec} to a list.") | |
1211 | #define FUNC_NAME s_scm_u32vector_to_list | |
1212 | { | |
1213 | int idx; | |
1214 | int_u32 * p; | |
1215 | SCM res = SCM_EOL; | |
1216 | ||
1217 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1218 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U32) | |
1219 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1220 | ||
1221 | idx = SCM_UVEC_LENGTH (uvec); | |
1222 | p = (int_u32 *) SCM_UVEC_BASE (uvec) + idx; | |
1223 | while (idx-- > 0) | |
1224 | { | |
1225 | p--; | |
1226 | res = scm_cons (scm_uint2num (*p), res); | |
1227 | } | |
1228 | return res; | |
1229 | } | |
1230 | #undef FUNC_NAME | |
1231 | ||
1232 | ||
1233 | SCM_DEFINE (scm_list_to_u32vector, "list->u32vector", 1, 0, 0, | |
1234 | (SCM l), | |
1235 | "Convert the list @var{l}, which must only contain unsigned\n" | |
1236 | "32-bit values, to a numeric homogeneous vector.") | |
1237 | #define FUNC_NAME s_scm_list_to_u32vector | |
1238 | { | |
1239 | SCM uvec; | |
1240 | int_u32 * p; | |
1241 | int n; | |
1242 | int arg_pos = 1; | |
1243 | ||
1244 | SCM_VALIDATE_LIST_COPYLEN (1, l, n); | |
1245 | ||
1246 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_U32, n); | |
1247 | p = (int_u32 *) SCM_UVEC_BASE (uvec); | |
1248 | while (SCM_CONSP (l)) | |
1249 | { | |
1250 | int_u32 f; | |
1251 | f = scm_num2uint (SCM_CAR (l), 2, FUNC_NAME); | |
1252 | *p++ = f; | |
1253 | l = SCM_CDR (l); | |
1254 | arg_pos++; | |
1255 | } | |
1256 | return uvec; | |
1257 | } | |
1258 | #undef FUNC_NAME | |
1259 | ||
1260 | ||
1261 | /* ================================================================ */ | |
1262 | /* S32 procedures. */ | |
1263 | /* ================================================================ */ | |
1264 | ||
1265 | ||
645f5e0e | 1266 | SCM_DEFINE (scm_s32vector_p, "s32vector?", 1, 0, 0, |
71ca65d9 MG |
1267 | (SCM obj), |
1268 | "Return @code{#t} if @var{obj} is a vector of type s32,\n" | |
1269 | "@code{#f} otherwise.") | |
1270 | #define FUNC_NAME s_scm_s32vector_p | |
1271 | { | |
1272 | return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && | |
1273 | SCM_UVEC_TYPE (obj) == SCM_UVEC_S32); | |
1274 | } | |
1275 | #undef FUNC_NAME | |
1276 | ||
1277 | ||
645f5e0e | 1278 | SCM_DEFINE (scm_make_s32vector, "make-s32vector", 1, 1, 0, |
71ca65d9 MG |
1279 | (SCM n, SCM fill), |
1280 | "Create a newly allocated homogeneous numeric vector which can\n" | |
1281 | "hold @var{len} elements. If @var{fill} is given, it is used to\n" | |
1282 | "initialize the elements, otherwise the contents of the vector\n" | |
1283 | "is unspecified.") | |
1284 | #define FUNC_NAME s_scm_make_s32vector | |
1285 | { | |
1286 | SCM uvec; | |
1287 | int_s32 * p; | |
1288 | int_s32 f; | |
1289 | int count; | |
1290 | ||
1291 | SCM_VALIDATE_INUM (1, n); | |
1292 | count = SCM_INUM (n); | |
1293 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_S32, count); | |
1294 | if (SCM_UNBNDP (fill)) | |
1295 | f = 0; | |
1296 | else | |
1297 | f = scm_num2int (fill, 2, FUNC_NAME); | |
1298 | p = (int_s32 *) SCM_UVEC_BASE (uvec); | |
1299 | while (count-- > 0) | |
1300 | *p++ = f; | |
1301 | return uvec; | |
1302 | } | |
1303 | #undef FUNC_NAME | |
1304 | ||
1305 | ||
645f5e0e | 1306 | SCM_DEFINE (scm_s32vector, "s32vector", 0, 0, 1, |
71ca65d9 MG |
1307 | (SCM l), |
1308 | "Create a newly allocated homogeneous numeric vector containing\n" | |
1309 | "all argument values.") | |
1310 | #define FUNC_NAME s_scm_s32vector | |
1311 | { | |
1312 | SCM_VALIDATE_REST_ARGUMENT (l); | |
1313 | return scm_list_to_s32vector (l); | |
1314 | } | |
1315 | #undef FUNC_NAME | |
1316 | ||
1317 | ||
645f5e0e | 1318 | SCM_DEFINE (scm_s32vector_length, "s32vector-length", 1, 0, 0, |
71ca65d9 MG |
1319 | (SCM uvec), |
1320 | "Return the number of elements in the homogeneous numeric vector\n" | |
1321 | "@var{uvec}.") | |
1322 | #define FUNC_NAME s_scm_s32vector_length | |
1323 | { | |
1324 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1325 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S32) | |
1326 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1327 | return scm_int2num (SCM_UVEC_LENGTH (uvec)); | |
1328 | } | |
1329 | #undef FUNC_NAME | |
1330 | ||
1331 | ||
645f5e0e | 1332 | SCM_DEFINE (scm_s32vector_ref, "s32vector-ref", 2, 0, 0, |
71ca65d9 MG |
1333 | (SCM uvec, SCM index), |
1334 | "Return the element at @var{index} in the homogeneous numeric\n" | |
1335 | "vector @var{uvec}.") | |
1336 | #define FUNC_NAME s_scm_s32vector_ref | |
1337 | { | |
1338 | int idx; | |
1339 | ||
1340 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1341 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S32) | |
1342 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1343 | ||
1344 | idx = scm_num2int (index, 2, FUNC_NAME); | |
1345 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
1346 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
1347 | ||
1348 | return scm_int2num (((int_s32 *) SCM_UVEC_BASE (uvec))[idx]); | |
1349 | } | |
1350 | #undef FUNC_NAME | |
1351 | ||
1352 | ||
645f5e0e | 1353 | SCM_DEFINE (scm_s32vector_set_x, "s32vector-set!", 3, 0, 0, |
71ca65d9 MG |
1354 | (SCM uvec, SCM index, SCM value), |
1355 | "Set the element at @var{index} in the homogeneous numeric\n" | |
1356 | "vector @var{uvec} to @var{value}. The return value is not\n" | |
1357 | "specified.") | |
1358 | #define FUNC_NAME s_scm_s32vector_ref | |
1359 | { | |
1360 | int idx; | |
1361 | int_s32 f; | |
1362 | ||
1363 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1364 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S32) | |
1365 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1366 | ||
1367 | idx = scm_num2int (index, 2, FUNC_NAME); | |
1368 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
1369 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
1370 | ||
1371 | f = scm_num2int (value, 3, FUNC_NAME); | |
1372 | ||
1373 | ((int_s32 *) SCM_UVEC_BASE (uvec))[idx] = f; | |
1374 | return SCM_UNSPECIFIED; | |
1375 | } | |
1376 | #undef FUNC_NAME | |
1377 | ||
1378 | ||
645f5e0e | 1379 | SCM_DEFINE (scm_s32vector_to_list, "s32vector->list", 1, 0, 0, |
71ca65d9 MG |
1380 | (SCM uvec), |
1381 | "Convert the homogeneous numeric vector @var{uvec} to a list.") | |
1382 | #define FUNC_NAME s_scm_s32vector_to_list | |
1383 | { | |
1384 | int idx; | |
1385 | int_s32 * p; | |
1386 | SCM res = SCM_EOL; | |
1387 | ||
1388 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1389 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S32) | |
1390 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1391 | ||
1392 | idx = SCM_UVEC_LENGTH (uvec); | |
1393 | p = (int_s32 *) SCM_UVEC_BASE (uvec) + idx; | |
1394 | while (idx-- > 0) | |
1395 | { | |
1396 | p--; | |
1397 | res = scm_cons (scm_int2num (*p), res); | |
1398 | } | |
1399 | return res; | |
1400 | } | |
1401 | #undef FUNC_NAME | |
1402 | ||
1403 | ||
1404 | SCM_DEFINE (scm_list_to_s32vector, "list->s32vector", 1, 0, 0, | |
1405 | (SCM l), | |
1406 | "Convert the list @var{l}, which must only contain signed\n" | |
1407 | "32-bit values, to a numeric homogeneous vector.") | |
1408 | #define FUNC_NAME s_scm_list_to_s32vector | |
1409 | { | |
1410 | SCM uvec; | |
1411 | int_s32 * p; | |
1412 | int n; | |
1413 | int arg_pos = 1; | |
1414 | ||
1415 | SCM_VALIDATE_LIST_COPYLEN (1, l, n); | |
1416 | ||
1417 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_S32, n); | |
1418 | p = (int_s32 *) SCM_UVEC_BASE (uvec); | |
1419 | while (SCM_CONSP (l)) | |
1420 | { | |
1421 | int_s32 f; | |
1422 | f = scm_num2int (SCM_CAR (l), 2, FUNC_NAME); | |
1423 | *p++ = f; | |
1424 | l = SCM_CDR (l); | |
1425 | arg_pos++; | |
1426 | } | |
1427 | return uvec; | |
1428 | } | |
1429 | #undef FUNC_NAME | |
1430 | ||
1431 | ||
1f537655 | 1432 | #ifdef HAVE_LONG_LONG |
71ca65d9 MG |
1433 | |
1434 | /* ================================================================ */ | |
1435 | /* U64 procedures. */ | |
1436 | /* ================================================================ */ | |
1437 | ||
1438 | ||
645f5e0e | 1439 | SCM_DEFINE (scm_u64vector_p, "u64vector?", 1, 0, 0, |
71ca65d9 MG |
1440 | (SCM obj), |
1441 | "Return @code{#t} if @var{obj} is a vector of type u64,\n" | |
1442 | "@code{#f} otherwise.") | |
1443 | #define FUNC_NAME s_scm_u64vector_p | |
1444 | { | |
1445 | return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && | |
1446 | SCM_UVEC_TYPE (obj) == SCM_UVEC_U64); | |
1447 | } | |
1448 | #undef FUNC_NAME | |
1449 | ||
1450 | ||
645f5e0e | 1451 | SCM_DEFINE (scm_make_u64vector, "make-u64vector", 1, 1, 0, |
71ca65d9 MG |
1452 | (SCM n, SCM fill), |
1453 | "Create a newly allocated homogeneous numeric vector which can\n" | |
1454 | "hold @var{len} elements. If @var{fill} is given, it is used to\n" | |
1455 | "initialize the elements, otherwise the contents of the vector\n" | |
1456 | "is unspecified.") | |
1457 | #define FUNC_NAME s_scm_make_u64vector | |
1458 | { | |
1459 | SCM uvec; | |
1460 | int_u64 * p; | |
1461 | int_u64 f; | |
1462 | int count; | |
1463 | ||
1464 | SCM_VALIDATE_INUM (1, n); | |
1465 | count = SCM_INUM (n); | |
1466 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_U64, count); | |
1467 | if (SCM_UNBNDP (fill)) | |
1468 | f = 0; | |
1469 | else | |
1470 | f = scm_num2ulong_long (fill, 2, FUNC_NAME); | |
1471 | p = (int_u64 *) SCM_UVEC_BASE (uvec); | |
1472 | while (count-- > 0) | |
1473 | *p++ = f; | |
1474 | return uvec; | |
1475 | } | |
1476 | #undef FUNC_NAME | |
1477 | ||
1478 | ||
645f5e0e | 1479 | SCM_DEFINE (scm_u64vector, "u64vector", 0, 0, 1, |
71ca65d9 MG |
1480 | (SCM l), |
1481 | "Create a newly allocated homogeneous numeric vector containing\n" | |
1482 | "all argument values.") | |
1483 | #define FUNC_NAME s_scm_u64vector | |
1484 | { | |
1485 | SCM_VALIDATE_REST_ARGUMENT (l); | |
1486 | return scm_list_to_u64vector (l); | |
1487 | } | |
1488 | #undef FUNC_NAME | |
1489 | ||
1490 | ||
645f5e0e | 1491 | SCM_DEFINE (scm_u64vector_length, "u64vector-length", 1, 0, 0, |
71ca65d9 MG |
1492 | (SCM uvec), |
1493 | "Return the number of elements in the homogeneous numeric vector\n" | |
1494 | "@var{uvec}.") | |
1495 | #define FUNC_NAME s_scm_u64vector_length | |
1496 | { | |
1497 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1498 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U64) | |
1499 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1500 | return scm_int2num (SCM_UVEC_LENGTH (uvec)); | |
1501 | } | |
1502 | #undef FUNC_NAME | |
1503 | ||
1504 | ||
645f5e0e | 1505 | SCM_DEFINE (scm_u64vector_ref, "u64vector-ref", 2, 0, 0, |
71ca65d9 MG |
1506 | (SCM uvec, SCM index), |
1507 | "Return the element at @var{index} in the homogeneous numeric\n" | |
1508 | "vector @var{uvec}.") | |
1509 | #define FUNC_NAME s_scm_u64vector_ref | |
1510 | { | |
1511 | int idx; | |
1512 | ||
1513 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1514 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U64) | |
1515 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1516 | ||
1517 | idx = scm_num2int (index, 2, FUNC_NAME); | |
1518 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
1519 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
1520 | ||
1521 | return scm_ulong_long2num (((int_u64 *) SCM_UVEC_BASE (uvec))[idx]); | |
1522 | } | |
1523 | #undef FUNC_NAME | |
1524 | ||
1525 | ||
645f5e0e | 1526 | SCM_DEFINE (scm_u64vector_set_x, "u64vector-set!", 3, 0, 0, |
71ca65d9 MG |
1527 | (SCM uvec, SCM index, SCM value), |
1528 | "Set the element at @var{index} in the homogeneous numeric\n" | |
1529 | "vector @var{uvec} to @var{value}. The return value is not\n" | |
1530 | "specified.") | |
1531 | #define FUNC_NAME s_scm_u64vector_ref | |
1532 | { | |
1533 | int idx; | |
1534 | int_u64 f; | |
1535 | ||
1536 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1537 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U64) | |
1538 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1539 | ||
1540 | idx = scm_num2int (index, 2, FUNC_NAME); | |
1541 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
1542 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
1543 | ||
1544 | f = scm_num2ulong_long (value, 3, FUNC_NAME); | |
1545 | ||
1546 | ((int_u64 *) SCM_UVEC_BASE (uvec))[idx] = f; | |
1547 | return SCM_UNSPECIFIED; | |
1548 | } | |
1549 | #undef FUNC_NAME | |
1550 | ||
1551 | ||
645f5e0e | 1552 | SCM_DEFINE (scm_u64vector_to_list, "u64vector->list", 1, 0, 0, |
71ca65d9 MG |
1553 | (SCM uvec), |
1554 | "Convert the homogeneous numeric vector @var{uvec} to a list.") | |
1555 | #define FUNC_NAME s_scm_u64vector_to_list | |
1556 | { | |
1557 | int idx; | |
1558 | int_u64 * p; | |
1559 | SCM res = SCM_EOL; | |
1560 | ||
1561 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1562 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_U64) | |
1563 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1564 | ||
1565 | idx = SCM_UVEC_LENGTH (uvec); | |
1566 | p = (int_u64 *) SCM_UVEC_BASE (uvec) + idx; | |
1567 | while (idx-- > 0) | |
1568 | { | |
1569 | p--; | |
1570 | res = scm_cons (scm_long_long2num (*p), res); | |
1571 | } | |
1572 | return res; | |
1573 | } | |
1574 | #undef FUNC_NAME | |
1575 | ||
1576 | ||
1577 | SCM_DEFINE (scm_list_to_u64vector, "list->u64vector", 1, 0, 0, | |
1578 | (SCM l), | |
1579 | "Convert the list @var{l}, which must only contain unsigned\n" | |
1580 | "64-bit values, to a numeric homogeneous vector.") | |
1581 | #define FUNC_NAME s_scm_list_to_u64vector | |
1582 | { | |
1583 | SCM uvec; | |
1584 | int_u64 * p; | |
1585 | int n; | |
1586 | int arg_pos = 1; | |
1587 | ||
1588 | SCM_VALIDATE_LIST_COPYLEN (1, l, n); | |
1589 | ||
1590 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_U64, n); | |
1591 | p = (int_u64 *) SCM_UVEC_BASE (uvec); | |
1592 | while (SCM_CONSP (l)) | |
1593 | { | |
1594 | int_u64 f; | |
1595 | f = scm_num2ulong_long (SCM_CAR (l), 2, FUNC_NAME); | |
1596 | *p++ = f; | |
1597 | l = SCM_CDR (l); | |
1598 | arg_pos++; | |
1599 | } | |
1600 | return uvec; | |
1601 | } | |
1602 | #undef FUNC_NAME | |
1603 | ||
1604 | ||
1605 | /* ================================================================ */ | |
1606 | /* S64 procedures. */ | |
1607 | /* ================================================================ */ | |
1608 | ||
1609 | ||
645f5e0e | 1610 | SCM_DEFINE (scm_s64vector_p, "s64vector?", 1, 0, 0, |
71ca65d9 MG |
1611 | (SCM obj), |
1612 | "Return @code{#t} if @var{obj} is a vector of type s64,\n" | |
1613 | "@code{#f} otherwise.") | |
1614 | #define FUNC_NAME s_scm_s64vector_p | |
1615 | { | |
1616 | return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && | |
1617 | SCM_UVEC_TYPE (obj) == SCM_UVEC_S64); | |
1618 | } | |
1619 | #undef FUNC_NAME | |
1620 | ||
1621 | ||
645f5e0e | 1622 | SCM_DEFINE (scm_make_s64vector, "make-s64vector", 1, 1, 0, |
71ca65d9 MG |
1623 | (SCM n, SCM fill), |
1624 | "Create a newly allocated homogeneous numeric vector which can\n" | |
1625 | "hold @var{len} elements. If @var{fill} is given, it is used to\n" | |
1626 | "initialize the elements, otherwise the contents of the vector\n" | |
1627 | "is unspecified.") | |
1628 | #define FUNC_NAME s_scm_make_s64vector | |
1629 | { | |
1630 | SCM uvec; | |
1631 | int_s64 * p; | |
1632 | int_s64 f; | |
1633 | int count; | |
1634 | ||
1635 | SCM_VALIDATE_INUM (1, n); | |
1636 | count = SCM_INUM (n); | |
1637 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_S64, count); | |
1638 | if (SCM_UNBNDP (fill)) | |
1639 | f = 0; | |
1640 | else | |
1641 | f = scm_num2long_long (fill, 2, FUNC_NAME); | |
1642 | p = (int_s64 *) SCM_UVEC_BASE (uvec); | |
1643 | while (count-- > 0) | |
1644 | *p++ = f; | |
1645 | return uvec; | |
1646 | } | |
1647 | #undef FUNC_NAME | |
1648 | ||
1649 | ||
645f5e0e | 1650 | SCM_DEFINE (scm_s64vector, "s64vector", 0, 0, 1, |
71ca65d9 MG |
1651 | (SCM l), |
1652 | "Create a newly allocated homogeneous numeric vector containing\n" | |
1653 | "all argument values.") | |
1654 | #define FUNC_NAME s_scm_s64vector | |
1655 | { | |
1656 | SCM_VALIDATE_REST_ARGUMENT (l); | |
1657 | return scm_list_to_s64vector (l); | |
1658 | } | |
1659 | #undef FUNC_NAME | |
1660 | ||
1661 | ||
645f5e0e | 1662 | SCM_DEFINE (scm_s64vector_length, "s64vector-length", 1, 0, 0, |
71ca65d9 MG |
1663 | (SCM uvec), |
1664 | "Return the number of elements in the homogeneous numeric vector\n" | |
1665 | "@var{uvec}.") | |
1666 | #define FUNC_NAME s_scm_s64vector_length | |
1667 | { | |
1668 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1669 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S64) | |
1670 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1671 | return scm_int2num (SCM_UVEC_LENGTH (uvec)); | |
1672 | } | |
1673 | #undef FUNC_NAME | |
1674 | ||
1675 | ||
645f5e0e | 1676 | SCM_DEFINE (scm_s64vector_ref, "s64vector-ref", 2, 0, 0, |
71ca65d9 MG |
1677 | (SCM uvec, SCM index), |
1678 | "Return the element at @var{index} in the homogeneous numeric\n" | |
1679 | "vector @var{uvec}.") | |
1680 | #define FUNC_NAME s_scm_s64vector_ref | |
1681 | { | |
1682 | int idx; | |
1683 | ||
1684 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1685 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S64) | |
1686 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1687 | ||
1688 | idx = scm_num2int (index, 2, FUNC_NAME); | |
1689 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
1690 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
1691 | ||
1692 | return scm_long_long2num (((int_s64 *) SCM_UVEC_BASE (uvec))[idx]); | |
1693 | } | |
1694 | #undef FUNC_NAME | |
1695 | ||
1696 | ||
645f5e0e | 1697 | SCM_DEFINE (scm_s64vector_set_x, "s64vector-set!", 3, 0, 0, |
71ca65d9 MG |
1698 | (SCM uvec, SCM index, SCM value), |
1699 | "Set the element at @var{index} in the homogeneous numeric\n" | |
1700 | "vector @var{uvec} to @var{value}. The return value is not\n" | |
1701 | "specified.") | |
1702 | #define FUNC_NAME s_scm_s64vector_ref | |
1703 | { | |
1704 | int idx; | |
1705 | int_s64 f; | |
1706 | ||
1707 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1708 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S64) | |
1709 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1710 | ||
1711 | idx = scm_num2int (index, 2, FUNC_NAME); | |
1712 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
1713 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
1714 | ||
1715 | f = scm_num2long_long (value, 3, FUNC_NAME); | |
1716 | ||
1717 | ((int_s64 *) SCM_UVEC_BASE (uvec))[idx] = f; | |
1718 | return SCM_UNSPECIFIED; | |
1719 | } | |
1720 | #undef FUNC_NAME | |
1721 | ||
1722 | ||
645f5e0e | 1723 | SCM_DEFINE (scm_s64vector_to_list, "s64vector->list", 1, 0, 0, |
71ca65d9 MG |
1724 | (SCM uvec), |
1725 | "Convert the homogeneous numeric vector @var{uvec} to a list.") | |
1726 | #define FUNC_NAME s_scm_s64vector_to_list | |
1727 | { | |
1728 | int idx; | |
1729 | int_s64 * p; | |
1730 | SCM res = SCM_EOL; | |
1731 | ||
1732 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1733 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_S64) | |
1734 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1735 | ||
1736 | idx = SCM_UVEC_LENGTH (uvec); | |
1737 | p = (int_s64 *) SCM_UVEC_BASE (uvec) + idx; | |
1738 | while (idx-- > 0) | |
1739 | { | |
1740 | p--; | |
1741 | res = scm_cons (scm_long_long2num (*p), res); | |
1742 | } | |
1743 | return res; | |
1744 | } | |
1745 | #undef FUNC_NAME | |
1746 | ||
1747 | ||
1748 | SCM_DEFINE (scm_list_to_s64vector, "list->s64vector", 1, 0, 0, | |
1749 | (SCM l), | |
1750 | "Convert the list @var{l}, which must only contain signed\n" | |
1751 | "64-bit values, to a numeric homogeneous vector.") | |
1752 | #define FUNC_NAME s_scm_list_to_s64vector | |
1753 | { | |
1754 | SCM uvec; | |
1755 | int_s64 * p; | |
1756 | int n; | |
1757 | int arg_pos = 1; | |
1758 | ||
1759 | SCM_VALIDATE_LIST_COPYLEN (1, l, n); | |
1760 | ||
1761 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_S64, n); | |
1762 | p = (int_s64 *) SCM_UVEC_BASE (uvec); | |
1763 | while (SCM_CONSP (l)) | |
1764 | { | |
1765 | int_s64 f; | |
1766 | f = scm_num2long_long (SCM_CAR (l), 2, FUNC_NAME); | |
1767 | *p++ = f; | |
1768 | l = SCM_CDR (l); | |
1769 | arg_pos++; | |
1770 | } | |
1771 | return uvec; | |
1772 | } | |
1773 | #undef FUNC_NAME | |
1774 | ||
1f537655 | 1775 | #endif /* HAVE_LONG_LONG */ |
71ca65d9 MG |
1776 | |
1777 | ||
1778 | /* ================================================================ */ | |
1779 | /* F32 procedures. */ | |
1780 | /* ================================================================ */ | |
1781 | ||
1782 | ||
645f5e0e | 1783 | SCM_DEFINE (scm_f32vector_p, "f32vector?", 1, 0, 0, |
71ca65d9 MG |
1784 | (SCM obj), |
1785 | "Return @code{#t} if @var{obj} is a vector of type f32,\n" | |
1786 | "@code{#f} otherwise.") | |
1787 | #define FUNC_NAME s_scm_f32vector_p | |
1788 | { | |
1789 | return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && | |
1790 | SCM_UVEC_TYPE (obj) == SCM_UVEC_F32); | |
1791 | } | |
1792 | #undef FUNC_NAME | |
1793 | ||
1794 | ||
645f5e0e | 1795 | SCM_DEFINE (scm_make_f32vector, "make-f32vector", 1, 1, 0, |
71ca65d9 MG |
1796 | (SCM n, SCM fill), |
1797 | "Create a newly allocated homogeneous numeric vector which can\n" | |
1798 | "hold @var{len} elements. If @var{fill} is given, it is used to\n" | |
1799 | "initialize the elements, otherwise the contents of the vector\n" | |
1800 | "is unspecified.") | |
1801 | #define FUNC_NAME s_scm_make_f32vector | |
1802 | { | |
1803 | SCM uvec; | |
1804 | float_f32 * p; | |
1805 | float_f32 f; | |
1806 | int count; | |
1807 | ||
1808 | SCM_VALIDATE_INUM (1, n); | |
1809 | count = SCM_INUM (n); | |
1810 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_F32, count); | |
1811 | if (SCM_UNBNDP (fill)) | |
1812 | f = 0; | |
1813 | else | |
1814 | { | |
1815 | double d = scm_num2dbl (fill, FUNC_NAME); | |
1816 | f = d; | |
1817 | #if 0 | |
1818 | /* This test somehow fails for even the simplest inexact | |
1819 | numbers, like 3.1. Must find out how to check properly. */ | |
1820 | if (f != d) | |
1821 | scm_out_of_range_pos (FUNC_NAME, fill, SCM_MAKINUM (2)); | |
1822 | #endif /* 0 */ | |
1823 | } | |
1824 | p = (float_f32 *) SCM_UVEC_BASE (uvec); | |
1825 | while (count-- > 0) | |
1826 | *p++ = f; | |
1827 | return uvec; | |
1828 | } | |
1829 | #undef FUNC_NAME | |
1830 | ||
1831 | ||
645f5e0e | 1832 | SCM_DEFINE (scm_f32vector, "f32vector", 0, 0, 1, |
71ca65d9 MG |
1833 | (SCM l), |
1834 | "Create a newly allocated homogeneous numeric vector containing\n" | |
1835 | "all argument values.") | |
1836 | #define FUNC_NAME s_scm_f32vector | |
1837 | { | |
1838 | SCM_VALIDATE_REST_ARGUMENT (l); | |
1839 | return scm_list_to_f32vector (l); | |
1840 | } | |
1841 | #undef FUNC_NAME | |
1842 | ||
1843 | ||
645f5e0e | 1844 | SCM_DEFINE (scm_f32vector_length, "f32vector-length", 1, 0, 0, |
71ca65d9 MG |
1845 | (SCM uvec), |
1846 | "Return the number of elements in the homogeneous numeric vector\n" | |
1847 | "@var{uvec}.") | |
1848 | #define FUNC_NAME s_scm_f32vector_length | |
1849 | { | |
1850 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1851 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_F32) | |
1852 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1853 | return scm_int2num (SCM_UVEC_LENGTH (uvec)); | |
1854 | } | |
1855 | #undef FUNC_NAME | |
1856 | ||
1857 | ||
645f5e0e | 1858 | SCM_DEFINE (scm_f32vector_ref, "f32vector-ref", 2, 0, 0, |
71ca65d9 MG |
1859 | (SCM uvec, SCM index), |
1860 | "Return the element at @var{index} in the homogeneous numeric\n" | |
1861 | "vector @var{uvec}.") | |
1862 | #define FUNC_NAME s_scm_f32vector_ref | |
1863 | { | |
1864 | int idx; | |
1865 | ||
1866 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1867 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_F32) | |
1868 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1869 | ||
1870 | idx = scm_num2int (index, 2, FUNC_NAME); | |
1871 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
1872 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
1873 | ||
1874 | return scm_make_real (((float_f32 *) SCM_UVEC_BASE (uvec))[idx]); | |
1875 | } | |
1876 | #undef FUNC_NAME | |
1877 | ||
1878 | ||
645f5e0e | 1879 | SCM_DEFINE (scm_f32vector_set_x, "f32vector-set!", 3, 0, 0, |
71ca65d9 MG |
1880 | (SCM uvec, SCM index, SCM value), |
1881 | "Set the element at @var{index} in the homogeneous numeric\n" | |
1882 | "vector @var{uvec} to @var{value}. The return value is not\n" | |
1883 | "specified.") | |
1884 | #define FUNC_NAME s_scm_f32vector_ref | |
1885 | { | |
1886 | int idx; | |
1887 | float_f32 f; | |
1888 | double d; | |
1889 | ||
1890 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1891 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_F32) | |
1892 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1893 | ||
1894 | idx = scm_num2int (index, 2, FUNC_NAME); | |
1895 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
1896 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
1897 | ||
1898 | d = scm_num2dbl (value, FUNC_NAME); | |
1899 | f = d; | |
1900 | #if 0 | |
1901 | /* This test somehow fails for even the simplest inexact | |
1902 | numbers, like 3.1. Must find out how to check properly. */ | |
1903 | if (f != d) | |
1904 | scm_out_of_range_pos (FUNC_NAME, value, SCM_MAKINUM (3)); | |
1905 | #endif /* 0 */ | |
1906 | ||
1907 | ((float_f32 *) SCM_UVEC_BASE (uvec))[idx] = f; | |
1908 | return SCM_UNSPECIFIED; | |
1909 | } | |
1910 | #undef FUNC_NAME | |
1911 | ||
1912 | ||
645f5e0e | 1913 | SCM_DEFINE (scm_f32vector_to_list, "f32vector->list", 1, 0, 0, |
71ca65d9 MG |
1914 | (SCM uvec), |
1915 | "Convert the homogeneous numeric vector @var{uvec} to a list.") | |
1916 | #define FUNC_NAME s_scm_f32vector_to_list | |
1917 | { | |
1918 | int idx; | |
1919 | float_f32 * p; | |
1920 | SCM res = SCM_EOL; | |
1921 | ||
1922 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
1923 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_F32) | |
1924 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
1925 | ||
1926 | idx = SCM_UVEC_LENGTH (uvec); | |
1927 | p = (float_f32 *) SCM_UVEC_BASE (uvec) + idx; | |
1928 | while (idx-- > 0) | |
1929 | { | |
1930 | p--; | |
1931 | res = scm_cons (scm_make_real (*p), res); | |
1932 | } | |
1933 | return res; | |
1934 | } | |
1935 | #undef FUNC_NAME | |
1936 | ||
1937 | ||
1938 | SCM_DEFINE (scm_list_to_f32vector, "list->f32vector", 1, 0, 0, | |
1939 | (SCM l), | |
1940 | "Convert the list @var{l}, which must only contain unsigned\n" | |
1941 | "8-bit values, to a numeric homogeneous vector.") | |
1942 | #define FUNC_NAME s_scm_list_to_f32vector | |
1943 | { | |
1944 | SCM uvec; | |
1945 | float_f32 * p; | |
1946 | int n; | |
1947 | int arg_pos = 1; | |
1948 | ||
1949 | SCM_VALIDATE_LIST_COPYLEN (1, l, n); | |
1950 | ||
1951 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_F32, n); | |
1952 | p = (float_f32 *) SCM_UVEC_BASE (uvec); | |
1953 | while (SCM_CONSP (l)) | |
1954 | { | |
1955 | float_f32 f; | |
1956 | double d; | |
1957 | d = scm_num2dbl (SCM_CAR (l), FUNC_NAME); | |
1958 | f = d; | |
1959 | #if 0 | |
1960 | /* This test somehow fails for even the simplest inexact | |
1961 | numbers, like 3.1. Must find out how to check properly. */ | |
1962 | if (d != f) | |
1963 | scm_out_of_range_pos (FUNC_NAME, l, SCM_MAKINUM (1)); | |
1964 | #endif /* 0 */ | |
1965 | *p++ = f; | |
1966 | l = SCM_CDR (l); | |
1967 | arg_pos++; | |
1968 | } | |
1969 | return uvec; | |
1970 | } | |
1971 | #undef FUNC_NAME | |
1972 | ||
1973 | ||
1974 | /* ================================================================ */ | |
1975 | /* F64 procedures. */ | |
1976 | /* ================================================================ */ | |
1977 | ||
1978 | ||
645f5e0e | 1979 | SCM_DEFINE (scm_f64vector_p, "f64vector?", 1, 0, 0, |
71ca65d9 MG |
1980 | (SCM obj), |
1981 | "Return @code{#t} if @var{obj} is a vector of type f64,\n" | |
1982 | "@code{#f} otherwise.") | |
1983 | #define FUNC_NAME s_scm_f64vector_p | |
1984 | { | |
1985 | return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj) && | |
1986 | SCM_UVEC_TYPE (obj) == SCM_UVEC_F64); | |
1987 | } | |
1988 | #undef FUNC_NAME | |
1989 | ||
1990 | ||
645f5e0e | 1991 | SCM_DEFINE (scm_make_f64vector, "make-f64vector", 1, 1, 0, |
71ca65d9 MG |
1992 | (SCM n, SCM fill), |
1993 | "Create a newly allocated homogeneous numeric vector which can\n" | |
1994 | "hold @var{len} elements. If @var{fill} is given, it is used to\n" | |
1995 | "initialize the elements, otherwise the contents of the vector\n" | |
1996 | "is unspecified.") | |
1997 | #define FUNC_NAME s_scm_make_f64vector | |
1998 | { | |
1999 | SCM uvec; | |
2000 | float_f64 * p; | |
2001 | float_f64 f; | |
2002 | int count; | |
2003 | ||
2004 | SCM_VALIDATE_INUM (1, n); | |
2005 | count = SCM_INUM (n); | |
2006 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_F64, count); | |
2007 | if (SCM_UNBNDP (fill)) | |
2008 | f = 0; | |
2009 | else | |
2010 | f = scm_num2dbl (fill, FUNC_NAME); | |
2011 | p = (float_f64 *) SCM_UVEC_BASE (uvec); | |
2012 | while (count-- > 0) | |
2013 | *p++ = f; | |
2014 | return uvec; | |
2015 | } | |
2016 | #undef FUNC_NAME | |
2017 | ||
2018 | ||
645f5e0e | 2019 | SCM_DEFINE (scm_f64vector, "f64vector", 0, 0, 1, |
71ca65d9 MG |
2020 | (SCM l), |
2021 | "Create a newly allocated homogeneous numeric vector containing\n" | |
2022 | "all argument values.") | |
2023 | #define FUNC_NAME s_scm_f64vector | |
2024 | { | |
2025 | SCM_VALIDATE_REST_ARGUMENT (l); | |
2026 | return scm_list_to_f64vector (l); | |
2027 | } | |
2028 | #undef FUNC_NAME | |
2029 | ||
2030 | ||
645f5e0e | 2031 | SCM_DEFINE (scm_f64vector_length, "f64vector-length", 1, 0, 0, |
71ca65d9 MG |
2032 | (SCM uvec), |
2033 | "Return the number of elements in the homogeneous numeric vector\n" | |
2034 | "@var{uvec}.") | |
2035 | #define FUNC_NAME s_scm_f64vector_length | |
2036 | { | |
2037 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
2038 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_F64) | |
2039 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
2040 | return scm_int2num (SCM_UVEC_LENGTH (uvec)); | |
2041 | } | |
2042 | #undef FUNC_NAME | |
2043 | ||
2044 | ||
645f5e0e | 2045 | SCM_DEFINE (scm_f64vector_ref, "f64vector-ref", 2, 0, 0, |
71ca65d9 MG |
2046 | (SCM uvec, SCM index), |
2047 | "Return the element at @var{index} in the homogeneous numeric\n" | |
2048 | "vector @var{uvec}.") | |
2049 | #define FUNC_NAME s_scm_f64vector_ref | |
2050 | { | |
2051 | int idx; | |
2052 | ||
2053 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
2054 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_F64) | |
2055 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
2056 | ||
2057 | idx = scm_num2int (index, 2, FUNC_NAME); | |
2058 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
2059 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
2060 | ||
2061 | return scm_make_real (((float_f64 *) SCM_UVEC_BASE (uvec))[idx]); | |
2062 | } | |
2063 | #undef FUNC_NAME | |
2064 | ||
2065 | ||
645f5e0e | 2066 | SCM_DEFINE (scm_f64vector_set_x, "f64vector-set!", 3, 0, 0, |
71ca65d9 MG |
2067 | (SCM uvec, SCM index, SCM value), |
2068 | "Set the element at @var{index} in the homogeneous numeric\n" | |
2069 | "vector @var{uvec} to @var{value}. The return value is not\n" | |
2070 | "specified.") | |
2071 | #define FUNC_NAME s_scm_f64vector_ref | |
2072 | { | |
2073 | int idx; | |
2074 | float_f64 f; | |
2075 | ||
2076 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
2077 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_F64) | |
2078 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
2079 | ||
2080 | idx = scm_num2int (index, 2, FUNC_NAME); | |
2081 | if (idx < 0 || idx >= SCM_UVEC_LENGTH (uvec)) | |
2082 | scm_out_of_range_pos (FUNC_NAME, index, SCM_MAKINUM (2)); | |
2083 | ||
2084 | f = scm_num2dbl (value, FUNC_NAME); | |
2085 | ||
2086 | ((float_f64 *) SCM_UVEC_BASE (uvec))[idx] = f; | |
2087 | return SCM_UNSPECIFIED; | |
2088 | } | |
2089 | #undef FUNC_NAME | |
2090 | ||
2091 | ||
645f5e0e | 2092 | SCM_DEFINE (scm_f64vector_to_list, "f64vector->list", 1, 0, 0, |
71ca65d9 MG |
2093 | (SCM uvec), |
2094 | "Convert the homogeneous numeric vector @var{uvec} to a list.") | |
2095 | #define FUNC_NAME s_scm_f64vector_to_list | |
2096 | { | |
2097 | int idx; | |
2098 | float_f64 * p; | |
2099 | SCM res = SCM_EOL; | |
2100 | ||
2101 | SCM_VALIDATE_SMOB (1, uvec, uvec); | |
2102 | if (SCM_UVEC_TYPE (uvec) != SCM_UVEC_F64) | |
2103 | scm_wrong_type_arg (FUNC_NAME, 1, uvec); | |
2104 | ||
2105 | idx = SCM_UVEC_LENGTH (uvec); | |
2106 | p = (float_f64 *) SCM_UVEC_BASE (uvec) + idx; | |
2107 | while (idx-- > 0) | |
2108 | { | |
2109 | p--; | |
2110 | res = scm_cons (scm_make_real (*p), res); | |
2111 | } | |
2112 | return res; | |
2113 | } | |
2114 | #undef FUNC_NAME | |
2115 | ||
2116 | ||
2117 | SCM_DEFINE (scm_list_to_f64vector, "list->f64vector", 1, 0, 0, | |
2118 | (SCM l), | |
2119 | "Convert the list @var{l}, which must only contain signed\n" | |
2120 | "8-bit values, to a numeric homogeneous vector.") | |
2121 | #define FUNC_NAME s_scm_list_to_f64vector | |
2122 | { | |
2123 | SCM uvec; | |
2124 | float_f64 * p; | |
2125 | int n; | |
2126 | int arg_pos = 1; | |
2127 | ||
2128 | SCM_VALIDATE_LIST_COPYLEN (1, l, n); | |
2129 | ||
2130 | uvec = make_uvec (FUNC_NAME, SCM_UVEC_F64, n); | |
2131 | p = (float_f64 *) SCM_UVEC_BASE (uvec); | |
2132 | while (SCM_CONSP (l)) | |
2133 | { | |
2134 | float_f64 f = scm_num2dbl (SCM_CAR (l), FUNC_NAME); | |
2135 | *p++ = f; | |
2136 | l = SCM_CDR (l); | |
2137 | arg_pos++; | |
2138 | } | |
2139 | return uvec; | |
2140 | } | |
2141 | #undef FUNC_NAME | |
2142 | ||
2143 | ||
2c4df451 MG |
2144 | /* Create the smob type for homogeneous numeric vectors and install |
2145 | the primitives. */ | |
71ca65d9 MG |
2146 | void |
2147 | scm_init_srfi_4 (void) | |
2148 | { | |
2149 | scm_tc16_uvec = scm_make_smob_type ("uvec", 0); | |
2150 | scm_set_smob_free (scm_tc16_uvec, uvec_free); | |
2151 | scm_set_smob_print (scm_tc16_uvec, uvec_print); | |
71ca65d9 | 2152 | #include "srfi/srfi-4.x" |
71ca65d9 | 2153 | } |
2c4df451 MG |
2154 | |
2155 | /* End of srfi-4.c. */ |