mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
Remove GH and its traces.
This commit is contained in:
Han-Wen Nienhuys
parent
76ed3e877f
commit
89bc270db3
19 changed files with 12 additions and 3189 deletions
2
NEWS
2
NEWS
|
|
@ -32,6 +32,8 @@ See `cancel-thread', `set-thread-cleanup!', and `thread-cleanup'.
|
|||
|
||||
* Changes to the C interface
|
||||
|
||||
** The GH interface (deprecated in version 1.6, 2001) was removed.
|
||||
|
||||
** Internal `scm_i_' functions now have "hidden" linkage with GCC/ELF
|
||||
|
||||
This makes these internal functions technically not callable from
|
||||
|
|
|
|||
|
|
@ -55,7 +55,6 @@ guile_TEXINFOS = preface.texi \
|
|||
scsh.texi \
|
||||
tcltk.texi \
|
||||
scheme-scripts.texi \
|
||||
gh.texi \
|
||||
api-overview.texi \
|
||||
scheme-debugging.texi \
|
||||
scheme-using.texi \
|
||||
|
|
|
|||
1201
doc/ref/gh.texi
1201
doc/ref/gh.texi
File diff suppressed because it is too large
Load diff
|
|
@ -307,7 +307,6 @@ available through both Scheme and C interfaces.
|
|||
* Translation:: Support for translating other languages.
|
||||
* Internationalization:: Support for gettext, etc.
|
||||
* Debugging:: Debugging infrastructure and Scheme interface.
|
||||
* GH:: The deprecated GH interface.
|
||||
@end menu
|
||||
|
||||
@include api-overview.texi
|
||||
|
|
@ -331,7 +330,6 @@ available through both Scheme and C interfaces.
|
|||
@include api-translation.texi
|
||||
@include api-i18n.texi
|
||||
@include api-debug.texi
|
||||
@include gh.texi
|
||||
|
||||
@node Guile Modules
|
||||
@chapter Guile Modules
|
||||
|
|
|
|||
|
|
@ -27,7 +27,6 @@
|
|||
|
||||
#ifdef HAVE_RL_GETC_FUNCTION
|
||||
#include "libguile.h"
|
||||
#include "libguile/gh.h"
|
||||
#include "libguile/iselect.h"
|
||||
|
||||
#include <stdio.h>
|
||||
|
|
|
|||
|
|
@ -1,256 +0,0 @@
|
|||
The gh implementation (gh_data.c, gh.h, etc.) used to live in a
|
||||
separate directory called gh. In April 1997, that dir was merged with
|
||||
libguile; this is the ChangeLog from the old directory.
|
||||
|
||||
Please put new entries in the ordinary ChangeLog.
|
||||
|
||||
Thu Apr 10 16:14:43 1997 Jim Blandy <jimb@floss.cyclic.com>
|
||||
|
||||
Let the test programs build even when we're not using threads.
|
||||
* configure.in: Use CY_AC_WITH_THREADS to decide whether to build
|
||||
with threads.
|
||||
* Makefile.am (check_PROGRAMS_LDADD): Remove -lthreads -lqt. The
|
||||
configure script will stick them in LIBS if they're needed.
|
||||
* Makefile.in, aclocal.m4, configure: Rebuilt.
|
||||
|
||||
* gh_funcs.c (gh_apply, gh_call0, gh_call1, gh_call2, gh_call3):
|
||||
New functions.
|
||||
* gh.h: Prototypes for above.
|
||||
* gh_test_c.c (main_prog): Added test cases for above.
|
||||
|
||||
* gh.h (gh_display, gh_newline): Added prototypes.
|
||||
|
||||
* gh_test_c.c (main_prog): Remove bizarre single quote from test
|
||||
of gh_symbol2scm, and from "test" of (display "hello world").
|
||||
|
||||
* gh.c: Removed; its guts have been redistributed to the other
|
||||
gh-mumble.c files.
|
||||
|
||||
* gh.c, gh_data.c, gh_eval.c, gh_funcs.c, gh_init.c, gh_io.c,
|
||||
gh_list.c, gh_predicates.c, gh_test_c.c, gh_test_repl.c:
|
||||
Re-indented, according to the GNU coding standards. (Put function
|
||||
names at beginning of lines, basically.)
|
||||
|
||||
Wed Apr 9 17:56:34 1997 Jim Blandy <jimb@floss.cyclic.com>
|
||||
|
||||
Changes to work with automake-1.1n, which has better libtool support.
|
||||
* Makefile.am: Use lib_LTLIBRARIES, not lib_PROGRAMS.
|
||||
* Makefile.in: Regenerated.
|
||||
|
||||
Sat Mar 8 06:37:23 1997 Gary Houston <ghouston@actrix.gen.nz>
|
||||
|
||||
* gh_eval.c (gh_eval_file): remove case_i, sharp arguments from
|
||||
scm_primitive_load call.
|
||||
|
||||
Mon Feb 24 21:45:32 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
|
||||
|
||||
* configure.in: Added AM_MAINTAINER_MODE
|
||||
|
||||
Wed Feb 12 16:34:42 1997 Mark Galassi <rosalia@sarastro.lanl.gov>
|
||||
|
||||
* gh_data.c (gh_symbol2newstr): added this conversion from SCM
|
||||
symbol to C string.
|
||||
(gh_set_substr): more data conversion: from part of a (possibly
|
||||
large) C string to an existing SCM string.
|
||||
(gh_get_substr): more data conversion: from part of a (possibly
|
||||
large) SCM string to an existing C char array.
|
||||
|
||||
Mon Feb 10 14:03:09 1997 Mark Galassi <rosalia@sarastro.lanl.gov>
|
||||
|
||||
* gh_funcs.c (gh_define): added this function.
|
||||
|
||||
* gh_init.c (gh_catch): fixed stupid bug, gh_catch() was not
|
||||
returning anything.
|
||||
|
||||
* gh_data.c (gh_scm2newstr): Renamed gh_scm2str0() to
|
||||
gh_scm2newstr(), and did away with the str0 convention (it doesn't
|
||||
seem to belong in gh_).
|
||||
(gh_scm2str): this function now copies Scheme data to a
|
||||
pre-allocated C string.
|
||||
|
||||
Fri Feb 7 15:12:30 1997 Mark Galassi <rosalia@sarastro.lanl.gov>
|
||||
|
||||
* gh_data.c (gh_scm2str0): On Sascha Ziemann and Jim Blandy's
|
||||
suggestion I changed gh_scm2str0() so that it returns a malloc-ed
|
||||
string, rather than taking a pre-allocated string with a maximum
|
||||
length...
|
||||
|
||||
Fri Jan 24 08:18:28 1997 Mark Galassi <rosalia@sarastro.lanl.gov>
|
||||
|
||||
* gh_eval.c (gh_eval_str): gh_eval_str() now returns an SCM object
|
||||
with the result of the evaluation. It has also been simplified to
|
||||
just call scm_eval_0str(). gh_eval_file() has been similarly
|
||||
altered.
|
||||
|
||||
Sat Jan 11 14:40:17 1997 Marius Vollmer <mvo@zagadka.ping.de>
|
||||
|
||||
* ltconfig, ltmain.sh: New files for libtool support. libguile,
|
||||
rx, gh and gtcltk-lib can now be build as shared libraries.
|
||||
* Makefile.am (EXTRA_DIST): Added ltconfig and ltmain.sh
|
||||
|
||||
Sun Jan 5 16:57:10 1997 Jim Blandy <jimb@floss.cyclic.com>
|
||||
|
||||
* Guile 1.0 released. This is the first release by the Free
|
||||
Software Foundation; Cygnus has also released earlier versions of
|
||||
Guile.
|
||||
|
||||
* GUILE-VERSION: Updated version number.
|
||||
* NEWS: Added comments for all the user-visible changes marked in
|
||||
the ChangeLogs.
|
||||
* README: Updated for release.
|
||||
|
||||
Thu Dec 12 00:14:32 1996 Gary Houston <ghouston@actrix.gen.nz>
|
||||
|
||||
* scsh: new directory.
|
||||
|
||||
Mon Dec 2 17:33:04 1996 Tom Tromey <tromey@cygnus.com>
|
||||
|
||||
* configure.in: Generate doc/guile-programmer/Makefile and
|
||||
doc/guile-user/Makefile.
|
||||
|
||||
Sat Nov 30 23:45:54 1996 Tom Tromey <tromey@cygnus.com>
|
||||
|
||||
* aclocal.m4: Now automatically generated by aclocal.
|
||||
* threads.m4: New file.
|
||||
* guile.m4: New file.
|
||||
* Makefile.am, doc/Makefile.am: New files.
|
||||
* configure.in: Updated for Automake. Avoid excessively verbose
|
||||
"greet" messages.
|
||||
|
||||
Wed Oct 16 07:32:14 1996 Mark Galassi <rosalia@sarastro.lanl.gov>
|
||||
|
||||
* lgh: directory renamed to gh, along with all prefixes of the
|
||||
high level library procedures.
|
||||
|
||||
Thu Oct 10 14:37:43 1996 Jim Blandy <jimb@floss.cyclic.com>
|
||||
|
||||
* Makefile.in (TAGS tags): Find the source files in $srcdir.
|
||||
|
||||
Wed Oct 9 19:37:14 1996 Jim Blandy <jimb@floss.cyclic.com>
|
||||
|
||||
* Makefile.in (DISTFILES): Add AUTHORS and aclocal.m4.
|
||||
|
||||
Tue Oct 1 00:13:55 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se>
|
||||
|
||||
* configure.in: Added some configuration magic from the Cygnus
|
||||
distribution.
|
||||
|
||||
* aclocal.m4: New file. For now used for thread support
|
||||
configuration.
|
||||
|
||||
Fri Sep 13 14:39:30 1996 Mark Galassi <rosalia@sarastro.lanl.gov>
|
||||
|
||||
* Makefile.in (DISTFILES): added mkinstalldirs to the DISTFILES
|
||||
|
||||
* PLUGIN: changed the PLUGIN/REQ files in the ice-9 and lgh
|
||||
directories, to arrange for lgh to the last thing
|
||||
configured/built.
|
||||
|
||||
Wed Sep 11 21:11:33 1996 Mark Galassi <rosalia@nis.lanl.gov>
|
||||
|
||||
* lgh/: added the directory in which I implement the high level
|
||||
libguile library (lgh_) for this release of Guile. See the
|
||||
ChangeLog in there for further details.
|
||||
|
||||
Wed Sep 11 16:12:53 1996 Mark Galassi <rosalia@sarastro.lanl.gov>
|
||||
|
||||
* doc/ (guile-user and guile-programmer): added the guile-user and
|
||||
guile-programmer directories which contain the user and programmer
|
||||
manuals. See the ChangeLog entries there for detail.
|
||||
|
||||
Wed Sep 11 14:33:49 1996 Jim Blandy <jimb@floss.cyclic.com>
|
||||
|
||||
* Makefile.in (distclean): Don't forget to delete doc/Makefile.
|
||||
|
||||
* Makefile.in (distclean): Don't forget to delete
|
||||
config.build-subdirs.
|
||||
|
||||
Thu Sep 5 17:36:15 1996 Jim Blandy <jimb@floss.cyclic.com>
|
||||
|
||||
* Makefile.in (tags): New name for `TAGS' target, which will
|
||||
always run the commands.
|
||||
|
||||
Thu Sep 5 09:56:50 1996 Jim Blandy <jimb@totoro.cyclic.com>
|
||||
|
||||
* README: Doc fixes.
|
||||
|
||||
Fri Aug 30 16:56:27 1996 Jim Blandy <jimb@floss.cyclic.com>
|
||||
|
||||
* Makefile.in (TAGS): Produce a single tags file for all of Guile.
|
||||
|
||||
Thu Aug 15 19:03:03 1996 Jim Blandy <jimb@floss.cyclic.com>
|
||||
|
||||
* configure.in: Check for -ldl, so the check for Tcl won't fail
|
||||
spuriously.
|
||||
|
||||
Thu Aug 15 01:29:29 1996 Jim Blandy <jimb@totoro.cyclic.com>
|
||||
|
||||
Change the way we decide whether to build gtcltk-lib, so that it's
|
||||
omitted from the build process when appropriate, but never from
|
||||
the dist process.
|
||||
* configure.in: Don't edit all_subdirs depending on the
|
||||
availability of Tk; let that be the list of all PLUGIN
|
||||
subdirectories present, as it used to be. Instead, edit a new
|
||||
variable, build_subdirs; write its final value, the list of
|
||||
subdirs we do want to compile in, to config.build-subdirs.
|
||||
Substitute that into the top-level Makefile too.
|
||||
* Makefile.in (subdirs): Set this to @build_subdirs@, so we only
|
||||
recurse on the subdirectories we should build.
|
||||
(distdirs): Set this to @existingdirs@, so it includes the subdirs
|
||||
we decided not to build.
|
||||
|
||||
* doc/gtcltk.texi: File resurrected from old Guile releases.
|
||||
* doc/Makefile.in (info): Build the gtcltk documentation.
|
||||
(DIST_FILES): Include it in the distribution.
|
||||
|
||||
* configure.in: If we can find the library for tcl7.5, build
|
||||
gtcltk-lib. Call AC_PROG_CC, to help run that test with the right
|
||||
compiler (not sure this is necessary).
|
||||
|
||||
Mon Aug 12 15:09:37 1996 Jim Blandy <jimb@totoro.cyclic.com>
|
||||
|
||||
* NEWS: Fix bug reporting address.
|
||||
|
||||
Fri Aug 9 15:58:42 1996 Jim Blandy <jimb@totoro.cyclic.com>
|
||||
|
||||
* AUTHORS: New file, in accordance with the GNU maintainers'
|
||||
standards.
|
||||
|
||||
Tue Aug 6 14:40:44 1996 Jim Blandy <jimb@totoro.cyclic.com>
|
||||
|
||||
* README: Renamed from ANNOUNCE; include bug report address,
|
||||
description, and short tour.
|
||||
* INSTALL: Renamed from BUILDING.
|
||||
* NEWS: New file.
|
||||
* Makefile.in (DISTFILES): Update appropriately.
|
||||
|
||||
Thu Aug 1 02:31:53 1996 Jim Blandy <jimb@totoro.cyclic.com>
|
||||
|
||||
* doc/Makefile.in: Added pattern targets for creating DVI and
|
||||
PostScript files.
|
||||
(%.ps, %.dvi, %.txt): New targets.
|
||||
(DVIPS, TEXI2DVI): New variables.
|
||||
|
||||
* GUILE-VERSION: Updated to 1.0b3.
|
||||
|
||||
Rehashed distribution system, in preparation for nightly
|
||||
snapshots. Other changes in subdirectories.
|
||||
* Makefile.in (dist): Rewritten --- the old target was out of
|
||||
date, dependent on files that we don't have, and relied on GNU
|
||||
tar. The new target is simpler.
|
||||
(VERSION, srcdir, dist_dirs): New variables.
|
||||
(DISTFILES): Renamed from localfiles. Added GUILE-VERSION and
|
||||
TODO.
|
||||
(localtreats): Variable removed. We don't have this file.
|
||||
(info): cd to doc and make info there; don't make info in every
|
||||
${subdir}; those Makefiles don't know what to do.
|
||||
(distname, distdir, treats, announcefile): Variables removed.
|
||||
(manifest-file): Target removed.
|
||||
(dist-dir): New target, responsible for distributable files in
|
||||
this directory.
|
||||
(GZIP, GZIP_EXT, TAR_VERBOSE, DIST_NAME): New variables,
|
||||
controlling the 'dist' target.
|
||||
* configure.in: Substitute GUILE-VERSION into the top-level
|
||||
Makefile. Build doc/Makefile from doc/Makefile.in.
|
||||
|
||||
* doc/Makefile.in: New file.
|
||||
|
|
@ -111,8 +111,7 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \
|
|||
eval.c evalext.c extensions.c feature.c fluids.c fports.c \
|
||||
futures.c gc.c gc-mark.c gc-segment.c gc-malloc.c gc-card.c \
|
||||
gc-freelist.c gc_os_dep.c gdbint.c gettext.c gc-segment-table.c \
|
||||
gh_data.c gh_eval.c gh_funcs.c \
|
||||
gh_init.c gh_io.c gh_list.c gh_predicates.c goops.c gsubr.c \
|
||||
goops.c gsubr.c \
|
||||
guardians.c hash.c hashtab.c hooks.c init.c inline.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 \
|
||||
|
|
@ -205,7 +204,7 @@ libguile_la_LIBADD = @LIBLOBJS@ $(gnulib_library)
|
|||
libguile_la_LDFLAGS = @LTLIBINTL@ -version-info @LIBGUILE_INTERFACE_CURRENT@:@LIBGUILE_INTERFACE_REVISION@:@LIBGUILE_INTERFACE_AGE@ -export-dynamic -no-undefined
|
||||
|
||||
# These are headers visible as <guile/mumble.h>
|
||||
pkginclude_HEADERS = gh.h
|
||||
pkginclude_HEADERS =
|
||||
|
||||
# These are headers visible as <libguile/mumble.h>.
|
||||
modincludedir = $(includedir)/libguile
|
||||
|
|
@ -235,7 +234,7 @@ bin_SCRIPTS = guile-snarf
|
|||
# and people feel like maintaining them. For now, this is not the case.
|
||||
noinst_SCRIPTS = guile-doc-snarf guile-snarf-docs guile-func-name-check
|
||||
|
||||
EXTRA_DIST = ChangeLog-gh ChangeLog-scm ChangeLog-threads \
|
||||
EXTRA_DIST = ChangeLog-scm ChangeLog-threads \
|
||||
ChangeLog-1996-1999 ChangeLog-2000 ChangeLog-2008 cpp_signal.c \
|
||||
cpp_errno.c cpp_err_symbols.in cpp_err_symbols.c \
|
||||
cpp_sig_symbols.c cpp_sig_symbols.in cpp_cnvt.awk \
|
||||
|
|
|
|||
|
|
@ -23,7 +23,6 @@
|
|||
#include "libguile/_scm.h"
|
||||
#include "libguile/alist.h"
|
||||
#include "libguile/eval.h"
|
||||
#include "libguile/gh.h"
|
||||
#include "libguile/hash.h"
|
||||
#include "libguile/list.h"
|
||||
#include "libguile/ports.h"
|
||||
|
|
|
|||
243
libguile/gh.h
243
libguile/gh.h
|
|
@ -1,243 +0,0 @@
|
|||
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2005, 2006 Free Software Foundation, Inc.
|
||||
*
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public
|
||||
* License as published by the Free Software Foundation; either
|
||||
* version 2.1 of the License, or (at your option) any later version.
|
||||
*
|
||||
* This library is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
*/
|
||||
|
||||
|
||||
#ifndef __GH_H
|
||||
#define __GH_H
|
||||
|
||||
/* This needs to be included outside of the extern "C" block.
|
||||
*/
|
||||
#include <libguile.h>
|
||||
|
||||
#if SCM_ENABLE_DEPRECATED
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
/* gcc has extern inline functions that are basically as fast as macros */
|
||||
#ifdef __GNUC__
|
||||
# define INL inline
|
||||
# define EXTINL extern inline
|
||||
#else
|
||||
# define INL
|
||||
#define EXTINL
|
||||
#endif /* __GNUC__ */
|
||||
|
||||
SCM_API void gh_enter(int argc, char *argv[],
|
||||
void (*c_main_prog)(int, char **));
|
||||
#define gh_init () scm_init_guile ()
|
||||
SCM_API void gh_repl(int argc, char *argv[]);
|
||||
SCM_API SCM gh_catch(SCM tag, scm_t_catch_body body, void *body_data,
|
||||
scm_t_catch_handler handler, void *handler_data);
|
||||
|
||||
SCM_API SCM gh_standard_handler(void *data, SCM tag, SCM throw_args);
|
||||
|
||||
SCM_API SCM gh_eval_str(const char *scheme_code);
|
||||
SCM_API SCM gh_eval_str_with_catch(const char *scheme_code, scm_t_catch_handler handler);
|
||||
SCM_API SCM gh_eval_str_with_standard_handler(const char *scheme_code);
|
||||
SCM_API SCM gh_eval_str_with_stack_saving_handler(const char *scheme_code);
|
||||
|
||||
SCM_API SCM gh_eval_file(const char *fname);
|
||||
#define gh_load(fname) gh_eval_file(fname)
|
||||
SCM_API SCM gh_eval_file_with_catch(const char *scheme_code, scm_t_catch_handler handler);
|
||||
SCM_API SCM gh_eval_file_with_standard_handler(const char *scheme_code);
|
||||
|
||||
#define gh_defer_ints() SCM_CRITICAL_SECTION_START
|
||||
#define gh_allow_ints() SCM_CRITICAL_SECTION_END
|
||||
|
||||
SCM_API SCM gh_new_procedure(const char *proc_name, SCM (*fn)(),
|
||||
int n_required_args, int n_optional_args,
|
||||
int varp);
|
||||
SCM_API SCM gh_new_procedure0_0(const char *proc_name, SCM (*fn)(void));
|
||||
SCM_API SCM gh_new_procedure0_1(const char *proc_name, SCM (*fn)(SCM));
|
||||
SCM_API SCM gh_new_procedure0_2(const char *proc_name, SCM (*fn)(SCM, SCM));
|
||||
SCM_API SCM gh_new_procedure1_0(const char *proc_name, SCM (*fn)(SCM));
|
||||
SCM_API SCM gh_new_procedure1_1(const char *proc_name, SCM (*fn)(SCM, SCM));
|
||||
SCM_API SCM gh_new_procedure1_2(const char *proc_name, SCM (*fn)(SCM, SCM, SCM));
|
||||
SCM_API SCM gh_new_procedure2_0(const char *proc_name, SCM (*fn)(SCM, SCM));
|
||||
SCM_API SCM gh_new_procedure2_1(const char *proc_name, SCM (*fn)(SCM, SCM, SCM));
|
||||
SCM_API SCM gh_new_procedure2_2(const char *proc_name, SCM (*fn)(SCM, SCM, SCM, SCM));
|
||||
SCM_API SCM gh_new_procedure3_0(const char *proc_name, SCM (*fn)(SCM, SCM, SCM));
|
||||
SCM_API SCM gh_new_procedure4_0(const char *proc_name, SCM (*fn)(SCM, SCM, SCM, SCM));
|
||||
SCM_API SCM gh_new_procedure5_0(const char *proc_name, SCM (*fn)(SCM, SCM, SCM, SCM, SCM));
|
||||
|
||||
/* C to Scheme conversion */
|
||||
SCM_API SCM gh_bool2scm(int x);
|
||||
SCM_API SCM gh_int2scm(int x);
|
||||
SCM_API SCM gh_ulong2scm(unsigned long x);
|
||||
SCM_API SCM gh_long2scm(long x);
|
||||
SCM_API SCM gh_double2scm(double x);
|
||||
SCM_API SCM gh_char2scm(char c);
|
||||
SCM_API SCM gh_str2scm(const char *s, size_t len);
|
||||
SCM_API SCM gh_str02scm(const char *s);
|
||||
SCM_API void gh_set_substr(const char *src, SCM dst, long start, size_t len);
|
||||
SCM_API SCM gh_symbol2scm(const char *symbol_str);
|
||||
SCM_API SCM gh_ints2scm(const int *d, long n);
|
||||
|
||||
SCM_API SCM gh_chars2byvect(const char *d, long n);
|
||||
SCM_API SCM gh_shorts2svect(const short *d, long n);
|
||||
SCM_API SCM gh_longs2ivect(const long *d, long n);
|
||||
SCM_API SCM gh_ulongs2uvect(const unsigned long *d, long n);
|
||||
SCM_API SCM gh_floats2fvect(const float *d, long n);
|
||||
SCM_API SCM gh_doubles2dvect(const double *d, long n);
|
||||
|
||||
SCM_API SCM gh_doubles2scm(const double *d, long n);
|
||||
|
||||
/* Scheme to C conversion */
|
||||
SCM_API int gh_scm2bool(SCM obj);
|
||||
SCM_API int gh_scm2int(SCM obj);
|
||||
SCM_API unsigned long gh_scm2ulong(SCM obj);
|
||||
SCM_API long gh_scm2long(SCM obj);
|
||||
SCM_API char gh_scm2char(SCM obj);
|
||||
SCM_API double gh_scm2double(SCM obj);
|
||||
SCM_API char *gh_scm2newstr(SCM str, size_t *lenp);
|
||||
SCM_API void gh_get_substr(SCM src, char *dst, long start, size_t len);
|
||||
SCM_API char *gh_symbol2newstr(SCM sym, size_t *lenp);
|
||||
SCM_API char *gh_scm2chars(SCM vector, char *result);
|
||||
SCM_API short *gh_scm2shorts(SCM vector, short *result);
|
||||
SCM_API long *gh_scm2longs(SCM vector, long *result);
|
||||
SCM_API float *gh_scm2floats(SCM vector, float *result);
|
||||
SCM_API double *gh_scm2doubles(SCM vector, double *result);
|
||||
|
||||
/* type predicates: tell you if an SCM object has a given type */
|
||||
SCM_API int gh_boolean_p(SCM val);
|
||||
SCM_API int gh_symbol_p(SCM val);
|
||||
SCM_API int gh_char_p(SCM val);
|
||||
SCM_API int gh_vector_p(SCM val);
|
||||
SCM_API int gh_pair_p(SCM val);
|
||||
SCM_API int gh_number_p(SCM val);
|
||||
SCM_API int gh_string_p(SCM val);
|
||||
SCM_API int gh_procedure_p(SCM val);
|
||||
SCM_API int gh_list_p(SCM val);
|
||||
SCM_API int gh_inexact_p(SCM val);
|
||||
SCM_API int gh_exact_p(SCM val);
|
||||
|
||||
/* more predicates */
|
||||
SCM_API int gh_eq_p(SCM x, SCM y);
|
||||
SCM_API int gh_eqv_p(SCM x, SCM y);
|
||||
SCM_API int gh_equal_p(SCM x, SCM y);
|
||||
SCM_API int gh_string_equal_p(SCM s1, SCM s2);
|
||||
SCM_API int gh_null_p(SCM l);
|
||||
|
||||
/* standard Scheme procedures available from C */
|
||||
|
||||
#define gh_not(x) scm_not(x)
|
||||
|
||||
SCM_API SCM gh_define(const char *name, SCM val);
|
||||
|
||||
/* string manipulation routines */
|
||||
#define gh_make_string(k, chr) scm_make_string(k, chr)
|
||||
#define gh_string_length(str) scm_string_length(str)
|
||||
#define gh_string_ref(str, k) scm_string_ref(str, k)
|
||||
#define gh_string_set_x(str, k, chr) scm_string_set_x(str, k, chr)
|
||||
#define gh_substring(str, start, end) scm_substring(str, start, end)
|
||||
#define gh_string_append(args) scm_string_append(args)
|
||||
|
||||
|
||||
/* vector manipulation routines */
|
||||
/* note that gh_vector() does not behave quite like the Scheme (vector
|
||||
obj1 obj2 ...), because the interpreter engine does not pass the
|
||||
data element by element, but rather as a list. thus, gh_vector()
|
||||
ends up being identical to gh_list_to_vector() */
|
||||
#define gh_vector(ls) scm_vector(ls)
|
||||
SCM_API SCM gh_make_vector(SCM length, SCM val);
|
||||
SCM_API SCM gh_vector_set_x(SCM vec, SCM pos, SCM val);
|
||||
SCM_API SCM gh_vector_ref(SCM vec, SCM pos);
|
||||
SCM_API unsigned long gh_vector_length (SCM v);
|
||||
SCM_API unsigned long gh_uniform_vector_length (SCM v);
|
||||
SCM_API SCM gh_uniform_vector_ref (SCM v, SCM ilist);
|
||||
#define gh_list_to_vector(ls) scm_vector(ls)
|
||||
#define gh_vector_to_list(v) scm_vector_to_list(v)
|
||||
|
||||
SCM_API SCM gh_lookup (const char *sname);
|
||||
SCM_API SCM gh_module_lookup (SCM module, const char *sname);
|
||||
|
||||
SCM_API SCM gh_cons(SCM x, SCM y);
|
||||
#define gh_list scm_list_n
|
||||
SCM_API unsigned long gh_length(SCM l);
|
||||
SCM_API SCM gh_append(SCM args);
|
||||
SCM_API SCM gh_append2(SCM l1, SCM l2);
|
||||
SCM_API SCM gh_append3(SCM l1, SCM l2, SCM l3);
|
||||
SCM_API SCM gh_append4(SCM l1, SCM l2, SCM l3, SCM l4);
|
||||
#define gh_reverse(ls) scm_reverse(ls)
|
||||
#define gh_list_tail(ls, k) scm_list_tail(ls, k)
|
||||
#define gh_list_ref(ls, k) scm_list_ref(ls, k)
|
||||
#define gh_memq(x, ls) scm_memq(x, ls)
|
||||
#define gh_memv(x, ls) scm_memv(x, ls)
|
||||
#define gh_member(x, ls) scm_member(x, ls)
|
||||
#define gh_assq(x, alist) scm_assq(x, alist)
|
||||
#define gh_assv(x, alist) scm_assv(x, alist)
|
||||
#define gh_assoc(x, alist) scm_assoc(x, alist)
|
||||
|
||||
SCM_API SCM gh_car(SCM x);
|
||||
SCM_API SCM gh_cdr(SCM x);
|
||||
|
||||
SCM_API SCM gh_caar(SCM x);
|
||||
SCM_API SCM gh_cadr(SCM x);
|
||||
SCM_API SCM gh_cdar(SCM x);
|
||||
SCM_API SCM gh_cddr(SCM x);
|
||||
|
||||
SCM_API SCM gh_caaar(SCM x);
|
||||
SCM_API SCM gh_caadr(SCM x);
|
||||
SCM_API SCM gh_cadar(SCM x);
|
||||
SCM_API SCM gh_caddr(SCM x);
|
||||
SCM_API SCM gh_cdaar(SCM x);
|
||||
SCM_API SCM gh_cdadr(SCM x);
|
||||
SCM_API SCM gh_cddar(SCM x);
|
||||
SCM_API SCM gh_cdddr(SCM x);
|
||||
|
||||
SCM_API SCM gh_set_car_x(SCM pair, SCM value);
|
||||
SCM_API SCM gh_set_cdr_x(SCM pair, SCM value);
|
||||
|
||||
|
||||
/* Calling Scheme functions from C. */
|
||||
SCM_API SCM gh_apply (SCM proc, SCM ls);
|
||||
SCM_API SCM gh_call0 (SCM proc);
|
||||
SCM_API SCM gh_call1 (SCM proc, SCM arg);
|
||||
SCM_API SCM gh_call2 (SCM proc, SCM arg1, SCM arg2);
|
||||
SCM_API SCM gh_call3 (SCM proc, SCM arg1, SCM arg2, SCM arg3);
|
||||
|
||||
/* reading and writing Scheme objects. */
|
||||
SCM_API void gh_display (SCM x);
|
||||
SCM_API void gh_write (SCM x);
|
||||
SCM_API void gh_newline (void);
|
||||
|
||||
/* void gh_gc_mark(SCM) : mark an SCM as in use. */
|
||||
/* void gh_defer_ints() : don't interrupt code section. */
|
||||
/* void gh_allow_ints() : see gh_defer_ints(). */
|
||||
/* void gh_new_cell(SCM, int tag) : initialize SCM to be of type 'tag' */
|
||||
/* int gh_type_p(SCM, tag) : test if SCM is of type 'tag' */
|
||||
/* SCM gh_intern(char*) : get symbol corresponding to c-string.*/
|
||||
/* void gh_set_ext_data(SCM, void*) : set extension data on SCM */
|
||||
/* void *gh_get_ext_data(SCM) : return extension data from SCM. */
|
||||
|
||||
/* void gh_assert(int cond, char *msg, SCM obj); */
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
#endif /* __GH_H */
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
End:
|
||||
*/
|
||||
|
|
@ -1,659 +0,0 @@
|
|||
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2004, 2006 Free Software Foundation, Inc.
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public
|
||||
* License as published by the Free Software Foundation; either
|
||||
* version 2.1 of the License, or (at your option) any later version.
|
||||
*
|
||||
* This library is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
*/
|
||||
|
||||
|
||||
/* data initialization and C<->Scheme data conversion */
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
#include "libguile/gh.h"
|
||||
#ifdef HAVE_STRING_H
|
||||
#include <string.h>
|
||||
#endif
|
||||
|
||||
#include <assert.h>
|
||||
|
||||
#if SCM_ENABLE_DEPRECATED
|
||||
|
||||
/* data conversion C->scheme */
|
||||
|
||||
SCM
|
||||
gh_bool2scm (int x)
|
||||
{
|
||||
return scm_from_bool(x);
|
||||
}
|
||||
SCM
|
||||
gh_int2scm (int x)
|
||||
{
|
||||
return scm_from_long ((long) x);
|
||||
}
|
||||
SCM
|
||||
gh_ulong2scm (unsigned long x)
|
||||
{
|
||||
return scm_from_ulong (x);
|
||||
}
|
||||
SCM
|
||||
gh_long2scm (long x)
|
||||
{
|
||||
return scm_from_long (x);
|
||||
}
|
||||
SCM
|
||||
gh_double2scm (double x)
|
||||
{
|
||||
return scm_from_double (x);
|
||||
}
|
||||
SCM
|
||||
gh_char2scm (char c)
|
||||
{
|
||||
return SCM_MAKE_CHAR (c);
|
||||
}
|
||||
SCM
|
||||
gh_str2scm (const char *s, size_t len)
|
||||
{
|
||||
return scm_from_locale_stringn (s, len);
|
||||
}
|
||||
SCM
|
||||
gh_str02scm (const char *s)
|
||||
{
|
||||
return scm_from_locale_string (s);
|
||||
}
|
||||
/* Copy LEN characters at SRC into the *existing* Scheme string DST,
|
||||
starting at START. START is an index into DST; zero means the
|
||||
beginning of the string.
|
||||
|
||||
If START + LEN is off the end of DST, signal an out-of-range
|
||||
error. */
|
||||
void
|
||||
gh_set_substr (const char *src, SCM dst, long start, size_t len)
|
||||
{
|
||||
char *dst_ptr;
|
||||
size_t dst_len;
|
||||
|
||||
SCM_ASSERT (scm_is_string (dst), dst, SCM_ARG3, "gh_set_substr");
|
||||
|
||||
dst_len = scm_i_string_length (dst);
|
||||
SCM_ASSERT (start + len <= dst_len, dst, SCM_ARG4, "gh_set_substr");
|
||||
|
||||
dst_ptr = scm_i_string_writable_chars (dst);
|
||||
memmove (dst_ptr + start, src, len);
|
||||
scm_i_string_stop_writing ();
|
||||
scm_remember_upto_here_1 (dst);
|
||||
}
|
||||
|
||||
/* Return the symbol named SYMBOL_STR. */
|
||||
SCM
|
||||
gh_symbol2scm (const char *symbol_str)
|
||||
{
|
||||
return scm_from_locale_symbol(symbol_str);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_ints2scm (const int *d, long n)
|
||||
{
|
||||
long i;
|
||||
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
|
||||
for (i = 0; i < n; ++i)
|
||||
SCM_SIMPLE_VECTOR_SET (v, i, scm_from_int (d[i]));
|
||||
|
||||
return v;
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_doubles2scm (const double *d, long n)
|
||||
{
|
||||
long i;
|
||||
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
|
||||
|
||||
for(i = 0; i < n; i++)
|
||||
SCM_SIMPLE_VECTOR_SET (v, i, scm_from_double (d[i]));
|
||||
return v;
|
||||
}
|
||||
|
||||
|
||||
SCM
|
||||
gh_chars2byvect (const char *d, long n)
|
||||
{
|
||||
char *m = scm_malloc (n);
|
||||
memcpy (m, d, n * sizeof (char));
|
||||
return scm_take_s8vector ((scm_t_int8 *)m, n);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_shorts2svect (const short *d, long n)
|
||||
{
|
||||
char *m = scm_malloc (n * sizeof (short));
|
||||
memcpy (m, d, n * sizeof (short));
|
||||
assert (sizeof (scm_t_int16) == sizeof (short));
|
||||
return scm_take_s16vector ((scm_t_int16 *)m, n);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_longs2ivect (const long *d, long n)
|
||||
{
|
||||
char *m = scm_malloc (n * sizeof (long));
|
||||
memcpy (m, d, n * sizeof (long));
|
||||
assert (sizeof (scm_t_int32) == sizeof (long));
|
||||
return scm_take_s32vector ((scm_t_int32 *)m, n);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_ulongs2uvect (const unsigned long *d, long n)
|
||||
{
|
||||
char *m = scm_malloc (n * sizeof (unsigned long));
|
||||
memcpy (m, d, n * sizeof (unsigned long));
|
||||
assert (sizeof (scm_t_uint32) == sizeof (unsigned long));
|
||||
return scm_take_u32vector ((scm_t_uint32 *)m, n);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_floats2fvect (const float *d, long n)
|
||||
{
|
||||
char *m = scm_malloc (n * sizeof (float));
|
||||
memcpy (m, d, n * sizeof (float));
|
||||
return scm_take_f32vector ((float *)m, n);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_doubles2dvect (const double *d, long n)
|
||||
{
|
||||
char *m = scm_malloc (n * sizeof (double));
|
||||
memcpy (m, d, n * sizeof (double));
|
||||
return scm_take_f64vector ((double *)m, n);
|
||||
}
|
||||
|
||||
/* data conversion scheme->C */
|
||||
int
|
||||
gh_scm2bool (SCM obj)
|
||||
{
|
||||
return (scm_is_false (obj)) ? 0 : 1;
|
||||
}
|
||||
unsigned long
|
||||
gh_scm2ulong (SCM obj)
|
||||
{
|
||||
return scm_to_ulong (obj);
|
||||
}
|
||||
long
|
||||
gh_scm2long (SCM obj)
|
||||
{
|
||||
return scm_to_long (obj);
|
||||
}
|
||||
int
|
||||
gh_scm2int (SCM obj)
|
||||
{
|
||||
return scm_to_int (obj);
|
||||
}
|
||||
double
|
||||
gh_scm2double (SCM obj)
|
||||
{
|
||||
return scm_to_double (obj);
|
||||
}
|
||||
char
|
||||
gh_scm2char (SCM obj)
|
||||
#define FUNC_NAME "gh_scm2char"
|
||||
{
|
||||
SCM_VALIDATE_CHAR (SCM_ARG1, obj);
|
||||
return SCM_CHAR (obj);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
/* Convert a vector, weak vector, string, substring or uniform vector
|
||||
into an array of chars. If result array in arg 2 is NULL, malloc a
|
||||
new one. If out of memory, return NULL. */
|
||||
char *
|
||||
gh_scm2chars (SCM obj, char *m)
|
||||
{
|
||||
long i, n;
|
||||
long v;
|
||||
SCM val;
|
||||
if (SCM_IMP (obj))
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
switch (SCM_TYP7 (obj))
|
||||
{
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
n = SCM_SIMPLE_VECTOR_LENGTH (obj);
|
||||
for (i = 0; i < n; ++i)
|
||||
{
|
||||
val = SCM_SIMPLE_VECTOR_REF (obj, i);
|
||||
if (SCM_I_INUMP (val))
|
||||
{
|
||||
v = SCM_I_INUM (val);
|
||||
if (v < -128 || v > 255)
|
||||
scm_out_of_range (0, obj);
|
||||
}
|
||||
else
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
}
|
||||
if (m == 0)
|
||||
m = (char *) malloc (n * sizeof (char));
|
||||
if (m == NULL)
|
||||
return NULL;
|
||||
for (i = 0; i < n; ++i)
|
||||
m[i] = SCM_I_INUM (SCM_SIMPLE_VECTOR_REF (obj, i));
|
||||
break;
|
||||
case scm_tc7_smob:
|
||||
if (scm_is_true (scm_s8vector_p (obj)))
|
||||
{
|
||||
scm_t_array_handle handle;
|
||||
size_t len;
|
||||
ssize_t inc;
|
||||
const scm_t_int8 *elts;
|
||||
|
||||
elts = scm_s8vector_elements (obj, &handle, &len, &inc);
|
||||
if (inc != 1)
|
||||
scm_misc_error (NULL, "only contiguous vectors are supported: ~a",
|
||||
scm_list_1 (obj));
|
||||
if (m == 0)
|
||||
m = (char *) malloc (len);
|
||||
if (m != NULL)
|
||||
memcpy (m, elts, len);
|
||||
scm_array_handle_release (&handle);
|
||||
if (m == NULL)
|
||||
return NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
goto wrong_type;
|
||||
case scm_tc7_string:
|
||||
n = scm_i_string_length (obj);
|
||||
if (m == 0)
|
||||
m = (char *) malloc (n * sizeof (char));
|
||||
if (m == NULL)
|
||||
return NULL;
|
||||
memcpy (m, scm_i_string_chars (obj), n * sizeof (char));
|
||||
break;
|
||||
default:
|
||||
wrong_type:
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
}
|
||||
return m;
|
||||
}
|
||||
|
||||
static void *
|
||||
scm2whatever (SCM obj, void *m, size_t size)
|
||||
{
|
||||
scm_t_array_handle handle;
|
||||
size_t len;
|
||||
ssize_t inc;
|
||||
const void *elts;
|
||||
|
||||
elts = scm_uniform_vector_elements (obj, &handle, &len, &inc);
|
||||
|
||||
if (inc != 1)
|
||||
scm_misc_error (NULL, "only contiguous vectors can be converted: ~a",
|
||||
scm_list_1 (obj));
|
||||
|
||||
if (m == 0)
|
||||
m = malloc (len * sizeof (size));
|
||||
if (m != NULL)
|
||||
memcpy (m, elts, len * size);
|
||||
|
||||
scm_array_handle_release (&handle);
|
||||
|
||||
return m;
|
||||
}
|
||||
|
||||
#define SCM2WHATEVER(obj,pred,utype,mtype) \
|
||||
if (scm_is_true (pred (obj))) \
|
||||
{ \
|
||||
assert (sizeof (utype) == sizeof (mtype)); \
|
||||
return (mtype *)scm2whatever (obj, m, sizeof (utype)); \
|
||||
}
|
||||
|
||||
/* Convert a vector, weak vector or uniform vector into an array of
|
||||
shorts. If result array in arg 2 is NULL, malloc a new one. If
|
||||
out of memory, return NULL. */
|
||||
short *
|
||||
gh_scm2shorts (SCM obj, short *m)
|
||||
{
|
||||
long i, n;
|
||||
long v;
|
||||
SCM val;
|
||||
if (SCM_IMP (obj))
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
|
||||
SCM2WHATEVER (obj, scm_s16vector_p, scm_t_int16, short)
|
||||
|
||||
switch (SCM_TYP7 (obj))
|
||||
{
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
n = SCM_SIMPLE_VECTOR_LENGTH (obj);
|
||||
for (i = 0; i < n; ++i)
|
||||
{
|
||||
val = SCM_SIMPLE_VECTOR_REF (obj, i);
|
||||
if (SCM_I_INUMP (val))
|
||||
{
|
||||
v = SCM_I_INUM (val);
|
||||
if (v < -32768 || v > 65535)
|
||||
scm_out_of_range (0, obj);
|
||||
}
|
||||
else
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
}
|
||||
if (m == 0)
|
||||
m = (short *) malloc (n * sizeof (short));
|
||||
if (m == NULL)
|
||||
return NULL;
|
||||
for (i = 0; i < n; ++i)
|
||||
m[i] = SCM_I_INUM (SCM_SIMPLE_VECTOR_REF (obj, i));
|
||||
break;
|
||||
default:
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
}
|
||||
return m;
|
||||
}
|
||||
|
||||
/* Convert a vector, weak vector or uniform vector into an array of
|
||||
longs. If result array in arg 2 is NULL, malloc a new one. If out
|
||||
of memory, return NULL. */
|
||||
long *
|
||||
gh_scm2longs (SCM obj, long *m)
|
||||
{
|
||||
long i, n;
|
||||
SCM val;
|
||||
if (SCM_IMP (obj))
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
|
||||
SCM2WHATEVER (obj, scm_s32vector_p, scm_t_int32, long)
|
||||
|
||||
switch (SCM_TYP7 (obj))
|
||||
{
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
n = SCM_SIMPLE_VECTOR_LENGTH (obj);
|
||||
for (i = 0; i < n; ++i)
|
||||
{
|
||||
val = SCM_SIMPLE_VECTOR_REF (obj, i);
|
||||
if (!SCM_I_INUMP (val) && !SCM_BIGP (val))
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
}
|
||||
if (m == 0)
|
||||
m = (long *) malloc (n * sizeof (long));
|
||||
if (m == NULL)
|
||||
return NULL;
|
||||
for (i = 0; i < n; ++i)
|
||||
{
|
||||
val = SCM_SIMPLE_VECTOR_REF (obj, i);
|
||||
m[i] = SCM_I_INUMP (val)
|
||||
? SCM_I_INUM (val)
|
||||
: scm_to_long (val);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
}
|
||||
return m;
|
||||
}
|
||||
|
||||
/* Convert a vector, weak vector or uniform vector into an array of
|
||||
floats. If result array in arg 2 is NULL, malloc a new one. If
|
||||
out of memory, return NULL. */
|
||||
float *
|
||||
gh_scm2floats (SCM obj, float *m)
|
||||
{
|
||||
long i, n;
|
||||
SCM val;
|
||||
if (SCM_IMP (obj))
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
|
||||
/* XXX - f64vectors are rejected now.
|
||||
*/
|
||||
SCM2WHATEVER (obj, scm_f32vector_p, float, float)
|
||||
|
||||
switch (SCM_TYP7 (obj))
|
||||
{
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
n = SCM_SIMPLE_VECTOR_LENGTH (obj);
|
||||
for (i = 0; i < n; ++i)
|
||||
{
|
||||
val = SCM_SIMPLE_VECTOR_REF (obj, i);
|
||||
if (!SCM_I_INUMP (val)
|
||||
&& !(SCM_BIGP (val) || SCM_REALP (val)))
|
||||
scm_wrong_type_arg (0, 0, val);
|
||||
}
|
||||
if (m == 0)
|
||||
m = (float *) malloc (n * sizeof (float));
|
||||
if (m == NULL)
|
||||
return NULL;
|
||||
for (i = 0; i < n; ++i)
|
||||
{
|
||||
val = SCM_SIMPLE_VECTOR_REF (obj, i);
|
||||
if (SCM_I_INUMP (val))
|
||||
m[i] = SCM_I_INUM (val);
|
||||
else if (SCM_BIGP (val))
|
||||
m[i] = scm_to_long (val);
|
||||
else
|
||||
m[i] = SCM_REAL_VALUE (val);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
}
|
||||
return m;
|
||||
}
|
||||
|
||||
/* Convert a vector, weak vector or uniform vector into an array of
|
||||
doubles. If result array in arg 2 is NULL, malloc a new one. If
|
||||
out of memory, return NULL. */
|
||||
double *
|
||||
gh_scm2doubles (SCM obj, double *m)
|
||||
{
|
||||
long i, n;
|
||||
SCM val;
|
||||
if (SCM_IMP (obj))
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
|
||||
/* XXX - f32vectors are rejected now.
|
||||
*/
|
||||
SCM2WHATEVER (obj, scm_f64vector_p, double, double)
|
||||
|
||||
switch (SCM_TYP7 (obj))
|
||||
{
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
n = SCM_SIMPLE_VECTOR_LENGTH (obj);
|
||||
for (i = 0; i < n; ++i)
|
||||
{
|
||||
val = SCM_SIMPLE_VECTOR_REF (obj, i);
|
||||
if (!SCM_I_INUMP (val)
|
||||
&& !(SCM_BIGP (val) || SCM_REALP (val)))
|
||||
scm_wrong_type_arg (0, 0, val);
|
||||
}
|
||||
if (m == 0)
|
||||
m = (double *) malloc (n * sizeof (double));
|
||||
if (m == NULL)
|
||||
return NULL;
|
||||
for (i = 0; i < n; ++i)
|
||||
{
|
||||
val = SCM_SIMPLE_VECTOR_REF (obj, i);
|
||||
if (SCM_I_INUMP (val))
|
||||
m[i] = SCM_I_INUM (val);
|
||||
else if (SCM_BIGP (val))
|
||||
m[i] = scm_to_long (val);
|
||||
else
|
||||
m[i] = SCM_REAL_VALUE (val);
|
||||
}
|
||||
break;
|
||||
|
||||
default:
|
||||
scm_wrong_type_arg (0, 0, obj);
|
||||
}
|
||||
return m;
|
||||
}
|
||||
|
||||
/* string conversions between C and Scheme */
|
||||
|
||||
/* gh_scm2newstr() -- Given a Scheme string STR, return a pointer to a
|
||||
new copy of its contents, followed by a null byte. If lenp is
|
||||
non-null, set *lenp to the string's length.
|
||||
|
||||
This function uses malloc to obtain storage for the copy; the
|
||||
caller is responsible for freeing it. If out of memory, NULL is
|
||||
returned.
|
||||
|
||||
Note that Scheme strings may contain arbitrary data, including null
|
||||
characters. This means that null termination is not a reliable way
|
||||
to determine the length of the returned value. However, the
|
||||
function always copies the complete contents of STR, and sets
|
||||
*LEN_P to the true length of the string (when LEN_P is non-null). */
|
||||
char *
|
||||
gh_scm2newstr (SCM str, size_t *lenp)
|
||||
{
|
||||
char *ret_str;
|
||||
|
||||
/* We can't use scm_to_locale_stringn directly since it does not
|
||||
guarantee null-termination when lenp is non-NULL.
|
||||
*/
|
||||
|
||||
ret_str = scm_to_locale_string (str);
|
||||
if (lenp)
|
||||
*lenp = scm_i_string_length (str);
|
||||
return ret_str;
|
||||
}
|
||||
|
||||
/* Copy LEN characters at START from the Scheme string SRC to memory
|
||||
at DST. START is an index into SRC; zero means the beginning of
|
||||
the string. DST has already been allocated by the caller.
|
||||
|
||||
If START + LEN is off the end of SRC, silently truncate the source
|
||||
region to fit the string. If truncation occurs, the corresponding
|
||||
area of DST is left unchanged. */
|
||||
void
|
||||
gh_get_substr (SCM src, char *dst, long start, size_t len)
|
||||
{
|
||||
size_t src_len, effective_length;
|
||||
SCM_ASSERT (scm_is_string (src), src, SCM_ARG3, "gh_get_substr");
|
||||
|
||||
src_len = scm_i_string_length (src);
|
||||
effective_length = (len < src_len) ? len : src_len;
|
||||
memcpy (dst + start, scm_i_string_chars (src), effective_length * sizeof (char));
|
||||
/* FIXME: must signal an error if len > src_len */
|
||||
scm_remember_upto_here_1 (src);
|
||||
}
|
||||
|
||||
|
||||
/* gh_scm2newsymbol() -- Given a Scheme symbol 'identifier, return a
|
||||
pointer to a string with the symbol characters "identifier",
|
||||
followed by a null byte. If lenp is non-null, set *lenp to the
|
||||
string's length.
|
||||
|
||||
This function uses malloc to obtain storage for the copy; the
|
||||
caller is responsible for freeing it. If out of memory, NULL is
|
||||
returned.*/
|
||||
char *
|
||||
gh_symbol2newstr (SCM sym, size_t *lenp)
|
||||
{
|
||||
return gh_scm2newstr (scm_symbol_to_string (sym), lenp);
|
||||
}
|
||||
|
||||
|
||||
/* create a new vector of the given length, all initialized to the
|
||||
given value */
|
||||
SCM
|
||||
gh_make_vector (SCM len, SCM fill)
|
||||
{
|
||||
return scm_make_vector (len, fill);
|
||||
}
|
||||
|
||||
/* set the given element of the given vector to the given value */
|
||||
SCM
|
||||
gh_vector_set_x (SCM vec, SCM pos, SCM val)
|
||||
{
|
||||
return scm_vector_set_x (vec, pos, val);
|
||||
}
|
||||
|
||||
/* retrieve the given element of the given vector */
|
||||
SCM
|
||||
gh_vector_ref (SCM vec, SCM pos)
|
||||
{
|
||||
return scm_vector_ref (vec, pos);
|
||||
}
|
||||
|
||||
/* returns the length of the given vector */
|
||||
unsigned long
|
||||
gh_vector_length (SCM v)
|
||||
{
|
||||
return (unsigned long) scm_c_vector_length (v);
|
||||
}
|
||||
|
||||
/* uniform vector support */
|
||||
|
||||
/* returns the length as a C unsigned long integer */
|
||||
unsigned long
|
||||
gh_uniform_vector_length (SCM v)
|
||||
{
|
||||
return (unsigned long) scm_c_uniform_vector_length (v);
|
||||
}
|
||||
|
||||
/* gets the given element from a uniform vector; ilist is a list (or
|
||||
possibly a single integer) of indices, and its length is the
|
||||
dimension of the uniform vector */
|
||||
SCM
|
||||
gh_uniform_vector_ref (SCM v, SCM ilist)
|
||||
{
|
||||
return scm_uniform_vector_ref (v, ilist);
|
||||
}
|
||||
|
||||
/* sets an individual element in a uniform vector */
|
||||
/* SCM */
|
||||
/* gh_list_to_uniform_array ( */
|
||||
|
||||
/* Data lookups between C and Scheme
|
||||
|
||||
Look up a symbol with a given name, and return the object to which
|
||||
it is bound. gh_lookup examines the Guile top level, and
|
||||
gh_module_lookup checks the module namespace specified by the
|
||||
`vec' argument.
|
||||
|
||||
The return value is the Scheme object to which SNAME is bound, or
|
||||
SCM_UNDEFINED if SNAME is not bound in the given context.
|
||||
*/
|
||||
|
||||
SCM
|
||||
gh_lookup (const char *sname)
|
||||
{
|
||||
return gh_module_lookup (scm_current_module (), sname);
|
||||
}
|
||||
|
||||
|
||||
SCM
|
||||
gh_module_lookup (SCM module, const char *sname)
|
||||
#define FUNC_NAME "gh_module_lookup"
|
||||
{
|
||||
SCM sym, var;
|
||||
|
||||
SCM_VALIDATE_MODULE (SCM_ARG1, module);
|
||||
|
||||
sym = scm_from_locale_symbol (sname);
|
||||
var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
|
||||
if (var != SCM_BOOL_F)
|
||||
return SCM_VARIABLE_REF (var);
|
||||
else
|
||||
return SCM_UNDEFINED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
#endif /* SCM_ENABLE_DEPRECATED */
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
End:
|
||||
*/
|
||||
|
|
@ -1,109 +0,0 @@
|
|||
/* Copyright (C) 1995,1996,1997,1998, 2000, 2001, 2006, 2008 Free Software Foundation, Inc.
|
||||
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public
|
||||
* License as published by the Free Software Foundation; either
|
||||
* version 2.1 of the License, or (at your option) any later version.
|
||||
*
|
||||
* This library is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
*/
|
||||
|
||||
|
||||
/* routines to evaluate Scheme code */
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
#include "libguile/gh.h"
|
||||
|
||||
#if SCM_ENABLE_DEPRECATED
|
||||
|
||||
typedef SCM (*gh_eval_t) (void *data, SCM jmpbuf);
|
||||
|
||||
/* Evaluate the string; toss the value. */
|
||||
SCM
|
||||
gh_eval_str (const char *scheme_code)
|
||||
{
|
||||
return scm_c_eval_string (scheme_code);
|
||||
}
|
||||
|
||||
/* evaluate the file by passing it to the lower level scm_primitive_load() */
|
||||
SCM
|
||||
gh_eval_file (const char *fname)
|
||||
{
|
||||
return scm_primitive_load (gh_str02scm (fname));
|
||||
}
|
||||
|
||||
static SCM
|
||||
eval_str_wrapper (void *data)
|
||||
{
|
||||
/* gh_eval_t real_eval_proc = (gh_eval_t) (* ((gh_eval_t *) data)); */
|
||||
|
||||
char *scheme_code = (char *) data;
|
||||
return gh_eval_str (scheme_code);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_eval_str_with_catch (const char *scheme_code, scm_t_catch_handler handler)
|
||||
{
|
||||
/* FIXME: not there yet */
|
||||
return gh_catch (SCM_BOOL_T, (scm_t_catch_body) eval_str_wrapper, (void *) scheme_code,
|
||||
(scm_t_catch_handler) handler, (void *) scheme_code);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_eval_str_with_standard_handler (const char *scheme_code)
|
||||
{
|
||||
return gh_eval_str_with_catch (scheme_code, gh_standard_handler);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_eval_str_with_stack_saving_handler (const char *scheme_code)
|
||||
{
|
||||
return scm_internal_stack_catch (SCM_BOOL_T,
|
||||
(scm_t_catch_body) eval_str_wrapper,
|
||||
(void *) scheme_code,
|
||||
(scm_t_catch_handler)
|
||||
gh_standard_handler,
|
||||
(void *) scheme_code);
|
||||
}
|
||||
|
||||
static SCM
|
||||
eval_file_wrapper (void *data)
|
||||
{
|
||||
/* gh_eval_t real_eval_proc = (gh_eval_t) (* ((gh_eval_t *) data)); */
|
||||
|
||||
char *scheme_code = (char *) data;
|
||||
return gh_eval_file (scheme_code);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_eval_file_with_catch (const char *scheme_code, scm_t_catch_handler handler)
|
||||
{
|
||||
/* FIXME: not there yet */
|
||||
return gh_catch (SCM_BOOL_T, (scm_t_catch_body) eval_file_wrapper,
|
||||
(void *) scheme_code, (scm_t_catch_handler) handler,
|
||||
(void *) scheme_code);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_eval_file_with_standard_handler (const char *scheme_code)
|
||||
{
|
||||
return gh_eval_file_with_catch (scheme_code, gh_standard_handler);
|
||||
}
|
||||
|
||||
#endif /* SCM_ENABLE_DEPRECATED */
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
End:
|
||||
*/
|
||||
|
|
@ -1,157 +0,0 @@
|
|||
/* Copyright (C) 1995,1996,1997,1998, 2000, 2001, 2006, 2008 Free Software Foundation, Inc.
|
||||
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public
|
||||
* License as published by the Free Software Foundation; either
|
||||
* version 2.1 of the License, or (at your option) any later version.
|
||||
*
|
||||
* This library is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
*/
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
|
||||
/* Defining Scheme functions implemented by C functions --- subrs. */
|
||||
|
||||
#include "libguile/gh.h"
|
||||
|
||||
#if SCM_ENABLE_DEPRECATED
|
||||
|
||||
/* allows you to define new scheme primitives written in C */
|
||||
SCM
|
||||
gh_new_procedure (const char *proc_name, SCM (*fn) (),
|
||||
int n_required_args, int n_optional_args, int varp)
|
||||
{
|
||||
return scm_c_define_gsubr (proc_name, n_required_args, n_optional_args,
|
||||
varp, fn);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_new_procedure0_0 (const char *proc_name, SCM (*fn) ())
|
||||
{
|
||||
return gh_new_procedure (proc_name, fn, 0, 0, 0);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_new_procedure0_1 (const char *proc_name, SCM (*fn) ())
|
||||
{
|
||||
return gh_new_procedure (proc_name, fn, 0, 1, 0);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_new_procedure0_2 (const char *proc_name, SCM (*fn) ())
|
||||
{
|
||||
return gh_new_procedure (proc_name, fn, 0, 2, 0);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_new_procedure1_0 (const char *proc_name, SCM (*fn) ())
|
||||
{
|
||||
return gh_new_procedure (proc_name, fn, 1, 0, 0);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_new_procedure1_1 (const char *proc_name, SCM (*fn) ())
|
||||
{
|
||||
return gh_new_procedure (proc_name, fn, 1, 1, 0);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_new_procedure1_2 (const char *proc_name, SCM (*fn) ())
|
||||
{
|
||||
return gh_new_procedure (proc_name, fn, 1, 2, 0);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_new_procedure2_0 (const char *proc_name, SCM (*fn) ())
|
||||
{
|
||||
return gh_new_procedure (proc_name, fn, 2, 0, 0);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_new_procedure2_1 (const char *proc_name, SCM (*fn) ())
|
||||
{
|
||||
return gh_new_procedure (proc_name, fn, 2, 1, 0);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_new_procedure2_2 (const char *proc_name, SCM (*fn) ())
|
||||
{
|
||||
return gh_new_procedure (proc_name, fn, 2, 2, 0);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_new_procedure3_0 (const char *proc_name, SCM (*fn) ())
|
||||
{
|
||||
return gh_new_procedure (proc_name, fn, 3, 0, 0);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_new_procedure4_0 (const char *proc_name, SCM (*fn) ())
|
||||
{
|
||||
return gh_new_procedure (proc_name, fn, 4, 0, 0);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_new_procedure5_0 (const char *proc_name, SCM (*fn) ())
|
||||
{
|
||||
return gh_new_procedure (proc_name, fn, 5, 0, 0);
|
||||
}
|
||||
|
||||
/* some (possibly most) Scheme functions available from C */
|
||||
SCM
|
||||
gh_define (const char *name, SCM val)
|
||||
{
|
||||
scm_c_define (name, val);
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
|
||||
/* Calling Scheme functions from C. */
|
||||
|
||||
SCM
|
||||
gh_apply (SCM proc, SCM args)
|
||||
{
|
||||
return scm_apply (proc, args, SCM_EOL);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_call0 (SCM proc)
|
||||
{
|
||||
return scm_apply (proc, SCM_EOL, SCM_EOL);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_call1 (SCM proc, SCM arg)
|
||||
{
|
||||
return scm_apply (proc, arg, scm_listofnull);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_call2 (SCM proc, SCM arg1, SCM arg2)
|
||||
{
|
||||
return scm_apply (proc, arg1, scm_cons (arg2, scm_listofnull));
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_call3 (SCM proc, SCM arg1, SCM arg2, SCM arg3)
|
||||
{
|
||||
return scm_apply (proc, arg1, scm_cons2 (arg2, arg3, scm_listofnull));
|
||||
}
|
||||
|
||||
#endif /* SCM_ENABLE_DEPRECATED */
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
End:
|
||||
*/
|
||||
|
|
@ -1,94 +0,0 @@
|
|||
/* Copyright (C) 1995,1996,1997,2000,2001, 2006, 2008 Free Software Foundation, Inc.
|
||||
*
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public
|
||||
* License as published by the Free Software Foundation; either
|
||||
* version 2.1 of the License, or (at your option) any later version.
|
||||
*
|
||||
* This library is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
*/
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
/* Guile high level (gh_) interface, initialization-related stuff */
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#include "libguile/gh.h"
|
||||
|
||||
#if SCM_ENABLE_DEPRECATED
|
||||
|
||||
typedef void (*main_prog_t) (int argc, char **argv);
|
||||
typedef void (*repl_prog_t) (int argc, char **argv);
|
||||
|
||||
/* This function takes care of all real GH initialization. Since it's
|
||||
called by scm_boot_guile, it can safely work with heap objects, or
|
||||
call functions that do so. */
|
||||
static void
|
||||
gh_launch_pad (void *closure, int argc, char **argv)
|
||||
{
|
||||
main_prog_t c_main_prog = (main_prog_t) closure;
|
||||
|
||||
c_main_prog (argc, argv);
|
||||
exit (0);
|
||||
}
|
||||
|
||||
/* starts up the Scheme interpreter, and stays in it. c_main_prog()
|
||||
is the address of the user's main program, since gh_enter() never
|
||||
returns. */
|
||||
void
|
||||
gh_enter (int argc, char *argv[], main_prog_t c_main_prog)
|
||||
{
|
||||
scm_boot_guile (argc, argv, gh_launch_pad, (void *) c_main_prog);
|
||||
/* never returns */
|
||||
}
|
||||
|
||||
/* offer a REPL to the C programmer; for now I just invoke the ice-9
|
||||
REPL that is written in Scheme */
|
||||
void
|
||||
gh_repl (int argc, char *argv[])
|
||||
{
|
||||
/* gh_eval_str ("(top-repl)"); */
|
||||
scm_shell (argc, argv);
|
||||
}
|
||||
|
||||
/* libguile programmers need exception handling mechanisms; here is
|
||||
the recommended way of doing it with the gh_ interface */
|
||||
|
||||
/* gh_catch() -- set up an exception handler for a particular type of
|
||||
error (or any thrown error if tag is SCM_BOOL_T); see
|
||||
../libguile/throw.c for the comments explaining scm_internal_catch */
|
||||
SCM
|
||||
gh_catch (SCM tag, scm_t_catch_body body, void *body_data,
|
||||
scm_t_catch_handler handler, void *handler_data)
|
||||
{
|
||||
return scm_internal_catch (tag, body, body_data, handler, handler_data);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_standard_handler (void *data SCM_UNUSED, SCM tag, SCM throw_args SCM_UNUSED)
|
||||
{
|
||||
fprintf (stderr, "\nJust got an error; tag is\n ");
|
||||
scm_display (tag, scm_current_output_port ());
|
||||
scm_newline (scm_current_output_port ());
|
||||
scm_newline (scm_current_output_port ());
|
||||
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
|
||||
#endif /* SCM_ENABLE_DEPRECATED */
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
End:
|
||||
*/
|
||||
|
|
@ -1,50 +0,0 @@
|
|||
/* Copyright (C) 1995,1996,1997, 2000, 2001, 2006, 2008 Free Software Foundation, Inc.
|
||||
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public
|
||||
* License as published by the Free Software Foundation; either
|
||||
* version 2.1 of the License, or (at your option) any later version.
|
||||
*
|
||||
* This library is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
*/
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
#include "libguile/gh.h"
|
||||
|
||||
#if SCM_ENABLE_DEPRECATED
|
||||
|
||||
void
|
||||
gh_display (SCM x)
|
||||
{
|
||||
scm_display (x, scm_current_output_port ());
|
||||
}
|
||||
|
||||
void
|
||||
gh_write (SCM x)
|
||||
{
|
||||
scm_write (x, scm_current_output_port ());
|
||||
}
|
||||
|
||||
void
|
||||
gh_newline ()
|
||||
{
|
||||
scm_newline (scm_current_output_port ());
|
||||
}
|
||||
|
||||
#endif /* SCM_ENABLE_DEPRECATED */
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
End:
|
||||
*/
|
||||
|
|
@ -1,181 +0,0 @@
|
|||
/* Copyright (C) 1995,1996,1997, 2000, 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
|
||||
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public
|
||||
* License as published by the Free Software Foundation; either
|
||||
* version 2.1 of the License, or (at your option) any later version.
|
||||
*
|
||||
* This library is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
*/
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
|
||||
/* list manipulation */
|
||||
|
||||
#include "libguile/gh.h"
|
||||
|
||||
#if SCM_ENABLE_DEPRECATED
|
||||
|
||||
/* returns the length of a list */
|
||||
unsigned long
|
||||
gh_length (SCM l)
|
||||
{
|
||||
return gh_scm2ulong (scm_length (l));
|
||||
}
|
||||
|
||||
/* list operations */
|
||||
|
||||
/* gh_list(SCM elt, ...) is implemented as a macro in gh.h. */
|
||||
|
||||
/* gh_append() takes a args, which is a list of lists, and appends
|
||||
them all together into a single list, which is returned. This is
|
||||
equivalent to the Scheme procedure (append list1 list2 ...) */
|
||||
SCM
|
||||
gh_append (SCM args)
|
||||
{
|
||||
return scm_append (args);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_append2 (SCM l1, SCM l2)
|
||||
{
|
||||
return scm_append (scm_list_2 (l1, l2));
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_append3(SCM l1, SCM l2, SCM l3)
|
||||
{
|
||||
return scm_append (scm_list_3 (l1, l2, l3));
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_append4 (SCM l1, SCM l2, SCM l3, SCM l4)
|
||||
{
|
||||
return scm_append (scm_list_4 (l1, l2, l3, l4));
|
||||
}
|
||||
|
||||
/* gh_reverse() is defined as a macro in gh.h */
|
||||
/* gh_list_tail() is defined as a macro in gh.h */
|
||||
/* gh_list_ref() is defined as a macro in gh.h */
|
||||
/* gh_memq() is defined as a macro in gh.h */
|
||||
/* gh_memv() is defined as a macro in gh.h */
|
||||
/* gh_member() is defined as a macro in gh.h */
|
||||
/* gh_assq() is defined as a macro in gh.h */
|
||||
/* gh_assv() is defined as a macro in gh.h */
|
||||
/* gh_assoc() is defined as a macro in gh.h */
|
||||
|
||||
/* analogous to the Scheme cons operator */
|
||||
SCM
|
||||
gh_cons (SCM x, SCM y)
|
||||
{
|
||||
return scm_cons (x, y);
|
||||
}
|
||||
|
||||
/* analogous to the Scheme car operator */
|
||||
SCM
|
||||
gh_car (SCM x)
|
||||
{
|
||||
return scm_car (x);
|
||||
}
|
||||
|
||||
/* analogous to the Scheme cdr operator */
|
||||
SCM
|
||||
gh_cdr (SCM x)
|
||||
{
|
||||
return scm_cdr (x);
|
||||
}
|
||||
|
||||
/* now for the multiple car/cdr utility procedures */
|
||||
SCM
|
||||
gh_caar (SCM x)
|
||||
{
|
||||
return scm_caar (x);
|
||||
}
|
||||
SCM
|
||||
gh_cadr (SCM x)
|
||||
{
|
||||
return scm_cadr (x);
|
||||
}
|
||||
SCM
|
||||
gh_cdar (SCM x)
|
||||
{
|
||||
return scm_cdar (x);
|
||||
}
|
||||
SCM
|
||||
gh_cddr (SCM x)
|
||||
{
|
||||
return scm_cddr (x);
|
||||
}
|
||||
|
||||
SCM
|
||||
gh_caaar (SCM x)
|
||||
{
|
||||
return scm_caaar (x);
|
||||
}
|
||||
SCM
|
||||
gh_caadr (SCM x)
|
||||
{
|
||||
return scm_caadr (x);
|
||||
}
|
||||
SCM
|
||||
gh_cadar (SCM x)
|
||||
{
|
||||
return scm_cadar (x);
|
||||
}
|
||||
SCM
|
||||
gh_caddr (SCM x)
|
||||
{
|
||||
return scm_caddr (x);
|
||||
}
|
||||
SCM
|
||||
gh_cdaar (SCM x)
|
||||
{
|
||||
return scm_cdaar (x);
|
||||
}
|
||||
SCM
|
||||
gh_cdadr (SCM x)
|
||||
{
|
||||
return scm_cdadr (x);
|
||||
}
|
||||
SCM
|
||||
gh_cddar (SCM x)
|
||||
{
|
||||
return scm_cddar (x);
|
||||
}
|
||||
SCM
|
||||
gh_cdddr (SCM x)
|
||||
{
|
||||
return scm_cdddr (x);
|
||||
}
|
||||
|
||||
/* equivalent to (set-car! pair value) */
|
||||
SCM
|
||||
gh_set_car_x(SCM pair, SCM value)
|
||||
{
|
||||
return scm_set_car_x(pair, value);
|
||||
}
|
||||
|
||||
/* equivalent to (set-cdr! pair value) */
|
||||
SCM
|
||||
gh_set_cdr_x(SCM pair, SCM value)
|
||||
{
|
||||
return scm_set_cdr_x(pair, value);
|
||||
}
|
||||
|
||||
#endif /* SCM_ENABLE_DEPRECATED */
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
End:
|
||||
*/
|
||||
|
|
@ -1,124 +0,0 @@
|
|||
/* Copyright (C) 1995,1996,1997, 2000, 2001, 2006, 2008 Free Software Foundation, Inc.
|
||||
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public
|
||||
* License as published by the Free Software Foundation; either
|
||||
* version 2.1 of the License, or (at your option) any later version.
|
||||
*
|
||||
* This library is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
*/
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
/* type predicates and equality predicates */
|
||||
|
||||
#include "libguile/gh.h"
|
||||
|
||||
#if SCM_ENABLE_DEPRECATED
|
||||
|
||||
/* type predicates: tell you if an SCM object has a given type */
|
||||
int
|
||||
gh_boolean_p (SCM val)
|
||||
{
|
||||
return (scm_is_true (scm_boolean_p (val)));
|
||||
}
|
||||
int
|
||||
gh_symbol_p (SCM val)
|
||||
{
|
||||
return (scm_is_true (scm_symbol_p (val)));
|
||||
}
|
||||
int
|
||||
gh_char_p (SCM val)
|
||||
{
|
||||
return (scm_is_true (scm_char_p (val)));
|
||||
}
|
||||
int
|
||||
gh_vector_p (SCM val)
|
||||
{
|
||||
return (scm_is_true (scm_vector_p (val)));
|
||||
}
|
||||
int
|
||||
gh_pair_p (SCM val)
|
||||
{
|
||||
return (scm_is_true (scm_pair_p (val)));
|
||||
}
|
||||
int
|
||||
gh_number_p (SCM val)
|
||||
{
|
||||
return (scm_is_true (scm_number_p (val)));
|
||||
}
|
||||
int
|
||||
gh_string_p (SCM val)
|
||||
{
|
||||
return (scm_is_true (scm_string_p (val)));
|
||||
}
|
||||
int
|
||||
gh_procedure_p (SCM val)
|
||||
{
|
||||
return (scm_is_true (scm_procedure_p (val)));
|
||||
}
|
||||
int
|
||||
gh_list_p (SCM val)
|
||||
{
|
||||
return (scm_is_true (scm_list_p (val)));
|
||||
}
|
||||
int
|
||||
gh_inexact_p (SCM val)
|
||||
{
|
||||
return (scm_is_true (scm_inexact_p (val)));
|
||||
}
|
||||
int
|
||||
gh_exact_p (SCM val)
|
||||
{
|
||||
return (scm_is_true (scm_exact_p (val)));
|
||||
}
|
||||
|
||||
/* the three types of equality */
|
||||
int
|
||||
gh_eq_p (SCM x, SCM y)
|
||||
{
|
||||
return (scm_is_true (scm_eq_p (x, y)));
|
||||
}
|
||||
int
|
||||
gh_eqv_p (SCM x, SCM y)
|
||||
{
|
||||
return (scm_is_true (scm_eqv_p (x, y)));
|
||||
}
|
||||
int
|
||||
gh_equal_p (SCM x, SCM y)
|
||||
{
|
||||
return (scm_is_true (scm_equal_p (x, y)));
|
||||
}
|
||||
|
||||
/* equivalent to (string=? ...), but returns 0 or 1 rather than Scheme
|
||||
booleans */
|
||||
int
|
||||
gh_string_equal_p(SCM s1, SCM s2)
|
||||
{
|
||||
return (scm_is_true (scm_string_equal_p(s1, s2)));
|
||||
}
|
||||
|
||||
/* equivalent to (null? ...), but returns 0 or 1 rather than Scheme
|
||||
booleans */
|
||||
int
|
||||
gh_null_p(SCM l)
|
||||
{
|
||||
return (scm_is_true(scm_null_p(l)));
|
||||
}
|
||||
|
||||
#endif /* SCM_ENABLE_DEPRECATED */
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
End:
|
||||
*/
|
||||
|
|
@ -26,12 +26,15 @@
|
|||
#include <ctype.h>
|
||||
|
||||
#include "libguile/_scm.h"
|
||||
#include "libguile/gh.h"
|
||||
#include "libguile/eval.h"
|
||||
#include "libguile/feature.h"
|
||||
#include "libguile/load.h"
|
||||
#include "libguile/version.h"
|
||||
|
||||
#include "libguile/validate.h"
|
||||
#include "libguile/read.h"
|
||||
#include "libguile/script.h"
|
||||
#include "libguile/strings.h"
|
||||
#include "libguile/strports.h"
|
||||
#include "libguile/validate.h"
|
||||
#include "libguile/version.h"
|
||||
|
||||
#ifdef HAVE_STRING_H
|
||||
#include <string.h>
|
||||
|
|
|
|||
|
|
@ -72,13 +72,6 @@ test_round_LDADD = ${top_builddir}/libguile/libguile.la
|
|||
check_PROGRAMS += test-round
|
||||
TESTS += test-round
|
||||
|
||||
# test-gh
|
||||
test_gh_SOURCES = test-gh.c
|
||||
test_gh_CFLAGS = ${test_cflags}
|
||||
test_gh_LDADD = ${top_builddir}/libguile/libguile.la
|
||||
check_PROGRAMS += test-gh
|
||||
TESTS += test-gh
|
||||
|
||||
# test-asmobs
|
||||
noinst_LTLIBRARIES += libtest-asmobs.la
|
||||
libtest_asmobs_la_SOURCES = test-asmobs-lib.c test-asmobs-lib.x
|
||||
|
|
|
|||
|
|
@ -1,95 +0,0 @@
|
|||
/* Copyright (C) 1999,2000,2001,2003, 2006, 2008 Free Software Foundation, Inc.
|
||||
*
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public
|
||||
* License as published by the Free Software Foundation; either
|
||||
* version 2.1 of the License, or (at your option) any later version.
|
||||
*
|
||||
* This library is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
*/
|
||||
|
||||
/* some bits originally by Jim Blandy <jimb@red-bean.com> */
|
||||
|
||||
#ifndef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
#include <libguile.h>
|
||||
#include <libguile/gh.h>
|
||||
|
||||
#include <assert.h>
|
||||
#include <string.h>
|
||||
|
||||
#if SCM_ENABLE_DEPRECATED
|
||||
|
||||
static int
|
||||
string_equal (SCM str, char *lit)
|
||||
{
|
||||
int len = strlen (lit);
|
||||
int result;
|
||||
|
||||
result = ((scm_c_string_length (str) == len)
|
||||
&& (!memcmp (scm_i_string_chars (str), lit, len)));
|
||||
scm_remember_upto_here_1 (str);
|
||||
return result;
|
||||
}
|
||||
|
||||
static void
|
||||
test_gh_set_substr ()
|
||||
{
|
||||
SCM string;
|
||||
|
||||
string = gh_str02scm ("Free, darnit!");
|
||||
assert (gh_string_p (string));
|
||||
|
||||
gh_set_substr ("dammit", string, 6, 6);
|
||||
assert (string_equal (string, "Free, dammit!"));
|
||||
|
||||
/* Make sure that we can use the string itself as a source.
|
||||
|
||||
I guess this behavior isn't really visible, since the GH API
|
||||
doesn't provide any direct access to the string contents. But I
|
||||
think it should, eventually. You can't write efficient string
|
||||
code if you have to copy the string just to look at it. */
|
||||
|
||||
/* Copy a substring to an overlapping region to its right. */
|
||||
gh_set_substr (scm_i_string_chars (string), string, 4, 6);
|
||||
assert (string_equal (string, "FreeFree, it!"));
|
||||
|
||||
string = gh_str02scm ("Free, darnit!");
|
||||
assert (gh_string_p (string));
|
||||
|
||||
/* Copy a substring to an overlapping region to its left. */
|
||||
gh_set_substr (scm_i_string_chars (string) + 6, string, 2, 6);
|
||||
assert (string_equal (string, "Frdarnitrnit!"));
|
||||
}
|
||||
|
||||
static void
|
||||
tests (void *data, int argc, char **argv)
|
||||
{
|
||||
test_gh_set_substr ();
|
||||
}
|
||||
|
||||
int
|
||||
main (int argc, char *argv[])
|
||||
{
|
||||
scm_boot_guile (argc, argv, tests, NULL);
|
||||
return 0;
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
int
|
||||
main (int argc, char *argv[])
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
|
||||
#endif /* !SCM_ENABLE_DEPRECATED */
|
||||
Loading…
Add table
Add a link
Reference in a new issue