From: Chris Hanson Date: Fri, 20 Dec 1991 22:49:23 +0000 (+0000) Subject: Change code for arrays of `double' floating-point numbers so that they X-Git-Tag: 20090517-FFI~10024 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d950effd757bd24df8d248f65582b0a4e90a7839;p=mit-scheme.git 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 88c7e40cf..8668d99df 100644 --- 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) 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 8d11547fd..adfaa68eb 100644 --- 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 2a011ea94..1d8cf6fcc 100644 --- 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<