srfi/srfi-4.c

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