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