merge stable-2.0

There are some bugs with command-line handling that will be sorted out
with the next commit.

5 files changed, 85 insertions, 14 deletions

diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 36f15491a..d42c650ae 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -1,6 +1,6 @@
 ## Process this file with Automake to create Makefile.in
 ##
-##  	Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+##  	Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -711,6 +711,7 @@ $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES): scmconfig.h snarf.h guile-snarf-docs.in
 error.x: cpp-E.c
 posix.x: cpp-SIG.c
 load.x: libpath.h
+dynl.x: libpath.h
 
 alldotdocfiles    = $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES)
 snarf2checkedtexi = GUILE_AUTO_COMPILE=0 $(top_builddir)/meta/uninstalled-env guild snarf-check-and-output-texi
diff --git a/libguile/eval.c b/libguile/eval.c
index 4076d16b7..f743ed78e 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,
+ *   2005,2006,2007,2008,2009,2010,2011,2012,2013
  * Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
@@ -851,6 +852,14 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
               env = scm_cons (args, env);
               i++;
             }
+          else if (scm_is_true (alt)
+                   && scm_is_pair (args) && !scm_is_keyword (CAR (args)))
+            {
+              /* Too many positional args, no rest arg, and we have an
+                 alternate clause.  */
+              mx = alt;
+              goto loop;
+            }
 
           /* Now fill in env with unbound values, limn the rest of the args for
              keywords, and fill in unbound values with their inits. */
diff --git a/libguile/load.c b/libguile/load.c
index 3b11a7c98..081c364e6 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2004, 2006, 2008,
- *   2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2013 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
@@ -846,11 +846,13 @@ canonical_suffix (SCM fname)
 SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
 	    (SCM args),
 	    "Search @var{%load-path} for the file named @var{filename} and\n"
-	    "load it into the top-level environment.  If @var{filename} is a\n"
-	    "relative pathname and is not found in the list of search paths,\n"
-	    "an error is signalled, unless the optional argument\n"
-            "@var{exception_on_not_found} is @code{#f}, in which case\n"
-            "@code{#f} is returned instead.")
+	    "load it into the top-level environment.\n\n"
+            "If @var{filename} is a relative pathname and is not found in\n"
+            "the list of search paths, one of three things may happen,\n"
+            "depending on the optional second argument,\n"
+            "@var{exception_on_not_found}.  If it is @code{#f}, @code{#f}\n"
+            "will be returned.  If it is a procedure, it will be called\n"
+            "with no arguments.  Otherwise an error is signalled.")
 #define FUNC_NAME s_scm_primitive_load_path
 {
   SCM filename, exception_on_not_found;
@@ -924,11 +926,13 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
   
   if (scm_is_false (full_filename) && scm_is_false (compiled_filename))
     {
-      if (scm_is_true (exception_on_not_found))
+      if (scm_is_true (scm_procedure_p (exception_on_not_found)))
+        return scm_call_0 (exception_on_not_found);
+      else if (scm_is_false (exception_on_not_found))
+        return SCM_BOOL_F;
+      else
         SCM_MISC_ERROR ("Unable to find file ~S in load path",
                         scm_list_1 (filename));
-      else
-        return SCM_BOOL_F;
     }
 
   if (!scm_is_false (hook))
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 0e3956363..dce90e326 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 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
@@ -558,7 +558,7 @@ VM_DEFINE_INSTRUCTION (170, make_array, "make-array", 3, -1, 1)
  * Structs
  */
 #define VM_VALIDATE_STRUCT(obj, proc)           \
-  VM_ASSERT (SCM_STRUCTP (obj), vm_error_not_a_pair (proc, obj))
+  VM_ASSERT (SCM_STRUCTP (obj), vm_error_not_a_struct (proc, obj))
 
 VM_DEFINE_FUNCTION (171, struct_p, "struct?", 1)
 {
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index a05326868..ac1d4a61a 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001,2008,2009,2010,2011,2012 Free Software Foundation, Inc.
+/* Copyright (C) 2001,2008,2009,2010,2011,2012,2013 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
@@ -647,6 +647,8 @@ VM_DEFINE_INSTRUCTION (49, bind_optionals_shuffle, "bind-optionals/shuffle", 6,
   NEXT;
 }
 
+/* See also bind-optionals/shuffle-or-br below.  */
+
 /* Flags that determine whether other keywords are allowed, and whether a
    rest argument is expected.  These values must match those used by the
    glil->assembly compiler.  */
@@ -1571,6 +1573,61 @@ VM_DEFINE_INSTRUCTION (95, assert_nargs_ee_locals, "assert-nargs-ee/locals", 1,
   NEXT;
 }
 
+/* Like bind-optionals/shuffle, but if there are too many positional
+   arguments, jumps to the next case-lambda clause.  */
+VM_DEFINE_INSTRUCTION (96, bind_optionals_shuffle_or_br, "bind-optionals/shuffle-or-br", 9, -1, -1)
+{
+  SCM *walk;
+  scm_t_ptrdiff nreq, nreq_and_opt, ntotal;
+  scm_t_int32 offset;
+  nreq = FETCH () << 8;
+  nreq += FETCH ();
+  nreq_and_opt = FETCH () << 8;
+  nreq_and_opt += FETCH ();
+  ntotal = FETCH () << 8;
+  ntotal += FETCH ();
+  FETCH_OFFSET (offset);
+
+  /* look in optionals for first keyword or last positional */
+  /* starting after the last required positional arg */
+  walk = fp + nreq;
+  while (/* while we have args */
+         walk <= sp
+         /* and we still have positionals to fill */
+         && walk - fp < nreq_and_opt
+         /* and we haven't reached a keyword yet */
+         && !scm_is_keyword (*walk))
+    /* bind this optional arg (by leaving it in place) */
+    walk++;
+  if (/* If we have filled all the positionals */
+      walk - fp == nreq_and_opt
+      /* and there are still more arguments */
+      && walk <= sp
+      /* and the next argument is not a keyword, */
+      && !scm_is_keyword (*walk))
+    {
+      /* Jump to the next case-lambda* clause. */
+      ip += offset;
+    }
+  else
+    {
+      /* Otherwise, finish as in bind-optionals/shuffle: shuffle up,
+         from walk to ntotal */
+      scm_t_ptrdiff nshuf = sp - walk + 1, i;
+      sp = (fp - 1) + ntotal + nshuf;
+      CHECK_OVERFLOW ();
+      for (i = 0; i < nshuf; i++)
+        sp[-i] = walk[nshuf-i-1];
+
+      /* and fill optionals & keyword args with SCM_UNDEFINED */
+      while (walk <= (fp - 1) + ntotal)
+        *walk++ = SCM_UNDEFINED;
+    }
+
+  NEXT;
+}
+
+
 /*
 (defun renumber-ops ()
   "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"