mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 10:10:23 +02:00
Code Activity

* unif.h: added some comments, removed the SCM_P macros.

Browse source 
* vports.c (sf_write): use scm_makfromstr, not scm_makfrom0str
	(thanks to Daniel Skarda).
This commit is contained in:
Gary Houston 1999-11-30 18:23:52 +00:00
parent 0328cad21e
commit 1d7bdb2562
6 changed files with 75 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

1
THANKS
View file

@ -9,5 +9,6 @@ Bug reports and fixes from:
Roland Orre Roland Orre
Bertrand Petit Bertrand Petit
Jorgen Schaefer Jorgen Schaefer
Daniel Skarda
Bernard Urban Bernard Urban
Lynn Winebarger Lynn Winebarger

9
libguile/ChangeLog
View file

@ -1,3 +1,12 @@
1999-11-30 Gary Houston <ghouston@freewire.co.uk>
* unif.h: added some comments, removed the SCM_P macros.
1999-11-29 Gary Houston <ghouston@freewire.co.uk>
* vports.c (sf_write): use scm_makfromstr, not scm_makfrom0str
(thanks to Daniel Skarda).
1999-11-22 Jim Blandy <jimb@savonarola.red-bean.com> 1999-11-22 Jim Blandy <jimb@savonarola.red-bean.com>
* gscm.c, gscm.h: Deleted. They were unused. * gscm.c, gscm.h: Deleted. They were unused.

4
libguile/ramap.c
View file

@ -253,10 +253,10 @@ scm_ra_matchp (ra0, ras)
return exact; 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 int
scm_ramapc (cproc, data, ra0, lra, what) 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, source list) or
cproc (dest, data, source list). */ cproc (dest, data, source list). */
SCM data; /* data to give to cproc or unbound. */ SCM data; /* data to give to cproc or unbound. */

7
libguile/unif.c
View file

@ -1290,14 +1290,15 @@ scm_array_set_x (v, obj, args)
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
/* extract an array from "ra" (regularised?), which may be an smob type. /* attempts to unroll an array into a one-dimensional array.
returns #f on failure. */ 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_PROC(s_array_contents, "array-contents", 1, 1, 0, scm_array_contents);
SCM SCM
scm_array_contents (ra, strict) scm_array_contents (ra, strict)
SCM ra; 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; SCM sra;
if (SCM_IMP (ra)) if (SCM_IMP (ra))

92
libguile/unif.h
View file

@ -2,7 +2,7 @@
#ifndef UNIFH #ifndef UNIFH
#define 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 * 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 * it under the terms of the GNU General Public License as published by
@ -47,9 +47,20 @@
#include "libguile/__scm.h" #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 typedef struct scm_array
{ {
SCM v; SCM v; /* the contents of the array, e.g., a vector or uniform vector. */
scm_sizet base; scm_sizet base;
} scm_array; } scm_array;
@ -63,50 +74,57 @@ typedef struct scm_array_dim
extern long scm_tc16_array; extern long scm_tc16_array;
#define SCM_ARRAYP(a) (scm_tc16_array==SCM_TYP16(a)) #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_NDIM(x) ((scm_sizet)(SCM_CAR(x)>>17))
#define SCM_ARRAY_CONTIGUOUS 0x10000 #define SCM_ARRAY_CONTIGUOUS 0x10000
#define SCM_ARRAY_CONTP(x) (SCM_ARRAY_CONTIGUOUS & (int)SCM_CAR(x)) #define SCM_ARRAY_CONTP(x) (SCM_ARRAY_CONTIGUOUS & (int)SCM_CAR(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_BASE(a) (((scm_array *)SCM_CDR(a))->base)
#define SCM_ARRAY_DIMS(a) ((scm_array_dim *)(SCM_CHARS(a)+sizeof(scm_array))) #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)) /* 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_sizet scm_uniform_element_size (SCM obj);
extern SCM scm_makflo SCM_P ((float x)); extern SCM scm_makflo (float x);
extern SCM scm_make_uve SCM_P ((long k, SCM prot)); extern SCM scm_make_uve (long k, SCM prot);
extern SCM scm_uniform_vector_length SCM_P ((SCM v)); extern SCM scm_uniform_vector_length (SCM v);
extern SCM scm_array_p SCM_P ((SCM v, SCM prot)); extern SCM scm_array_p (SCM v, SCM prot);
extern SCM scm_array_rank SCM_P ((SCM ra)); extern SCM scm_array_rank (SCM ra);
extern SCM scm_array_dimensions SCM_P ((SCM ra)); extern SCM scm_array_dimensions (SCM ra);
extern long scm_aind SCM_P ((SCM ra, SCM args, const char *what)); extern long scm_aind (SCM ra, SCM args, const char *what);
extern SCM scm_make_ra SCM_P ((int ndim)); extern SCM scm_make_ra (int ndim);
extern SCM scm_shap2ra SCM_P ((SCM args, const char *what)); extern SCM scm_shap2ra (SCM args, const char *what);
extern SCM scm_dimensions_to_uniform_array SCM_P ((SCM dims, SCM prot, SCM fill)); extern SCM scm_dimensions_to_uniform_array (SCM dims, SCM prot, SCM fill);
extern void scm_ra_set_contp SCM_P ((SCM ra)); extern void scm_ra_set_contp (SCM ra);
extern SCM scm_make_shared_array SCM_P ((SCM oldra, SCM mapfunc, SCM dims)); extern SCM scm_make_shared_array (SCM oldra, SCM mapfunc, SCM dims);
extern SCM scm_transpose_array SCM_P ((SCM args)); extern SCM scm_transpose_array (SCM args);
extern SCM scm_enclose_array SCM_P ((SCM axes)); extern SCM scm_enclose_array (SCM axes);
extern SCM scm_array_in_bounds_p SCM_P ((SCM args)); extern SCM scm_array_in_bounds_p (SCM args);
extern SCM scm_uniform_vector_ref SCM_P ((SCM v, SCM args)); extern SCM scm_uniform_vector_ref (SCM v, SCM args);
extern SCM scm_cvref SCM_P ((SCM v, scm_sizet pos, SCM last)); extern SCM scm_cvref (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_set_x (SCM v, SCM obj, SCM args);
extern SCM scm_array_contents SCM_P ((SCM ra, SCM strict)); extern SCM scm_array_contents (SCM ra, SCM strict);
extern SCM scm_ra2contig SCM_P ((SCM ra, int copy)); extern SCM scm_ra2contig (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_read_x (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_uniform_array_write (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_count (SCM item, SCM seq);
extern SCM scm_bit_position SCM_P ((SCM item, SCM v, SCM k)); extern SCM scm_bit_position (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_set_star_x (SCM v, SCM kv, SCM obj);
extern SCM scm_bit_count_star SCM_P ((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_P ((SCM v)); extern SCM scm_bit_invert_x (SCM v);
extern SCM scm_istr2bve SCM_P ((char *str, long len)); extern SCM scm_istr2bve (char *str, long len);
extern SCM scm_array_to_list SCM_P ((SCM v)); extern SCM scm_array_to_list (SCM v);
extern SCM scm_list_to_uniform_array SCM_P ((SCM ndim, SCM prot, SCM lst)); extern SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst);
extern int scm_raprin1 SCM_P ((SCM exp, SCM port, scm_print_state *pstate)); extern int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);
extern SCM scm_array_prototype SCM_P ((SCM ra)); extern SCM scm_array_prototype (SCM ra);
extern void scm_init_unif SCM_P ((void)); extern void scm_init_unif (void);
#endif /* UNIFH */ #endif /* UNIFH */

4
libguile/vports.c
View file

@ -87,8 +87,8 @@ sf_write (SCM port, void *data, size_t size)
{ {
SCM p = SCM_STREAM (port); SCM p = SCM_STREAM (port);
scm_apply (SCM_VELTS (p)[1], scm_cons (scm_makfrom0str ((char *) data), scm_apply (SCM_VELTS (p)[1],
SCM_EOL), scm_cons (scm_makfromstr ((char *) data, size, 0), SCM_EOL),
SCM_EOL); SCM_EOL);
} }