Change code for arrays of `double' floating-point numbers so that they

work on machines with floating-point alignment constraints.

diff --git a/v7/src/microcode/array.c b/v7/src/microcode/array.c
index 88c7e40cf975b25f55ff9d8aad37e454c386d9e1..8668d99df2e04abc0838ec480671c3b54f4c758d 100644 (file)
--- a/v7/src/microcode/array.c
+++ b/v7/src/microcode/array.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/array.c,v 9.43 1991/10/14 23:51:19 thanos Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/array.c,v 9.44 1991/12/20 22:48:36 cph Exp $
 
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987-91 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -86,13 +86,29 @@ flonum_to_real (argument, arg_number)
 \f
 SCHEME_OBJECT
 allocate_array (length)
-     fast long length;
+     long length;
 {
+#if (REAL_IS_DEFINED_DOUBLE == 0)
+
   fast SCHEME_OBJECT result =
     (allocate_non_marked_vector
      (TC_NON_MARKED_VECTOR, ((length * REAL_SIZE) + 1), true));
   FAST_MEMORY_SET (result, 1, length);
   return (result);
+
+#else /* (REAL_IS_DEFINED_DOUBLE != 0) */
+  
+  long n_words = (length * DOUBLE_SIZE);
+  ALIGN_FLOAT (Free);
+  Primitive_GC_If_Needed (n_words + 1);
+  {
+    SCHEME_OBJECT result = (MAKE_POINTER_OBJECT (TC_BIG_FLONUM, (Free)));
+    (*Free++) = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, n_words));
+    Free += n_words;
+    return (result);
+  }
+
+#endif /* (REAL_IS_DEFINED_DOUBLE != 0) */
 }
 
 DEFINE_PRIMITIVE ("VECTOR->ARRAY", Prim_vector_to_array, 1, 1, 0)

diff --git a/v7/src/microcode/array.h b/v7/src/microcode/array.h
index 8d11547fd34f6026881ec81cc8458d6456ab2c30..adfaa68ebfd5f54f08287e11c5734569513a2825 100644 (file)
--- a/v7/src/microcode/array.h
+++ b/v7/src/microcode/array.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/array.h,v 9.31 1989/09/20 23:05:33 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/array.h,v 9.32 1991/12/20 22:48:56 cph Exp $
 
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987-91 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -46,12 +46,25 @@ MIT in each case. */
 #define FLOAT_SIZE (BYTES_TO_WORDS (sizeof (float)))
 #define DOUBLE_SIZE (BYTES_TO_WORDS (sizeof (double)))
 
+#if (REAL_IS_DEFINED_DOUBLE == 0)
+
 /* Scheme_Arrays are implemented as NON_MARKED_VECTOR. */
 
 #define ARRAY_P NON_MARKED_VECTOR_P
 #define ARRAY_LENGTH(array) ((long) (FAST_MEMORY_REF ((array), 1)))
 #define ARRAY_CONTENTS(array) ((REAL *) (MEMORY_LOC (array, 2)))
 
+#else /* (REAL_IS_DEFINED_DOUBLE != 0) */
+
+/* Scheme_Arrays are implemented as flonum vectors.
+   This is required to get alignment to work right on RISC machines. */
+
+#define ARRAY_P FLONUM_P
+#define ARRAY_LENGTH(array) ((VECTOR_LENGTH (array)) / DOUBLE_SIZE)
+#define ARRAY_CONTENTS(array) ((REAL *) (MEMORY_LOC (array, 1)))
+
+#endif /* (REAL_IS_DEFINED_DOUBLE != 0) */
+
 extern SCHEME_OBJECT allocate_array ();
 
 extern void C_Array_Find_Min_Max ();

diff --git a/v7/src/microcode/fft.c b/v7/src/microcode/fft.c
index 2a011ea9449e38a91f70144bf7251f4b8d16998e..1d8cf6fcc2efcd39c92fe96a553760939255020a 100644 (file)
--- a/v7/src/microcode/fft.c
+++ b/v7/src/microcode/fft.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/fft.c,v 9.29 1990/01/02 18:35:22 pas Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/fft.c,v 9.30 1991/12/20 22:49:07 cph Exp $
 
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987-91 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -1435,6 +1435,10 @@ C_Array_2D_FFT_In_Scheme_Heap(flag, nrows, ncols, Real_Array, Imag_Array)
       if ( (i % 2) == 1) error_bad_range_arg (1);
       i=i/2; }
 
+#if (REAL_IS_DEFINED_DOUBLE != 0)
+    ALIGN_FLOAT (Free);
+    Free += 1;
+#endif
     Primitive_GC_If_Needed(Length*REAL_SIZE + ((max(nrows,ncols))*3*REAL_SIZE));
     Work_Here = (REAL *) Free;
     g1 = Work_Here;
@@ -1478,6 +1482,10 @@ Square_Image_2D_FFT_In_Scheme_Heap(flag, nrows, Real_Array, Imag_Array)
   for (nrows_power=0, i=nrows; i>1; nrows_power++) { /* FIND/CHECK POWERS OF ROWS */
     if ( (i % 2) == 1) error_bad_range_arg (2);
     i=i/2; }
+#if (REAL_IS_DEFINED_DOUBLE != 0)
+    ALIGN_FLOAT (Free);
+    Free += 1;
+#endif
   Primitive_GC_If_Needed(nrows*3*REAL_SIZE);
   Work_Here = (REAL *) Free;
   g1 = Work_Here;
@@ -1538,6 +1546,10 @@ Cube_Space_3D_FFT_In_Scheme_Heap(flag, ndeps, Real_Array, Imag_Array)
   for (ndeps_power=0, l=ndeps; l>1; ndeps_power++) {                 /* FIND/CHECK POWER OF NDEPS */
     if ( (l % 2) == 1) error_bad_range_arg (2);
     l=l/2; }
+#if (REAL_IS_DEFINED_DOUBLE != 0)
+    ALIGN_FLOAT (Free);
+    Free += 1;
+#endif
   Primitive_GC_If_Needed(ndeps*3*REAL_SIZE);
   Work_Here = (REAL *) Free;
   g1 = Work_Here;
@@ -1596,6 +1608,10 @@ DEFINE_PRIMITIVE ("ARRAY-FFT!", Prim_array_fft, 3, 3, 0)
   f2 = ARRAY_CONTENTS(ARG_REF(3));
   if (f1==f2)  error_wrong_type_arg(2);
 
+#if (REAL_IS_DEFINED_DOUBLE != 0)
+    ALIGN_FLOAT (Free);
+    Free += 1;
+#endif
   Primitive_GC_If_Needed(length*3*REAL_SIZE);
   Work_Here = (REAL *) Free;
   g1 = Work_Here;
@@ -1640,6 +1656,10 @@ DEFINE_PRIMITIVE ("ARRAY-CZT!", Prim_array_czt, 6,6, 0)
   L  = 1<<log2_L;              /* length of intermediate computation arrays */
   maxMN =  (((M)<(N)) ? (N) : (M)); /* length of czt tables =  maximum(M,N) */
 
+#if (REAL_IS_DEFINED_DOUBLE != 0)
+    ALIGN_FLOAT (Free);
+    Free += 1;
+#endif
   Primitive_GC_If_Needed( ((7*L) + (2*maxMN)) * REAL_SIZE);
   g1  = (REAL *) Free;
   g2  = g1  + L;

diff --git a/v7/src/microcode/image.c b/v7/src/microcode/image.c
index 443dbea6ba94f34f1a9a51f0cb89e8db08f0092e..4959c321b318d30792fcc4d271febbb1200a8ce9 100644 (file)
--- a/v7/src/microcode/image.c
+++ b/v7/src/microcode/image.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/image.c,v 9.31 1990/01/15 18:09:34 pas Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/image.c,v 9.32 1991/12/20 22:49:23 cph Exp $
 
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987-91 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -215,6 +215,10 @@ DEFINE_PRIMITIVE ("IMAGE-READ-CTSCAN", Prim_read_image_ctscan, 1, 1, 0)
          (Array [array_index + m]) = ((REAL) (read_2bint (fp)));
       }
     /* CTSCAN images are upside down */
+#if (REAL_IS_DEFINED_DOUBLE != 0)
+    ALIGN_FLOAT (Free);
+    Free += 1;
+#endif
     Primitive_GC_If_Needed (512 * REAL_SIZE);
     Image_Mirror_Upside_Down (Array, nrows, ncols, ((REAL *) Free));
     if ((fclose (fp)) != 0)
@@ -598,6 +602,10 @@ DEFINE_PRIMITIVE ("IMAGE-ROTATE-90CLW!", Prim_image_rotate_90clw, 1, 1, 0)
     Array = (ARRAY_CONTENTS (Parray));
   }
   Length = (nrows * ncols);
+#if (REAL_IS_DEFINED_DOUBLE != 0)
+    ALIGN_FLOAT (Free);
+    Free += 1;
+#endif
   Primitive_GC_If_Needed (Length * REAL_SIZE);
   {
     REAL * Temp_Array = ((REAL *) Free);
@@ -625,6 +633,10 @@ DEFINE_PRIMITIVE ("IMAGE-ROTATE-90CCLW!", Prim_image_rotate_90cclw, 1, 1, 0)
     Array = (ARRAY_CONTENTS (Parray));
   }
   Length = (nrows * ncols);
+#if (REAL_IS_DEFINED_DOUBLE != 0)
+    ALIGN_FLOAT (Free);
+    Free += 1;
+#endif
   Primitive_GC_If_Needed (Length * REAL_SIZE);
   {
     REAL * Temp_Array = ((REAL *) Free);