#ifndef UNIFH
#define UNIFH
-/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999, 2000 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
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.
- */
+ * If you do not wish that, delete this exception notice. */
+
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+ gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
\f
#include "libguile/__scm.h"
\f
+
+/*
+ an array SCM is a non-immediate pointing to a heap cell with:
+
+ CAR: bits 0-14 hold the dimension (0 -- 32767)
+ bit 15 is the SCM_ARRAY_CONTIGUOUS flag
+ bits 16-31 hold the smob type id: scm_tc16_array
+ CDR: pointer to a malloced block containing an scm_array structure
+ followed by an scm_array_dim structure for each dimension.
+*/
+
typedef struct scm_array
{
- SCM v;
+ SCM v; /* the contents of the array, e.g., a vector or uniform vector. */
scm_sizet base;
} scm_array;
} scm_array_dim;
-extern long scm_tc16_array;
-#define SCM_ARRAYP(a) (scm_tc16_array==SCM_TYP16(a))
-#define SCM_ARRAY_V(a) (((scm_array *)SCM_CDR(a))->v)
-#define SCM_ARRAY_NDIM(x) ((scm_sizet)(SCM_CAR(x)>>17))
+extern scm_bits_t scm_tc16_array;
+#define SCM_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc16_array, a)
+#define SCM_ARRAY_NDIM(x) ((scm_sizet) (SCM_CELL_WORD_0 (x) >> 17))
#define SCM_ARRAY_CONTIGUOUS 0x10000
-#define SCM_ARRAY_CONTP(x) (SCM_ARRAY_CONTIGUOUS & (int)SCM_CAR(x))
-#define SCM_ARRAY_BASE(a) (((scm_array *)SCM_CDR(a))->base)
-#define SCM_ARRAY_DIMS(a) ((scm_array_dim *)(SCM_CHARS(a)+sizeof(scm_array)))
+#define SCM_ARRAY_CONTP(x) (SCM_ARRAY_CONTIGUOUS & (SCM_CELL_WORD_0 (x)))
+
+#define SCM_ARRAY_MEM(a) ((scm_array *) SCM_CELL_WORD_1 (a))
+#define SCM_ARRAY_V(a) (SCM_ARRAY_MEM (a)->v)
+#define SCM_ARRAY_BASE(a) (SCM_ARRAY_MEM (a)->base)
+#define SCM_ARRAY_DIMS(a) ((scm_array_dim *)((char *) SCM_ARRAY_MEM (a) + sizeof (scm_array)))
-#define SCM_HUGE_LENGTH(x) (SCM_LENGTH_MAX==SCM_LENGTH(x) ? *((long *)SCM_VELTS(x)) : SCM_LENGTH(x))
+#define SCM_UVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x)))
+#define SCM_SET_UVECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b)))
+#define SCM_UVECTOR_MAX_LENGTH (0xffffffL)
+#define SCM_UVECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
+#define SCM_SET_UVECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), ((l) << 8) + (t)))
+
+#define SCM_BITVECTOR_P(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_bvect))
+#define SCM_BITVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x)))
+#define SCM_SET_BITVECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b)))
+#define SCM_BITVECTOR_MAX_LENGTH (0xffffffL)
+#define SCM_BITVECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
+#define SCM_SET_BITVECTOR_LENGTH(v, l) (SCM_SET_CELL_WORD_0 ((v), ((l) << 8) + scm_tc7_bvect))
\f
-#ifdef __STDC__
-extern SCM scm_vector_set_length_x (SCM vect, SCM len);
-extern SCM scm_makflo (float x);
+
+extern scm_sizet scm_uniform_element_size (SCM obj);
extern SCM scm_make_uve (long k, SCM prot);
extern SCM scm_uniform_vector_length (SCM v);
extern SCM scm_array_p (SCM v, SCM prot);
extern SCM scm_array_rank (SCM ra);
extern SCM scm_array_dimensions (SCM ra);
-extern long scm_aind (SCM ra, SCM args, char *what);
+extern SCM scm_shared_array_root (SCM ra);
+extern SCM scm_shared_array_offset (SCM ra);
+extern SCM scm_shared_array_increments (SCM ra);
+extern long scm_aind (SCM ra, SCM args, const char *what);
extern SCM scm_make_ra (int ndim);
-extern SCM scm_shap2ra (SCM args, char *what);
+extern SCM scm_shap2ra (SCM args, const char *what);
extern SCM scm_dimensions_to_uniform_array (SCM dims, SCM prot, SCM fill);
extern void scm_ra_set_contp (SCM ra);
extern SCM scm_make_shared_array (SCM oldra, SCM mapfunc, SCM dims);
-extern SCM scm_transpose_array (SCM args);
-extern SCM scm_enclose_array (SCM axes);
-extern SCM scm_array_in_bounds_p (SCM args);
+extern SCM scm_transpose_array (SCM ra, SCM args);
+extern SCM scm_enclose_array (SCM ra, SCM axes);
+extern SCM scm_array_in_bounds_p (SCM v, SCM args);
extern SCM scm_uniform_vector_ref (SCM v, SCM args);
extern SCM scm_cvref (SCM v, scm_sizet pos, SCM last);
extern SCM scm_array_set_x (SCM v, SCM obj, SCM args);
extern SCM scm_array_contents (SCM ra, SCM strict);
extern SCM scm_ra2contig (SCM ra, int copy);
-extern SCM scm_uniform_array_read_x (SCM ra, SCM port);
-extern SCM scm_uniform_array_write (SCM v, SCM port);
+extern SCM scm_uniform_array_read_x (SCM ra, SCM port_or_fd, SCM start, SCM end);
+extern SCM scm_uniform_array_write (SCM v, SCM port_or_fd, SCM start, SCM end);
extern SCM scm_bit_count (SCM item, SCM seq);
extern SCM scm_bit_position (SCM item, SCM v, SCM k);
extern SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
extern SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
extern SCM scm_bit_invert_x (SCM v);
-extern SCM scm_string_upcase_x (SCM v);
-extern SCM scm_string_downcase_x (SCM v);
extern SCM scm_istr2bve (char *str, long len);
extern SCM scm_array_to_list (SCM v);
extern SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst);
-extern int scm_raprin1 (SCM exp, SCM port, int writing);
+extern int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);
extern SCM scm_array_prototype (SCM ra);
extern void scm_init_unif (void);
-#else /* STDC */
-extern SCM scm_vector_set_length_x ();
-extern SCM scm_makflo ();
-extern SCM scm_make_uve ();
-extern SCM scm_uniform_vector_length ();
-extern SCM scm_array_p ();
-extern SCM scm_array_rank ();
-extern SCM scm_array_dimensions ();
-extern long scm_aind ();
-extern SCM scm_make_ra ();
-extern SCM scm_shap2ra ();
-extern SCM scm_dimensions_to_uniform_array ();
-extern void scm_ra_set_contp ();
-extern SCM scm_make_shared_array ();
-extern SCM scm_transpose_array ();
-extern SCM scm_enclose_array ();
-extern SCM scm_array_in_bounds_p ();
-extern SCM scm_uniform_vector_ref ();
-extern SCM scm_cvref ();
-extern SCM scm_array_set_x ();
-extern SCM scm_array_contents ();
-extern SCM scm_ra2contig ();
-extern SCM scm_uniform_array_read_x ();
-extern SCM scm_uniform_array_write ();
-extern SCM scm_bit_count ();
-extern SCM scm_bit_position ();
-extern SCM scm_bit_set_star_x ();
-extern SCM scm_bit_count_star ();
-extern SCM scm_bit_invert_x ();
-extern SCM scm_string_upcase_x ();
-extern SCM scm_string_downcase_x ();
-extern SCM scm_istr2bve ();
-extern SCM scm_array_to_list ();
-extern SCM scm_list_to_uniform_array ();
-extern int scm_raprin1 ();
-extern SCM scm_array_prototype ();
-extern void scm_init_unif ();
-
-#endif /* STDC */
-
+\f
+#if (SCM_DEBUG_DEPRECATED == 0)
+/* apparently it's possible to have more than SCM_LENGTH_MAX elements
+ in an array: if the length is SCM_LENGTH_MAX then the SCM_VELTS
+ block begins with the true length (a long int). I wonder if it
+ works. */
+#define SCM_HUGE_LENGTH(x)\
+ (SCM_LENGTH_MAX==SCM_LENGTH(x) ? *((long *)SCM_VELTS(x)) : SCM_LENGTH(x))
+#endif /* SCM_DEBUG_DEPRECATED == 0 */
#endif /* UNIFH */
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/
HCoop / bpt / guile.git / blobdiff