*** empty log message ***

[bpt/guile.git] / libguile / unif.h

diff --git a/libguile/unif.h b/libguile/unif.h
index 26c47a2..fd4d0e7 100644 (file)
--- a/libguile/unif.h
+++ b/libguile/unif.h
@@ -2,7 +2,7 @@
 
 #ifndef UNIFH
 #define UNIFH
-/*     Copyright (C) 1995,1996,1997,1999 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
@@ -42,6 +42,9 @@
  * 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.  */
+
+/* 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"
@@ -72,42 +75,50 @@ typedef struct scm_array_dim
 } scm_array_dim;
 
 
-extern long scm_tc16_array;
-#define SCM_ARRAYP(a)          (scm_tc16_array==SCM_TYP16(a))
-#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_CONTP(x)     (SCM_ARRAY_CONTIGUOUS & (SCM_CELL_WORD_0 (x)))
 
-#define SCM_ARRAY_V(a)           (((scm_array *)SCM_CDR(a))->v)
-#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_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))) 
 
-/* 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_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_HUGE_LENGTH(x)\
-  (SCM_LENGTH_MAX==SCM_LENGTH(x) ? *((long *)SCM_VELTS(x)) : SCM_LENGTH(x))
+#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
 
 extern scm_sizet scm_uniform_element_size (SCM obj);
-extern SCM scm_makflo (float x);
 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 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, 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);
@@ -127,4 +138,23 @@ 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);
 
+\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:
+*/