HCoop / bpt / guile.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(ice9_sources): Add gap-buffer.scm.
[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 *
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. */
53typedef unsigned char int_u8;
54typedef signed char int_s8;
55typedef unsigned short int_u16;
56typedef signed short int_s16;
57typedef unsigned int int_u32;
58typedef signed int int_s32;
1f537655 59#ifdef HAVE_LONG_LONG
71ca65d9
MG		 60#if SIZEOF_LONG == 8
61typedef unsigned long int_u64;
62typedef signed long int_s64;
63#else
64typedef unsigned long long int_u64;
65typedef signed long long int_s64;
66#endif /* SIZEOF_LONG */
1f537655 67#endif /* HAVE_LONG_LONG */
71ca65d9
MG		 68typedef float float_f32;
69typedef double float_f64;
70
2c4df451 71
71ca65d9
MG		 72/* Smob type code for homogeneous numeric vectors. */
73int 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. */
102static 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. */
111static int
112uvec_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. */
346static size_t
347uvec_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. */
363static SCM
364make_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 378SCM_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 390SCM_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 423SCM_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 435SCM_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 449SCM_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 470SCM_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 500SCM_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
525SCM_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 564SCM_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 576SCM_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 609SCM_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 621SCM_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 635SCM_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 656SCM_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 686SCM_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
711SCM_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 752SCM_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 764SCM_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 792SCM_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 804SCM_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 818SCM_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 839SCM_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 865SCM_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
890SCM_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 922SCM_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 934SCM_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 962SCM_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 974SCM_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 988SCM_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 1009SCM_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 1035SCM_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
1060SCM_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 1095SCM_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 1107SCM_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 1135SCM_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 1147SCM_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 1161SCM_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 1182SCM_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 1208SCM_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
1233SCM_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 1266SCM_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 1278SCM_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 1306SCM_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 1318SCM_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 1332SCM_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 1353SCM_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 1379SCM_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
1404SCM_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 1439SCM_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 1451SCM_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 1479SCM_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 1491SCM_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 1505SCM_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 1526SCM_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 1552SCM_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
1577SCM_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 1610SCM_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 1622SCM_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 1650SCM_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 1662SCM_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 1676SCM_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 1697SCM_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 1723SCM_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
1748SCM_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 1783SCM_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 1795SCM_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 1832SCM_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 1844SCM_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 1858SCM_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 1879SCM_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 1913SCM_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
1938SCM_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 1979SCM_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 1991SCM_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 2019SCM_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 2031SCM_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 2045SCM_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 2066SCM_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 2092SCM_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
2117SCM_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		 2146void
2147scm_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. */
Unnamed repository; edit this file 'description' to name the repository.