1 /* srfi-4.c --- Homogeneous numeric vector datatypes.
3 * Copyright (C) 2001 Free Software Foundation, Inc.
5 * This library is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU Lesser General Public
7 * License as published by the Free Software Foundation; either
8 * version 2.1 of the License, or (at your option) any later version.
10 * This library is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 * Lesser General Public License for more details.
15 * You should have received a copy of the GNU Lesser General Public
16 * License along with this library; if not, write to the Free Software
17 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
25 /* For brevity and maintainability, we define our own types for the
26 various integer and floating point types. */
27 typedef scm_t_uint8 int_u8
;
28 typedef scm_t_int8 int_s8
;
29 typedef scm_t_uint16 int_u16
;
30 typedef scm_t_int16 int_s16
;
31 typedef scm_t_uint32 int_u32
;
32 typedef scm_t_int32 int_s32
;
34 #ifdef SCM_HAVE_T_INT64
35 typedef scm_t_uint64 int_u64
;
36 typedef scm_t_int64 int_s64
;
37 #endif /* SCM_HAVE_T_INT64 */
39 typedef float float_f32
;
40 typedef double float_f64
;
43 /* Smob type code for homogeneous numeric vectors. */
44 int scm_tc16_uvec
= 0;
47 /* Accessor macros for the three components of a homogeneous numeric
49 - The type tag (one of the symbolic constants below).
50 - The vector's length (counted in elements).
51 - The address of the data area (holding the elements of the
53 #define SCM_UVEC_TYPE(u) (SCM_CELL_WORD_1(u))
54 #define SCM_UVEC_LENGTH(u) (SCM_CELL_WORD_2(u))
55 #define SCM_UVEC_BASE(u) (SCM_CELL_OBJECT_3(u))
58 /* Symbolic constants encoding the various types of homogeneous
62 #define SCM_UVEC_U16 2
63 #define SCM_UVEC_S16 3
64 #define SCM_UVEC_U32 4
65 #define SCM_UVEC_S32 5
66 #define SCM_UVEC_U64 6
67 #define SCM_UVEC_S64 7
68 #define SCM_UVEC_F32 8
69 #define SCM_UVEC_F64 9
72 /* This array maps type tags to the size of the elements. */
73 static int uvec_sizes
[10] = {1, 1, 2, 2, 4, 4, 8, 8, 4, 8};
76 /* ================================================================ */
77 /* SMOB procedures. */
78 /* ================================================================ */
81 /* Smob print hook for homogeneous vectors. */
83 uvec_print (SCM uvec
, SCM port
, scm_print_state
*pstate SCM_UNUSED
)
85 switch (SCM_UVEC_TYPE (uvec
))
89 int_u8
* p
= (int_u8
*) SCM_UVEC_BASE (uvec
);
92 scm_puts ("#u8(", port
);
93 if (SCM_UVEC_LENGTH (uvec
) > 0)
95 scm_intprint (*p
, 10, port
);
98 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
100 scm_puts (" ", port
);
101 scm_intprint (*p
, 10, port
);
105 scm_puts (")", port
);
111 int_s8
* p
= (int_s8
*) SCM_UVEC_BASE (uvec
);
114 scm_puts ("#s8(", port
);
115 if (SCM_UVEC_LENGTH (uvec
) > 0)
117 scm_intprint (*p
, 10, port
);
120 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
122 scm_puts (" ", port
);
123 scm_intprint (*p
, 10, port
);
127 scm_puts (")", port
);
133 int_u16
* p
= (int_u16
*) SCM_UVEC_BASE (uvec
);
136 scm_puts ("#u16(", port
);
137 if (SCM_UVEC_LENGTH (uvec
) > 0)
139 scm_intprint (*p
, 10, port
);
142 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
144 scm_puts (" ", port
);
145 scm_intprint (*p
, 10, port
);
149 scm_puts (")", port
);
155 int_s16
* p
= (int_s16
*) SCM_UVEC_BASE (uvec
);
158 scm_puts ("#s16(", port
);
159 if (SCM_UVEC_LENGTH (uvec
) > 0)
161 scm_intprint (*p
, 10, port
);
164 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
166 scm_puts (" ", port
);
167 scm_intprint (*p
, 10, port
);
171 scm_puts (")", port
);
177 int_u32
* p
= (int_u32
*) SCM_UVEC_BASE (uvec
);
180 scm_puts ("#u32(", port
);
181 if (SCM_UVEC_LENGTH (uvec
) > 0)
183 scm_intprint (*p
, 10, port
);
186 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
188 scm_puts (" ", port
);
189 scm_intprint (*p
, 10, port
);
193 scm_puts (")", port
);
199 int_s32
* p
= (int_s32
*) SCM_UVEC_BASE (uvec
);
202 scm_puts ("#s32(", port
);
203 if (SCM_UVEC_LENGTH (uvec
) > 0)
205 scm_intprint (*p
, 10, port
);
208 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
210 scm_puts (" ", port
);
211 scm_intprint (*p
, 10, port
);
215 scm_puts (")", port
);
219 #ifdef SCM_HAVE_T_INT64
222 int_u64
* p
= (int_u64
*) SCM_UVEC_BASE (uvec
);
225 scm_puts ("#u64(", port
);
226 if (SCM_UVEC_LENGTH (uvec
) > 0)
228 scm_intprint (*p
, 10, port
);
231 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
233 scm_puts (" ", port
);
234 scm_intprint (*p
, 10, port
);
238 scm_puts (")", port
);
244 int_s64
* p
= (int_s64
*) SCM_UVEC_BASE (uvec
);
247 scm_puts ("#s64(", port
);
248 if (SCM_UVEC_LENGTH (uvec
) > 0)
250 scm_intprint (*p
, 10, port
);
253 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
255 scm_puts (" ", port
);
256 scm_intprint (*p
, 10, port
);
260 scm_puts (")", port
);
267 float_f32
* p
= (float_f32
*) SCM_UVEC_BASE (uvec
);
270 scm_puts ("#f32(", port
);
271 if (SCM_UVEC_LENGTH (uvec
) > 0)
273 scm_iprin1 (scm_make_real (*p
), port
, pstate
);
276 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
278 scm_puts (" ", port
);
279 scm_iprin1 (scm_make_real (*p
), port
, pstate
);
283 scm_puts (")", port
);
289 float_f64
* p
= (float_f64
*) SCM_UVEC_BASE (uvec
);
292 scm_puts ("#f64(", port
);
293 if (SCM_UVEC_LENGTH (uvec
) > 0)
295 scm_iprin1 (scm_make_real (*p
), port
, pstate
);
298 for (; i
< SCM_UVEC_LENGTH (uvec
); i
++)
300 scm_puts (" ", port
);
301 scm_iprin1 (scm_make_real (*p
), port
, pstate
);
305 scm_puts (")", port
);
310 abort (); /* Sanity check. */
316 /* Smob free hook for homogeneous numeric vectors. */
320 scm_gc_free (SCM_UVEC_BASE (uvec
),
321 SCM_UVEC_LENGTH (uvec
) * uvec_sizes
[SCM_UVEC_TYPE (uvec
)],
327 /* ================================================================ */
328 /* Utility procedures. */
329 /* ================================================================ */
332 /* Create a new, uninitialized homogeneous numeric vector of type TYPE
333 with space for LEN elements. */
335 make_uvec (const char * func_name
, int type
, int len
)
339 p
= scm_gc_malloc (len
* uvec_sizes
[type
], "uvec");
340 SCM_RETURN_NEWSMOB3 (scm_tc16_uvec
, type
, len
, p
);
344 /* ================================================================ */
346 /* ================================================================ */
349 SCM_DEFINE (scm_u8vector_p
, "u8vector?", 1, 0, 0,
351 "Return @code{#t} if @var{obj} is a vector of type u8,\n"
352 "@code{#f} otherwise.")
353 #define FUNC_NAME s_scm_u8vector_p
355 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
356 SCM_UVEC_TYPE (obj
) == SCM_UVEC_U8
);
361 SCM_DEFINE (scm_make_u8vector
, "make-u8vector", 1, 1, 0,
363 "Create a newly allocated homogeneous numeric vector which can\n"
364 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
365 "initialize the elements, otherwise the contents of the vector\n"
367 #define FUNC_NAME s_scm_make_u8vector
374 SCM_VALIDATE_INUM (1, n
);
375 count
= SCM_INUM (n
);
376 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U8
, count
);
377 if (SCM_UNBNDP (fill
))
381 unsigned int s
= scm_num2uint (fill
, 2, FUNC_NAME
);
383 if ((unsigned int) f
!= s
)
384 scm_out_of_range_pos (FUNC_NAME
, fill
, SCM_MAKINUM (2));
386 p
= (int_u8
*) SCM_UVEC_BASE (uvec
);
394 SCM_DEFINE (scm_u8vector
, "u8vector", 0, 0, 1,
396 "Create a newly allocated homogeneous numeric vector containing\n"
397 "all argument values.")
398 #define FUNC_NAME s_scm_u8vector
400 SCM_VALIDATE_REST_ARGUMENT (l
);
401 return scm_list_to_u8vector (l
);
406 SCM_DEFINE (scm_u8vector_length
, "u8vector-length", 1, 0, 0,
408 "Return the number of elements in the homogeneous numeric vector\n"
410 #define FUNC_NAME s_scm_u8vector_length
412 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
413 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U8
)
414 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
415 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
420 SCM_DEFINE (scm_u8vector_ref
, "u8vector-ref", 2, 0, 0,
421 (SCM uvec
, SCM index
),
422 "Return the element at @var{index} in the homogeneous numeric\n"
423 "vector @var{uvec}.")
424 #define FUNC_NAME s_scm_u8vector_ref
428 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
429 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U8
)
430 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
432 idx
= scm_num2int (index
, 2, FUNC_NAME
);
433 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
434 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
436 return scm_short2num (((int_u8
*) SCM_UVEC_BASE (uvec
))[idx
]);
441 SCM_DEFINE (scm_u8vector_set_x
, "u8vector-set!", 3, 0, 0,
442 (SCM uvec
, SCM index
, SCM value
),
443 "Set the element at @var{index} in the homogeneous numeric\n"
444 "vector @var{uvec} to @var{value}. The return value is not\n"
446 #define FUNC_NAME s_scm_u8vector_ref
452 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
453 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U8
)
454 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
456 idx
= scm_num2int (index
, 2, FUNC_NAME
);
457 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
458 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
460 s
= scm_num2uint (value
, 3, FUNC_NAME
);
462 if ((unsigned int) f
!= s
)
463 scm_out_of_range_pos (FUNC_NAME
, value
, SCM_MAKINUM (3));
465 ((int_u8
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
466 return SCM_UNSPECIFIED
;
471 SCM_DEFINE (scm_u8vector_to_list
, "u8vector->list", 1, 0, 0,
473 "Convert the homogeneous numeric vector @var{uvec} to a list.")
474 #define FUNC_NAME s_scm_u8vector_to_list
480 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
481 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U8
)
482 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
484 idx
= SCM_UVEC_LENGTH (uvec
);
485 p
= (int_u8
*) SCM_UVEC_BASE (uvec
) + idx
;
489 res
= scm_cons (SCM_MAKINUM (*p
), res
);
496 SCM_DEFINE (scm_list_to_u8vector
, "list->u8vector", 1, 0, 0,
498 "Convert the list @var{l}, which must only contain unsigned\n"
499 "8-bit values, to a numeric homogeneous vector.")
500 #define FUNC_NAME s_scm_list_to_u8vector
508 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
510 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U8
, n
);
511 p
= (int_u8
*) SCM_UVEC_BASE (uvec
);
513 while (SCM_CONSP (tmp
))
516 unsigned int s
= scm_num2uint (SCM_CAR (tmp
), 2, FUNC_NAME
);
518 if ((unsigned int) f
!= s
)
519 scm_out_of_range (FUNC_NAME
, SCM_CAR (tmp
));
524 scm_remember_upto_here_1 (l
);
530 /* ================================================================ */
532 /* ================================================================ */
535 SCM_DEFINE (scm_s8vector_p
, "s8vector?", 1, 0, 0,
537 "Return @code{#t} if @var{obj} is a vector of type s8,\n"
538 "@code{#f} otherwise.")
539 #define FUNC_NAME s_scm_s8vector_p
541 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
542 SCM_UVEC_TYPE (obj
) == SCM_UVEC_S8
);
547 SCM_DEFINE (scm_make_s8vector
, "make-s8vector", 1, 1, 0,
549 "Create a newly allocated homogeneous numeric vector which can\n"
550 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
551 "initialize the elements, otherwise the contents of the vector\n"
553 #define FUNC_NAME s_scm_make_s8vector
560 SCM_VALIDATE_INUM (1, n
);
561 count
= SCM_INUM (n
);
562 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S8
, count
);
563 if (SCM_UNBNDP (fill
))
567 signed int s
= scm_num2int (fill
, 2, FUNC_NAME
);
569 if ((signed int) f
!= s
)
570 scm_out_of_range_pos (FUNC_NAME
, fill
, SCM_MAKINUM (2));
572 p
= (int_s8
*) SCM_UVEC_BASE (uvec
);
580 SCM_DEFINE (scm_s8vector
, "s8vector", 0, 0, 1,
582 "Create a newly allocated homogeneous numeric vector containing\n"
583 "all argument values.")
584 #define FUNC_NAME s_scm_s8vector
586 SCM_VALIDATE_REST_ARGUMENT (l
);
587 return scm_list_to_s8vector (l
);
592 SCM_DEFINE (scm_s8vector_length
, "s8vector-length", 1, 0, 0,
594 "Return the number of elements in the homogeneous numeric vector\n"
596 #define FUNC_NAME s_scm_s8vector_length
598 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
599 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S8
)
600 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
601 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
606 SCM_DEFINE (scm_s8vector_ref
, "s8vector-ref", 2, 0, 0,
607 (SCM uvec
, SCM index
),
608 "Return the element at @var{index} in the homogeneous numeric\n"
609 "vector @var{uvec}.")
610 #define FUNC_NAME s_scm_s8vector_ref
614 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
615 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S8
)
616 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
618 idx
= scm_num2int (index
, 2, FUNC_NAME
);
619 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
620 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
622 return scm_short2num (((int_s8
*) SCM_UVEC_BASE (uvec
))[idx
]);
627 SCM_DEFINE (scm_s8vector_set_x
, "s8vector-set!", 3, 0, 0,
628 (SCM uvec
, SCM index
, SCM value
),
629 "Set the element at @var{index} in the homogeneous numeric\n"
630 "vector @var{uvec} to @var{value}. The return value is not\n"
632 #define FUNC_NAME s_scm_s8vector_ref
638 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
639 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S8
)
640 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
642 idx
= scm_num2int (index
, 2, FUNC_NAME
);
643 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
644 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
646 s
= scm_num2int (value
, 3, FUNC_NAME
);
648 if ((signed int) f
!= s
)
649 scm_out_of_range_pos (FUNC_NAME
, value
, SCM_MAKINUM (3));
651 ((int_s8
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
652 return SCM_UNSPECIFIED
;
657 SCM_DEFINE (scm_s8vector_to_list
, "s8vector->list", 1, 0, 0,
659 "Convert the homogeneous numeric vector @var{uvec} to a list.")
660 #define FUNC_NAME s_scm_s8vector_to_list
666 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
667 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S8
)
668 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
670 idx
= SCM_UVEC_LENGTH (uvec
);
671 p
= (int_s8
*) SCM_UVEC_BASE (uvec
) + idx
;
675 res
= scm_cons (SCM_MAKINUM (*p
), res
);
682 SCM_DEFINE (scm_list_to_s8vector
, "list->s8vector", 1, 0, 0,
684 "Convert the list @var{l}, which must only contain signed\n"
685 "8-bit values, to a numeric homogeneous vector.")
686 #define FUNC_NAME s_scm_list_to_s8vector
694 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
696 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S8
, n
);
697 p
= (int_s8
*) SCM_UVEC_BASE (uvec
);
699 while (SCM_CONSP (tmp
))
704 s
= scm_num2int (SCM_CAR (tmp
), 2, FUNC_NAME
);
706 if ((signed int) f
!= s
)
707 scm_out_of_range (FUNC_NAME
, SCM_CAR (tmp
));
712 scm_remember_upto_here_1 (l
);
718 /* ================================================================ */
719 /* U16 procedures. */
720 /* ================================================================ */
723 SCM_DEFINE (scm_u16vector_p
, "u16vector?", 1, 0, 0,
725 "Return @code{#t} if @var{obj} is a vector of type u16,\n"
726 "@code{#f} otherwise.")
727 #define FUNC_NAME s_scm_u16vector_p
729 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
730 SCM_UVEC_TYPE (obj
) == SCM_UVEC_U16
);
735 SCM_DEFINE (scm_make_u16vector
, "make-u16vector", 1, 1, 0,
737 "Create a newly allocated homogeneous numeric vector which can\n"
738 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
739 "initialize the elements, otherwise the contents of the vector\n"
741 #define FUNC_NAME s_scm_make_u16vector
748 SCM_VALIDATE_INUM (1, n
);
749 count
= SCM_INUM (n
);
750 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U16
, count
);
751 if (SCM_UNBNDP (fill
))
754 f
= scm_num2ushort (fill
, 2, FUNC_NAME
);
755 p
= (int_u16
*) SCM_UVEC_BASE (uvec
);
763 SCM_DEFINE (scm_u16vector
, "u16vector", 0, 0, 1,
765 "Create a newly allocated homogeneous numeric vector containing\n"
766 "all argument values.")
767 #define FUNC_NAME s_scm_u16vector
769 SCM_VALIDATE_REST_ARGUMENT (l
);
770 return scm_list_to_u16vector (l
);
775 SCM_DEFINE (scm_u16vector_length
, "u16vector-length", 1, 0, 0,
777 "Return the number of elements in the homogeneous numeric vector\n"
779 #define FUNC_NAME s_scm_u16vector_length
781 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
782 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U16
)
783 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
784 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
789 SCM_DEFINE (scm_u16vector_ref
, "u16vector-ref", 2, 0, 0,
790 (SCM uvec
, SCM index
),
791 "Return the element at @var{index} in the homogeneous numeric\n"
792 "vector @var{uvec}.")
793 #define FUNC_NAME s_scm_u16vector_ref
797 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
798 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U16
)
799 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
801 idx
= scm_num2int (index
, 2, FUNC_NAME
);
802 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
803 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
805 return scm_ushort2num (((int_u16
*) SCM_UVEC_BASE (uvec
))[idx
]);
810 SCM_DEFINE (scm_u16vector_set_x
, "u16vector-set!", 3, 0, 0,
811 (SCM uvec
, SCM index
, SCM value
),
812 "Set the element at @var{index} in the homogeneous numeric\n"
813 "vector @var{uvec} to @var{value}. The return value is not\n"
815 #define FUNC_NAME s_scm_u16vector_ref
820 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
821 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U16
)
822 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
824 idx
= scm_num2int (index
, 2, FUNC_NAME
);
825 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
826 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
828 f
= scm_num2ushort (value
, 3, FUNC_NAME
);
830 ((int_u16
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
831 return SCM_UNSPECIFIED
;
836 SCM_DEFINE (scm_u16vector_to_list
, "u16vector->list", 1, 0, 0,
838 "Convert the homogeneous numeric vector @var{uvec} to a list.")
839 #define FUNC_NAME s_scm_u16vector_to_list
845 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
846 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U16
)
847 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
849 idx
= SCM_UVEC_LENGTH (uvec
);
850 p
= (int_u16
*) SCM_UVEC_BASE (uvec
) + idx
;
854 res
= scm_cons (SCM_MAKINUM (*p
), res
);
861 SCM_DEFINE (scm_list_to_u16vector
, "list->u16vector", 1, 0, 0,
863 "Convert the list @var{l}, which must only contain unsigned\n"
864 "16-bit values, to a numeric homogeneous vector.")
865 #define FUNC_NAME s_scm_list_to_u16vector
872 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
874 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U16
, n
);
875 p
= (int_u16
*) SCM_UVEC_BASE (uvec
);
876 while (SCM_CONSP (l
))
878 int_u16 f
= scm_num2ushort (SCM_CAR (l
), 2, FUNC_NAME
);
888 /* ================================================================ */
889 /* S16 procedures. */
890 /* ================================================================ */
893 SCM_DEFINE (scm_s16vector_p
, "s16vector?", 1, 0, 0,
895 "Return @code{#t} if @var{obj} is a vector of type s16,\n"
896 "@code{#f} otherwise.")
897 #define FUNC_NAME s_scm_s16vector_p
899 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
900 SCM_UVEC_TYPE (obj
) == SCM_UVEC_S16
);
905 SCM_DEFINE (scm_make_s16vector
, "make-s16vector", 1, 1, 0,
907 "Create a newly allocated homogeneous numeric vector which can\n"
908 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
909 "initialize the elements, otherwise the contents of the vector\n"
911 #define FUNC_NAME s_scm_make_s16vector
918 SCM_VALIDATE_INUM (1, n
);
919 count
= SCM_INUM (n
);
920 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S16
, count
);
921 if (SCM_UNBNDP (fill
))
924 f
= scm_num2short (fill
, 2, FUNC_NAME
);
925 p
= (int_s16
*) SCM_UVEC_BASE (uvec
);
933 SCM_DEFINE (scm_s16vector
, "s16vector", 0, 0, 1,
935 "Create a newly allocated homogeneous numeric vector containing\n"
936 "all argument values.")
937 #define FUNC_NAME s_scm_s16vector
939 SCM_VALIDATE_REST_ARGUMENT (l
);
940 return scm_list_to_s16vector (l
);
945 SCM_DEFINE (scm_s16vector_length
, "s16vector-length", 1, 0, 0,
947 "Return the number of elements in the homogeneous numeric vector\n"
949 #define FUNC_NAME s_scm_s16vector_length
951 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
952 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S16
)
953 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
954 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
959 SCM_DEFINE (scm_s16vector_ref
, "s16vector-ref", 2, 0, 0,
960 (SCM uvec
, SCM index
),
961 "Return the element at @var{index} in the homogeneous numeric\n"
962 "vector @var{uvec}.")
963 #define FUNC_NAME s_scm_s16vector_ref
967 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
968 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S16
)
969 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
971 idx
= scm_num2int (index
, 2, FUNC_NAME
);
972 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
973 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
975 return scm_short2num (((int_s16
*) SCM_UVEC_BASE (uvec
))[idx
]);
980 SCM_DEFINE (scm_s16vector_set_x
, "s16vector-set!", 3, 0, 0,
981 (SCM uvec
, SCM index
, SCM value
),
982 "Set the element at @var{index} in the homogeneous numeric\n"
983 "vector @var{uvec} to @var{value}. The return value is not\n"
985 #define FUNC_NAME s_scm_s16vector_ref
990 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
991 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S16
)
992 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
994 idx
= scm_num2int (index
, 2, FUNC_NAME
);
995 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
996 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
998 f
= scm_num2short (value
, 3, FUNC_NAME
);
1000 ((int_s16
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
1001 return SCM_UNSPECIFIED
;
1006 SCM_DEFINE (scm_s16vector_to_list
, "s16vector->list", 1, 0, 0,
1008 "Convert the homogeneous numeric vector @var{uvec} to a list.")
1009 #define FUNC_NAME s_scm_s16vector_to_list
1015 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1016 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S16
)
1017 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1019 idx
= SCM_UVEC_LENGTH (uvec
);
1020 p
= (int_s16
*) SCM_UVEC_BASE (uvec
) + idx
;
1024 res
= scm_cons (SCM_MAKINUM (*p
), res
);
1031 SCM_DEFINE (scm_list_to_s16vector
, "list->s16vector", 1, 0, 0,
1033 "Convert the list @var{l}, which must only contain signed\n"
1034 "16-bit values, to a numeric homogeneous vector.")
1035 #define FUNC_NAME s_scm_list_to_s16vector
1043 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
1045 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S16
, n
);
1046 p
= (int_s16
*) SCM_UVEC_BASE (uvec
);
1048 while (SCM_CONSP (tmp
))
1050 int_s16 f
= scm_num2short (SCM_CAR (tmp
), 2, FUNC_NAME
);
1052 tmp
= SCM_CDR (tmp
);
1055 scm_remember_upto_here_1 (l
);
1061 /* ================================================================ */
1062 /* U32 procedures. */
1063 /* ================================================================ */
1066 SCM_DEFINE (scm_u32vector_p
, "u32vector?", 1, 0, 0,
1068 "Return @code{#t} if @var{obj} is a vector of type u32,\n"
1069 "@code{#f} otherwise.")
1070 #define FUNC_NAME s_scm_u32vector_p
1072 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
1073 SCM_UVEC_TYPE (obj
) == SCM_UVEC_U32
);
1078 SCM_DEFINE (scm_make_u32vector
, "make-u32vector", 1, 1, 0,
1080 "Create a newly allocated homogeneous numeric vector which can\n"
1081 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
1082 "initialize the elements, otherwise the contents of the vector\n"
1084 #define FUNC_NAME s_scm_make_u32vector
1091 SCM_VALIDATE_INUM (1, n
);
1092 count
= SCM_INUM (n
);
1093 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U32
, count
);
1094 if (SCM_UNBNDP (fill
))
1097 f
= scm_num2uint (fill
, 2, FUNC_NAME
);
1098 p
= (int_u32
*) SCM_UVEC_BASE (uvec
);
1106 SCM_DEFINE (scm_u32vector
, "u32vector", 0, 0, 1,
1108 "Create a newly allocated homogeneous numeric vector containing\n"
1109 "all argument values.")
1110 #define FUNC_NAME s_scm_u32vector
1112 SCM_VALIDATE_REST_ARGUMENT (l
);
1113 return scm_list_to_u32vector (l
);
1118 SCM_DEFINE (scm_u32vector_length
, "u32vector-length", 1, 0, 0,
1120 "Return the number of elements in the homogeneous numeric vector\n"
1122 #define FUNC_NAME s_scm_u32vector_length
1124 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1125 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U32
)
1126 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1127 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
1132 SCM_DEFINE (scm_u32vector_ref
, "u32vector-ref", 2, 0, 0,
1133 (SCM uvec
, SCM index
),
1134 "Return the element at @var{index} in the homogeneous numeric\n"
1135 "vector @var{uvec}.")
1136 #define FUNC_NAME s_scm_u32vector_ref
1140 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1141 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U32
)
1142 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1144 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1145 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1146 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1148 return scm_uint2num (((int_u32
*) SCM_UVEC_BASE (uvec
))[idx
]);
1153 SCM_DEFINE (scm_u32vector_set_x
, "u32vector-set!", 3, 0, 0,
1154 (SCM uvec
, SCM index
, SCM value
),
1155 "Set the element at @var{index} in the homogeneous numeric\n"
1156 "vector @var{uvec} to @var{value}. The return value is not\n"
1158 #define FUNC_NAME s_scm_u32vector_ref
1163 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1164 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U32
)
1165 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1167 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1168 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1169 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1171 f
= scm_num2uint (value
, 3, FUNC_NAME
);
1173 ((int_u32
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
1174 return SCM_UNSPECIFIED
;
1179 SCM_DEFINE (scm_u32vector_to_list
, "u32vector->list", 1, 0, 0,
1181 "Convert the homogeneous numeric vector @var{uvec} to a list.")
1182 #define FUNC_NAME s_scm_u32vector_to_list
1188 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1189 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U32
)
1190 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1192 idx
= SCM_UVEC_LENGTH (uvec
);
1193 p
= (int_u32
*) SCM_UVEC_BASE (uvec
) + idx
;
1197 res
= scm_cons (scm_uint2num (*p
), res
);
1204 SCM_DEFINE (scm_list_to_u32vector
, "list->u32vector", 1, 0, 0,
1206 "Convert the list @var{l}, which must only contain unsigned\n"
1207 "32-bit values, to a numeric homogeneous vector.")
1208 #define FUNC_NAME s_scm_list_to_u32vector
1215 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
1217 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U32
, n
);
1218 p
= (int_u32
*) SCM_UVEC_BASE (uvec
);
1219 while (SCM_CONSP (l
))
1222 f
= scm_num2uint (SCM_CAR (l
), 2, FUNC_NAME
);
1232 /* ================================================================ */
1233 /* S32 procedures. */
1234 /* ================================================================ */
1237 SCM_DEFINE (scm_s32vector_p
, "s32vector?", 1, 0, 0,
1239 "Return @code{#t} if @var{obj} is a vector of type s32,\n"
1240 "@code{#f} otherwise.")
1241 #define FUNC_NAME s_scm_s32vector_p
1243 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
1244 SCM_UVEC_TYPE (obj
) == SCM_UVEC_S32
);
1249 SCM_DEFINE (scm_make_s32vector
, "make-s32vector", 1, 1, 0,
1251 "Create a newly allocated homogeneous numeric vector which can\n"
1252 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
1253 "initialize the elements, otherwise the contents of the vector\n"
1255 #define FUNC_NAME s_scm_make_s32vector
1262 SCM_VALIDATE_INUM (1, n
);
1263 count
= SCM_INUM (n
);
1264 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S32
, count
);
1265 if (SCM_UNBNDP (fill
))
1268 f
= scm_num2int (fill
, 2, FUNC_NAME
);
1269 p
= (int_s32
*) SCM_UVEC_BASE (uvec
);
1277 SCM_DEFINE (scm_s32vector
, "s32vector", 0, 0, 1,
1279 "Create a newly allocated homogeneous numeric vector containing\n"
1280 "all argument values.")
1281 #define FUNC_NAME s_scm_s32vector
1283 SCM_VALIDATE_REST_ARGUMENT (l
);
1284 return scm_list_to_s32vector (l
);
1289 SCM_DEFINE (scm_s32vector_length
, "s32vector-length", 1, 0, 0,
1291 "Return the number of elements in the homogeneous numeric vector\n"
1293 #define FUNC_NAME s_scm_s32vector_length
1295 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1296 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S32
)
1297 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1298 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
1303 SCM_DEFINE (scm_s32vector_ref
, "s32vector-ref", 2, 0, 0,
1304 (SCM uvec
, SCM index
),
1305 "Return the element at @var{index} in the homogeneous numeric\n"
1306 "vector @var{uvec}.")
1307 #define FUNC_NAME s_scm_s32vector_ref
1311 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1312 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S32
)
1313 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1315 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1316 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1317 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1319 return scm_int2num (((int_s32
*) SCM_UVEC_BASE (uvec
))[idx
]);
1324 SCM_DEFINE (scm_s32vector_set_x
, "s32vector-set!", 3, 0, 0,
1325 (SCM uvec
, SCM index
, SCM value
),
1326 "Set the element at @var{index} in the homogeneous numeric\n"
1327 "vector @var{uvec} to @var{value}. The return value is not\n"
1329 #define FUNC_NAME s_scm_s32vector_ref
1334 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1335 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S32
)
1336 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1338 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1339 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1340 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1342 f
= scm_num2int (value
, 3, FUNC_NAME
);
1344 ((int_s32
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
1345 return SCM_UNSPECIFIED
;
1350 SCM_DEFINE (scm_s32vector_to_list
, "s32vector->list", 1, 0, 0,
1352 "Convert the homogeneous numeric vector @var{uvec} to a list.")
1353 #define FUNC_NAME s_scm_s32vector_to_list
1359 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1360 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S32
)
1361 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1363 idx
= SCM_UVEC_LENGTH (uvec
);
1364 p
= (int_s32
*) SCM_UVEC_BASE (uvec
) + idx
;
1368 res
= scm_cons (scm_int2num (*p
), res
);
1375 SCM_DEFINE (scm_list_to_s32vector
, "list->s32vector", 1, 0, 0,
1377 "Convert the list @var{l}, which must only contain signed\n"
1378 "32-bit values, to a numeric homogeneous vector.")
1379 #define FUNC_NAME s_scm_list_to_s32vector
1386 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
1388 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S32
, n
);
1389 p
= (int_s32
*) SCM_UVEC_BASE (uvec
);
1390 while (SCM_CONSP (l
))
1393 f
= scm_num2int (SCM_CAR (l
), 2, FUNC_NAME
);
1403 #ifdef SCM_HAVE_T_INT64
1405 /* ================================================================ */
1406 /* U64 procedures. */
1407 /* ================================================================ */
1410 SCM_DEFINE (scm_u64vector_p
, "u64vector?", 1, 0, 0,
1412 "Return @code{#t} if @var{obj} is a vector of type u64,\n"
1413 "@code{#f} otherwise.")
1414 #define FUNC_NAME s_scm_u64vector_p
1416 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
1417 SCM_UVEC_TYPE (obj
) == SCM_UVEC_U64
);
1422 SCM_DEFINE (scm_make_u64vector
, "make-u64vector", 1, 1, 0,
1424 "Create a newly allocated homogeneous numeric vector which can\n"
1425 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
1426 "initialize the elements, otherwise the contents of the vector\n"
1428 #define FUNC_NAME s_scm_make_u64vector
1435 SCM_VALIDATE_INUM (1, n
);
1436 count
= SCM_INUM (n
);
1437 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U64
, count
);
1438 if (SCM_UNBNDP (fill
))
1441 f
= scm_num2ulong_long (fill
, 2, FUNC_NAME
);
1442 p
= (int_u64
*) SCM_UVEC_BASE (uvec
);
1450 SCM_DEFINE (scm_u64vector
, "u64vector", 0, 0, 1,
1452 "Create a newly allocated homogeneous numeric vector containing\n"
1453 "all argument values.")
1454 #define FUNC_NAME s_scm_u64vector
1456 SCM_VALIDATE_REST_ARGUMENT (l
);
1457 return scm_list_to_u64vector (l
);
1462 SCM_DEFINE (scm_u64vector_length
, "u64vector-length", 1, 0, 0,
1464 "Return the number of elements in the homogeneous numeric vector\n"
1466 #define FUNC_NAME s_scm_u64vector_length
1468 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1469 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U64
)
1470 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1471 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
1476 SCM_DEFINE (scm_u64vector_ref
, "u64vector-ref", 2, 0, 0,
1477 (SCM uvec
, SCM index
),
1478 "Return the element at @var{index} in the homogeneous numeric\n"
1479 "vector @var{uvec}.")
1480 #define FUNC_NAME s_scm_u64vector_ref
1484 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1485 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U64
)
1486 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1488 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1489 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1490 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1492 return scm_ulong_long2num (((int_u64
*) SCM_UVEC_BASE (uvec
))[idx
]);
1497 SCM_DEFINE (scm_u64vector_set_x
, "u64vector-set!", 3, 0, 0,
1498 (SCM uvec
, SCM index
, SCM value
),
1499 "Set the element at @var{index} in the homogeneous numeric\n"
1500 "vector @var{uvec} to @var{value}. The return value is not\n"
1502 #define FUNC_NAME s_scm_u64vector_ref
1507 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1508 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U64
)
1509 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1511 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1512 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1513 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1515 f
= scm_num2ulong_long (value
, 3, FUNC_NAME
);
1517 ((int_u64
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
1518 return SCM_UNSPECIFIED
;
1523 SCM_DEFINE (scm_u64vector_to_list
, "u64vector->list", 1, 0, 0,
1525 "Convert the homogeneous numeric vector @var{uvec} to a list.")
1526 #define FUNC_NAME s_scm_u64vector_to_list
1532 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1533 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_U64
)
1534 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1536 idx
= SCM_UVEC_LENGTH (uvec
);
1537 p
= (int_u64
*) SCM_UVEC_BASE (uvec
) + idx
;
1541 res
= scm_cons (scm_long_long2num (*p
), res
);
1548 SCM_DEFINE (scm_list_to_u64vector
, "list->u64vector", 1, 0, 0,
1550 "Convert the list @var{l}, which must only contain unsigned\n"
1551 "64-bit values, to a numeric homogeneous vector.")
1552 #define FUNC_NAME s_scm_list_to_u64vector
1559 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
1561 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_U64
, n
);
1562 p
= (int_u64
*) SCM_UVEC_BASE (uvec
);
1563 while (SCM_CONSP (l
))
1566 f
= scm_num2ulong_long (SCM_CAR (l
), 2, FUNC_NAME
);
1576 /* ================================================================ */
1577 /* S64 procedures. */
1578 /* ================================================================ */
1581 SCM_DEFINE (scm_s64vector_p
, "s64vector?", 1, 0, 0,
1583 "Return @code{#t} if @var{obj} is a vector of type s64,\n"
1584 "@code{#f} otherwise.")
1585 #define FUNC_NAME s_scm_s64vector_p
1587 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
1588 SCM_UVEC_TYPE (obj
) == SCM_UVEC_S64
);
1593 SCM_DEFINE (scm_make_s64vector
, "make-s64vector", 1, 1, 0,
1595 "Create a newly allocated homogeneous numeric vector which can\n"
1596 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
1597 "initialize the elements, otherwise the contents of the vector\n"
1599 #define FUNC_NAME s_scm_make_s64vector
1606 SCM_VALIDATE_INUM (1, n
);
1607 count
= SCM_INUM (n
);
1608 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S64
, count
);
1609 if (SCM_UNBNDP (fill
))
1612 f
= scm_num2long_long (fill
, 2, FUNC_NAME
);
1613 p
= (int_s64
*) SCM_UVEC_BASE (uvec
);
1621 SCM_DEFINE (scm_s64vector
, "s64vector", 0, 0, 1,
1623 "Create a newly allocated homogeneous numeric vector containing\n"
1624 "all argument values.")
1625 #define FUNC_NAME s_scm_s64vector
1627 SCM_VALIDATE_REST_ARGUMENT (l
);
1628 return scm_list_to_s64vector (l
);
1633 SCM_DEFINE (scm_s64vector_length
, "s64vector-length", 1, 0, 0,
1635 "Return the number of elements in the homogeneous numeric vector\n"
1637 #define FUNC_NAME s_scm_s64vector_length
1639 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1640 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S64
)
1641 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1642 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
1647 SCM_DEFINE (scm_s64vector_ref
, "s64vector-ref", 2, 0, 0,
1648 (SCM uvec
, SCM index
),
1649 "Return the element at @var{index} in the homogeneous numeric\n"
1650 "vector @var{uvec}.")
1651 #define FUNC_NAME s_scm_s64vector_ref
1655 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1656 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S64
)
1657 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1659 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1660 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1661 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1663 return scm_long_long2num (((int_s64
*) SCM_UVEC_BASE (uvec
))[idx
]);
1668 SCM_DEFINE (scm_s64vector_set_x
, "s64vector-set!", 3, 0, 0,
1669 (SCM uvec
, SCM index
, SCM value
),
1670 "Set the element at @var{index} in the homogeneous numeric\n"
1671 "vector @var{uvec} to @var{value}. The return value is not\n"
1673 #define FUNC_NAME s_scm_s64vector_ref
1678 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1679 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S64
)
1680 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1682 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1683 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1684 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1686 f
= scm_num2long_long (value
, 3, FUNC_NAME
);
1688 ((int_s64
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
1689 return SCM_UNSPECIFIED
;
1694 SCM_DEFINE (scm_s64vector_to_list
, "s64vector->list", 1, 0, 0,
1696 "Convert the homogeneous numeric vector @var{uvec} to a list.")
1697 #define FUNC_NAME s_scm_s64vector_to_list
1703 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1704 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_S64
)
1705 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1707 idx
= SCM_UVEC_LENGTH (uvec
);
1708 p
= (int_s64
*) SCM_UVEC_BASE (uvec
) + idx
;
1712 res
= scm_cons (scm_long_long2num (*p
), res
);
1719 SCM_DEFINE (scm_list_to_s64vector
, "list->s64vector", 1, 0, 0,
1721 "Convert the list @var{l}, which must only contain signed\n"
1722 "64-bit values, to a numeric homogeneous vector.")
1723 #define FUNC_NAME s_scm_list_to_s64vector
1730 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
1732 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_S64
, n
);
1733 p
= (int_s64
*) SCM_UVEC_BASE (uvec
);
1734 while (SCM_CONSP (l
))
1737 f
= scm_num2long_long (SCM_CAR (l
), 2, FUNC_NAME
);
1746 #endif /* SCM_HAVE_T_INT64 */
1749 /* ================================================================ */
1750 /* F32 procedures. */
1751 /* ================================================================ */
1754 SCM_DEFINE (scm_f32vector_p
, "f32vector?", 1, 0, 0,
1756 "Return @code{#t} if @var{obj} is a vector of type f32,\n"
1757 "@code{#f} otherwise.")
1758 #define FUNC_NAME s_scm_f32vector_p
1760 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
1761 SCM_UVEC_TYPE (obj
) == SCM_UVEC_F32
);
1766 SCM_DEFINE (scm_make_f32vector
, "make-f32vector", 1, 1, 0,
1768 "Create a newly allocated homogeneous numeric vector which can\n"
1769 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
1770 "initialize the elements, otherwise the contents of the vector\n"
1772 #define FUNC_NAME s_scm_make_f32vector
1779 SCM_VALIDATE_INUM (1, n
);
1780 count
= SCM_INUM (n
);
1781 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_F32
, count
);
1782 if (SCM_UNBNDP (fill
))
1786 double d
= scm_num2dbl (fill
, FUNC_NAME
);
1789 /* This test somehow fails for even the simplest inexact
1790 numbers, like 3.1. Must find out how to check properly. */
1792 scm_out_of_range_pos (FUNC_NAME
, fill
, SCM_MAKINUM (2));
1795 p
= (float_f32
*) SCM_UVEC_BASE (uvec
);
1803 SCM_DEFINE (scm_f32vector
, "f32vector", 0, 0, 1,
1805 "Create a newly allocated homogeneous numeric vector containing\n"
1806 "all argument values.")
1807 #define FUNC_NAME s_scm_f32vector
1809 SCM_VALIDATE_REST_ARGUMENT (l
);
1810 return scm_list_to_f32vector (l
);
1815 SCM_DEFINE (scm_f32vector_length
, "f32vector-length", 1, 0, 0,
1817 "Return the number of elements in the homogeneous numeric vector\n"
1819 #define FUNC_NAME s_scm_f32vector_length
1821 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1822 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F32
)
1823 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1824 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
1829 SCM_DEFINE (scm_f32vector_ref
, "f32vector-ref", 2, 0, 0,
1830 (SCM uvec
, SCM index
),
1831 "Return the element at @var{index} in the homogeneous numeric\n"
1832 "vector @var{uvec}.")
1833 #define FUNC_NAME s_scm_f32vector_ref
1837 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1838 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F32
)
1839 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1841 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1842 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1843 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1845 return scm_make_real (((float_f32
*) SCM_UVEC_BASE (uvec
))[idx
]);
1850 SCM_DEFINE (scm_f32vector_set_x
, "f32vector-set!", 3, 0, 0,
1851 (SCM uvec
, SCM index
, SCM value
),
1852 "Set the element at @var{index} in the homogeneous numeric\n"
1853 "vector @var{uvec} to @var{value}. The return value is not\n"
1855 #define FUNC_NAME s_scm_f32vector_ref
1861 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1862 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F32
)
1863 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1865 idx
= scm_num2int (index
, 2, FUNC_NAME
);
1866 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
1867 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
1869 d
= scm_num2dbl (value
, FUNC_NAME
);
1872 /* This test somehow fails for even the simplest inexact
1873 numbers, like 3.1. Must find out how to check properly. */
1875 scm_out_of_range_pos (FUNC_NAME
, value
, SCM_MAKINUM (3));
1878 ((float_f32
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
1879 return SCM_UNSPECIFIED
;
1884 SCM_DEFINE (scm_f32vector_to_list
, "f32vector->list", 1, 0, 0,
1886 "Convert the homogeneous numeric vector @var{uvec} to a list.")
1887 #define FUNC_NAME s_scm_f32vector_to_list
1893 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
1894 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F32
)
1895 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
1897 idx
= SCM_UVEC_LENGTH (uvec
);
1898 p
= (float_f32
*) SCM_UVEC_BASE (uvec
) + idx
;
1902 res
= scm_cons (scm_make_real (*p
), res
);
1909 SCM_DEFINE (scm_list_to_f32vector
, "list->f32vector", 1, 0, 0,
1911 "Convert the list @var{l}, which must only contain unsigned\n"
1912 "8-bit values, to a numeric homogeneous vector.")
1913 #define FUNC_NAME s_scm_list_to_f32vector
1920 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
1922 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_F32
, n
);
1923 p
= (float_f32
*) SCM_UVEC_BASE (uvec
);
1924 while (SCM_CONSP (l
))
1928 d
= scm_num2dbl (SCM_CAR (l
), FUNC_NAME
);
1931 /* This test somehow fails for even the simplest inexact
1932 numbers, like 3.1. Must find out how to check properly. */
1934 scm_out_of_range_pos (FUNC_NAME
, l
, SCM_MAKINUM (1));
1945 /* ================================================================ */
1946 /* F64 procedures. */
1947 /* ================================================================ */
1950 SCM_DEFINE (scm_f64vector_p
, "f64vector?", 1, 0, 0,
1952 "Return @code{#t} if @var{obj} is a vector of type f64,\n"
1953 "@code{#f} otherwise.")
1954 #define FUNC_NAME s_scm_f64vector_p
1956 return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_uvec
, obj
) &&
1957 SCM_UVEC_TYPE (obj
) == SCM_UVEC_F64
);
1962 SCM_DEFINE (scm_make_f64vector
, "make-f64vector", 1, 1, 0,
1964 "Create a newly allocated homogeneous numeric vector which can\n"
1965 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
1966 "initialize the elements, otherwise the contents of the vector\n"
1968 #define FUNC_NAME s_scm_make_f64vector
1975 SCM_VALIDATE_INUM (1, n
);
1976 count
= SCM_INUM (n
);
1977 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_F64
, count
);
1978 if (SCM_UNBNDP (fill
))
1981 f
= scm_num2dbl (fill
, FUNC_NAME
);
1982 p
= (float_f64
*) SCM_UVEC_BASE (uvec
);
1990 SCM_DEFINE (scm_f64vector
, "f64vector", 0, 0, 1,
1992 "Create a newly allocated homogeneous numeric vector containing\n"
1993 "all argument values.")
1994 #define FUNC_NAME s_scm_f64vector
1996 SCM_VALIDATE_REST_ARGUMENT (l
);
1997 return scm_list_to_f64vector (l
);
2002 SCM_DEFINE (scm_f64vector_length
, "f64vector-length", 1, 0, 0,
2004 "Return the number of elements in the homogeneous numeric vector\n"
2006 #define FUNC_NAME s_scm_f64vector_length
2008 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
2009 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F64
)
2010 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
2011 return scm_int2num (SCM_UVEC_LENGTH (uvec
));
2016 SCM_DEFINE (scm_f64vector_ref
, "f64vector-ref", 2, 0, 0,
2017 (SCM uvec
, SCM index
),
2018 "Return the element at @var{index} in the homogeneous numeric\n"
2019 "vector @var{uvec}.")
2020 #define FUNC_NAME s_scm_f64vector_ref
2024 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
2025 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F64
)
2026 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
2028 idx
= scm_num2int (index
, 2, FUNC_NAME
);
2029 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
2030 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
2032 return scm_make_real (((float_f64
*) SCM_UVEC_BASE (uvec
))[idx
]);
2037 SCM_DEFINE (scm_f64vector_set_x
, "f64vector-set!", 3, 0, 0,
2038 (SCM uvec
, SCM index
, SCM value
),
2039 "Set the element at @var{index} in the homogeneous numeric\n"
2040 "vector @var{uvec} to @var{value}. The return value is not\n"
2042 #define FUNC_NAME s_scm_f64vector_ref
2047 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
2048 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F64
)
2049 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
2051 idx
= scm_num2int (index
, 2, FUNC_NAME
);
2052 if (idx
< 0 || idx
>= SCM_UVEC_LENGTH (uvec
))
2053 scm_out_of_range_pos (FUNC_NAME
, index
, SCM_MAKINUM (2));
2055 f
= scm_num2dbl (value
, FUNC_NAME
);
2057 ((float_f64
*) SCM_UVEC_BASE (uvec
))[idx
] = f
;
2058 return SCM_UNSPECIFIED
;
2063 SCM_DEFINE (scm_f64vector_to_list
, "f64vector->list", 1, 0, 0,
2065 "Convert the homogeneous numeric vector @var{uvec} to a list.")
2066 #define FUNC_NAME s_scm_f64vector_to_list
2072 SCM_VALIDATE_SMOB (1, uvec
, uvec
);
2073 if (SCM_UVEC_TYPE (uvec
) != SCM_UVEC_F64
)
2074 scm_wrong_type_arg (FUNC_NAME
, 1, uvec
);
2076 idx
= SCM_UVEC_LENGTH (uvec
);
2077 p
= (float_f64
*) SCM_UVEC_BASE (uvec
) + idx
;
2081 res
= scm_cons (scm_make_real (*p
), res
);
2088 SCM_DEFINE (scm_list_to_f64vector
, "list->f64vector", 1, 0, 0,
2090 "Convert the list @var{l}, which must only contain signed\n"
2091 "8-bit values, to a numeric homogeneous vector.")
2092 #define FUNC_NAME s_scm_list_to_f64vector
2099 SCM_VALIDATE_LIST_COPYLEN (1, l
, n
);
2101 uvec
= make_uvec (FUNC_NAME
, SCM_UVEC_F64
, n
);
2102 p
= (float_f64
*) SCM_UVEC_BASE (uvec
);
2103 while (SCM_CONSP (l
))
2105 float_f64 f
= scm_num2dbl (SCM_CAR (l
), FUNC_NAME
);
2115 /* Create the smob type for homogeneous numeric vectors and install
2118 scm_init_srfi_4 (void)
2120 scm_tc16_uvec
= scm_make_smob_type ("uvec", 0);
2121 scm_set_smob_free (scm_tc16_uvec
, uvec_free
);
2122 scm_set_smob_print (scm_tc16_uvec
, uvec_print
);
2123 #include "srfi/srfi-4.x"
2126 /* End of srfi-4.c. */