From 1d7bdb2562b217b9c60ad76890642247ec0ea640 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Tue, 30 Nov 1999 18:23:52 +0000 Subject: [PATCH] * unif.h: added some comments, removed the SCM_P macros. * vports.c (sf_write): use scm_makfromstr, not scm_makfrom0str (thanks to Daniel Skarda). --- THANKS | 1 + libguile/ChangeLog | 9 +++++ libguile/ramap.c | 4 +- libguile/unif.c | 7 ++-- libguile/unif.h | 96 +++++++++++++++++++++++++++------------------- libguile/vports.c | 4 +- 6 files changed, 75 insertions(+), 46 deletions(-) diff --git a/THANKS b/THANKS index fe8ae7bd9..c7778b0a9 100644 --- a/THANKS +++ b/THANKS @@ -9,5 +9,6 @@ Bug reports and fixes from: Roland Orre Bertrand Petit Jorgen Schaefer + Daniel Skarda Bernard Urban Lynn Winebarger diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 91bae0ea1..1f2bef9bc 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,12 @@ +1999-11-30 Gary Houston + + * unif.h: added some comments, removed the SCM_P macros. + +1999-11-29 Gary Houston + + * vports.c (sf_write): use scm_makfromstr, not scm_makfrom0str + (thanks to Daniel Skarda). + 1999-11-22 Jim Blandy * gscm.c, gscm.h: Deleted. They were unused. diff --git a/libguile/ramap.c b/libguile/ramap.c index 68ecac65d..3f09fad45 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -253,10 +253,10 @@ scm_ra_matchp (ra0, ras) return exact; } -/* array mapper: apply cproc to each dimension of the given arrays. */ +/* array mapper: apply cproc to each dimension of the given arrays?. */ int scm_ramapc (cproc, data, ra0, lra, what) - int (*cproc) (); /* procedure to call on normalised arrays: + int (*cproc) (); /* procedure to call on unrolled arrays? cproc (dest, source list) or cproc (dest, data, source list). */ SCM data; /* data to give to cproc or unbound. */ diff --git a/libguile/unif.c b/libguile/unif.c index 98818e518..0384099d1 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -1290,14 +1290,15 @@ scm_array_set_x (v, obj, args) return SCM_UNSPECIFIED; } -/* extract an array from "ra" (regularised?), which may be an smob type. - returns #f on failure. */ +/* attempts to unroll an array into a one-dimensional array. + returns the unrolled array or #f if it can't be done. */ SCM_PROC(s_array_contents, "array-contents", 1, 1, 0, scm_array_contents); SCM scm_array_contents (ra, strict) SCM ra; - SCM strict; /* more checks if not SCM_UNDEFINED. */ + SCM strict; /* if not SCM_UNDEFINED, return #f if returned array + wouldn't have contiguous elements. */ { SCM sra; if (SCM_IMP (ra)) diff --git a/libguile/unif.h b/libguile/unif.h index 83b020fbc..26c47a286 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -2,7 +2,7 @@ #ifndef UNIFH #define UNIFH -/* Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1999 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 @@ -47,9 +47,20 @@ #include "libguile/__scm.h" + +/* + an array SCM is a non-immediate pointing to a heap cell with: + + CAR: bits 0-14 hold the dimension (0 -- 32767) + bit 15 is the SCM_ARRAY_CONTIGUOUS flag + bits 16-31 hold the smob type id: scm_tc16_array + CDR: pointer to a malloced block containing an scm_array structure + followed by an scm_array_dim structure for each dimension. +*/ + typedef struct scm_array { - SCM v; + SCM v; /* the contents of the array, e.g., a vector or uniform vector. */ scm_sizet base; } scm_array; @@ -63,50 +74,57 @@ typedef struct scm_array_dim extern long scm_tc16_array; #define SCM_ARRAYP(a) (scm_tc16_array==SCM_TYP16(a)) -#define SCM_ARRAY_V(a) (((scm_array *)SCM_CDR(a))->v) #define SCM_ARRAY_NDIM(x) ((scm_sizet)(SCM_CAR(x)>>17)) #define SCM_ARRAY_CONTIGUOUS 0x10000 #define SCM_ARRAY_CONTP(x) (SCM_ARRAY_CONTIGUOUS & (int)SCM_CAR(x)) -#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_HUGE_LENGTH(x) (SCM_LENGTH_MAX==SCM_LENGTH(x) ? *((long *)SCM_VELTS(x)) : SCM_LENGTH(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))) + +/* 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)) extern scm_sizet scm_uniform_element_size (SCM obj); -extern SCM scm_makflo SCM_P ((float x)); -extern SCM scm_make_uve SCM_P ((long k, SCM prot)); -extern SCM scm_uniform_vector_length SCM_P ((SCM v)); -extern SCM scm_array_p SCM_P ((SCM v, SCM prot)); -extern SCM scm_array_rank SCM_P ((SCM ra)); -extern SCM scm_array_dimensions SCM_P ((SCM ra)); -extern long scm_aind SCM_P ((SCM ra, SCM args, const char *what)); -extern SCM scm_make_ra SCM_P ((int ndim)); -extern SCM scm_shap2ra SCM_P ((SCM args, const char *what)); -extern SCM scm_dimensions_to_uniform_array SCM_P ((SCM dims, SCM prot, SCM fill)); -extern void scm_ra_set_contp SCM_P ((SCM ra)); -extern SCM scm_make_shared_array SCM_P ((SCM oldra, SCM mapfunc, SCM dims)); -extern SCM scm_transpose_array SCM_P ((SCM args)); -extern SCM scm_enclose_array SCM_P ((SCM axes)); -extern SCM scm_array_in_bounds_p SCM_P ((SCM args)); -extern SCM scm_uniform_vector_ref SCM_P ((SCM v, SCM args)); -extern SCM scm_cvref SCM_P ((SCM v, scm_sizet pos, SCM last)); -extern SCM scm_array_set_x SCM_P ((SCM v, SCM obj, SCM args)); -extern SCM scm_array_contents SCM_P ((SCM ra, SCM strict)); -extern SCM scm_ra2contig SCM_P ((SCM ra, int copy)); -extern SCM scm_uniform_array_read_x SCM_P ((SCM ra, SCM port_or_fd, SCM start, SCM end)); -extern SCM scm_uniform_array_write SCM_P ((SCM v, SCM port_or_fd, SCM start, SCM end)); -extern SCM scm_bit_count SCM_P ((SCM item, SCM seq)); -extern SCM scm_bit_position SCM_P ((SCM item, SCM v, SCM k)); -extern SCM scm_bit_set_star_x SCM_P ((SCM v, SCM kv, SCM obj)); -extern SCM scm_bit_count_star SCM_P ((SCM v, SCM kv, SCM obj)); -extern SCM scm_bit_invert_x SCM_P ((SCM v)); -extern SCM scm_istr2bve SCM_P ((char *str, long len)); -extern SCM scm_array_to_list SCM_P ((SCM v)); -extern SCM scm_list_to_uniform_array SCM_P ((SCM ndim, SCM prot, SCM lst)); -extern int scm_raprin1 SCM_P ((SCM exp, SCM port, scm_print_state *pstate)); -extern SCM scm_array_prototype SCM_P ((SCM ra)); -extern void scm_init_unif SCM_P ((void)); +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 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_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); +extern SCM scm_array_contents (SCM ra, SCM strict); +extern SCM scm_ra2contig (SCM ra, int copy); +extern SCM scm_uniform_array_read_x (SCM ra, SCM port_or_fd, SCM start, SCM end); +extern SCM scm_uniform_array_write (SCM v, SCM port_or_fd, SCM start, SCM end); +extern SCM scm_bit_count (SCM item, SCM seq); +extern SCM scm_bit_position (SCM item, SCM v, SCM k); +extern SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj); +extern SCM scm_bit_count_star (SCM v, SCM kv, SCM obj); +extern SCM scm_bit_invert_x (SCM v); +extern SCM scm_istr2bve (char *str, long len); +extern SCM scm_array_to_list (SCM v); +extern SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst); +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); #endif /* UNIFH */ diff --git a/libguile/vports.c b/libguile/vports.c index bff9cf397..8d66194a5 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -87,8 +87,8 @@ sf_write (SCM port, void *data, size_t size) { SCM p = SCM_STREAM (port); - scm_apply (SCM_VELTS (p)[1], scm_cons (scm_makfrom0str ((char *) data), - SCM_EOL), + scm_apply (SCM_VELTS (p)[1], + scm_cons (scm_makfromstr ((char *) data, size, 0), SCM_EOL), SCM_EOL); } -- 2.20.1