From 1fb02f9bc961524d7eb572dda6f21b903c8e1e2a Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 5 Dec 1993 06:08:10 +0000
Subject: [PATCH] Generalize support for flonum vectors.
---
v7/src/microcode/dfloat.c | 92 ++++++++++++++++++---------------------
v7/src/microcode/object.h | 18 +++++++-
v7/src/microcode/prims.h | 6 +--
v8/src/microcode/object.h | 18 +++++++-
4 files changed, 80 insertions(+), 54 deletions(-)
diff --git a/v7/src/microcode/dfloat.c b/v7/src/microcode/dfloat.c
index 873e2a74a..32c53a76b 100644
--- a/v7/src/microcode/dfloat.c
+++ b/v7/src/microcode/dfloat.c
@@ -1,8 +1,8 @@
/* -*-C-*-
-$Id: dfloat.c,v 1.4 1993/06/24 07:07:55 gjr Exp $
+$Id: dfloat.c,v 1.5 1993/12/05 06:08:10 cph Exp $
-Copyright (c) 1991 Massachusetts Institute of Technology
+Copyright (c) 1991-93 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
@@ -37,68 +37,62 @@ MIT in each case. */
#include "scheme.h"
#include "prims.h"
-#define FLONUM_SIZE (BYTES_TO_WORDS (sizeof (double)))
-
-#define ARG_DOUBLE_VECTOR(argument_number) \
- ((FLONUM_P (ARG_REF (argument_number))) \
- ? (ARG_REF (argument_number)) \
- : ((error_wrong_type_arg (argument_number)), ((SCHEME_OBJECT) 0)))
-
-#define ARG_DOUBLE_VECTOR_INDEX(argument_number, vector) \
- (arg_index_integer (argument_number, \
- ((VECTOR_LENGTH (vector)) / FLONUM_SIZE)))
+#define FLOATING_VECTOR_INDEX_ARG(argument_number, vector) \
+ (arg_index_integer ((argument_number), (FLOATING_VECTOR_LENGTH (vector))))
DEFINE_PRIMITIVE ("FLOATING-VECTOR-CONS", Prim_floating_vector_cons, 1, 1, 0)
{
- long length = (arg_nonnegative_integer (1));
- long length_in_words = length * FLONUM_SIZE;
- SCHEME_OBJECT result;
- fast double *vect;
-
PRIMITIVE_HEADER (1);
- ALIGN_FLOAT (Free);
- Primitive_GC_If_Needed(length_in_words + 1);
- result = (MAKE_POINTER_OBJECT (TC_BIG_FLONUM, Free));
- *Free++ = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, length_in_words));
- vect = (double *) Free;
- while ((length--) > 0) (*vect++) = 0.0;
- Free = (SCHEME_OBJECT *) vect;
- PRIMITIVE_RETURN (result);
+ {
+ long length = (arg_nonnegative_integer (1));
+ long length_in_words = (length * FLONUM_SIZE);
+ SCHEME_OBJECT result;
+ fast double *vect;
+
+ ALIGN_FLOAT (Free);
+ Primitive_GC_If_Needed (length_in_words + 1);
+ result = (MAKE_POINTER_OBJECT (TC_BIG_FLONUM, Free));
+ (*Free++) = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, length_in_words));
+ vect = ((double *) Free);
+ while ((length--) > 0) (*vect++) = 0.0;
+ Free = ((SCHEME_OBJECT *) vect);
+ PRIMITIVE_RETURN (result);
+ }
}
-DEFINE_PRIMITIVE( "FLOATING-VECTOR-REF", Prim_floating_vector_ref,
- 2, 2, 0)
-{ SCHEME_OBJECT vector = ARG_DOUBLE_VECTOR(1);
- long index = ARG_DOUBLE_VECTOR_INDEX(2, vector);
- double *where = ((double *) VECTOR_LOC(vector, (index * FLONUM_SIZE)));
-
+DEFINE_PRIMITIVE ("FLOATING-VECTOR-REF", Prim_floating_vector_ref, 2, 2, 0)
+{
PRIMITIVE_HEADER (2);
- Primitive_GC_If_Needed(FLONUM_SIZE + 1);
- PRIMITIVE_RETURN (FLOAT_TO_FLONUM(*where));
+ {
+ SCHEME_OBJECT vector = (FLOATING_VECTOR_ARG (1));
+ Primitive_GC_If_Needed (FLONUM_SIZE + 1);
+ PRIMITIVE_RETURN
+ (FLOAT_TO_FLONUM
+ (FLOATING_VECTOR_REF (vector,
+ (FLOATING_VECTOR_INDEX_ARG (2, vector)))));
+ }
}
extern double EXFUN (arg_flonum, (int));
-DEFINE_PRIMITIVE( "FLOATING-VECTOR-SET!", Prim_floating_vector_set,
- 3, 3, 0)
-{ SCHEME_OBJECT vector = ARG_DOUBLE_VECTOR(1);
- long index = ARG_DOUBLE_VECTOR_INDEX(2, vector);
- double new_value = arg_flonum(3);
- double * where = ((double *) VECTOR_LOC(vector, (index * FLONUM_SIZE)));
-
+DEFINE_PRIMITIVE ("FLOATING-VECTOR-SET!", Prim_floating_vector_set, 3, 3, 0)
+{
PRIMITIVE_HEADER (3);
- /* Primitive_GC_If_Needed(FLONUM_SIZE + 1); */
- *where = new_value;
- /* double value = *where; */
- PRIMITIVE_RETURN (SHARP_F);
+ {
+ SCHEME_OBJECT vector = (FLOATING_VECTOR_ARG (1));
+ FLOATING_VECTOR_SET
+ (vector,
+ (FLOATING_VECTOR_INDEX_ARG (2, vector)),
+ (arg_flonum (3)));
+ }
+ PRIMITIVE_RETURN (UNSPECIFIC);
}
-DEFINE_PRIMITIVE ("FLOATING-VECTOR-LENGTH", Prim_floating_vector_length,
- 1, 1, 0)
+DEFINE_PRIMITIVE ("FLOATING-VECTOR-LENGTH", Prim_floating_vector_length, 1, 1,
+ 0)
{
- SCHEME_OBJECT vector = (ARG_DOUBLE_VECTOR (1));
PRIMITIVE_HEADER (1);
-
PRIMITIVE_RETURN
- (LONG_TO_UNSIGNED_FIXNUM ((VECTOR_LENGTH (vector)) / FLONUM_SIZE));
+ (LONG_TO_UNSIGNED_FIXNUM
+ (FLOATING_VECTOR_LENGTH (FLOATING_VECTOR_ARG (1))));
}
diff --git a/v7/src/microcode/object.h b/v7/src/microcode/object.h
index 4d0ed3f82..ed64cff64 100644
--- a/v7/src/microcode/object.h
+++ b/v7/src/microcode/object.h
@@ -1,6 +1,6 @@
/* -*-C-*-
-$Id: object.h,v 9.43 1993/10/14 19:19:02 gjr Exp $
+$Id: object.h,v 9.44 1993/12/05 06:07:52 cph Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
@@ -447,6 +447,8 @@ extern SCHEME_OBJECT * memory_base;
/* Flonum Operations */
+#define FLONUM_SIZE (BYTES_TO_WORDS (sizeof (double)))
+
#define FLONUM_TO_DOUBLE(object) \
(* ((double *) (MEMORY_LOC ((object), 1))))
@@ -456,6 +458,20 @@ extern SCHEME_OBJECT * memory_base;
#define FLONUM_TRUNCATE(object) \
(double_to_flonum (double_truncate (FLONUM_TO_DOUBLE (object))))
+/* Flonum-vector Operations */
+
+#define FLOATING_VECTOR_LENGTH(vector) \
+ ((VECTOR_LENGTH (vector)) / FLONUM_SIZE)
+
+#define FLOATING_VECTOR_LOC(vector, index) \
+ ((double *) (VECTOR_LOC ((vector), ((index) * FLONUM_SIZE))))
+
+#define FLOATING_VECTOR_REF(vector, index) \
+ (* (FLOATING_VECTOR_LOC ((vector), (index))))
+
+#define FLOATING_VECTOR_REF(vector, index, x) \
+ (* (FLOATING_VECTOR_LOC ((vector), (index)))) = ((double) (x))
+
/* Numeric Type Conversions */
#define BIGNUM_TO_FIXNUM_P(bignum) \
diff --git a/v7/src/microcode/prims.h b/v7/src/microcode/prims.h
index dcc7d9699..040d2e1e8 100644
--- a/v7/src/microcode/prims.h
+++ b/v7/src/microcode/prims.h
@@ -1,6 +1,6 @@
/* -*-C-*-
-$Id: prims.h,v 9.43 1993/08/03 08:29:59 gjr Exp $
+$Id: prims.h,v 9.44 1993/12/05 06:08:03 cph Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
@@ -136,7 +136,7 @@ extern long EXFUN (arg_ascii_integer, (int));
#define FLOATING_VECTOR_ARG(arg) \
((FLONUM_P (ARG_REF (arg))) \
- ? ((double *) (VECTOR_LOC (ARG_REF(arg), 0))) \
- : ((error_wrong_type_arg (arg)), ((double *) 0)))
+ ? (ARG_REF (arg)) \
+ : ((error_wrong_type_arg (arg)), ((SCHEME_OBJECT) 0)))
#endif /* SCM_PRIMS_H */
diff --git a/v8/src/microcode/object.h b/v8/src/microcode/object.h
index 4d0ed3f82..ed64cff64 100644
--- a/v8/src/microcode/object.h
+++ b/v8/src/microcode/object.h
@@ -1,6 +1,6 @@
/* -*-C-*-
-$Id: object.h,v 9.43 1993/10/14 19:19:02 gjr Exp $
+$Id: object.h,v 9.44 1993/12/05 06:07:52 cph Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
@@ -447,6 +447,8 @@ extern SCHEME_OBJECT * memory_base;
/* Flonum Operations */
+#define FLONUM_SIZE (BYTES_TO_WORDS (sizeof (double)))
+
#define FLONUM_TO_DOUBLE(object) \
(* ((double *) (MEMORY_LOC ((object), 1))))
@@ -456,6 +458,20 @@ extern SCHEME_OBJECT * memory_base;
#define FLONUM_TRUNCATE(object) \
(double_to_flonum (double_truncate (FLONUM_TO_DOUBLE (object))))
+/* Flonum-vector Operations */
+
+#define FLOATING_VECTOR_LENGTH(vector) \
+ ((VECTOR_LENGTH (vector)) / FLONUM_SIZE)
+
+#define FLOATING_VECTOR_LOC(vector, index) \
+ ((double *) (VECTOR_LOC ((vector), ((index) * FLONUM_SIZE))))
+
+#define FLOATING_VECTOR_REF(vector, index) \
+ (* (FLOATING_VECTOR_LOC ((vector), (index))))
+
+#define FLOATING_VECTOR_REF(vector, index, x) \
+ (* (FLOATING_VECTOR_LOC ((vector), (index)))) = ((double) (x))
+
/* Numeric Type Conversions */
#define BIGNUM_TO_FIXNUM_P(bignum) \
--
2.25.1