diff --git a/libguile/Makefile.am b/libguile/Makefile.am index a0d6f5492..ffa12232d 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -28,7 +28,8 @@ libguile_la_SOURCES = \ EXTRA_libguile_la_SOURCES = _scm.h \ backtrace.c stacks.c debug.c srcprop.c \ strerror.c inet_aton.c putenv.c \ - threads.c alloca.c + threads.c alloca.c \ + regex-posix.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 @@ -52,7 +53,7 @@ modinclude_HEADERS = __scm.h alist.h append.h arbiters.h async.h \ eq.h error.h eval.h extchrs.h feature.h filesys.h fports.h gc.h \ gdb_interface.h gdbint.h genio.h gsubr.h hash.h hashtab.h init.h \ ioext.h kw.h list.h load.h mallocs.h markers.h mbstrings.h net_db.h \ - numbers.h objprop.h options.h pairs.h ports.h posix.h print.h \ + numbers.h objprop.h options.h pairs.h ports.h posix.h regex-posix.h print.h \ procprop.h procs.h ramap.h read.h root.h scmhob.h scmsigs.h script.h \ sequences.h simpos.h smob.h socket.h srcprop.h stackchk.h stacks.h \ stime.h strings.h strop.h strorder.h strports.h struct.h symbols.h \ diff --git a/libguile/Makefile.in b/libguile/Makefile.in index ea24e1193..5b6470790 100644 --- a/libguile/Makefile.in +++ b/libguile/Makefile.in @@ -99,7 +99,8 @@ libguile_la_SOURCES = \ EXTRA_libguile_la_SOURCES = _scm.h \ backtrace.c stacks.c debug.c srcprop.c \ strerror.c inet_aton.c putenv.c \ - threads.c alloca.c + threads.c alloca.c \ + regex-posix.c noinst_HEADERS = coop-threads.c coop-threads.h coop.c @@ -119,7 +120,7 @@ modinclude_HEADERS = __scm.h alist.h append.h arbiters.h async.h \ eq.h error.h eval.h extchrs.h feature.h filesys.h fports.h gc.h \ gdb_interface.h gdbint.h genio.h gsubr.h hash.h hashtab.h init.h \ ioext.h kw.h list.h load.h mallocs.h markers.h mbstrings.h net_db.h \ - numbers.h objprop.h options.h pairs.h ports.h posix.h print.h \ + numbers.h objprop.h options.h pairs.h ports.h posix.h regex-posix.h print.h \ procprop.h procs.h ramap.h read.h root.h scmhob.h scmsigs.h script.h \ sequences.h simpos.h smob.h socket.h srcprop.h stackchk.h stacks.h \ stime.h strings.h strop.h strorder.h strports.h struct.h symbols.h \ @@ -216,12 +217,12 @@ DEP_FILES = .deps/alist.P .deps/alloca.P .deps/append.P .deps/appinit.P \ .deps/net_db.P .deps/numbers.P .deps/objprop.P .deps/options.P \ .deps/pairs.P .deps/ports.P .deps/posix.P .deps/print.P \ .deps/procprop.P .deps/procs.P .deps/putenv.P .deps/ramap.P \ -.deps/read.P .deps/root.P .deps/scmsigs.P .deps/script.P \ -.deps/sequences.P .deps/simpos.P .deps/smob.P .deps/socket.P \ -.deps/srcprop.P .deps/stackchk.P .deps/stacks.P .deps/stime.P \ -.deps/strerror.P .deps/strings.P .deps/strop.P .deps/strorder.P \ -.deps/strports.P .deps/struct.P .deps/symbols.P .deps/tag.P \ -.deps/threads.P .deps/throw.P .deps/unif.P .deps/variable.P \ +.deps/read.P .deps/regex-posix.P .deps/root.P .deps/scmsigs.P \ +.deps/script.P .deps/sequences.P .deps/simpos.P .deps/smob.P \ +.deps/socket.P .deps/srcprop.P .deps/stackchk.P .deps/stacks.P \ +.deps/stime.P .deps/strerror.P .deps/strings.P .deps/strop.P \ +.deps/strorder.P .deps/strports.P .deps/struct.P .deps/symbols.P \ +.deps/tag.P .deps/threads.P .deps/throw.P .deps/unif.P .deps/variable.P \ .deps/vectors.P .deps/version.P .deps/vports.P .deps/weaks.P SOURCES = $(libguile_la_SOURCES) $(EXTRA_libguile_la_SOURCES) $(guile_SOURCES) $(gh_test_c_SOURCES) $(gh_test_repl_SOURCES) OBJECTS = $(libguile_la_OBJECTS) $(guile_OBJECTS) $(gh_test_c_OBJECTS) $(gh_test_repl_OBJECTS) diff --git a/libguile/init.c b/libguile/init.c index 0133cf2b5..2b7271ca9 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -81,6 +81,9 @@ #include "pairs.h" #include "ports.h" #include "posix.h" +#ifdef HAVE_REGCOMP +#include "regex-posix.h" +#endif #include "print.h" #include "procprop.h" #include "procs.h" @@ -415,6 +418,9 @@ scm_boot_guile_1 (base, closure) scm_init_pairs (); scm_init_ports (); scm_init_posix (); +#ifdef HAVE_REGCOMP + scm_init_regex_posix (); +#endif scm_init_procs (); scm_init_procprop (); scm_init_scmsigs (); diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c new file mode 100644 index 000000000..c40919909 --- /dev/null +++ b/libguile/regex-posix.c @@ -0,0 +1,229 @@ +/* Copyright (C) 1997 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program 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 General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + +/* regex-posix.c -- POSIX regular expression support. + + This code was written against Henry Spencer's famous regex package. + The principal reference for POSIX behavior was the man page for this + library, not the 1003.2 document itself. Ergo, other `POSIX' + libraries which do not agree with the Spencer implementation may + produce varying behavior. Sigh. */ + +#include +#include +#include +#include "_scm.h" +#include "smob.h" +#include "symbols.h" +#include "vectors.h" +#include "strports.h" +#include "ports.h" + +#include "regex-posix.h" + +long scm_tc16_regex_t; + +static size_t +scm_free_regex_t (obj) + SCM obj; +{ + regfree (SCM_RGX (obj)); + free (SCM_RGX (obj)); + return 0; +} + +static int +scm_print_regex_t (obj, port, pstate) + SCM obj; + SCM port; + scm_print_state *pstate; +{ + regex_t *r; + r = SCM_RGX (obj); + scm_gen_puts (scm_regular_string, "#", port); + return 1; +} + + +static scm_smobfuns regex_t_smob = +{ scm_mark0, scm_free_regex_t, scm_print_regex_t, 0 }; + + +SCM_SYMBOL (scm_regexp_error_key, "regular-expression-syntax"); + +char * +scm_regexp_error_msg (regerrno, rx) + int regerrno; + SCM rx; +{ + SCM errmsg; + int l; + + /* FIXME: must we wrap any external calls in SCM_DEFER_INTS...SCM_ALLOW_INTS? + Or are these only necessary when a SCM object may be left in an + undetermined state (half-formed)? If the latter then I believe we + may do without the critical section code. -twp */ + + /* We could simply make errmsg a char pointer, and allocate space with + malloc. But since we are about to pass the pointer to scm_error, which + never returns, we would never have the opportunity to free it. Creating + it as a SCM object means that the system will GC it at some point. */ + + errmsg = scm_make_string (SCM_MAKINUM (80), SCM_UNDEFINED); + SCM_DEFER_INTS; + l = regerror (regerrno, SCM_RGX (rx), SCM_CHARS (errmsg), 80); + if (l > 80) + { + errmsg = scm_make_string (SCM_MAKINUM (l), SCM_UNDEFINED); + regerror (regerrno, SCM_RGX (rx), SCM_CHARS (errmsg), l); + } + SCM_ALLOW_INTS; + return SCM_CHARS (errmsg); +} + +SCM_PROC (s_regexp_p, "regexp?", 1, 0, 0, scm_regexp_p); + +SCM +scm_regexp_p (x) + SCM x; +{ + return (SCM_NIMP (x) && SCM_RGXP (x) ? SCM_BOOL_T : SCM_BOOL_F); +} + +/* FIXME: make-regexp should support flags like + * REG_BASIC and REG_ICASE. Maybe these could be optional symbols + * in the command args: e.g.: + * (make-regexp "foo.*bar" 'basic + * 'ignore-case + * 'multi-line) + */ + +SCM_PROC (s_make_regexp, "make-regexp", 1, 0, 0, scm_make_regexp); + +SCM +scm_make_regexp (pat) + SCM pat; +{ + SCM result; + regex_t *rx; + int status; + + SCM_ASSERT (SCM_NIMP(pat) && SCM_ROSTRINGP(pat), pat, SCM_ARG1, + s_make_regexp); + SCM_COERCE_SUBSTR (pat); + + SCM_DEFER_INTS; + rx = (regex_t *) scm_must_malloc (sizeof (regex_t), s_make_regexp); + status = regcomp (rx, SCM_ROCHARS (pat), REG_EXTENDED); + if (status != 0) + { + SCM_ALLOW_INTS; + scm_error (scm_regexp_error_key, + s_make_regexp, + scm_regexp_error_msg (status, rx), + SCM_BOOL_F, + SCM_BOOL_F); + /* never returns */ + } + SCM_NEWCELL (result); + SCM_SETCAR (result, scm_tc16_regex_t); + SCM_SETCDR (result, rx); + SCM_ALLOW_INTS; + return result; +} + +SCM_PROC (s_regexp_exec, "regexp-exec", 2, 1, 0, scm_regexp_exec); + +SCM +scm_regexp_exec (rx, str, start) + SCM rx; + SCM str; + SCM start; +{ + int status, nmatches; + regmatch_t *matches; + SCM mvec = SCM_BOOL_F; + + SCM_ASSERT (SCM_NIMP (rx) && SCM_RGXP (rx), rx, SCM_ARG1, s_regexp_exec); + SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG2, + s_regexp_exec); + SCM_COERCE_SUBSTR (str); + + /* re_nsub doesn't account for the `subexpression' representing the + whole regexp, so add 1 to nmatches. */ + + nmatches = SCM_RGX(rx)->re_nsub + 1; + SCM_DEFER_INTS; + matches = (regmatch_t *) scm_must_malloc (sizeof (regmatch_t) * nmatches, + s_regexp_exec); + status = regexec (SCM_RGX (rx), SCM_ROCHARS (str), nmatches, matches, 0); + if (!status) + { + int i; + /* The match vector must include a cell for the string that was matched, + so add 1. */ + mvec = scm_make_vector (SCM_MAKINUM (nmatches + 1), SCM_UNSPECIFIED, + SCM_UNDEFINED); + SCM_VELTS(mvec)[0] = str; + for (i = 0; i < nmatches; ++i) + SCM_VELTS(mvec)[i+1] = scm_cons (SCM_MAKINUM (matches[i].rm_so), + SCM_MAKINUM (matches[i].rm_eo)); + } + SCM_ALLOW_INTS; + + if (status != 0 && status != REG_NOMATCH) + scm_error (scm_regexp_error_key, + s_regexp_exec, + scm_regexp_error_msg (status), + SCM_BOOL_F, + SCM_BOOL_F); + return mvec; +} + +void +scm_init_regex_posix () +{ + scm_tc16_regex_t = scm_newsmob (®ex_t_smob); +#include "regex-posix.x" +} diff --git a/libguile/regex-posix.h b/libguile/regex-posix.h new file mode 100644 index 000000000..d72fb45c9 --- /dev/null +++ b/libguile/regex-posix.h @@ -0,0 +1,57 @@ +/* classes: h_files */ + +#ifndef REGEXPOSIXH +#define REGEXPOSIXH + +/* Copyright (C) 1997 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program 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 General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + +#include "libguile/__scm.h" + +extern long scm_tc16_regex_t; +#define SCM_RGX(X) ((regex_t *)SCM_CDR(X)) +#define SCM_RGXP(X) (SCM_CAR(X) == (SCM)scm_tc16_regex_t) + +extern SCM scm_make_regexp SCM_P ((SCM pat)); +extern SCM scm_regexp_exec SCM_P ((SCM rx, SCM str, SCM start)); +extern void scm_init_regex_posix (); + +#endif diff --git a/libguile/scmconfig.h.in b/libguile/scmconfig.h.in index ba1e48c1a..2005c89e3 100644 --- a/libguile/scmconfig.h.in +++ b/libguile/scmconfig.h.in @@ -197,6 +197,9 @@ /* Define if you have the readlink function. */ #undef HAVE_READLINK +/* Define if you have the regcomp function. */ +#undef HAVE_REGCOMP + /* Define if you have the rename function. */ #undef HAVE_RENAME