-/* Copyright (C) 1995,1996,1997,1998, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998, 2000, 2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* long long llvect
*/
-long scm_tc16_array;
+scm_bits_t scm_tc16_array;
/* return the size of an element in a uniform array or 0 if type not
found. */
SCM v;
long i, type;
- SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_LENGTH_MAX);
-
if (SCM_EQ_P (prot, SCM_BOOL_T))
{
SCM_NEWCELL (v);
if (k > 0)
{
+ SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_BITVECTOR_MAX_LENGTH);
i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
- SCM_SETCHARS (v, (char *) scm_must_malloc (i, "vector"));
+ SCM_SET_BITVECTOR_BASE (v, (char *) scm_must_malloc (i, "vector"));
SCM_SET_BITVECTOR_LENGTH (v, k);
}
else
{
- SCM_SETCHARS (v, 0);
+ SCM_SET_BITVECTOR_BASE (v, 0);
SCM_SET_BITVECTOR_LENGTH (v, 0);
}
return v;
{
i = sizeof (char) * k;
type = scm_tc7_byvect;
- }
+ }
else if (SCM_CHARP (prot))
{
i = sizeof (char) * k;
#endif
else
{
- return scm_make_vector (SCM_MAKINUM (k), SCM_UNDEFINED);
+ return scm_c_make_vector (k, SCM_UNDEFINED);
}
}
- else
- if (SCM_IMP (prot) || !SCM_INEXACTP (prot))
+ else if (!SCM_INEXACTP (prot))
/* Huge non-unif vectors are NOT supported. */
/* no special scm_vector */
- return scm_make_vector (SCM_MAKINUM (k), SCM_UNDEFINED);
+ return scm_c_make_vector (k, SCM_UNDEFINED);
else if (singp (prot))
{
i = sizeof (float) * k;
type = scm_tc7_dvect;
}
+ SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_UVECTOR_MAX_LENGTH);
+
SCM_NEWCELL (v);
SCM_DEFER_INTS;
- SCM_SETCHARS (v, (char *) scm_must_malloc (i ? i : 1, "vector"));
+ SCM_SET_UVECTOR_BASE (v, (char *) scm_must_malloc (i ? i : 1, "vector"));
SCM_SET_UVECTOR_LENGTH (v, k, type);
SCM_ALLOW_INTS;
return v;
SCM ra;
if (SCM_INUMP (dims))
{
- SCM answer;
-
- SCM_ASSERT_RANGE (1, dims, SCM_INUM (dims) <= SCM_LENGTH_MAX);
-
- answer = scm_make_uve (SCM_INUM (dims), prot);
+ SCM answer = scm_make_uve (SCM_INUM (dims), prot);
if (!SCM_UNBNDP (fill))
scm_array_fill_x (answer, fill);
else if (SCM_SYMBOLP (prot))
rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
}
- SCM_ASSERT_RANGE (1, dims, rlen <= SCM_LENGTH_MAX);
-
SCM_ARRAY_V (ra) = scm_make_uve (rlen, prot);
if (!SCM_UNBNDP (fill))
SCM
scm_cvref (SCM v, scm_sizet pos, SCM last)
+#define FUNC_NAME "scm_cvref"
{
switch SCM_TYP7 (v)
{
default:
- scm_wta (v, (char *) SCM_ARG1, "PROGRAMMING ERROR: scm_cvref");
+ SCM_WRONG_TYPE_ARG (SCM_ARG1, v);
case scm_tc7_bvect:
if (SCM_BITVEC_REF(v,pos))
return SCM_BOOL_T;
}
}
}
+#undef FUNC_NAME
+
SCM_REGISTER_PROC(s_uniform_array_set1_x, "uniform-array-set1!", 3, 0, 0, scm_array_set_x);
{0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4};
SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
- (SCM b, SCM bitvector),
- "Returns the number of occurrences of the boolean B in BITVECTOR.")
+ (SCM b, SCM bitvector),
+ "Returns the number of occurrences of the boolean @var{b} in\n"
+ "@var{bitvector}.")
#define FUNC_NAME s_scm_bit_count
{
SCM_VALIDATE_BOOL (1, b);
SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
- (SCM v, SCM kv, SCM obj),
- "If uve is a bit-vector @var{bv} and uve must be of the same length. If\n"
- "@var{bool} is @code{#t}, uve is OR'ed into @var{bv}; If @var{bool} is @code{#f}, the\n"
- "inversion of uve is AND'ed into @var{bv}.\n\n"
- "If uve is a unsigned integer vector all the elements of uve must be\n"
- "between 0 and the @code{LENGTH} of @var{bv}. The bits of @var{bv}\n"
- "corresponding to the indexes in uve are set to @var{bool}.\n\n"
- "The return value is unspecified.")
+ (SCM v, SCM kv, SCM obj),
+ "If uve is a bit-vector @var{bv} and uve must be of the same\n"
+ "length. If @var{bool} is @code{#t}, uve is OR'ed into\n"
+ "@var{bv}; If @var{bool} is @code{#f}, the inversion of uve is\n"
+ "AND'ed into @var{bv}.\n\n"
+ "If uve is a unsigned integer vector all the elements of uve\n"
+ "must be between 0 and the @code{length} of @var{bv}. The bits\n"
+ "of @var{bv} corresponding to the indexes in uve are set to\n"
+ "@var{bool}. The return value is unspecified.")
#define FUNC_NAME s_scm_bit_set_star_x
{
register long i, k, vlen;
rapr1 (SCM ra,scm_sizet j,scm_sizet k,SCM port,scm_print_state *pstate)
{
long inc = 1;
- long n = SCM_INUM (scm_uniform_vector_length (ra));
+ long n = (SCM_TYP7 (ra) == scm_tc7_smob
+ ? 0
+ : SCM_INUM (scm_uniform_vector_length (ra)));
int enclosed = 0;
tail:
switch SCM_TYP7 (ra)
case scm_tc7_ivect:
return SCM_MAKINUM (-1L);
case scm_tc7_svect:
- return SCM_CDR (scm_intern ("s", 1));
+ return scm_str2symbol ("s");
#ifdef HAVE_LONG_LONGS
case scm_tc7_llvect:
- return SCM_CDR (scm_intern ("l", 1));
+ return scm_str2symbol ("l");
#endif
case scm_tc7_fvect:
return scm_make_real (1.0);
static SCM
-markra (SCM ptr)
+array_mark (SCM ptr)
{
return SCM_ARRAY_V (ptr);
}
static scm_sizet
-freera (SCM ptr)
+array_free (SCM ptr)
{
scm_must_free (SCM_ARRAY_MEM (ptr));
return sizeof (scm_array) + SCM_ARRAY_NDIM (ptr) * sizeof (scm_array_dim);
void
scm_init_unif ()
{
- scm_tc16_array = scm_make_smob_type_mfpe ("array", 0,
- markra,
- freera,
- scm_raprin1,
- scm_array_equal_p);
+ scm_tc16_array = scm_make_smob_type ("array", 0);
+ scm_set_smob_mark (scm_tc16_array, array_mark);
+ scm_set_smob_free (scm_tc16_array, array_free);
+ scm_set_smob_print (scm_tc16_array, scm_raprin1);
+ scm_set_smob_equalp (scm_tc16_array, scm_array_equal_p);
scm_add_feature ("array");
#ifndef SCM_MAGIC_SNARFER
#include "libguile/unif.x"
HCoop / bpt / guile.git / blobdiff