1 /* srfi-4.c --- Homogeneous numeric vector datatypes.
3 * Copyright (C) 2001 Free Software Foundation, Inc.
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.
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.
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
20 * As a special exception, the Free Software Foundation gives
21 * permission for additional uses of the text contained in its release
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.
30 * This exception does not however invalidate any other reasons why
31 * the executable file might be covered by the GNU General Public
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.
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. */
51 /* For brevity and maintainability, we define our own types for the
52 various integer and floating point types. */
53 typedef unsigned char int_u8
;
54 typedef signed char int_s8
;
55 typedef unsigned short int_u16
;
56 typedef signed short int_s16
;
57 typedef unsigned int int_u32
;
58 typedef signed int int_s32
;
61 typedef unsigned long int_u64
;
62 typedef signed long int_s64
;
64 typedef unsigned long long int_u64
;
65 typedef signed long long int_s64
;
66 #endif /* SIZEOF_LONG */
67 #endif /* HAVE_LONG_LONGS */
68 typedef float float_f32
;
69 typedef double float_f64
;
72 /* Smob type code for homogeneous numeric vectors. */
73 int scm_tc16_uvec
= 0;
76 /* Accessor macros for the three components of a homogeneous numeric
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
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))
87 /* Symbolic constants encoding the various types of homogeneous
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
101 /* This array maps type tags to the size of the elements. */
102 static int uvec_sizes
[10] = {1, 1, 2, 2, 4, 4, 8, 8, 4, 8};
105 /* ================================================================ */
106 /* SMOB procedures. */
107 /* ================================================================ */
110 /* Smob print hook for homogeneous vectors. */
112 uvec_print (SCM uvec
, SCM port
, scm_print_state
*pstate SCM_UNUSED
)
114 switch (SCM_UVEC_TYPE (uvec
))
118 int_u8
* p
= (int_u8
*) SCM_UVEC_BASE (uvec
);
121 scm_puts ("#u8(", port
);
122 if (SCM_UVEC_LENGTH (uvec
) > 0)
124 scm_intprint (*p
, 10, port
);
127 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
129 scm_puts (" ", port
);
130 scm_intprint (*p
, 10, port
);
134 scm_puts (")", port
);
140 int_s8
* p
= (int_s8
*) SCM_UVEC_BASE (uvec
);
143 scm_puts ("#s8(", port
);
144 if (SCM_UVEC_LENGTH (uvec
) > 0)
146 scm_intprint (*p
, 10, port
);
149 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
151 scm_puts (" ", port
);
152 scm_intprint (*p
, 10, port
);
156 scm_puts (")", port
);
162 int_u16
* p
= (int_u16
*) SCM_UVEC_BASE (uvec
);
165 scm_puts ("#u16(", port
);
166 if (SCM_UVEC_LENGTH (uvec
) > 0)
168 scm_intprint (*p
, 10, port
);
171 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
173 scm_puts (" ", port
);
174 scm_intprint (*p
, 10, port
);
178 scm_puts (")", port
);
184 int_s16
* p
= (int_s16
*) SCM_UVEC_BASE (uvec
);
187 scm_puts ("#s16(", port
);
188 if (SCM_UVEC_LENGTH (uvec
) > 0)
190 scm_intprint (*p
, 10, port
);
193 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
195 scm_puts (" ", port
);
196 scm_intprint (*p
, 10, port
);
200 scm_puts (")", port
);
206 int_u32
* p
= (int_u32
*) SCM_UVEC_BASE (uvec
);
209 scm_puts ("#u32(", port
);
210 if (SCM_UVEC_LENGTH (uvec
) > 0)
212 scm_intprint (*p
, 10, port
);
215 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
217 scm_puts (" ", port
);
218 scm_intprint (*p
, 10, port
);
222 scm_puts (")", port
);
228 int_s32
* p
= (int_s32
*) SCM_UVEC_BASE (uvec
);
231 scm_puts ("#s32(", port
);
232 if (SCM_UVEC_LENGTH (uvec
) > 0)
234 scm_intprint (*p
, 10, port
);
237 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
239 scm_puts (" ", port
);
240 scm_intprint (*p
, 10, port
);
244 scm_puts (")", port
);
251 int_u64
* p
= (int_u64
*) SCM_UVEC_BASE (uvec
);
254 scm_puts ("#u64(", port
);
255 if (SCM_UVEC_LENGTH (uvec
) > 0)
257 scm_intprint (*p
, 10, port
);
260 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
262 scm_puts (" ", port
);
263 scm_intprint (*p
, 10, port
);
267 scm_puts (")", port
);
273 int_s64
* p
= (int_s64
*) SCM_UVEC_BASE (uvec
);
276 scm_puts ("#s64(", port
);
277 if (SCM_UVEC_LENGTH (uvec
) > 0)
279 scm_intprint (*p
, 10, port
);
282 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
284 scm_puts (" ", port
);
285 scm_intprint (*p
, 10, port
);
289 scm_puts (")", port
);
296 float_f32
* p
= (float_f32
*) SCM_UVEC_BASE (uvec
);
299 scm_puts ("#f32(", port
);
300 if (SCM_UVEC_LENGTH (uvec
) > 0)
302 scm_iprin1 (scm_make_real (*p
), port
, pstate
);
305 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
307 scm_puts (" ", port
);
308 scm_iprin1 (scm_make_real (*p
), port
, pstate
);
312 scm_puts (")", port
);
318 float_f64
* p
= (float_f64
*) SCM_UVEC_BASE (uvec
);
321 scm_puts ("#f64(", port
);
322 if (SCM_UVEC_LENGTH (uvec
) > 0)
324 scm_iprin1 (scm_make_real (*p
), port
, pstate
);
327 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
329 scm_puts (" ", port
);
330 scm_iprin1 (scm_make_real (*p
), port
, pstate
);
334 scm_puts (")", port
);
339 abort (); /* Sanity check. */
345 /* Smob free hook for homogeneous numeric vectors. */
349 scm_must_free (SCM_UVEC_BASE (uvec
));
350 return SCM_UVEC_LENGTH (uvec
) * uvec_sizes
[SCM_UVEC_TYPE (uvec
)];
354 /* ================================================================ */
355 /* Utility procedures. */
356 /* ================================================================ */
359 /* Create a new, uninitialized homogeneous numeric vector of type TYPE
360 with space for LEN elements. */
362 make_uvec (const char * func_name
, int type
, int len
)
366 p
= scm_must_malloc (len
* uvec_sizes
[type
], func_name
);
367 SCM_RETURN_NEWSMOB3 (scm_tc16_uvec
, type
, len
, p
);
371 /* ================================================================ */
373 /* ================================================================ */
376 SCM_DEFINE (scm_u8vector_p
, "u8vector?", 1, 0, 0,
378 "Return @code{#t} if @var{obj} is a vector of type u8,\n"
379 "@code{#f} otherwise.")
380 #define FUNC_NAME s_scm_u8vector_p
382 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
383 SCM_UVEC_TYPE (obj
) == SCM_UVEC_U8
);
388 SCM_DEFINE (scm_make_u8vector
, "make-u8vector", 1, 1, 0,
390 "Create a newly allocated homogeneous numeric vector which can\n"
391 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
392 "initialize the elements, otherwise the contents of the vector\n"
394 #define FUNC_NAME s_scm_make_u8vector
401 SCM_VALIDATE_INUM (1, n
);
402 count
= SCM_INUM (n
);
403 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U8
, count
);
404 if (SCM_UNBNDP (fill
))
408 unsigned int s
= scm_num2uint (fill
, 2, FUNC_NAME
);
410 if ((unsigned int) f
!= s
)
411 scm_out_of_range_pos (FUNC_NAME
, fill
, SCM_MAKINUM (2));
413 p
= (int_u8
*) SCM_UVEC_BASE (uvec
);
421 SCM_DEFINE (scm_u8vector
, "u8vector", 0, 0, 1,
423 "Create a newly allocated homogeneous numeric vector containing\n"
424 "all argument values.")
425 #define FUNC_NAME s_scm_u8vector
427 SCM_VALIDATE_REST_ARGUMENT (l
);
428 return scm_list_to_u8vector (l
);
433 SCM_DEFINE (scm_u8vector_length
, "u8vector-length", 1, 0, 0,
435 "Return the number of elements in the homogeneous numeric vector\n"
437 #define FUNC_NAME s_scm_u8vector_length
439 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
440 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U8
)
441 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
442 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
447 SCM_DEFINE (scm_u8vector_ref
, "u8vector-ref", 2, 0, 0,
448 (SCM uvec
, SCM index
),
449 "Return the element at @var{index} in the homogeneous numeric\n"
450 "vector @var{uvec}.")
451 #define FUNC_NAME s_scm_u8vector_ref
455 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
456 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U8
)
457 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
459 idx
= scm_num2int (index
, 2, FUNC_NAME
);
460 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
461 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
463 return scm_short2num (((int_u8
*) SCM_UVEC_BASE (uvec
))[idx
]);
468 SCM_DEFINE (scm_u8vector_set_x
, "u8vector-set!", 3, 0, 0,
469 (SCM uvec
, SCM index
, SCM value
),
470 "Set the element at @var{index} in the homogeneous numeric\n"
471 "vector @var{uvec} to @var{value}. The return value is not\n"
473 #define FUNC_NAME s_scm_u8vector_ref
479 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
480 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U8
)
481 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
483 idx
= scm_num2int (index
, 2, FUNC_NAME
);
484 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
485 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
487 s
= scm_num2uint (value
, 3, FUNC_NAME
);
489 if ((unsigned int) f
!= s
)
490 scm_out_of_range_pos (FUNC_NAME
, value
, SCM_MAKINUM (3));
492 ((int_u8
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
493 return SCM_UNSPECIFIED
;
498 SCM_DEFINE (scm_u8vector_to_list
, "u8vector->list", 1, 0, 0,
500 "Convert the homogeneous numeric vector @var{uvec} to a list.")
501 #define FUNC_NAME s_scm_u8vector_to_list
507 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
508 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U8
)
509 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
511 idx
= SCM_UVEC_LENGTH (uvec
);
512 p
= (int_u8
*) SCM_UVEC_BASE (uvec
) + idx
;
516 res
= scm_cons (SCM_MAKINUM (*p
), res
);
523 SCM_DEFINE (scm_list_to_u8vector
, "list->u8vector", 1, 0, 0,
525 "Convert the list @var{l}, which must only contain unsigned\n"
526 "8-bit values, to a numeric homogeneous vector.")
527 #define FUNC_NAME s_scm_list_to_u8vector
535 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
537 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U8
, n
);
538 p
= (int_u8
*) SCM_UVEC_BASE (uvec
);
540 while (SCM_CONSP (tmp
))
543 unsigned int s
= scm_num2uint (SCM_CAR (tmp
), 2, FUNC_NAME
);
545 if ((unsigned int) f
!= s
)
546 scm_out_of_range (FUNC_NAME
, SCM_CAR (tmp
));
551 scm_remember_upto_here_1 (l
);
557 /* ================================================================ */
559 /* ================================================================ */
562 SCM_DEFINE (scm_s8vector_p
, "s8vector?", 1, 0, 0,
564 "Return @code{#t} if @var{obj} is a vector of type s8,\n"
565 "@code{#f} otherwise.")
566 #define FUNC_NAME s_scm_s8vector_p
568 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
569 SCM_UVEC_TYPE (obj
) == SCM_UVEC_S8
);
574 SCM_DEFINE (scm_make_s8vector
, "make-s8vector", 1, 1, 0,
576 "Create a newly allocated homogeneous numeric vector which can\n"
577 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
578 "initialize the elements, otherwise the contents of the vector\n"
580 #define FUNC_NAME s_scm_make_s8vector
587 SCM_VALIDATE_INUM (1, n
);
588 count
= SCM_INUM (n
);
589 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S8
, count
);
590 if (SCM_UNBNDP (fill
))
594 signed int s
= scm_num2int (fill
, 2, FUNC_NAME
);
596 if ((signed int) f
!= s
)
597 scm_out_of_range_pos (FUNC_NAME
, fill
, SCM_MAKINUM (2));
599 p
= (int_s8
*) SCM_UVEC_BASE (uvec
);
607 SCM_DEFINE (scm_s8vector
, "s8vector", 0, 0, 1,
609 "Create a newly allocated homogeneous numeric vector containing\n"
610 "all argument values.")
611 #define FUNC_NAME s_scm_s8vector
613 SCM_VALIDATE_REST_ARGUMENT (l
);
614 return scm_list_to_s8vector (l
);
619 SCM_DEFINE (scm_s8vector_length
, "s8vector-length", 1, 0, 0,
621 "Return the number of elements in the homogeneous numeric vector\n"
623 #define FUNC_NAME s_scm_s8vector_length
625 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
626 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S8
)
627 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
628 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
633 SCM_DEFINE (scm_s8vector_ref
, "s8vector-ref", 2, 0, 0,
634 (SCM uvec
, SCM index
),
635 "Return the element at @var{index} in the homogeneous numeric\n"
636 "vector @var{uvec}.")
637 #define FUNC_NAME s_scm_s8vector_ref
641 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
642 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S8
)
643 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
645 idx
= scm_num2int (index
, 2, FUNC_NAME
);
646 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
647 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
649 return scm_short2num (((int_s8
*) SCM_UVEC_BASE (uvec
))[idx
]);
654 SCM_DEFINE (scm_s8vector_set_x
, "s8vector-set!", 3, 0, 0,
655 (SCM uvec
, SCM index
, SCM value
),
656 "Set the element at @var{index} in the homogeneous numeric\n"
657 "vector @var{uvec} to @var{value}. The return value is not\n"
659 #define FUNC_NAME s_scm_s8vector_ref
665 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
666 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S8
)
667 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
669 idx
= scm_num2int (index
, 2, FUNC_NAME
);
670 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
671 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
673 s
= scm_num2int (value
, 3, FUNC_NAME
);
675 if ((signed int) f
!= s
)
676 scm_out_of_range_pos (FUNC_NAME
, value
, SCM_MAKINUM (3));
678 ((int_s8
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
679 return SCM_UNSPECIFIED
;
684 SCM_DEFINE (scm_s8vector_to_list
, "s8vector->list", 1, 0, 0,
686 "Convert the homogeneous numeric vector @var{uvec} to a list.")
687 #define FUNC_NAME s_scm_s8vector_to_list
693 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
694 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S8
)
695 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
697 idx
= SCM_UVEC_LENGTH (uvec
);
698 p
= (int_s8
*) SCM_UVEC_BASE (uvec
) + idx
;
702 res
= scm_cons (SCM_MAKINUM (*p
), res
);
709 SCM_DEFINE (scm_list_to_s8vector
, "list->s8vector", 1, 0, 0,
711 "Convert the list @var{l}, which must only contain signed\n"
712 "8-bit values, to a numeric homogeneous vector.")
713 #define FUNC_NAME s_scm_list_to_s8vector
721 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
723 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S8
, n
);
724 p
= (int_s8
*) SCM_UVEC_BASE (uvec
);
726 while (SCM_CONSP (tmp
))
731 s
= scm_num2int (SCM_CAR (tmp
), 2, FUNC_NAME
);
733 if ((signed int) f
!= s
)
734 scm_out_of_range (FUNC_NAME
, SCM_CAR (tmp
));
739 scm_remember_upto_here_1 (l
);
745 /* ================================================================ */
746 /* U16 procedures. */
747 /* ================================================================ */
750 SCM_DEFINE (scm_u16vector_p
, "u16vector?", 1, 0, 0,
752 "Return @code{#t} if @var{obj} is a vector of type u16,\n"
753 "@code{#f} otherwise.")
754 #define FUNC_NAME s_scm_u16vector_p
756 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
757 SCM_UVEC_TYPE (obj
) == SCM_UVEC_U16
);
762 SCM_DEFINE (scm_make_u16vector
, "make-u16vector", 1, 1, 0,
764 "Create a newly allocated homogeneous numeric vector which can\n"
765 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
766 "initialize the elements, otherwise the contents of the vector\n"
768 #define FUNC_NAME s_scm_make_u16vector
775 SCM_VALIDATE_INUM (1, n
);
776 count
= SCM_INUM (n
);
777 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U16
, count
);
778 if (SCM_UNBNDP (fill
))
781 f
= scm_num2ushort (fill
, 2, FUNC_NAME
);
782 p
= (int_u16
*) SCM_UVEC_BASE (uvec
);
790 SCM_DEFINE (scm_u16vector
, "u16vector", 0, 0, 1,
792 "Create a newly allocated homogeneous numeric vector containing\n"
793 "all argument values.")
794 #define FUNC_NAME s_scm_u16vector
796 SCM_VALIDATE_REST_ARGUMENT (l
);
797 return scm_list_to_u16vector (l
);
802 SCM_DEFINE (scm_u16vector_length
, "u16vector-length", 1, 0, 0,
804 "Return the number of elements in the homogeneous numeric vector\n"
806 #define FUNC_NAME s_scm_u16vector_length
808 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
809 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U16
)
810 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
811 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
816 SCM_DEFINE (scm_u16vector_ref
, "u16vector-ref", 2, 0, 0,
817 (SCM uvec
, SCM index
),
818 "Return the element at @var{index} in the homogeneous numeric\n"
819 "vector @var{uvec}.")
820 #define FUNC_NAME s_scm_u16vector_ref
824 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
825 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U16
)
826 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
828 idx
= scm_num2int (index
, 2, FUNC_NAME
);
829 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
830 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
832 return scm_ushort2num (((int_u16
*) SCM_UVEC_BASE (uvec
))[idx
]);
837 SCM_DEFINE (scm_u16vector_set_x
, "u16vector-set!", 3, 0, 0,
838 (SCM uvec
, SCM index
, SCM value
),
839 "Set the element at @var{index} in the homogeneous numeric\n"
840 "vector @var{uvec} to @var{value}. The return value is not\n"
842 #define FUNC_NAME s_scm_u16vector_ref
847 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
848 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U16
)
849 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
851 idx
= scm_num2int (index
, 2, FUNC_NAME
);
852 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
853 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
855 f
= scm_num2ushort (value
, 3, FUNC_NAME
);
857 ((int_u16
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
858 return SCM_UNSPECIFIED
;
863 SCM_DEFINE (scm_u16vector_to_list
, "u16vector->list", 1, 0, 0,
865 "Convert the homogeneous numeric vector @var{uvec} to a list.")
866 #define FUNC_NAME s_scm_u16vector_to_list
872 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
873 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U16
)
874 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
876 idx
= SCM_UVEC_LENGTH (uvec
);
877 p
= (int_u16
*) SCM_UVEC_BASE (uvec
) + idx
;
881 res
= scm_cons (SCM_MAKINUM (*p
), res
);
888 SCM_DEFINE (scm_list_to_u16vector
, "list->u16vector", 1, 0, 0,
890 "Convert the list @var{l}, which must only contain unsigned\n"
891 "16-bit values, to a numeric homogeneous vector.")
892 #define FUNC_NAME s_scm_list_to_u16vector
899 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
901 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U16
, n
);
902 p
= (int_u16
*) SCM_UVEC_BASE (uvec
);
903 while (SCM_CONSP (l
))
905 int_u16 f
= scm_num2ushort (SCM_CAR (l
), 2, FUNC_NAME
);
915 /* ================================================================ */
916 /* S16 procedures. */
917 /* ================================================================ */
920 SCM_DEFINE (scm_s16vector_p
, "s16vector?", 1, 0, 0,
922 "Return @code{#t} if @var{obj} is a vector of type s16,\n"
923 "@code{#f} otherwise.")
924 #define FUNC_NAME s_scm_s16vector_p
926 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
927 SCM_UVEC_TYPE (obj
) == SCM_UVEC_S16
);
932 SCM_DEFINE (scm_make_s16vector
, "make-s16vector", 1, 1, 0,
934 "Create a newly allocated homogeneous numeric vector which can\n"
935 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
936 "initialize the elements, otherwise the contents of the vector\n"
938 #define FUNC_NAME s_scm_make_s16vector
945 SCM_VALIDATE_INUM (1, n
);
946 count
= SCM_INUM (n
);
947 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S16
, count
);
948 if (SCM_UNBNDP (fill
))
951 f
= scm_num2short (fill
, 2, FUNC_NAME
);
952 p
= (int_s16
*) SCM_UVEC_BASE (uvec
);
960 SCM_DEFINE (scm_s16vector
, "s16vector", 0, 0, 1,
962 "Create a newly allocated homogeneous numeric vector containing\n"
963 "all argument values.")
964 #define FUNC_NAME s_scm_s16vector
966 SCM_VALIDATE_REST_ARGUMENT (l
);
967 return scm_list_to_s16vector (l
);
972 SCM_DEFINE (scm_s16vector_length
, "s16vector-length", 1, 0, 0,
974 "Return the number of elements in the homogeneous numeric vector\n"
976 #define FUNC_NAME s_scm_s16vector_length
978 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
979 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S16
)
980 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
981 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
986 SCM_DEFINE (scm_s16vector_ref
, "s16vector-ref", 2, 0, 0,
987 (SCM uvec
, SCM index
),
988 "Return the element at @var{index} in the homogeneous numeric\n"
989 "vector @var{uvec}.")
990 #define FUNC_NAME s_scm_s16vector_ref
994 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
995 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S16
)
996 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
998 idx
= scm_num2int (index
, 2, FUNC_NAME
);
999 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1000 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1002 return scm_short2num (((int_s16
*) SCM_UVEC_BASE (uvec
))[idx
]);
1007 SCM_DEFINE (scm_s16vector_set_x
, "s16vector-set!", 3, 0, 0,
1008 (SCM uvec
, SCM index
, SCM value
),
1009 "Set the element at @var{index} in the homogeneous numeric\n"
1010 "vector @var{uvec} to @var{value}. The return value is not\n"
1012 #define FUNC_NAME s_scm_s16vector_ref
1017 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1018 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S16
)
1019 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1021 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1022 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1023 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1025 f
= scm_num2short (value
, 3, FUNC_NAME
);
1027 ((int_s16
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
1028 return SCM_UNSPECIFIED
;
1033 SCM_DEFINE (scm_s16vector_to_list
, "s16vector->list", 1, 0, 0,
1035 "Convert the homogeneous numeric vector @var{uvec} to a list.")
1036 #define FUNC_NAME s_scm_s16vector_to_list
1042 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1043 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S16
)
1044 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1046 idx
= SCM_UVEC_LENGTH (uvec
);
1047 p
= (int_s16
*) SCM_UVEC_BASE (uvec
) + idx
;
1051 res
= scm_cons (SCM_MAKINUM (*p
), res
);
1058 SCM_DEFINE (scm_list_to_s16vector
, "list->s16vector", 1, 0, 0,
1060 "Convert the list @var{l}, which must only contain signed\n"
1061 "16-bit values, to a numeric homogeneous vector.")
1062 #define FUNC_NAME s_scm_list_to_s16vector
1070 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
1072 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S16
, n
);
1073 p
= (int_s16
*) SCM_UVEC_BASE (uvec
);
1075 while (SCM_CONSP (tmp
))
1077 int_s16 f
= scm_num2short (SCM_CAR (tmp
), 2, FUNC_NAME
);
1079 tmp
= SCM_CDR (tmp
);
1082 scm_remember_upto_here_1 (l
);
1088 /* ================================================================ */
1089 /* U32 procedures. */
1090 /* ================================================================ */
1093 SCM_DEFINE (scm_u32vector_p
, "u32vector?", 1, 0, 0,
1095 "Return @code{#t} if @var{obj} is a vector of type u32,\n"
1096 "@code{#f} otherwise.")
1097 #define FUNC_NAME s_scm_u32vector_p
1099 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
1100 SCM_UVEC_TYPE (obj
) == SCM_UVEC_U32
);
1105 SCM_DEFINE (scm_make_u32vector
, "make-u32vector", 1, 1, 0,
1107 "Create a newly allocated homogeneous numeric vector which can\n"
1108 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
1109 "initialize the elements, otherwise the contents of the vector\n"
1111 #define FUNC_NAME s_scm_make_u32vector
1118 SCM_VALIDATE_INUM (1, n
);
1119 count
= SCM_INUM (n
);
1120 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U32
, count
);
1121 if (SCM_UNBNDP (fill
))
1124 f
= scm_num2uint (fill
, 2, FUNC_NAME
);
1125 p
= (int_u32
*) SCM_UVEC_BASE (uvec
);
1133 SCM_DEFINE (scm_u32vector
, "u32vector", 0, 0, 1,
1135 "Create a newly allocated homogeneous numeric vector containing\n"
1136 "all argument values.")
1137 #define FUNC_NAME s_scm_u32vector
1139 SCM_VALIDATE_REST_ARGUMENT (l
);
1140 return scm_list_to_u32vector (l
);
1145 SCM_DEFINE (scm_u32vector_length
, "u32vector-length", 1, 0, 0,
1147 "Return the number of elements in the homogeneous numeric vector\n"
1149 #define FUNC_NAME s_scm_u32vector_length
1151 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1152 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U32
)
1153 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1154 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
1159 SCM_DEFINE (scm_u32vector_ref
, "u32vector-ref", 2, 0, 0,
1160 (SCM uvec
, SCM index
),
1161 "Return the element at @var{index} in the homogeneous numeric\n"
1162 "vector @var{uvec}.")
1163 #define FUNC_NAME s_scm_u32vector_ref
1167 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1168 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U32
)
1169 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1171 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1172 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1173 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1175 return scm_uint2num (((int_u32
*) SCM_UVEC_BASE (uvec
))[idx
]);
1180 SCM_DEFINE (scm_u32vector_set_x
, "u32vector-set!", 3, 0, 0,
1181 (SCM uvec
, SCM index
, SCM value
),
1182 "Set the element at @var{index} in the homogeneous numeric\n"
1183 "vector @var{uvec} to @var{value}. The return value is not\n"
1185 #define FUNC_NAME s_scm_u32vector_ref
1190 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1191 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U32
)
1192 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1194 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1195 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1196 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1198 f
= scm_num2uint (value
, 3, FUNC_NAME
);
1200 ((int_u32
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
1201 return SCM_UNSPECIFIED
;
1206 SCM_DEFINE (scm_u32vector_to_list
, "u32vector->list", 1, 0, 0,
1208 "Convert the homogeneous numeric vector @var{uvec} to a list.")
1209 #define FUNC_NAME s_scm_u32vector_to_list
1215 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1216 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U32
)
1217 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1219 idx
= SCM_UVEC_LENGTH (uvec
);
1220 p
= (int_u32
*) SCM_UVEC_BASE (uvec
) + idx
;
1224 res
= scm_cons (scm_uint2num (*p
), res
);
1231 SCM_DEFINE (scm_list_to_u32vector
, "list->u32vector", 1, 0, 0,
1233 "Convert the list @var{l}, which must only contain unsigned\n"
1234 "32-bit values, to a numeric homogeneous vector.")
1235 #define FUNC_NAME s_scm_list_to_u32vector
1242 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
1244 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U32
, n
);
1245 p
= (int_u32
*) SCM_UVEC_BASE (uvec
);
1246 while (SCM_CONSP (l
))
1249 f
= scm_num2uint (SCM_CAR (l
), 2, FUNC_NAME
);
1259 /* ================================================================ */
1260 /* S32 procedures. */
1261 /* ================================================================ */
1264 SCM_DEFINE (scm_s32vector_p
, "s32vector?", 1, 0, 0,
1266 "Return @code{#t} if @var{obj} is a vector of type s32,\n"
1267 "@code{#f} otherwise.")
1268 #define FUNC_NAME s_scm_s32vector_p
1270 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
1271 SCM_UVEC_TYPE (obj
) == SCM_UVEC_S32
);
1276 SCM_DEFINE (scm_make_s32vector
, "make-s32vector", 1, 1, 0,
1278 "Create a newly allocated homogeneous numeric vector which can\n"
1279 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
1280 "initialize the elements, otherwise the contents of the vector\n"
1282 #define FUNC_NAME s_scm_make_s32vector
1289 SCM_VALIDATE_INUM (1, n
);
1290 count
= SCM_INUM (n
);
1291 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S32
, count
);
1292 if (SCM_UNBNDP (fill
))
1295 f
= scm_num2int (fill
, 2, FUNC_NAME
);
1296 p
= (int_s32
*) SCM_UVEC_BASE (uvec
);
1304 SCM_DEFINE (scm_s32vector
, "s32vector", 0, 0, 1,
1306 "Create a newly allocated homogeneous numeric vector containing\n"
1307 "all argument values.")
1308 #define FUNC_NAME s_scm_s32vector
1310 SCM_VALIDATE_REST_ARGUMENT (l
);
1311 return scm_list_to_s32vector (l
);
1316 SCM_DEFINE (scm_s32vector_length
, "s32vector-length", 1, 0, 0,
1318 "Return the number of elements in the homogeneous numeric vector\n"
1320 #define FUNC_NAME s_scm_s32vector_length
1322 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1323 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S32
)
1324 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1325 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
1330 SCM_DEFINE (scm_s32vector_ref
, "s32vector-ref", 2, 0, 0,
1331 (SCM uvec
, SCM index
),
1332 "Return the element at @var{index} in the homogeneous numeric\n"
1333 "vector @var{uvec}.")
1334 #define FUNC_NAME s_scm_s32vector_ref
1338 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1339 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S32
)
1340 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1342 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1343 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1344 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1346 return scm_int2num (((int_s32
*) SCM_UVEC_BASE (uvec
))[idx
]);
1351 SCM_DEFINE (scm_s32vector_set_x
, "s32vector-set!", 3, 0, 0,
1352 (SCM uvec
, SCM index
, SCM value
),
1353 "Set the element at @var{index} in the homogeneous numeric\n"
1354 "vector @var{uvec} to @var{value}. The return value is not\n"
1356 #define FUNC_NAME s_scm_s32vector_ref
1361 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1362 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S32
)
1363 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1365 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1366 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1367 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1369 f
= scm_num2int (value
, 3, FUNC_NAME
);
1371 ((int_s32
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
1372 return SCM_UNSPECIFIED
;
1377 SCM_DEFINE (scm_s32vector_to_list
, "s32vector->list", 1, 0, 0,
1379 "Convert the homogeneous numeric vector @var{uvec} to a list.")
1380 #define FUNC_NAME s_scm_s32vector_to_list
1386 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1387 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S32
)
1388 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1390 idx
= SCM_UVEC_LENGTH (uvec
);
1391 p
= (int_s32
*) SCM_UVEC_BASE (uvec
) + idx
;
1395 res
= scm_cons (scm_int2num (*p
), res
);
1402 SCM_DEFINE (scm_list_to_s32vector
, "list->s32vector", 1, 0, 0,
1404 "Convert the list @var{l}, which must only contain signed\n"
1405 "32-bit values, to a numeric homogeneous vector.")
1406 #define FUNC_NAME s_scm_list_to_s32vector
1413 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
1415 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S32
, n
);
1416 p
= (int_s32
*) SCM_UVEC_BASE (uvec
);
1417 while (SCM_CONSP (l
))
1420 f
= scm_num2int (SCM_CAR (l
), 2, FUNC_NAME
);
1432 /* ================================================================ */
1433 /* U64 procedures. */
1434 /* ================================================================ */
1437 SCM_DEFINE (scm_u64vector_p
, "u64vector?", 1, 0, 0,
1439 "Return @code{#t} if @var{obj} is a vector of type u64,\n"
1440 "@code{#f} otherwise.")
1441 #define FUNC_NAME s_scm_u64vector_p
1443 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
1444 SCM_UVEC_TYPE (obj
) == SCM_UVEC_U64
);
1449 SCM_DEFINE (scm_make_u64vector
, "make-u64vector", 1, 1, 0,
1451 "Create a newly allocated homogeneous numeric vector which can\n"
1452 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
1453 "initialize the elements, otherwise the contents of the vector\n"
1455 #define FUNC_NAME s_scm_make_u64vector
1462 SCM_VALIDATE_INUM (1, n
);
1463 count
= SCM_INUM (n
);
1464 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U64
, count
);
1465 if (SCM_UNBNDP (fill
))
1468 f
= scm_num2ulong_long (fill
, 2, FUNC_NAME
);
1469 p
= (int_u64
*) SCM_UVEC_BASE (uvec
);
1477 SCM_DEFINE (scm_u64vector
, "u64vector", 0, 0, 1,
1479 "Create a newly allocated homogeneous numeric vector containing\n"
1480 "all argument values.")
1481 #define FUNC_NAME s_scm_u64vector
1483 SCM_VALIDATE_REST_ARGUMENT (l
);
1484 return scm_list_to_u64vector (l
);
1489 SCM_DEFINE (scm_u64vector_length
, "u64vector-length", 1, 0, 0,
1491 "Return the number of elements in the homogeneous numeric vector\n"
1493 #define FUNC_NAME s_scm_u64vector_length
1495 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1496 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U64
)
1497 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1498 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
1503 SCM_DEFINE (scm_u64vector_ref
, "u64vector-ref", 2, 0, 0,
1504 (SCM uvec
, SCM index
),
1505 "Return the element at @var{index} in the homogeneous numeric\n"
1506 "vector @var{uvec}.")
1507 #define FUNC_NAME s_scm_u64vector_ref
1511 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1512 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U64
)
1513 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1515 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1516 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1517 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1519 return scm_ulong_long2num (((int_u64
*) SCM_UVEC_BASE (uvec
))[idx
]);
1524 SCM_DEFINE (scm_u64vector_set_x
, "u64vector-set!", 3, 0, 0,
1525 (SCM uvec
, SCM index
, SCM value
),
1526 "Set the element at @var{index} in the homogeneous numeric\n"
1527 "vector @var{uvec} to @var{value}. The return value is not\n"
1529 #define FUNC_NAME s_scm_u64vector_ref
1534 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1535 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U64
)
1536 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1538 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1539 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1540 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1542 f
= scm_num2ulong_long (value
, 3, FUNC_NAME
);
1544 ((int_u64
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
1545 return SCM_UNSPECIFIED
;
1550 SCM_DEFINE (scm_u64vector_to_list
, "u64vector->list", 1, 0, 0,
1552 "Convert the homogeneous numeric vector @var{uvec} to a list.")
1553 #define FUNC_NAME s_scm_u64vector_to_list
1559 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1560 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U64
)
1561 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1563 idx
= SCM_UVEC_LENGTH (uvec
);
1564 p
= (int_u64
*) SCM_UVEC_BASE (uvec
) + idx
;
1568 res
= scm_cons (scm_long_long2num (*p
), res
);
1575 SCM_DEFINE (scm_list_to_u64vector
, "list->u64vector", 1, 0, 0,
1577 "Convert the list @var{l}, which must only contain unsigned\n"
1578 "64-bit values, to a numeric homogeneous vector.")
1579 #define FUNC_NAME s_scm_list_to_u64vector
1586 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
1588 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U64
, n
);
1589 p
= (int_u64
*) SCM_UVEC_BASE (uvec
);
1590 while (SCM_CONSP (l
))
1593 f
= scm_num2ulong_long (SCM_CAR (l
), 2, FUNC_NAME
);
1603 /* ================================================================ */
1604 /* S64 procedures. */
1605 /* ================================================================ */
1608 SCM_DEFINE (scm_s64vector_p
, "s64vector?", 1, 0, 0,
1610 "Return @code{#t} if @var{obj} is a vector of type s64,\n"
1611 "@code{#f} otherwise.")
1612 #define FUNC_NAME s_scm_s64vector_p
1614 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
1615 SCM_UVEC_TYPE (obj
) == SCM_UVEC_S64
);
1620 SCM_DEFINE (scm_make_s64vector
, "make-s64vector", 1, 1, 0,
1622 "Create a newly allocated homogeneous numeric vector which can\n"
1623 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
1624 "initialize the elements, otherwise the contents of the vector\n"
1626 #define FUNC_NAME s_scm_make_s64vector
1633 SCM_VALIDATE_INUM (1, n
);
1634 count
= SCM_INUM (n
);
1635 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S64
, count
);
1636 if (SCM_UNBNDP (fill
))
1639 f
= scm_num2long_long (fill
, 2, FUNC_NAME
);
1640 p
= (int_s64
*) SCM_UVEC_BASE (uvec
);
1648 SCM_DEFINE (scm_s64vector
, "s64vector", 0, 0, 1,
1650 "Create a newly allocated homogeneous numeric vector containing\n"
1651 "all argument values.")
1652 #define FUNC_NAME s_scm_s64vector
1654 SCM_VALIDATE_REST_ARGUMENT (l
);
1655 return scm_list_to_s64vector (l
);
1660 SCM_DEFINE (scm_s64vector_length
, "s64vector-length", 1, 0, 0,
1662 "Return the number of elements in the homogeneous numeric vector\n"
1664 #define FUNC_NAME s_scm_s64vector_length
1666 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1667 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S64
)
1668 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1669 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
1674 SCM_DEFINE (scm_s64vector_ref
, "s64vector-ref", 2, 0, 0,
1675 (SCM uvec
, SCM index
),
1676 "Return the element at @var{index} in the homogeneous numeric\n"
1677 "vector @var{uvec}.")
1678 #define FUNC_NAME s_scm_s64vector_ref
1682 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1683 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S64
)
1684 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1686 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1687 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1688 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1690 return scm_long_long2num (((int_s64
*) SCM_UVEC_BASE (uvec
))[idx
]);
1695 SCM_DEFINE (scm_s64vector_set_x
, "s64vector-set!", 3, 0, 0,
1696 (SCM uvec
, SCM index
, SCM value
),
1697 "Set the element at @var{index} in the homogeneous numeric\n"
1698 "vector @var{uvec} to @var{value}. The return value is not\n"
1700 #define FUNC_NAME s_scm_s64vector_ref
1705 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1706 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S64
)
1707 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1709 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1710 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1711 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1713 f
= scm_num2long_long (value
, 3, FUNC_NAME
);
1715 ((int_s64
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
1716 return SCM_UNSPECIFIED
;
1721 SCM_DEFINE (scm_s64vector_to_list
, "s64vector->list", 1, 0, 0,
1723 "Convert the homogeneous numeric vector @var{uvec} to a list.")
1724 #define FUNC_NAME s_scm_s64vector_to_list
1730 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1731 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S64
)
1732 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1734 idx
= SCM_UVEC_LENGTH (uvec
);
1735 p
= (int_s64
*) SCM_UVEC_BASE (uvec
) + idx
;
1739 res
= scm_cons (scm_long_long2num (*p
), res
);
1746 SCM_DEFINE (scm_list_to_s64vector
, "list->s64vector", 1, 0, 0,
1748 "Convert the list @var{l}, which must only contain signed\n"
1749 "64-bit values, to a numeric homogeneous vector.")
1750 #define FUNC_NAME s_scm_list_to_s64vector
1757 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
1759 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S64
, n
);
1760 p
= (int_s64
*) SCM_UVEC_BASE (uvec
);
1761 while (SCM_CONSP (l
))
1764 f
= scm_num2long_long (SCM_CAR (l
), 2, FUNC_NAME
);
1773 #endif /* HAVE_LONG_LONGS */
1776 /* ================================================================ */
1777 /* F32 procedures. */
1778 /* ================================================================ */
1781 SCM_DEFINE (scm_f32vector_p
, "f32vector?", 1, 0, 0,
1783 "Return @code{#t} if @var{obj} is a vector of type f32,\n"
1784 "@code{#f} otherwise.")
1785 #define FUNC_NAME s_scm_f32vector_p
1787 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
1788 SCM_UVEC_TYPE (obj
) == SCM_UVEC_F32
);
1793 SCM_DEFINE (scm_make_f32vector
, "make-f32vector", 1, 1, 0,
1795 "Create a newly allocated homogeneous numeric vector which can\n"
1796 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
1797 "initialize the elements, otherwise the contents of the vector\n"
1799 #define FUNC_NAME s_scm_make_f32vector
1806 SCM_VALIDATE_INUM (1, n
);
1807 count
= SCM_INUM (n
);
1808 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_F32
, count
);
1809 if (SCM_UNBNDP (fill
))
1813 double d
= scm_num2dbl (fill
, FUNC_NAME
);
1816 /* This test somehow fails for even the simplest inexact
1817 numbers, like 3.1. Must find out how to check properly. */
1819 scm_out_of_range_pos (FUNC_NAME
, fill
, SCM_MAKINUM (2));
1822 p
= (float_f32
*) SCM_UVEC_BASE (uvec
);
1830 SCM_DEFINE (scm_f32vector
, "f32vector", 0, 0, 1,
1832 "Create a newly allocated homogeneous numeric vector containing\n"
1833 "all argument values.")
1834 #define FUNC_NAME s_scm_f32vector
1836 SCM_VALIDATE_REST_ARGUMENT (l
);
1837 return scm_list_to_f32vector (l
);
1842 SCM_DEFINE (scm_f32vector_length
, "f32vector-length", 1, 0, 0,
1844 "Return the number of elements in the homogeneous numeric vector\n"
1846 #define FUNC_NAME s_scm_f32vector_length
1848 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1849 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F32
)
1850 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1851 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
1856 SCM_DEFINE (scm_f32vector_ref
, "f32vector-ref", 2, 0, 0,
1857 (SCM uvec
, SCM index
),
1858 "Return the element at @var{index} in the homogeneous numeric\n"
1859 "vector @var{uvec}.")
1860 #define FUNC_NAME s_scm_f32vector_ref
1864 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1865 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F32
)
1866 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1868 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1869 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1870 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1872 return scm_make_real (((float_f32
*) SCM_UVEC_BASE (uvec
))[idx
]);
1877 SCM_DEFINE (scm_f32vector_set_x
, "f32vector-set!", 3, 0, 0,
1878 (SCM uvec
, SCM index
, SCM value
),
1879 "Set the element at @var{index} in the homogeneous numeric\n"
1880 "vector @var{uvec} to @var{value}. The return value is not\n"
1882 #define FUNC_NAME s_scm_f32vector_ref
1888 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1889 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F32
)
1890 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1892 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1893 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1894 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1896 d
= scm_num2dbl (value
, FUNC_NAME
);
1899 /* This test somehow fails for even the simplest inexact
1900 numbers, like 3.1. Must find out how to check properly. */
1902 scm_out_of_range_pos (FUNC_NAME
, value
, SCM_MAKINUM (3));
1905 ((float_f32
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
1906 return SCM_UNSPECIFIED
;
1911 SCM_DEFINE (scm_f32vector_to_list
, "f32vector->list", 1, 0, 0,
1913 "Convert the homogeneous numeric vector @var{uvec} to a list.")
1914 #define FUNC_NAME s_scm_f32vector_to_list
1920 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1921 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F32
)
1922 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1924 idx
= SCM_UVEC_LENGTH (uvec
);
1925 p
= (float_f32
*) SCM_UVEC_BASE (uvec
) + idx
;
1929 res
= scm_cons (scm_make_real (*p
), res
);
1936 SCM_DEFINE (scm_list_to_f32vector
, "list->f32vector", 1, 0, 0,
1938 "Convert the list @var{l}, which must only contain unsigned\n"
1939 "8-bit values, to a numeric homogeneous vector.")
1940 #define FUNC_NAME s_scm_list_to_f32vector
1947 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
1949 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_F32
, n
);
1950 p
= (float_f32
*) SCM_UVEC_BASE (uvec
);
1951 while (SCM_CONSP (l
))
1955 d
= scm_num2dbl (SCM_CAR (l
), FUNC_NAME
);
1958 /* This test somehow fails for even the simplest inexact
1959 numbers, like 3.1. Must find out how to check properly. */
1961 scm_out_of_range_pos (FUNC_NAME
, l
, SCM_MAKINUM (1));
1972 /* ================================================================ */
1973 /* F64 procedures. */
1974 /* ================================================================ */
1977 SCM_DEFINE (scm_f64vector_p
, "f64vector?", 1, 0, 0,
1979 "Return @code{#t} if @var{obj} is a vector of type f64,\n"
1980 "@code{#f} otherwise.")
1981 #define FUNC_NAME s_scm_f64vector_p
1983 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
1984 SCM_UVEC_TYPE (obj
) == SCM_UVEC_F64
);
1989 SCM_DEFINE (scm_make_f64vector
, "make-f64vector", 1, 1, 0,
1991 "Create a newly allocated homogeneous numeric vector which can\n"
1992 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
1993 "initialize the elements, otherwise the contents of the vector\n"
1995 #define FUNC_NAME s_scm_make_f64vector
2002 SCM_VALIDATE_INUM (1, n
);
2003 count
= SCM_INUM (n
);
2004 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_F64
, count
);
2005 if (SCM_UNBNDP (fill
))
2008 f
= scm_num2dbl (fill
, FUNC_NAME
);
2009 p
= (float_f64
*) SCM_UVEC_BASE (uvec
);
2017 SCM_DEFINE (scm_f64vector
, "f64vector", 0, 0, 1,
2019 "Create a newly allocated homogeneous numeric vector containing\n"
2020 "all argument values.")
2021 #define FUNC_NAME s_scm_f64vector
2023 SCM_VALIDATE_REST_ARGUMENT (l
);
2024 return scm_list_to_f64vector (l
);
2029 SCM_DEFINE (scm_f64vector_length
, "f64vector-length", 1, 0, 0,
2031 "Return the number of elements in the homogeneous numeric vector\n"
2033 #define FUNC_NAME s_scm_f64vector_length
2035 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
2036 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F64
)
2037 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
2038 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
2043 SCM_DEFINE (scm_f64vector_ref
, "f64vector-ref", 2, 0, 0,
2044 (SCM uvec
, SCM index
),
2045 "Return the element at @var{index} in the homogeneous numeric\n"
2046 "vector @var{uvec}.")
2047 #define FUNC_NAME s_scm_f64vector_ref
2051 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
2052 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F64
)
2053 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
2055 idx
= scm_num2int (index
, 2, FUNC_NAME
);
2056 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
2057 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
2059 return scm_make_real (((float_f64
*) SCM_UVEC_BASE (uvec
))[idx
]);
2064 SCM_DEFINE (scm_f64vector_set_x
, "f64vector-set!", 3, 0, 0,
2065 (SCM uvec
, SCM index
, SCM value
),
2066 "Set the element at @var{index} in the homogeneous numeric\n"
2067 "vector @var{uvec} to @var{value}. The return value is not\n"
2069 #define FUNC_NAME s_scm_f64vector_ref
2074 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
2075 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F64
)
2076 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
2078 idx
= scm_num2int (index
, 2, FUNC_NAME
);
2079 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
2080 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
2082 f
= scm_num2dbl (value
, FUNC_NAME
);
2084 ((float_f64
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
2085 return SCM_UNSPECIFIED
;
2090 SCM_DEFINE (scm_f64vector_to_list
, "f64vector->list", 1, 0, 0,
2092 "Convert the homogeneous numeric vector @var{uvec} to a list.")
2093 #define FUNC_NAME s_scm_f64vector_to_list
2099 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
2100 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F64
)
2101 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
2103 idx
= SCM_UVEC_LENGTH (uvec
);
2104 p
= (float_f64
*) SCM_UVEC_BASE (uvec
) + idx
;
2108 res
= scm_cons (scm_make_real (*p
), res
);
2115 SCM_DEFINE (scm_list_to_f64vector
, "list->f64vector", 1, 0, 0,
2117 "Convert the list @var{l}, which must only contain signed\n"
2118 "8-bit values, to a numeric homogeneous vector.")
2119 #define FUNC_NAME s_scm_list_to_f64vector
2126 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
2128 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_F64
, n
);
2129 p
= (float_f64
*) SCM_UVEC_BASE (uvec
);
2130 while (SCM_CONSP (l
))
2132 float_f64 f
= scm_num2dbl (SCM_CAR (l
), FUNC_NAME
);
2142 /* Create the smob type for homogeneous numeric vectors and install
2145 scm_init_srfi_4 (void)
2147 scm_tc16_uvec
= scm_make_smob_type ("uvec", 0);
2148 scm_set_smob_free (scm_tc16_uvec
, uvec_free
);
2149 scm_set_smob_print (scm_tc16_uvec
, uvec_print
);
2150 #ifndef SCM_MAGIC_SNARFER
2151 #include "srfi/srfi-4.x"
2155 /* End of srfi-4.c. */