srfi/srfi-4.c

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