From 39b1568b1e1c58cc61946a6347338c938cb22b23 Mon Sep 17 00:00:00 2001 From: Panayotis Skordos Date: Sat, 9 Jul 1988 11:18:24 +0000 Subject: [PATCH] 1.array-make-polar returns angle=0 for x,y=0,0 2.added procs: array-accumulate, array-cons-reals, array-read-2bint-file --- v7/src/microcode/array.c | 238 +++++++++++++++++++++++++++++---------- 1 file changed, 178 insertions(+), 60 deletions(-) diff --git a/v7/src/microcode/array.c b/v7/src/microcode/array.c index d53b61b1e..91c4bf5b1 100644 --- a/v7/src/microcode/array.c +++ b/v7/src/microcode/array.c @@ -30,15 +30,21 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/array.c,v 9.30 1988/05/05 09:29:44 cph Exp $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/array.c,v 9.31 1988/07/09 11:18:24 pas Exp $ */ -/* CONTAINS: */ -/* Scheme_Array constructors, and selectors */ -/* Also procedures for converting between C_Array, and Scheme_Vector */ +/* ARRAY = + sequence of REAL(float or double numbers) with a tag on the front */ +/*___________________________________________________________________*/ +/* contents + Scheme_Array datatype + constructors, selectors, operators + procedures for converting between C_Array, and Scheme_Vector + basic and advanced array primitive operations (see manual.scm) */ +/*___________________________________________________________________*/ + +/* See array.h for definition using NM_VECTOR, + and for many useful EXTERN */ -/* See array.h for definition using NM_VECTOR, */ -/* and for many useful EXTERN */ -/* ARRAY = SEQUENCE OF REALS */ #include "scheme.h" #include "primitive.h" @@ -47,8 +53,10 @@ MIT in each case. */ #include #include /* contains some math constants */ +/*__________________________________________________________*/ + -/* first a useful procedure */ +/* First some utilities */ int Scheme_Number_To_REAL(Arg, Cell) Pointer Arg; REAL *Cell; /* 0 means conversion ok, 1 means too big, 2 means not a number */ @@ -108,8 +116,7 @@ int Scheme_Number_To_Double(Arg, Cell) Pointer Arg; double *Cell; return (0); } - -/**** SCHEME PRIMITIVES *****/ +/*__________________begin__________________*/ /* I think this is not needed, can be done at s-code ... Define_Primitive(Prim_Array_Predicate, 1, "ARRAY?") @@ -138,7 +145,6 @@ Define_Primitive(Prim_Array_Cons, 2, "ARRAY-CONS") REAL Init_Value, *Next; int Error_Number; Pointer Result; - Primitive_2_Args(); Arg_1_Type(TC_FIXNUM); Range_Check(Length, Arg1, 0, ARRAY_MAX_LENGTH, ERR_ARG_1_BAD_RANGE); @@ -149,10 +155,29 @@ Define_Primitive(Prim_Array_Cons, 2, "ARRAY-CONS") Allocate_Array(Result,Length,allocated_cells); Next = Scheme_Array_To_C_Array(Result); + for (i=0; i waste lots of space. + */ +Define_Primitive(Prim_Array_Read_2bint_File, 2, "ARRAY-READ-2BINT-FILE") +{ FILE *fp; + long Length, allocated_cells; + REAL *a; + SCHEME_ARRAY Result; + Primitive_2_Args(); + Arg_1_Type(TC_CHARACTER_STRING); /* filename */ + Arg_2_Type(TC_FIXNUM); /* length of data */ + Length = Get_Integer(Arg2); + if (Length <= 0) Primitive_Error(ERR_ARG_2_BAD_RANGE); + Allocate_Array(Result, Length, allocated_cells); + if (!(Open_File(Arg1, "r", &fp))) Primitive_Error(ERR_ARG_1_BAD_RANGE); + printf("Reading 2bint file ...\n"); fflush(stdout); + a = Scheme_Array_To_C_Array(Result); + C_Array_Read_2bint_File(a,Length,fp); + return Result; +} +C_Array_Read_2bint_File(a,N,fp) + REAL *a; long N; FILE *fp; +{ long i; + int foo1,foo2; + for (i=0;i= (fabs(((double) (a[i]-value))))) + return Make_Pointer(TC_FIXNUM, i); + else + return NIL; } Define_Primitive(Prim_Array_Min_Max_Index, 1, "ARRAY-MIN-MAX-INDEX") @@ -594,6 +701,11 @@ void C_Array_Find_Min_Max(x, n, nmin, nmax) REAL *x; long n, *nmax, *nmin; *nmin = nnmin ; *nmax = nnmax ; } + + +/* The following becomes obsolete. + Done using array-reduce + divide by array-length + */ Define_Primitive(Prim_Array_Find_Average, 1, "ARRAY-AVERAGE") { long Length; REAL average; Primitive_1_Args(); @@ -603,6 +715,10 @@ Define_Primitive(Prim_Array_Find_Average, 1, "ARRAY-AVERAGE") C_Array_Find_Average( Scheme_Array_To_C_Array(Arg1), Length, &average); Reduced_Flonum_Result((double) average); } +/* Computes the average in pieces, so as to reduce + roundoff smearing in cumulative sum. + example= first huge positive numbers, then small nums, then huge negative numbers. + */ void C_Array_Find_Average(Array, Length, pAverage) long Length; REAL *Array, *pAverage; { long i; @@ -673,7 +789,6 @@ Define_Primitive(Prim_Array_Clip_Min_Max, 3, "ARRAY-CLIP-MIN-MAX!") To_Here = Scheme_Array_To_C_Array(Result); if (xmin>xmax) Primitive_Error(ERR_ARG_3_BAD_RANGE); - for (i=0; i < Length; i++) { if ((*From_Here)xmax) *To_Here++ = xmax; @@ -702,12 +817,11 @@ Define_Primitive(Prim_Array_Make_Polar, 2, "ARRAY-MAKE-POLAR!") To_Here_Mag = Scheme_Array_To_C_Array(Result_Mag); To_Here_Phase = Scheme_Array_To_C_Array(Result_Phase); - for (i=0; i < Length; i++) { + for (i=0; i < Length; i++) + { C_Make_Polar(*From_Here_Real, *From_Here_Imag, *To_Here_Mag, *To_Here_Phase); - From_Here_Real++ ; - From_Here_Imag++ ; - To_Here_Mag++ ; - To_Here_Phase++ ; + From_Here_Real++ ; From_Here_Imag++ ; + To_Here_Mag++ ; To_Here_Phase++ ; } Primitive_GC_If_Needed(4); @@ -1157,6 +1271,10 @@ double integer_power(a, n) double a; long n; { return(a * integer_power(a, (n-1))); } } + +/* The following should go away. + Better done using ARRAY-CONS-INTEGERS, and ARRAY-UNARY-FUNCTION + */ Define_Primitive(Prim_Sample_Aperiodic_Function, 3, "SAMPLE-APERIODIC-FUNCTION") { long N, i, allocated_cells, Function_Number; double Sampling_Frequency, DT, DTi; -- 2.25.1