mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 04:10:18 +02:00
* acconfig.h: add HAVE_ARRAYS.
* configure.in: add --disable-arrays option, probably temporary. * the following changes allow guile to be built with the array "module" omitted. some of this stuff is just tc7 type support, which wouldn't be needed if uniform array types were converted to smobs. * tag.c (scm_utag_bvect ... scm_utag_cvect): don't define unless HAVE_ARRAYS. (scm_tag): don't check array types unless HAVE_ARRAYS. * sort.c (scm_restricted_vector_sort_x, scm_sorted_p): remove the unused array types. * (scm_stable_sort, scm_sort): don't support vectors if not HAVE_ARRAYS. a bit excessive. * random.c (vector_scale, vector_sum_squares, scm_random_solid_sphere_x, scm_random_hollow_sphere_x, scm_random_normal_vector_x): don't define unless HAVE_ARRAYS. * gh_data.c (makvect, gh_chars2byvect, gh_shorts2svect, gh_longs2ivect, gh_ulongs2uvect, gh_floats2fvect, gh_doubles2dvect, gh_uniform_vector_length, gh_uniform_vector_ref): don't define unless HAVE_ARRAYS. (gh_scm2chars, gh_scm2shorts, gh_scm2longs, gh_scm2floats, gh_scm2doubles): don't check vector types if not HAVE_ARRAYS. * eq.c (scm_equal_p), eval.c (SCM_CEVAL), print.c (scm_iprin1), gc.c (scm_gc_mark, scm_gc_sweep), objects.c (scm_class_of): don't support the array types unless HAVE_ARRAYS is defined. * tags.h: make nine tc7 types conditional on HAVE_ARRAYS. * read.c (scm_lreadr): don't check for #* unless HAVE_ARRAYS is defined (this should use read-hash-extend). * ramap.c, unif.c: don't check whether ARRAYS is defined. * vectors.c (scm_vector_set_length_x): moved here from unif.c. call scm_uniform_element_size if HAVE_ARRAYS. vectors.h: prototype too. * unif.c (scm_uniform_element_size): new procedure. * init.c (scm_boot_guile_1): don't call scm_init_ramap or scm_init_unif unless HAVE_ARRAYS is defined. * __scm.h: don't define ARRAYS. * Makefile.am (EXTRA_libguile_la_SOURCES): unif.c and ramap.c moved here from libguile_la_SOURCES. * Makefile.am (ice9_sources): add arrays.scm. * boot-9.scm: load arrays.scm if 'array is provided. * arrays.scm: new file with stuff from boot-9.scm.
This commit is contained in:
Gary Houston
parent
5c11cc9deb
commit
afe5177e7f
28 changed files with 268 additions and 211 deletions
|
|
@ -1,3 +1,9 @@
|
|||
1999-11-19 Gary Houston <ghouston@freewire.co.uk>
|
||||
|
||||
* acconfig.h: add HAVE_ARRAYS.
|
||||
|
||||
* configure.in: add --disable-arrays option, probably temporary.
|
||||
|
||||
1999-11-17 Gary Houston <ghouston@freewire.co.uk>
|
||||
|
||||
* configure.in: check for hstrerror.
|
||||
|
|
|
|||
4
NEWS
4
NEWS
|
|
@ -34,6 +34,7 @@ appropriately.
|
|||
|
||||
** configure has new options to remove support for certain features:
|
||||
|
||||
--disable-arrays omit array and uniform array support
|
||||
--disable-posix omit posix interfaces
|
||||
--disable-net omit networking interfaces
|
||||
--disable-regex omit regular expression interfaces
|
||||
|
|
@ -131,8 +132,7 @@ instead of 'system-error, since errno is not relevant.
|
|||
** Certain gethostbyname/gethostbyaddr failures now throw errors with
|
||||
specific keys instead of 'system-error. The latter is inappropriate
|
||||
since errno will not have been set. The keys are:
|
||||
'dns-host-not-found, 'dns-try-again, 'dns-no-recovery and
|
||||
'dns-no-data.
|
||||
'host-not-found, 'try-again, 'no-recovery and 'no-data.
|
||||
|
||||
** sethostent, setnetent, setprotoent, setservent: now take an
|
||||
optional argument STAYOPEN, which specifies whether the database
|
||||
|
|
|
|||
|
|
@ -116,6 +116,9 @@
|
|||
/* Define if the system supports Unix-domain (file-domain) sockets. */
|
||||
#undef HAVE_UNIX_DOMAIN_SOCKETS
|
||||
|
||||
/* Define this if you want support for arrays and uniform arrays. */
|
||||
#undef HAVE_ARRAYS
|
||||
|
||||
/* This is included as part of a workaround for a autoheader bug. */
|
||||
#undef HAVE_REGCOMP
|
||||
|
||||
|
|
|
|||
|
|
@ -56,6 +56,10 @@ AC_ARG_ENABLE(debug-freelist,
|
|||
AC_DEFINE(GUILE_DEBUG_FREELIST)
|
||||
fi)
|
||||
|
||||
AC_ARG_ENABLE(arrays,
|
||||
[ --disable-arrays omit array and uniform array support],,
|
||||
enable_arrays=yes)
|
||||
|
||||
AC_ARG_ENABLE(posix,
|
||||
[ --disable-posix omit posix interfaces],,
|
||||
enable_posix=yes)
|
||||
|
|
@ -75,6 +79,11 @@ AC_DEFINE(READER_EXTENSIONS)
|
|||
|
||||
dnl files which are destined for separate modules.
|
||||
|
||||
if test "$enable_arrays" = yes; then
|
||||
LIBOBJS="$LIBOBJS ramap.o unif.o"
|
||||
AC_DEFINE(HAVE_ARRAYS)
|
||||
fi
|
||||
|
||||
if test "$enable_posix" = yes; then
|
||||
LIBOBJS="$LIBOBJS filesys.o posix.o"
|
||||
AC_DEFINE(HAVE_POSIX)
|
||||
|
|
|
|||
|
|
@ -1,3 +1,11 @@
|
|||
1999-11-19 Gary Houston <ghouston@freewire.co.uk>
|
||||
|
||||
* Makefile.am (ice9_sources): add arrays.scm.
|
||||
|
||||
* boot-9.scm: load arrays.scm if 'array is provided.
|
||||
|
||||
* arrays.scm: new file with stuff from boot-9.scm.
|
||||
|
||||
1999-11-18 Gary Houston <ghouston@freewire.co.uk>
|
||||
|
||||
* boot-9.scm (read-hash-extend to set up arrays): add 'l' for
|
||||
|
|
|
|||
|
|
@ -23,7 +23,8 @@ AUTOMAKE_OPTIONS = foreign
|
|||
|
||||
# These should be installed and distributed.
|
||||
ice9_sources = \
|
||||
and-let*.scm boot-9.scm calling.scm common-list.scm debug.scm \
|
||||
and-let*.scm arrays.scm boot-9.scm \
|
||||
calling.scm common-list.scm debug.scm \
|
||||
debugger.scm emacs.scm expect.scm format.scm \
|
||||
getopt-gnu-style.scm getopt-long.scm hcons.scm lineio.scm \
|
||||
ls.scm mapping.scm networking.scm \
|
||||
|
|
|
|||
|
|
@ -301,27 +301,8 @@
|
|||
;;; {Arrays}
|
||||
;;;
|
||||
|
||||
(begin
|
||||
(define uniform-vector? array?)
|
||||
(define make-uniform-vector dimensions->uniform-array)
|
||||
; (define uniform-vector-ref array-ref)
|
||||
(define (uniform-vector-set! u i o)
|
||||
(uniform-array-set1! u o i))
|
||||
(define uniform-vector-fill! array-fill!)
|
||||
(define uniform-vector-read! uniform-array-read!)
|
||||
(define uniform-vector-write uniform-array-write)
|
||||
|
||||
(define (make-array fill . args)
|
||||
(dimensions->uniform-array args () fill))
|
||||
(define (make-uniform-array prot . args)
|
||||
(dimensions->uniform-array args prot))
|
||||
(define (list->array ndim lst)
|
||||
(list->uniform-array ndim '() lst))
|
||||
(define (list->uniform-vector prot lst)
|
||||
(list->uniform-array 1 prot lst))
|
||||
(define (array-shape a)
|
||||
(map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind))
|
||||
(array-dimensions a))))
|
||||
(if (provided? 'array)
|
||||
(primitive-load-path "ice-9/arrays.scm"))
|
||||
|
||||
|
||||
;;; {Keywords}
|
||||
|
|
@ -902,48 +883,6 @@
|
|||
(read-hash-extend #\. (lambda (c port)
|
||||
(eval (read port))))
|
||||
|
||||
(if (provided? 'array)
|
||||
(begin
|
||||
(let ((make-array-proc (lambda (template)
|
||||
(lambda (c port)
|
||||
(read:uniform-vector template port)))))
|
||||
(for-each (lambda (char template)
|
||||
(read-hash-extend char
|
||||
(make-array-proc template)))
|
||||
'(#\b #\a #\u #\e #\s #\i #\c #\y #\h #\l)
|
||||
'(#t #\a 1 -1 1.0 1/3 0+i #\nul s l)))
|
||||
(let ((array-proc (lambda (c port)
|
||||
(read:array c port))))
|
||||
(for-each (lambda (char) (read-hash-extend char array-proc))
|
||||
'(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))))
|
||||
|
||||
(define (read:array digit port)
|
||||
(define chr0 (char->integer #\0))
|
||||
(let ((rank (let readnum ((val (- (char->integer digit) chr0)))
|
||||
(if (char-numeric? (peek-char port))
|
||||
(readnum (+ (* 10 val)
|
||||
(- (char->integer (read-char port)) chr0)))
|
||||
val)))
|
||||
(prot (if (eq? #\( (peek-char port))
|
||||
'()
|
||||
(let ((c (read-char port)))
|
||||
(case c ((#\b) #t)
|
||||
((#\a) #\a)
|
||||
((#\u) 1)
|
||||
((#\e) -1)
|
||||
((#\s) 1.0)
|
||||
((#\i) 1/3)
|
||||
((#\c) 0+i)
|
||||
(else (error "read:array unknown option " c)))))))
|
||||
(if (eq? (peek-char port) #\()
|
||||
(list->uniform-array rank prot (read port))
|
||||
(error "read:array list not found"))))
|
||||
|
||||
(define (read:uniform-vector proto port)
|
||||
(if (eq? #\( (peek-char port))
|
||||
(list->uniform-array 1 proto (read port))
|
||||
(error "read:uniform-vector list not found")))
|
||||
|
||||
|
||||
;;; {Command Line Options}
|
||||
;;;
|
||||
|
|
|
|||
|
|
@ -1,3 +1,56 @@
|
|||
1999-11-19 Gary Houston <ghouston@freewire.co.uk>
|
||||
|
||||
* the following changes allow guile to be built with the array
|
||||
"module" omitted. some of this stuff is just tc7 type support,
|
||||
which wouldn't be needed if uniform array types were converted
|
||||
to smobs.
|
||||
|
||||
* tag.c (scm_utag_bvect ... scm_utag_cvect): don't define unless
|
||||
HAVE_ARRAYS.
|
||||
(scm_tag): don't check array types unless HAVE_ARRAYS.
|
||||
|
||||
* sort.c (scm_restricted_vector_sort_x, scm_sorted_p):
|
||||
remove the unused array types.
|
||||
* (scm_stable_sort, scm_sort): don't support vectors if not
|
||||
HAVE_ARRAYS. a bit excessive.
|
||||
|
||||
* random.c (vector_scale, vector_sum_squares,
|
||||
scm_random_solid_sphere_x, scm_random_hollow_sphere_x,
|
||||
scm_random_normal_vector_x): don't define unless HAVE_ARRAYS.
|
||||
|
||||
* gh_data.c (makvect, gh_chars2byvect, gh_shorts2svect,
|
||||
gh_longs2ivect, gh_ulongs2uvect, gh_floats2fvect, gh_doubles2dvect,
|
||||
gh_uniform_vector_length, gh_uniform_vector_ref):
|
||||
don't define unless HAVE_ARRAYS.
|
||||
(gh_scm2chars, gh_scm2shorts, gh_scm2longs, gh_scm2floats,
|
||||
gh_scm2doubles):
|
||||
don't check vector types if not HAVE_ARRAYS.
|
||||
|
||||
* eq.c (scm_equal_p), eval.c (SCM_CEVAL), print.c (scm_iprin1),
|
||||
gc.c (scm_gc_mark, scm_gc_sweep), objects.c (scm_class_of):
|
||||
don't support the array types unless HAVE_ARRAYS is defined.
|
||||
|
||||
* tags.h: make nine tc7 types conditional on HAVE_ARRAYS.
|
||||
|
||||
* read.c (scm_lreadr): don't check for #* unless HAVE_ARRAYS is
|
||||
defined (this should use read-hash-extend).
|
||||
|
||||
* ramap.c, unif.c: don't check whether ARRAYS is defined.
|
||||
|
||||
* vectors.c (scm_vector_set_length_x): moved here from unif.c. call
|
||||
scm_uniform_element_size if HAVE_ARRAYS.
|
||||
vectors.h: prototype too.
|
||||
|
||||
* unif.c (scm_uniform_element_size): new procedure.
|
||||
|
||||
* init.c (scm_boot_guile_1): don't call scm_init_ramap or
|
||||
scm_init_unif unless HAVE_ARRAYS is defined.
|
||||
|
||||
* __scm.h: don't define ARRAYS.
|
||||
|
||||
* Makefile.am (EXTRA_libguile_la_SOURCES): unif.c and ramap.c
|
||||
moved here from libguile_la_SOURCES.
|
||||
|
||||
1999-11-18 Gary Houston <ghouston@freewire.co.uk>
|
||||
|
||||
* socket.c (scm_htons, scm_ntohs, scm_htonl, scm_ntohl): new
|
||||
|
|
|
|||
|
|
@ -42,10 +42,10 @@ libguile_la_SOURCES = \
|
|||
gh_predicates.c gsubr.c guardians.c hash.c hashtab.c init.c \
|
||||
ioext.c keywords.c lang.c list.c load.c macros.c mallocs.c \
|
||||
modules.c numbers.c objects.c objprop.c options.c pairs.c \
|
||||
ports.c print.c procprop.c procs.c ramap.c random.c read.c \
|
||||
ports.c print.c procprop.c procs.c random.c read.c \
|
||||
root.c scmsigs.c script.c simpos.c smob.c sort.c \
|
||||
srcprop.c stackchk.c stacks.c stime.c strings.c strop.c strorder.c \
|
||||
strports.c struct.c symbols.c tag.c throw.c unif.c variable.c \
|
||||
strports.c struct.c symbols.c tag.c throw.c variable.c \
|
||||
vectors.c version.c vports.c weaks.c
|
||||
|
||||
BUILT_SOURCES = \
|
||||
|
|
@ -65,7 +65,8 @@ BUILT_SOURCES = \
|
|||
EXTRA_libguile_la_SOURCES = _scm.h \
|
||||
alloca.c inet_aton.c memmove.c putenv.c strerror.c \
|
||||
threads.c regex-posix.c iselect.c \
|
||||
filesys.c posix.c net_db.c socket.c
|
||||
filesys.c posix.c net_db.c socket.c \
|
||||
ramap.c unif.c
|
||||
|
||||
## This is kind of nasty... there are ".c" files that we don't want to
|
||||
## compile, since they are #included in threads.c. So instead we list
|
||||
|
|
|
|||
|
|
@ -84,13 +84,6 @@
|
|||
*/
|
||||
#undef ENGNOT
|
||||
|
||||
/* Include support for uniform arrays?
|
||||
*
|
||||
* Possibly some of the initialization code depends on this
|
||||
* being defined, but that is a bug and should be fixed.
|
||||
*/
|
||||
#define ARRAYS
|
||||
|
||||
#undef SCM_CAREFUL_INTS
|
||||
|
||||
/* {Unsupported Options}
|
||||
|
|
@ -111,13 +104,12 @@
|
|||
|
||||
#define STACK_CHECKING
|
||||
#undef NO_CEVAL_STACK_CHECKING
|
||||
#undef LONGLONGS
|
||||
|
||||
/* Some auto-generated .h files contain unused prototypes
|
||||
* that need these typedefs.
|
||||
*/
|
||||
typedef long long_long;
|
||||
typedef unsigned long ulong_long;
|
||||
typedef long long long_long;
|
||||
typedef unsigned long long ulong_long;
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -124,6 +124,7 @@ scm_equal_p (x, y)
|
|||
else
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
#ifdef HAVE_ARRAYS
|
||||
case scm_tc7_bvect: case scm_tc7_uvect: case scm_tc7_ivect:
|
||||
case scm_tc7_fvect: case scm_tc7_cvect: case scm_tc7_dvect:
|
||||
case scm_tc7_svect:
|
||||
|
|
@ -134,6 +135,7 @@ scm_equal_p (x, y)
|
|||
if ( scm_tc16_array
|
||||
&& scm_smobs[0x0ff & (scm_tc16_array >> 8)].equalp)
|
||||
return scm_array_equal_p(x, y);
|
||||
#endif
|
||||
}
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -2531,6 +2531,7 @@ dispatch:
|
|||
scm_listify (proc, SCM_UNDEFINED));
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
#ifdef HAVE_ARRAYS
|
||||
case scm_tc7_bvect:
|
||||
case scm_tc7_byvect:
|
||||
case scm_tc7_svect:
|
||||
|
|
@ -2541,6 +2542,7 @@ dispatch:
|
|||
case scm_tc7_cvect:
|
||||
#ifdef HAVE_LONG_LONGS
|
||||
case scm_tc7_llvect:
|
||||
#endif
|
||||
#endif
|
||||
case scm_tc7_string:
|
||||
case scm_tc7_substring:
|
||||
|
|
|
|||
|
|
@ -746,6 +746,7 @@ gc_mark_nimp:
|
|||
sizeof (scm_contregs)) /
|
||||
sizeof (SCM_STACKITEM)));
|
||||
break;
|
||||
#ifdef HAVE_ARRAYS
|
||||
case scm_tc7_bvect:
|
||||
case scm_tc7_byvect:
|
||||
case scm_tc7_ivect:
|
||||
|
|
@ -757,7 +758,7 @@ gc_mark_nimp:
|
|||
#ifdef HAVE_LONG_LONGS
|
||||
case scm_tc7_llvect:
|
||||
#endif
|
||||
|
||||
#endif
|
||||
case scm_tc7_string:
|
||||
SCM_SETGC8MARK (ptr);
|
||||
break;
|
||||
|
|
@ -1168,6 +1169,7 @@ scm_gc_sweep ()
|
|||
scm_must_free (SCM_CHARS (scmptr));
|
||||
/* SCM_SETCHARS(scmptr, 0);*/
|
||||
break;
|
||||
#ifdef HAVE_ARRAYS
|
||||
case scm_tc7_bvect:
|
||||
if SCM_GC8MARKP (scmptr)
|
||||
goto c8mrkcontinue;
|
||||
|
|
@ -1211,6 +1213,7 @@ scm_gc_sweep ()
|
|||
goto c8mrkcontinue;
|
||||
m += SCM_HUGE_LENGTH (scmptr) * 2 * sizeof (double);
|
||||
goto freechars;
|
||||
#endif
|
||||
case scm_tc7_substring:
|
||||
if (SCM_GC8MARKP (scmptr))
|
||||
goto c8mrkcontinue;
|
||||
|
|
|
|||
|
|
@ -108,18 +108,21 @@ SCM gh_str02scm(char *s);
|
|||
void gh_set_substr(char *src, SCM dst, int start, int len);
|
||||
SCM gh_symbol2scm(const char *symbol_str);
|
||||
SCM gh_ints2scm(int *d, int n);
|
||||
|
||||
#ifdef HAVE_ARRAYS
|
||||
SCM gh_chars2byvect(char *d, int n);
|
||||
SCM gh_shorts2svect(short *d, int n);
|
||||
SCM gh_longs2ivect(long *d, int n);
|
||||
SCM gh_ulongs2uvect(unsigned long *d, int n);
|
||||
SCM gh_doubles2scm(double *d, int n);
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
SCM gh_floats2fvect(float *d, int n);
|
||||
#endif
|
||||
SCM gh_doubles2dvect(double *d, int n);
|
||||
#endif
|
||||
#endif
|
||||
|
||||
SCM gh_doubles2scm(double *d, int n);
|
||||
|
||||
/* Scheme to C conversion */
|
||||
int gh_scm2bool(SCM obj);
|
||||
|
|
|
|||
|
|
@ -152,6 +152,7 @@ gh_doubles2scm (double *d, int n)
|
|||
return v;
|
||||
}
|
||||
|
||||
#ifdef HAVE_ARRAYS
|
||||
/* Do not use this function for building normal Scheme vectors, unless
|
||||
you arrange for the elements to be protected from GC while you
|
||||
initialize the vector. */
|
||||
|
|
@ -218,6 +219,7 @@ gh_doubles2dvect (double *d, int n)
|
|||
return makvect (m, n, scm_tc7_dvect);
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* data conversion scheme->C */
|
||||
int
|
||||
|
|
@ -285,7 +287,9 @@ gh_scm2chars (SCM obj, char *m)
|
|||
for (i = 0; i < n; ++i)
|
||||
m[i] = SCM_INUM (SCM_VELTS (obj)[i]);
|
||||
break;
|
||||
#ifdef HAVE_ARRAYS
|
||||
case scm_tc7_byvect:
|
||||
#endif
|
||||
case scm_tc7_string:
|
||||
case scm_tc7_substring:
|
||||
n = SCM_LENGTH (obj);
|
||||
|
|
@ -331,12 +335,14 @@ gh_scm2shorts (SCM obj, short *m)
|
|||
for (i = 0; i < n; ++i)
|
||||
m[i] = SCM_INUM (SCM_VELTS (obj)[i]);
|
||||
break;
|
||||
#ifdef HAVE_ARRAYS
|
||||
case scm_tc7_svect:
|
||||
n = SCM_LENGTH (obj);
|
||||
if (m == 0)
|
||||
m = (short *) malloc (n * sizeof (short));
|
||||
memcpy (m, SCM_VELTS (obj), n * sizeof (short));
|
||||
break;
|
||||
#endif
|
||||
default:
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
}
|
||||
|
|
@ -371,6 +377,7 @@ gh_scm2longs (SCM obj, long *m)
|
|||
m[i] = SCM_INUMP (val) ? SCM_INUM (val) : scm_num2long (val, 0, 0);
|
||||
}
|
||||
break;
|
||||
#ifdef HAVE_ARRAYS
|
||||
case scm_tc7_ivect:
|
||||
case scm_tc7_uvect:
|
||||
n = SCM_LENGTH (obj);
|
||||
|
|
@ -378,6 +385,7 @@ gh_scm2longs (SCM obj, long *m)
|
|||
m = (long *) malloc (n * sizeof (long));
|
||||
memcpy (m, SCM_VELTS (obj), n * sizeof (long));
|
||||
break;
|
||||
#endif
|
||||
default:
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
}
|
||||
|
|
@ -418,6 +426,7 @@ gh_scm2floats (SCM obj, float *m)
|
|||
m[i] = SCM_REALPART (val);
|
||||
}
|
||||
break;
|
||||
#ifdef HAVE_ARRAYS
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
|
|
@ -434,6 +443,7 @@ gh_scm2floats (SCM obj, float *m)
|
|||
for (i = 0; i < n; ++i)
|
||||
m[i] = ((double *) SCM_VELTS (obj))[i];
|
||||
break;
|
||||
#endif
|
||||
#endif
|
||||
default:
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
|
|
@ -475,6 +485,7 @@ gh_scm2doubles (SCM obj, double *m)
|
|||
m[i] = SCM_REALPART (val);
|
||||
}
|
||||
break;
|
||||
#ifdef HAVE_ARRAYS
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
|
|
@ -491,6 +502,7 @@ gh_scm2doubles (SCM obj, double *m)
|
|||
m = (double*) malloc (n * sizeof (double));
|
||||
memcpy (m, SCM_VELTS (obj), n * sizeof (double));
|
||||
break;
|
||||
#endif
|
||||
#endif
|
||||
default:
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
|
|
@ -635,7 +647,7 @@ gh_vector_length (SCM v)
|
|||
return gh_scm2ulong (scm_vector_length (v));
|
||||
}
|
||||
|
||||
|
||||
#ifdef HAVE_ARRAYS
|
||||
/* uniform vector support */
|
||||
|
||||
/* returns the length as a C unsigned long integer */
|
||||
|
|
@ -657,7 +669,7 @@ gh_uniform_vector_ref (SCM v, SCM ilist)
|
|||
/* sets an individual element in a uniform vector */
|
||||
/* SCM */
|
||||
/* gh_list_to_uniform_array ( */
|
||||
|
||||
#endif
|
||||
|
||||
/* Data lookups between C and Scheme
|
||||
|
||||
|
|
|
|||
|
|
@ -523,9 +523,11 @@ scm_boot_guile_1 (base, closure)
|
|||
#ifdef DEBUG_EXTENSIONS
|
||||
scm_init_debug (); /* Requires macro smobs */
|
||||
#endif
|
||||
scm_init_ramap ();
|
||||
scm_init_random ();
|
||||
#ifdef HAVE_ARRAYS
|
||||
scm_init_ramap ();
|
||||
scm_init_unif ();
|
||||
#endif
|
||||
scm_init_simpos ();
|
||||
scm_init_load_path ();
|
||||
scm_init_standard_ports ();
|
||||
|
|
|
|||
|
|
@ -116,6 +116,7 @@ scm_class_of (SCM x)
|
|||
return scm_class_symbol;
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
#ifdef HAVE_ARRAYS
|
||||
case scm_tc7_bvect:
|
||||
case scm_tc7_byvect:
|
||||
case scm_tc7_svect:
|
||||
|
|
@ -124,6 +125,7 @@ scm_class_of (SCM x)
|
|||
case scm_tc7_fvect:
|
||||
case scm_tc7_dvect:
|
||||
case scm_tc7_cvect:
|
||||
#endif
|
||||
return scm_class_vector;
|
||||
case scm_tc7_string:
|
||||
case scm_tc7_substring:
|
||||
|
|
|
|||
|
|
@ -592,6 +592,7 @@ taloop:
|
|||
}
|
||||
EXIT_NESTED_DATA (pstate);
|
||||
break;
|
||||
#ifdef HAVE_ARRAYS
|
||||
case scm_tc7_bvect:
|
||||
case scm_tc7_byvect:
|
||||
case scm_tc7_svect:
|
||||
|
|
@ -605,6 +606,7 @@ taloop:
|
|||
#endif
|
||||
scm_raprin1 (exp, port, pstate);
|
||||
break;
|
||||
#endif
|
||||
case scm_tcs_subrs:
|
||||
scm_puts (SCM_SUBR_GENERIC (exp) && *SCM_SUBR_GENERIC (exp)
|
||||
? "#<primitive-generic "
|
||||
|
|
|
|||
|
|
@ -55,8 +55,6 @@
|
|||
#include "ramap.h"
|
||||
|
||||
|
||||
#ifdef ARRAYS
|
||||
|
||||
typedef struct
|
||||
{
|
||||
char *name;
|
||||
|
|
@ -2174,5 +2172,3 @@ scm_init_ramap ()
|
|||
#include "ramap.x"
|
||||
scm_add_feature (s_array_for_each);
|
||||
}
|
||||
|
||||
#endif /* ARRAYS */
|
||||
|
|
|
|||
|
|
@ -411,6 +411,22 @@ scm_random_uniform (SCM state)
|
|||
return scm_makdbl (scm_c_uniform01 (SCM_RSTATE (state)), 0.0);
|
||||
}
|
||||
|
||||
SCM_PROC (s_random_normal, "random:normal", 0, 1, 0, scm_random_normal);
|
||||
|
||||
SCM
|
||||
scm_random_normal (SCM state)
|
||||
{
|
||||
if (SCM_UNBNDP (state))
|
||||
state = SCM_CDR (scm_var_random_state);
|
||||
SCM_ASSERT (SCM_NIMP (state) && SCM_RSTATEP (state),
|
||||
state,
|
||||
SCM_ARG1,
|
||||
s_random_normal);
|
||||
return scm_makdbl (scm_c_normal01 (SCM_RSTATE (state)), 0.0);
|
||||
}
|
||||
|
||||
#ifdef HAVE_ARRAYS
|
||||
|
||||
static void
|
||||
vector_scale (SCM v, double c)
|
||||
{
|
||||
|
|
@ -443,13 +459,13 @@ vector_sum_squares (SCM v)
|
|||
return sum;
|
||||
}
|
||||
|
||||
SCM_PROC (s_random_solid_sphere_x, "random:solid-sphere!", 1, 1, 0, scm_random_solid_sphere_x);
|
||||
|
||||
/* For the uniform distribution on the solid sphere, note that in
|
||||
* this distribution the length r of the vector has cumulative
|
||||
* distribution r^n; i.e., u=r^n is uniform [0,1], so r can be
|
||||
* generated as r=u^(1/n).
|
||||
*/
|
||||
SCM_PROC (s_random_solid_sphere_x, "random:solid-sphere!", 1, 1, 0, scm_random_solid_sphere_x);
|
||||
|
||||
SCM
|
||||
scm_random_solid_sphere_x (SCM v, SCM state)
|
||||
{
|
||||
|
|
@ -488,21 +504,6 @@ scm_random_hollow_sphere_x (SCM v, SCM state)
|
|||
vector_scale (v, 1 / sqrt (vector_sum_squares (v)));
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
SCM_PROC (s_random_normal, "random:normal", 0, 1, 0, scm_random_normal);
|
||||
|
||||
SCM
|
||||
scm_random_normal (SCM state)
|
||||
{
|
||||
if (SCM_UNBNDP (state))
|
||||
state = SCM_CDR (scm_var_random_state);
|
||||
SCM_ASSERT (SCM_NIMP (state) && SCM_RSTATEP (state),
|
||||
state,
|
||||
SCM_ARG1,
|
||||
s_random_normal);
|
||||
return scm_makdbl (scm_c_normal01 (SCM_RSTATE (state)), 0.0);
|
||||
}
|
||||
|
||||
SCM_PROC (s_random_normal_vector_x, "random:normal-vector!", 1, 1, 0, scm_random_normal_vector_x);
|
||||
|
||||
SCM
|
||||
|
|
@ -528,6 +529,8 @@ scm_random_normal_vector_x (SCM v, SCM state)
|
|||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
#endif /* HAVE_ARRAYS */
|
||||
|
||||
SCM_PROC (s_random_exp, "random:exp", 0, 1, 0, scm_random_exp);
|
||||
|
||||
SCM
|
||||
|
|
|
|||
|
|
@ -366,6 +366,7 @@ tryagain_no_flush_ws:
|
|||
c = scm_flush_ws (port, (char *)NULL);
|
||||
goto tryagain_no_flush_ws;
|
||||
|
||||
#ifdef HAVE_ARRAYS
|
||||
case '*':
|
||||
j = scm_read_token (c, tok_buf, port, 0);
|
||||
p = scm_istr2bve (SCM_CHARS (*tok_buf) + 1, (long) (j - 1));
|
||||
|
|
@ -373,6 +374,7 @@ tryagain_no_flush_ws:
|
|||
return p;
|
||||
else
|
||||
goto unkshrp;
|
||||
#endif
|
||||
|
||||
case '{':
|
||||
j = scm_read_token (c, tok_buf, port, 1);
|
||||
|
|
|
|||
|
|
@ -422,10 +422,12 @@ scm_restricted_vector_sort_x (SCM vec, SCM less, SCM startpos, SCM endpos)
|
|||
{
|
||||
case scm_tc7_vector: /* the only type we manage is vector */
|
||||
break;
|
||||
#if 0 /* HAVE_ARRAYS */
|
||||
case scm_tc7_ivect: /* long */
|
||||
case scm_tc7_uvect: /* unsigned */
|
||||
case scm_tc7_fvect: /* float */
|
||||
case scm_tc7_dvect: /* double */
|
||||
#endif
|
||||
default:
|
||||
scm_wta (vec, (char *) SCM_ARG1, s_restricted_vector_sort_x);
|
||||
}
|
||||
|
|
@ -510,10 +512,12 @@ scm_sorted_p (SCM items, SCM less)
|
|||
return SCM_BOOL_T;
|
||||
}
|
||||
break;
|
||||
#if 0 /* HAVE_ARRAYS */
|
||||
case scm_tc7_ivect: /* long */
|
||||
case scm_tc7_uvect: /* unsigned */
|
||||
case scm_tc7_fvect: /* float */
|
||||
case scm_tc7_dvect: /* double */
|
||||
#endif
|
||||
default:
|
||||
scm_wta (items, (char *) SCM_ARG1, s_sorted_p);
|
||||
}
|
||||
|
|
@ -755,6 +759,8 @@ scm_sort (SCM items, SCM less)
|
|||
items = scm_list_copy (items);
|
||||
return scm_merge_list_step (&items, scm_cmp_function (less), less, len);
|
||||
}
|
||||
#ifdef HAVE_ARRAYS
|
||||
/* support ordinary vectors even if arrays not available? */
|
||||
else if (SCM_VECTORP (items))
|
||||
{
|
||||
len = SCM_LENGTH (items);
|
||||
|
|
@ -766,6 +772,7 @@ scm_sort (SCM items, SCM less)
|
|||
SCM_MAKINUM (len));
|
||||
return sortvec;
|
||||
}
|
||||
#endif
|
||||
else
|
||||
return scm_wta (items, (char *) SCM_ARG1, s_sort_x);
|
||||
} /* scm_sort */
|
||||
|
|
@ -878,6 +885,8 @@ scm_stable_sort (SCM items, SCM less)
|
|||
items = scm_list_copy (items);
|
||||
return scm_merge_list_step (&items, scm_cmp_function (less), less, len);
|
||||
}
|
||||
#ifdef HAVE_ARRAYS
|
||||
/* support ordinary vectors even if arrays not available? */
|
||||
else if (SCM_VECTORP (items))
|
||||
{
|
||||
SCM retvec;
|
||||
|
|
@ -896,6 +905,7 @@ scm_stable_sort (SCM items, SCM less)
|
|||
free (temp);
|
||||
return retvec;
|
||||
}
|
||||
#endif
|
||||
else
|
||||
return scm_wta (items, (char *) SCM_ARG1, s_stable_sort);
|
||||
} /* scm_stable_sort */
|
||||
|
|
|
|||
|
|
@ -54,6 +54,8 @@ SCM_CONST_LONG (scm_utag_closure, "utag_closure", 3);
|
|||
SCM_CONST_LONG (scm_utag_symbol, "utag_symbol", 4);
|
||||
SCM_CONST_LONG (scm_utag_vector, "utag_vector", 5);
|
||||
SCM_CONST_LONG (scm_utag_wvect, "utag_wvect", 6);
|
||||
|
||||
#ifdef HAVE_ARRAYS
|
||||
SCM_CONST_LONG (scm_utag_bvect, "utag_bvect", 7);
|
||||
SCM_CONST_LONG (scm_utag_byvect, "utag_byvect", 8);
|
||||
SCM_CONST_LONG (scm_utag_svect, "utag_svect", 9);
|
||||
|
|
@ -62,6 +64,8 @@ SCM_CONST_LONG (scm_utag_uvect, "utag_uvect", 11);
|
|||
SCM_CONST_LONG (scm_utag_fvect, "utag_fvect", 12);
|
||||
SCM_CONST_LONG (scm_utag_dvect, "utag_dvect", 13);
|
||||
SCM_CONST_LONG (scm_utag_cvect, "utag_cvect", 14);
|
||||
#endif
|
||||
|
||||
SCM_CONST_LONG (scm_utag_string, "utag_string", 15);
|
||||
SCM_CONST_LONG (scm_utag_substring, "utag_substring", 17);
|
||||
SCM_CONST_LONG (scm_utag_asubr, "utag_asubr", 19);
|
||||
|
|
@ -116,6 +120,8 @@ scm_tag (x)
|
|||
return SCM_CDR (scm_utag_vector) ;
|
||||
case scm_tc7_wvect:
|
||||
return SCM_CDR (scm_utag_wvect) ;
|
||||
|
||||
#ifdef HAVE_ARRAYS
|
||||
case scm_tc7_bvect:
|
||||
return SCM_CDR (scm_utag_bvect) ;
|
||||
case scm_tc7_byvect:
|
||||
|
|
@ -132,6 +138,8 @@ scm_tag (x)
|
|||
return SCM_CDR (scm_utag_dvect) ;
|
||||
case scm_tc7_cvect:
|
||||
return SCM_CDR (scm_utag_cvect) ;
|
||||
#endif
|
||||
|
||||
case scm_tc7_string:
|
||||
return SCM_CDR (scm_utag_string) ;
|
||||
case scm_tc7_substring:
|
||||
|
|
|
|||
|
|
@ -337,20 +337,24 @@ typedef long SCM;
|
|||
* into structs or smobs. We need back some
|
||||
* of these 7 bit tags!
|
||||
*/
|
||||
#define scm_tc7_llvect 29
|
||||
#define scm_tc7_pws 31
|
||||
#define scm_tc7_uvect 37
|
||||
#define scm_tc7_lvector 39
|
||||
|
||||
#ifdef HAVE_ARRAYS
|
||||
#define scm_tc7_llvect 29
|
||||
#define scm_tc7_uvect 37
|
||||
#define scm_tc7_fvect 45
|
||||
#define scm_tc7_dvect 47
|
||||
#define scm_tc7_cvect 53
|
||||
#define scm_tc7_svect 55
|
||||
#define scm_tc7_contin 61
|
||||
#define scm_tc7_cclo 63
|
||||
#define scm_tc7_rpsubr 69
|
||||
#define scm_tc7_bvect 71
|
||||
#define scm_tc7_byvect 77
|
||||
#define scm_tc7_ivect 79
|
||||
#endif
|
||||
|
||||
#define scm_tc7_contin 61
|
||||
#define scm_tc7_cclo 63
|
||||
#define scm_tc7_rpsubr 69
|
||||
#define scm_tc7_subr_0 85
|
||||
#define scm_tc7_subr_1 87
|
||||
#define scm_tc7_cxr 93
|
||||
|
|
|
|||
121
libguile/unif.c
121
libguile/unif.c
|
|
@ -73,105 +73,58 @@
|
|||
|
||||
long scm_tc16_array;
|
||||
|
||||
/*
|
||||
* This complicates things too much if allowed on any array.
|
||||
* C code can safely call it on arrays known to be used in a single
|
||||
* threaded manner.
|
||||
*
|
||||
* SCM_PROC(s_vector_set_length_x, "vector-set-length!", 2, 0, 0, scm_vector_set_length_x);
|
||||
*/
|
||||
static char s_vector_set_length_x[] = "vector-set-length!";
|
||||
|
||||
|
||||
SCM
|
||||
scm_vector_set_length_x (vect, len)
|
||||
SCM vect;
|
||||
SCM len;
|
||||
/* return the size of an element in a uniform array or 0 if type not
|
||||
found. */
|
||||
scm_sizet
|
||||
scm_uniform_element_size (SCM obj)
|
||||
{
|
||||
long l;
|
||||
scm_sizet siz;
|
||||
scm_sizet sz;
|
||||
scm_sizet result;
|
||||
|
||||
l = SCM_INUM (len);
|
||||
SCM_ASRTGO (SCM_NIMP (vect), badarg1);
|
||||
switch (SCM_TYP7 (vect))
|
||||
switch (SCM_TYP7 (obj))
|
||||
{
|
||||
default:
|
||||
badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x);
|
||||
case scm_tc7_string:
|
||||
SCM_ASRTGO (vect != scm_nullstr, badarg1);
|
||||
sz = sizeof (char);
|
||||
l++;
|
||||
break;
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
SCM_ASRTGO (vect != scm_nullvect, badarg1);
|
||||
sz = sizeof (SCM);
|
||||
break;
|
||||
#ifdef ARRAYS
|
||||
case scm_tc7_bvect:
|
||||
l = (l + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
|
||||
case scm_tc7_uvect:
|
||||
case scm_tc7_ivect:
|
||||
sz = sizeof (long);
|
||||
result = sizeof (long);
|
||||
break;
|
||||
|
||||
case scm_tc7_byvect:
|
||||
sz = sizeof (char);
|
||||
result = sizeof (char);
|
||||
break;
|
||||
|
||||
case scm_tc7_svect:
|
||||
sz = sizeof (short);
|
||||
result = sizeof (short);
|
||||
break;
|
||||
|
||||
#ifdef HAVE_LONG_LONGS
|
||||
case scm_tc7_llvect:
|
||||
sz = sizeof (long_long);
|
||||
result = sizeof (long_long);
|
||||
break;
|
||||
#endif
|
||||
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
sz = sizeof (float);
|
||||
result = sizeof (float);
|
||||
break;
|
||||
#endif
|
||||
|
||||
case scm_tc7_dvect:
|
||||
sz = sizeof (double);
|
||||
result = sizeof (double);
|
||||
break;
|
||||
|
||||
case scm_tc7_cvect:
|
||||
sz = 2 * sizeof (double);
|
||||
result = 2 * sizeof (double);
|
||||
break;
|
||||
#endif
|
||||
#endif
|
||||
|
||||
default:
|
||||
result = 0;
|
||||
}
|
||||
SCM_ASSERT (SCM_INUMP (len), len, SCM_ARG2, s_vector_set_length_x);
|
||||
if (!l)
|
||||
l = 1L;
|
||||
siz = l * sz;
|
||||
if (siz != l * sz)
|
||||
scm_wta (SCM_MAKINUM (l * sz), (char *) SCM_NALLOC, s_vector_set_length_x);
|
||||
SCM_REDEFER_INTS;
|
||||
SCM_SETCHARS (vect,
|
||||
((char *)
|
||||
scm_must_realloc (SCM_CHARS (vect),
|
||||
(long) SCM_LENGTH (vect) * sz,
|
||||
(long) siz,
|
||||
s_vector_set_length_x)));
|
||||
if (SCM_VECTORP (vect))
|
||||
{
|
||||
sz = SCM_LENGTH (vect);
|
||||
while (l > sz)
|
||||
SCM_VELTS (vect)[--l] = SCM_UNSPECIFIED;
|
||||
}
|
||||
else if (SCM_STRINGP (vect))
|
||||
SCM_CHARS (vect)[l - 1] = 0;
|
||||
SCM_SETLENGTH (vect, SCM_INUM (len), SCM_TYP7 (vect));
|
||||
SCM_REALLOW_INTS;
|
||||
return vect;
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
#ifdef ARRAYS
|
||||
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
|
||||
|
|
@ -2568,8 +2521,6 @@ freera (ptr)
|
|||
return sizeof (scm_array) + SCM_ARRAY_NDIM (ptr) * sizeof (scm_array_dim);
|
||||
}
|
||||
|
||||
/* This must be done after scm_init_scl() */
|
||||
|
||||
void
|
||||
scm_init_unif ()
|
||||
{
|
||||
|
|
@ -2581,33 +2532,3 @@ scm_init_unif ()
|
|||
scm_add_feature ("array");
|
||||
#include "unif.x"
|
||||
}
|
||||
|
||||
#else /* ARRAYS */
|
||||
|
||||
|
||||
int
|
||||
scm_raprin1 (exp, port, pstate)
|
||||
SCM exp;
|
||||
SCM port;
|
||||
scm_print_state *pstate;
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
SCM
|
||||
scm_istr2bve (str, len)
|
||||
char *str;
|
||||
long len;
|
||||
{
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
|
||||
void
|
||||
scm_init_unif ()
|
||||
{
|
||||
#include "unif.x"
|
||||
scm_make_subr (s_resizuve, scm_tc7_subr_2, scm_vector_set_length_x);
|
||||
}
|
||||
|
||||
#endif /* ARRAYS */
|
||||
|
|
|
|||
|
|
@ -74,7 +74,7 @@ extern long scm_tc16_array;
|
|||
|
||||
|
||||
|
||||
extern SCM scm_vector_set_length_x SCM_P ((SCM vect, SCM len));
|
||||
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));
|
||||
|
|
|
|||
|
|
@ -47,6 +47,76 @@
|
|||
#include "vectors.h"
|
||||
|
||||
|
||||
/*
|
||||
* This complicates things too much if allowed on any array.
|
||||
* C code can safely call it on arrays known to be used in a single
|
||||
* threaded manner.
|
||||
*
|
||||
* SCM_PROC(s_vector_set_length_x, "vector-set-length!", 2, 0, 0, scm_vector_set_length_x);
|
||||
*/
|
||||
static char s_vector_set_length_x[] = "vector-set-length!";
|
||||
|
||||
|
||||
SCM
|
||||
scm_vector_set_length_x (vect, len)
|
||||
SCM vect;
|
||||
SCM len;
|
||||
{
|
||||
long l;
|
||||
scm_sizet siz;
|
||||
scm_sizet sz;
|
||||
|
||||
l = SCM_INUM (len);
|
||||
SCM_ASRTGO (SCM_NIMP (vect), badarg1);
|
||||
|
||||
#ifdef HAVE_ARRAYS
|
||||
if (SCM_TYP7 (vect) == scm_tc7_bvect)
|
||||
{
|
||||
l = (l + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
|
||||
}
|
||||
sz = scm_uniform_element_size (vect);
|
||||
if (sz == 0)
|
||||
#endif
|
||||
switch (SCM_TYP7 (vect))
|
||||
{
|
||||
default:
|
||||
badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x);
|
||||
case scm_tc7_string:
|
||||
SCM_ASRTGO (vect != scm_nullstr, badarg1);
|
||||
sz = sizeof (char);
|
||||
l++;
|
||||
break;
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
SCM_ASRTGO (vect != scm_nullvect, badarg1);
|
||||
sz = sizeof (SCM);
|
||||
break;
|
||||
}
|
||||
SCM_ASSERT (SCM_INUMP (len), len, SCM_ARG2, s_vector_set_length_x);
|
||||
if (!l)
|
||||
l = 1L;
|
||||
siz = l * sz;
|
||||
if (siz != l * sz)
|
||||
scm_wta (SCM_MAKINUM (l * sz), (char *) SCM_NALLOC, s_vector_set_length_x);
|
||||
SCM_REDEFER_INTS;
|
||||
SCM_SETCHARS (vect,
|
||||
((char *)
|
||||
scm_must_realloc (SCM_CHARS (vect),
|
||||
(long) SCM_LENGTH (vect) * sz,
|
||||
(long) siz,
|
||||
s_vector_set_length_x)));
|
||||
if (SCM_VECTORP (vect))
|
||||
{
|
||||
sz = SCM_LENGTH (vect);
|
||||
while (l > sz)
|
||||
SCM_VELTS (vect)[--l] = SCM_UNSPECIFIED;
|
||||
}
|
||||
else if (SCM_STRINGP (vect))
|
||||
SCM_CHARS (vect)[l - 1] = 0;
|
||||
SCM_SETLENGTH (vect, SCM_INUM (len), SCM_TYP7 (vect));
|
||||
SCM_REALLOW_INTS;
|
||||
return vect;
|
||||
}
|
||||
|
||||
SCM_PROC(s_vector_p, "vector?", 1, 0, 0, scm_vector_p);
|
||||
|
||||
|
|
@ -263,5 +333,7 @@ void
|
|||
scm_init_vectors ()
|
||||
{
|
||||
#include "vectors.x"
|
||||
/*
|
||||
scm_make_subr (s_resizuve, scm_tc7_subr_2, scm_vector_set_length_x); */
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -55,6 +55,7 @@
|
|||
|
||||
|
||||
|
||||
extern SCM scm_vector_set_length_x SCM_P ((SCM vect, SCM len));
|
||||
extern SCM scm_vector_p SCM_P ((SCM x));
|
||||
extern SCM scm_vector_length SCM_P ((SCM v));
|
||||
extern SCM scm_vector SCM_P ((SCM l));
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue