guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.1-9-gb735d33


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.1-9-gb735d33
Date: Fri, 29 Apr 2011 11:21:23 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=b735d33b2b636f457c8ca0740c99169e20b377b3

The branch, stable-2.0 has been updated
       via  b735d33b2b636f457c8ca0740c99169e20b377b3 (commit)
       via  f3a9a51d3ea545042f8e62b42a48afadb4839ee9 (commit)
       via  501cf7d6074eab3330555c1d57284fbd34e286d8 (commit)
       via  ad378da9757ebc503a9d6237afbc74dacea1b348 (commit)
      from  e6efefad0811e975e6a501829a0871d030b0ab88 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit b735d33b2b636f457c8ca0740c99169e20b377b3
Author: Andy Wingo <address@hidden>
Date:   Fri Apr 29 11:11:26 2011 +0200

    psyntax simplification
    
    * module/ice-9/psyntax.scm (id-var-name): Just rely on multiple-values
      truncation.

commit f3a9a51d3ea545042f8e62b42a48afadb4839ee9
Author: Andy Wingo <address@hidden>
Date:   Fri Apr 29 11:10:38 2011 +0200

    MV truncation in the boot evaluator
    
    * libguile/eval.c (truncate_values): New helper.
      (EVAL1): New macro, does an eval then truncates the values.
      (eval, prepare_boot_closure_env_for_apply)
      (prepare_boot_closure_env_for_eval): Use EVAL1 in appropriate places
      to get multiple-values truncation even here in the boot evaluator.
    
    eval.c fixen

commit 501cf7d6074eab3330555c1d57284fbd34e286d8
Author: Andy Wingo <address@hidden>
Date:   Fri Apr 29 11:07:25 2011 +0200

    latin1 strings in vm error messages
    
    * libguile/vm-engine.c: Use latin1 strings here for the string
      literals.

commit ad378da9757ebc503a9d6237afbc74dacea1b348
Author: Andy Wingo <address@hidden>
Date:   Tue Apr 12 13:12:56 2011 +0200

    check for iconveh values at configure-time
    
    * configure.ac: Check for the iconveh values here, instead of relying on
      gen-scmconfig to know them.  That doesn't work in general because
      gen-scmconfig runs on the build machine, not the target machine.
    
    * libguile/Makefile.am (gen-scmconfig.$(OBJEXT)): Revert rule to the
      revision before 533d8212.
    
    * libguile/gen-scmconfig.h.in (SCM_I_GSC_ICONVEH_ERROR):
      (SCM_I_GSC_ICONVEH_QUESTION_MARK):
      (SCM_I_GSC_ICONVEH_ESCAPE_SEQUENCE):
    * libguile/gen-scmconfig.c: Use configure-time substitutions to set
      SCM_ICONVEH_ERROR_HANDLER et al.

-----------------------------------------------------------------------

Summary of changes:
 configure.ac                |   64 ++++++++++++++++++++++++++++++++
 libguile/Makefile.am        |   12 +++----
 libguile/eval.c             |   85 +++++++++++++++++++++++++++++--------------
 libguile/gen-scmconfig.c    |    9 ++---
 libguile/gen-scmconfig.h.in |    3 ++
 libguile/vm-engine.c        |   34 +++++++++---------
 module/ice-9/psyntax.scm    |    3 +-
 7 files changed, 153 insertions(+), 57 deletions(-)

diff --git a/configure.ac b/configure.ac
index c341148..64cab9a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1193,6 +1193,70 @@ GUILE_STRUCT_UTIMBUF
 
 #--------------------------------------------------------------------
 #
+# What values do the iconv error handlers have?
+#
+# The only place that we need iconv in our public interfaces is for
+# the error handlers, which are just ints.  So we weaken our
+# dependency by looking up those values at configure-time.
+#--------------------------------------------------------------------
+SCM_I_GSC_ICONVEH_ERROR=0
+SCM_I_GSC_ICONVEH_QUESTION_MARK=1
+SCM_I_GSC_ICONVEH_ESCAPE_SEQUENCE=2
+AC_MSG_CHECKING([for iconveh_error])
+AC_RUN_IFELSE([AC_LANG_SOURCE(
+[AC_INCLUDES_DEFAULT
+#include <uniconv.h>
+int
+main (int argc, char *argv[])
+{
+  if (argc > 1)
+    printf ("%d\n", (int)iconveh_error);
+  return 0;
+}])],
+              [SCM_I_GSC_ICONVEH_ERROR=`./conftest$EXEEXT pretty-please`
+                AC_MSG_RESULT([$SCM_I_GSC_ICONVEH_ERROR])],
+              [AC_MSG_FAILURE([failed to get iconveh_error])],
+              [AC_MSG_WARN([assuming $SCM_I_GSC_ICONVEH_ERROR for 
cross-compilation])])
+
+AC_MSG_CHECKING([for iconveh_question_mark])
+AC_RUN_IFELSE([AC_LANG_SOURCE(
+[AC_INCLUDES_DEFAULT
+#include <uniconv.h>
+int
+main (int argc, char *argv[])
+{
+  if (argc > 1)
+    printf ("%d\n", (int)iconveh_question_mark);
+  return 0;
+}])],
+              [SCM_I_GSC_ICONVEH_QUESTION_MARK=`./conftest$EXEEXT 
pretty-please`
+                AC_MSG_RESULT([$SCM_I_GSC_ICONVEH_QUESTION_MARK])],
+              [AC_MSG_FAILURE([failed to get iconveh_question_mark])],
+              [AC_MSG_WARN([assuming $SCM_I_GSC_ICONVEH_QUESTION_MARK for 
cross-compilation])])
+
+AC_MSG_CHECKING([for iconveh_escape_sequence])
+AC_RUN_IFELSE([AC_LANG_SOURCE(
+[AC_INCLUDES_DEFAULT
+#include <uniconv.h>
+int
+main (int argc, char *argv[])
+{
+  if (argc > 1)
+    printf ("%d\n", (int)iconveh_escape_sequence);
+  return 0;
+}])],
+              [SCM_I_GSC_ICONVEH_ESCAPE_SEQUENCE=`./conftest$EXEEXT 
pretty-please`
+                AC_MSG_RESULT([$SCM_I_GSC_ICONVEH_ESCAPE_SEQUENCE])],
+              [AC_MSG_FAILURE([failed to get iconveh_escape_sequence])],
+              [AC_MSG_WARN([assuming $SCM_I_GSC_ICONVEH_ESCAPE_SEQUENCE for 
cross-compilation])])
+
+AC_SUBST([SCM_I_GSC_ICONVEH_ERROR])
+AC_SUBST([SCM_I_GSC_ICONVEH_QUESTION_MARK])
+AC_SUBST([SCM_I_GSC_ICONVEH_ESCAPE_SEQUENCE])
+
+
+#--------------------------------------------------------------------
+#
 # Which way does the stack grow?
 #
 # Following code comes from Autoconf 2.61's internal _AC_LIBOBJ_ALLOCA
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 4790cd9..4ec7ee5 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -55,13 +55,11 @@ gen_scmconfig_SOURCES = gen-scmconfig.c
 ## Override default rule; this should be compiled for BUILD host.
 ## For some reason, OBJEXT does not include the dot
 gen-scmconfig.$(OBJEXT): gen-scmconfig.c
-       $(AM_V_GEN)                                                     \
-       if [ "$(cross_compiling)" = "yes" ]; then                       \
-               $(CC_FOR_BUILD) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
-                 $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)     \
-                 -c -o $@ $<;                                          \
-       else                                                            \
-               $(COMPILE) -c -o $@ $<;                                 \
+       $(AM_V_GEN) \
+       if [ "$(cross_compiling)" = "yes" ]; then \
+               $(CC_FOR_BUILD) $(DEFS) $(DEFAULT_INCLUDES) $(AM_CPPFLAGS) -c 
-o $@ $<; \
+       else \
+               $(COMPILE) -c -o $@ $<; \
        fi
 
 ## Override default rule; this should run on BUILD host.
diff --git a/libguile/eval.c b/libguile/eval.c
index 164aadd..f830e00 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -175,6 +175,32 @@ static void error_unrecognized_keyword (SCM proc)
 }
 
 
+/* Multiple values truncation.  */
+static SCM
+truncate_values (SCM x)
+{
+  if (SCM_LIKELY (!SCM_VALUESP (x)))
+    return x;
+  else
+    {
+      SCM l = scm_struct_ref (x, SCM_INUM0);
+      if (SCM_LIKELY (scm_is_pair (l)))
+        return scm_car (l);
+      else
+        {
+          scm_ithrow (scm_from_latin1_symbol ("vm-run"),
+                      scm_list_3 (scm_from_latin1_symbol ("vm-run"),
+                                  scm_from_locale_string
+                                  ("Too few values returned to continuation"),
+                                  SCM_EOL),
+                      1);
+          /* Not reached.  */
+          return SCM_BOOL_F;
+        }
+    }
+}
+#define EVAL1(x, env) (truncate_values (eval ((x), (env))))
+
 /* the environment:
    (VAL ... . MOD)
    If MOD is #f, it means the environment was captured before modules were
@@ -209,7 +235,7 @@ eval (SCM x, SCM env)
       goto loop;
 
     case SCM_M_IF:
-      if (scm_is_true (eval (CAR (mx), env)))
+      if (scm_is_true (EVAL1 (CAR (mx), env)))
         x = CADR (mx);
       else
         x = CDDR (mx);
@@ -220,7 +246,8 @@ eval (SCM x, SCM env)
         SCM inits = CAR (mx);
         SCM new_env = CAPTURE_ENV (env);
         for (; scm_is_pair (inits); inits = CDR (inits))
-          new_env = scm_cons (eval (CAR (inits), env), new_env);
+          new_env = scm_cons (EVAL1 (CAR (inits), env),
+                              new_env);
         env = new_env;
         x = CDR (mx);
         goto loop;
@@ -233,14 +260,14 @@ eval (SCM x, SCM env)
       return mx;
 
     case SCM_M_DEFINE:
-      scm_define (CAR (mx), eval (CDR (mx), env));
+      scm_define (CAR (mx), EVAL1 (CDR (mx), env));
       return SCM_UNSPECIFIED;
 
     case SCM_M_DYNWIND:
       {
         SCM in, out, res, old_winds;
-        in = eval (CAR (mx), env);
-        out = eval (CDDR (mx), env);
+        in = EVAL1 (CAR (mx), env);
+        out = EVAL1 (CDDR (mx), env);
         scm_call_0 (in);
         old_winds = scm_i_dynwinds ();
         scm_i_set_dynwinds (scm_acons (in, out, old_winds));
@@ -257,10 +284,10 @@ eval (SCM x, SCM env)
         len = scm_ilength (CAR (mx));
         fluidv = alloca (sizeof (SCM)*len);
         for (i = 0, walk = CAR (mx); i < len; i++, walk = CDR (walk))
-          fluidv[i] = eval (CAR (walk), env);
+          fluidv[i] = EVAL1 (CAR (walk), env);
         valuesv = alloca (sizeof (SCM)*len);
         for (i = 0, walk = CADR (mx); i < len; i++, walk = CDR (walk))
-          valuesv[i] = eval (CAR (walk), env);
+          valuesv[i] = EVAL1 (CAR (walk), env);
         
         wf = scm_i_make_with_fluids (len, fluidv, valuesv);
         scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state);
@@ -274,9 +301,9 @@ eval (SCM x, SCM env)
 
     case SCM_M_APPLY:
       /* Evaluate the procedure to be applied.  */
-      proc = eval (CAR (mx), env);
+      proc = EVAL1 (CAR (mx), env);
       /* Evaluate the argument holding the list of arguments */
-      args = eval (CADR (mx), env);
+      args = EVAL1 (CADR (mx), env);
           
     apply_proc:
       /* Go here to tail-apply a procedure.  PROC is the procedure and
@@ -291,7 +318,7 @@ eval (SCM x, SCM env)
 
     case SCM_M_CALL:
       /* Evaluate the procedure to be applied.  */
-      proc = eval (CAR (mx), env);
+      proc = EVAL1 (CAR (mx), env);
       argc = SCM_I_INUM (CADR (mx));
       mx = CDDR (mx);
 
@@ -307,21 +334,22 @@ eval (SCM x, SCM env)
 
          argv = alloca (argc * sizeof (SCM));
          for (i = 0; i < argc; i++, mx = CDR (mx))
-           argv[i] = eval (CAR (mx), env);
+           argv[i] = EVAL1 (CAR (mx), env);
 
          return scm_c_vm_run (scm_the_vm (), proc, argv, argc);
         }
 
     case SCM_M_CONT:
-      return scm_i_call_with_current_continuation (eval (mx, env));
+      return scm_i_call_with_current_continuation (EVAL1 (mx, env));
 
     case SCM_M_CALL_WITH_VALUES:
       {
         SCM producer;
         SCM v;
 
-        producer = eval (CAR (mx), env);
-        proc = eval (CDR (mx), env);  /* proc is the consumer. */
+        producer = EVAL1 (CAR (mx), env);
+        /* `proc' is the consumer.  */
+        proc = EVAL1 (CDR (mx), env);
         v = scm_call_with_vm (scm_the_vm (), producer, SCM_EOL);
         if (SCM_VALUESP (v))
           args = scm_struct_ref (v, SCM_INUM0);
@@ -347,7 +375,7 @@ eval (SCM x, SCM env)
     case SCM_M_LEXICAL_SET:
       {
         int n;
-        SCM val = eval (CDR (mx), env);
+        SCM val = EVAL1 (CDR (mx), env);
         for (n = SCM_I_INUM (CAR (mx)); n; n--)
           env = CDR (env);
         SCM_SETCAR (env, val);
@@ -368,7 +396,7 @@ eval (SCM x, SCM env)
     case SCM_M_TOPLEVEL_SET:
       {
         SCM var = CAR (mx);
-        SCM val = eval (CDR (mx), env);
+        SCM val = EVAL1 (CDR (mx), env);
         if (SCM_VARIABLEP (var))
           {
             SCM_VARIABLE_SET (var, val);
@@ -395,14 +423,14 @@ eval (SCM x, SCM env)
     case SCM_M_MODULE_SET:
       if (SCM_VARIABLEP (CDR (mx)))
         {
-          SCM_VARIABLE_SET (CDR (mx), eval (CAR (mx), env));
+          SCM_VARIABLE_SET (CDR (mx), EVAL1 (CAR (mx), env));
           return SCM_UNSPECIFIED;
         }
       else
         {
           SCM_VARIABLE_SET
             (scm_memoize_variable_access_x (x, SCM_BOOL_F),
-             eval (CAR (mx), env));
+             EVAL1 (CAR (mx), env));
           return SCM_UNSPECIFIED;
         }
 
@@ -414,10 +442,11 @@ eval (SCM x, SCM env)
         volatile SCM handler, prompt;
 
         vm = scm_the_vm ();
-        prompt = scm_c_make_prompt (eval (CAR (mx), env), SCM_VM_DATA (vm)->fp,
+        prompt = scm_c_make_prompt (EVAL1 (CAR (mx), env),
+                                    SCM_VM_DATA (vm)->fp,
                                     SCM_VM_DATA (vm)->sp, SCM_VM_DATA (vm)->ip,
                                     0, -1, scm_i_dynwinds ());
-        handler = eval (CDDR (mx), env);
+        handler = EVAL1 (CDDR (mx), env);
         scm_i_set_dynwinds (scm_cons (prompt, scm_i_dynwinds ()));
 
         if (SCM_PROMPT_SETJMP (prompt))
@@ -885,7 +914,7 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
             }
               
           for (; i < nreq + nopt; i++, inits = CDR (inits))
-            env = scm_cons (eval (CAR (inits), env), env);
+            env = scm_cons (EVAL1 (CAR (inits), env), env);
 
           if (scm_is_true (rest))
             env = scm_cons (args, env);
@@ -903,7 +932,7 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
             env = scm_cons (CAR (args), env);
               
           for (; i < nreq + nopt; i++, inits = CDR (inits))
-            env = scm_cons (eval (CAR (inits), env), env);
+            env = scm_cons (EVAL1 (CAR (inits), env), env);
 
           if (scm_is_true (rest))
             {
@@ -957,7 +986,7 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
               {
                 SCM tail = scm_list_tail (env, SCM_I_MAKINUM (i));
                 if (SCM_UNBNDP (CAR (tail)))
-                  SCM_SETCAR (tail, eval (CAR (inits), CDR (tail)));
+                  SCM_SETCAR (tail, EVAL1 (CAR (inits), CDR (tail)));
               }
           }
         }
@@ -978,7 +1007,8 @@ prepare_boot_closure_env_for_eval (SCM proc, unsigned int 
argc,
           && !BOOT_CLOSURE_HAS_REST_ARGS (proc)))
     {
       for (; scm_is_pair (exps); exps = CDR (exps), nreq--)
-        new_env = scm_cons (eval (CAR (exps), *inout_env), new_env);
+        new_env = scm_cons (EVAL1 (CAR (exps), *inout_env),
+                            new_env);
       if (SCM_UNLIKELY (nreq != 0))
         scm_wrong_num_args (proc);
       *out_body = BOOT_CLOSURE_BODY (proc);
@@ -989,11 +1019,12 @@ prepare_boot_closure_env_for_eval (SCM proc, unsigned 
int argc,
       if (SCM_UNLIKELY (argc < nreq))
         scm_wrong_num_args (proc);
       for (; nreq; nreq--, exps = CDR (exps))
-        new_env = scm_cons (eval (CAR (exps), *inout_env), new_env);
+        new_env = scm_cons (EVAL1 (CAR (exps), *inout_env),
+                            new_env);
       {
         SCM rest = SCM_EOL;
         for (; scm_is_pair (exps); exps = CDR (exps))
-          rest = scm_cons (eval (CAR (exps), *inout_env), rest);
+          rest = scm_cons (EVAL1 (CAR (exps), *inout_env), rest);
         new_env = scm_cons (scm_reverse (rest),
                             new_env);
       }
@@ -1004,7 +1035,7 @@ prepare_boot_closure_env_for_eval (SCM proc, unsigned int 
argc,
     {
       SCM args = SCM_EOL;
       for (; scm_is_pair (exps); exps = CDR (exps))
-        args = scm_cons (eval (CAR (exps), *inout_env), args);
+        args = scm_cons (EVAL1 (CAR (exps), *inout_env), args);
       args = scm_reverse_x (args, SCM_UNDEFINED);
       prepare_boot_closure_env_for_apply (proc, args, out_body, inout_env);
     }
diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c
index 5834346..176f25c 100644
--- a/libguile/gen-scmconfig.c
+++ b/libguile/gen-scmconfig.c
@@ -123,7 +123,6 @@
 
 #include <stdio.h>
 #include <string.h>
-#include <uniconv.h>
 
 #define pf printf
 
@@ -397,11 +396,11 @@ main (int argc, char *argv[])
 
   pf ("\n");
   pf ("/* Constants from uniconv.h.  */\n");
-  pf ("#define SCM_ICONVEH_ERROR %d\n", (int) iconveh_error);
-  pf ("#define SCM_ICONVEH_QUESTION_MARK %d\n", 
-      (int) iconveh_question_mark);
+  pf ("#define SCM_ICONVEH_ERROR %d\n", SCM_I_GSC_ICONVEH_ERROR);
+  pf ("#define SCM_ICONVEH_QUESTION_MARK %d\n",
+      SCM_I_GSC_ICONVEH_QUESTION_MARK);
   pf ("#define SCM_ICONVEH_ESCAPE_SEQUENCE %d\n",
-      (int) iconveh_escape_sequence);  
+      SCM_I_GSC_ICONVEH_ESCAPE_SEQUENCE);  
 
   printf ("#endif\n");
 
diff --git a/libguile/gen-scmconfig.h.in b/libguile/gen-scmconfig.h.in
index 125720a..30f43d7 100644
--- a/libguile/gen-scmconfig.h.in
+++ b/libguile/gen-scmconfig.h.in
@@ -31,6 +31,9 @@
 #define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER 
@SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER@
 #define SCM_I_GSC_HAVE_THREAD_STORAGE_CLASS 
@SCM_I_GSC_HAVE_THREAD_STORAGE_CLASS@
 #define SCM_I_GSC_HAVE_STRUCT_DIRENT64 @SCM_I_GSC_HAVE_STRUCT_DIRENT64@
+#define SCM_I_GSC_ICONVEH_ERROR @SCM_I_GSC_ICONVEH_ERROR@
+#define SCM_I_GSC_ICONVEH_QUESTION_MARK @SCM_I_GSC_ICONVEH_QUESTION_MARK@
+#define SCM_I_GSC_ICONVEH_ESCAPE_SEQUENCE @SCM_I_GSC_ICONVEH_ESCAPE_SEQUENCE@
 
 /*
   Local Variables:
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 4b0ca3e..ab9ffc9 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -134,21 +134,21 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
     /* FIXME: need to sync regs before allocating anything, in each case. */
 
   vm_error_bad_instruction:
-    err_msg  = scm_from_locale_string ("VM: Bad instruction: ~s");
+    err_msg  = scm_from_latin1_string ("VM: Bad instruction: ~s");
     finish_args = scm_list_1 (scm_from_uchar (ip[-1]));
     goto vm_error;
 
   vm_error_unbound:
     /* FINISH_ARGS should be the name of the unbound variable.  */
     SYNC_ALL ();
-    err_msg = scm_from_locale_string ("Unbound variable: ~s");
+    err_msg = scm_from_latin1_string ("Unbound variable: ~s");
     scm_error_scm (scm_misc_error_key, program, err_msg,
                    scm_list_1 (finish_args), SCM_BOOL_F);
     goto vm_error;
 
   vm_error_unbound_fluid:
     SYNC_ALL ();
-    err_msg = scm_from_locale_string ("Unbound fluid: ~s");
+    err_msg = scm_from_latin1_string ("Unbound fluid: ~s");
     scm_error_scm (scm_misc_error_key, program, err_msg,
                    scm_list_1 (finish_args), SCM_BOOL_F);
     goto vm_error;
@@ -167,26 +167,26 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
 
   vm_error_kwargs_length_not_even:
     SYNC_ALL ();
-    err_msg = scm_from_locale_string ("Odd length of keyword argument list");
+    err_msg = scm_from_latin1_string ("Odd length of keyword argument list");
     scm_error_scm (sym_keyword_argument_error, program, err_msg,
                    SCM_EOL, SCM_BOOL_F);
 
   vm_error_kwargs_invalid_keyword:
     /* FIXME say which one it was */
     SYNC_ALL ();
-    err_msg = scm_from_locale_string ("Invalid keyword");
+    err_msg = scm_from_latin1_string ("Invalid keyword");
     scm_error_scm (sym_keyword_argument_error, program, err_msg,
                    SCM_EOL, SCM_BOOL_F);
 
   vm_error_kwargs_unrecognized_keyword:
     /* FIXME say which one it was */
     SYNC_ALL ();
-    err_msg = scm_from_locale_string ("Unrecognized keyword");
+    err_msg = scm_from_latin1_string ("Unrecognized keyword");
     scm_error_scm (sym_keyword_argument_error, program, err_msg,
                    SCM_EOL, SCM_BOOL_F);
 
   vm_error_too_many_args:
-    err_msg  = scm_from_locale_string ("VM: Too many arguments");
+    err_msg  = scm_from_latin1_string ("VM: Too many arguments");
     finish_args = scm_list_1 (scm_from_int (nargs));
     goto vm_error;
 
@@ -204,7 +204,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
     goto vm_error;
 
   vm_error_stack_overflow:
-    err_msg  = scm_from_locale_string ("VM: Stack overflow");
+    err_msg  = scm_from_latin1_string ("VM: Stack overflow");
     finish_args = SCM_EOL;
     if (stack_limit < vp->stack_base + vp->stack_size)
       /* There are VM_STACK_RESERVE_SIZE bytes left.  Make them available so
@@ -213,12 +213,12 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
     goto vm_error;
 
   vm_error_stack_underflow:
-    err_msg  = scm_from_locale_string ("VM: Stack underflow");
+    err_msg  = scm_from_latin1_string ("VM: Stack underflow");
     finish_args = SCM_EOL;
     goto vm_error;
 
   vm_error_improper_list:
-    err_msg  = scm_from_locale_string ("Expected a proper list, but got object 
with tail ~s");
+    err_msg  = scm_from_latin1_string ("Expected a proper list, but got object 
with tail ~s");
     goto vm_error;
 
   vm_error_not_a_pair:
@@ -246,41 +246,41 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
     goto vm_error;
 
   vm_error_no_values:
-    err_msg  = scm_from_locale_string ("Zero values returned to single-valued 
continuation");
+    err_msg  = scm_from_latin1_string ("Zero values returned to single-valued 
continuation");
     finish_args = SCM_EOL;
     goto vm_error;
 
   vm_error_not_enough_values:
-    err_msg  = scm_from_locale_string ("Too few values returned to 
continuation");
+    err_msg  = scm_from_latin1_string ("Too few values returned to 
continuation");
     finish_args = SCM_EOL;
     goto vm_error;
 
   vm_error_continuation_not_rewindable:
-    err_msg  = scm_from_locale_string ("Unrewindable partial continuation");
+    err_msg  = scm_from_latin1_string ("Unrewindable partial continuation");
     finish_args = scm_cons (finish_args, SCM_EOL);
     goto vm_error;
 
   vm_error_bad_wide_string_length:
-    err_msg  = scm_from_locale_string ("VM: Bad wide string length: ~S");
+    err_msg  = scm_from_latin1_string ("VM: Bad wide string length: ~S");
     goto vm_error;
 
 #ifdef VM_CHECK_IP
   vm_error_invalid_address:
-    err_msg  = scm_from_locale_string ("VM: Invalid program address");
+    err_msg  = scm_from_latin1_string ("VM: Invalid program address");
     finish_args = SCM_EOL;
     goto vm_error;
 #endif
 
 #if VM_CHECK_OBJECT
   vm_error_object:
-    err_msg = scm_from_locale_string ("VM: Invalid object table access");
+    err_msg = scm_from_latin1_string ("VM: Invalid object table access");
     finish_args = SCM_EOL;
     goto vm_error;
 #endif
 
 #if VM_CHECK_FREE_VARIABLES
   vm_error_free_variable:
-    err_msg = scm_from_locale_string ("VM: Invalid free variable access");
+    err_msg = scm_from_latin1_string ("VM: Invalid free variable access");
     finish_args = SCM_EOL;
     goto vm_error;
 #endif
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 17acf3f..85ceb13 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -770,7 +770,8 @@
       (lambda (id w)
         (define-syntax first
           (syntax-rules ()
-            ((_ e) (call-with-values (lambda () e) (lambda (x . ignore) x)))))
+            ;; Rely on Guile's multiple-values truncation.
+            ((_ e) e)))
         (define search
           (lambda (sym subst marks)
             (if (null? subst)


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]