Merge commit '60617d819d77a1b92ed6c557a0b49b8e9a8e97b9'

Conflicts:
	libguile/continuations.c
	libguile/eval.c
	libguile/goops.c
	libguile/instructions.c

diff --cc libguile/backtrace.c
Simple merge

diff --cc libguile/debug.c
Simple merge

diff --cc libguile/eval.c
index 3e828a1,815f7c7..39e66c5
--- 1/libguile/eval.c
--- 2/libguile/eval.c
+++ b/libguile/eval.c
@@@ -1,5 -1,4 +1,5 @@@
 -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2013
 +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,
-  *   2005,2006,2007,2008,2009,2010,2011,2012,2013
++ *   2005,2006,2007,2008,2009,2010,2011,2012,2013,2014
   * Free Software Foundation, Inc.
   * 
   * This library is free software; you can redistribute it and/or
@@@ -617,34 -597,83 +617,41 @@@ scm_apply_2 (SCM proc, SCM arg1, SCM ar
  SCM
  scm_apply_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args)
  {
 -  return scm_apply (proc, scm_cons (arg1, scm_cons2 (arg2, arg3, args)),
 -                  SCM_EOL);
 -}
 -
 -/* This code processes the arguments to apply:
 -
 -   (apply PROC ARG1 ... ARGS)
 -
 -   Given a list (ARG1 ... ARGS), this function conses the ARG1
 -   ... arguments onto the front of ARGS, and returns the resulting
 -   list.  Note that ARGS is a list; thus, the argument to this
 -   function is a list whose last element is a list.
 -
 -   Apply calls this function, and applies PROC to the elements of the
 -   result.  apply:nconc2last takes care of building the list of
 -   arguments, given (ARG1 ... ARGS).
 -
 -   Rather than do new consing, apply:nconc2last destroys its argument.
 -   On that topic, this code came into my care with the following
 -   beautifully cryptic comment on that topic: "This will only screw
 -   you if you do (scm_apply scm_apply '( ... ))"  If you know what
 -   they're referring to, send me a patch to this comment.  */
 -
 -SCM_DEFINE (scm_nconc2last, "apply:nconc2last", 1, 0, 0, 
 -          (SCM lst),
 -          "Given a list (@var{arg1} @dots{} @var{args}), this function\n"
 -          "conses the @var{arg1} @dots{} arguments onto the front of\n"
 -          "@var{args}, and returns the resulting list. Note that\n"
 -          "@var{args} is a list; thus, the argument to this function is\n"
 -          "a list whose last element is a list.\n"
 -          "Note: Rather than do new consing, @code{apply:nconc2last}\n"
 -          "destroys its argument, so use with care.")
 -#define FUNC_NAME s_scm_nconc2last
 -{
 -  SCM *lloc;
 -  SCM_VALIDATE_NONEMPTYLIST (1, lst);
 -  lloc = &lst;
 -  while (!scm_is_null (SCM_CDR (*lloc)))
 -    lloc = SCM_CDRLOC (*lloc);
 -  SCM_ASSERT (scm_ilength (SCM_CAR (*lloc)) >= 0, lst, SCM_ARG1, FUNC_NAME);
 -  *lloc = SCM_CAR (*lloc);
 -  return lst;
 +  return scm_apply_0 (proc, scm_cons (arg1, scm_cons2 (arg2, arg3, args)));
  }
 -#undef FUNC_NAME
  
+ static SCM map_var, for_each_var;
+ 
+ static void init_map_var (void)
+ {
+   map_var = scm_private_variable (scm_the_root_module (),
+                                   scm_from_latin1_symbol ("map"));
+ }
+ 
+ static void init_for_each_var (void)
+ {
+   for_each_var = scm_private_variable (scm_the_root_module (),
+                                        scm_from_latin1_symbol ("for-each"));
+ }
  
  SCM 
  scm_map (SCM proc, SCM arg1, SCM args)
  {
-   static SCM var = SCM_BOOL_F;
+   static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+   scm_i_pthread_once (&once, init_map_var);
  
-   if (scm_is_false (var))
-     var = scm_private_variable (scm_the_root_module (),
-                                 scm_from_latin1_symbol ("map"));
- 
-   return scm_apply_0 (scm_variable_ref (var),
 -  return scm_apply (scm_variable_ref (map_var),
 -                    scm_cons (proc, scm_cons (arg1, args)), SCM_EOL);
++  return scm_apply_0 (scm_variable_ref (map_var),
 +                      scm_cons (proc, scm_cons (arg1, args)));
  }
  
  SCM 
  scm_for_each (SCM proc, SCM arg1, SCM args)
  {
-   static SCM var = SCM_BOOL_F;
- 
-   if (scm_is_false (var))
-     var = scm_private_variable (scm_the_root_module (),
-                                 scm_from_latin1_symbol ("for-each"));
+   static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+   scm_i_pthread_once (&once, init_for_each_var);
  
-   return scm_apply_0 (scm_variable_ref (var),
 -  return scm_apply (scm_variable_ref (for_each_var),
 -                    scm_cons (proc, scm_cons (arg1, args)), SCM_EOL);
++  return scm_apply_0 (scm_variable_ref (for_each_var),
 +                      scm_cons (proc, scm_cons (arg1, args)));
  }
  
  

diff --cc libguile/frames.c
Simple merge

diff --cc libguile/goops.c
index 013a65c,4a2e24d..2cf343f
--- 1/libguile/goops.c
--- 2/libguile/goops.c
+++ b/libguile/goops.c
@@@ -1,4 -1,4 +1,4 @@@
- /* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013
 -/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012
++/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014
   * Free Software Foundation, Inc.
   *
   * This library is free software; you can redistribute it and/or
@@@ -1711,8 -1732,46 +1711,17 @@@ SCM_KEYWORD (k_name, "name")
  
  SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
  
 -
 -SCM
 -scm_apply_generic (SCM gf, SCM args)
 -{
 -  return scm_apply (SCM_STRUCT_PROCEDURE (gf), args, SCM_EOL);
 -}
 -
 -SCM
 -scm_call_generic_0 (SCM gf)
 -{
 -  return scm_call_0 (SCM_STRUCT_PROCEDURE (gf));
 -}
 -
 -SCM
 -scm_call_generic_1 (SCM gf, SCM a1)
 -{
 -  return scm_call_1 (SCM_STRUCT_PROCEDURE (gf), a1);
 -}
 -
 -SCM
 -scm_call_generic_2 (SCM gf, SCM a1, SCM a2)
 -{
 -  return scm_call_2 (SCM_STRUCT_PROCEDURE (gf), a1, a2);
 -}
--
 -SCM
 -scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3)
 -{
 -  return scm_call_3 (SCM_STRUCT_PROCEDURE (gf), a1, a2, a3);
 -}
 +SCM_SYMBOL (sym_delayed_compile, "delayed-compile");
+ 
+ static SCM delayed_compile_var;
+ 
+ static void
+ init_delayed_compile_var (void)
+ {
+   delayed_compile_var
+     = scm_c_private_lookup ("oop goops dispatch", "delayed-compile");
+ }
+ 
  static SCM
  make_dispatch_procedure (SCM gf)
  {

diff --cc libguile/ports.c
Simple merge

diff --cc libguile/strings.c
index 1f492bd,cab5d05..e8eb91c
--- 1/libguile/strings.c
--- 2/libguile/strings.c
+++ b/libguile/strings.c
@@@ -261,25 -258,17 +261,34 @@@ scm_i_pthread_mutex_t stringbuf_write_m
  
  #define IS_SH_STRING(str)   (SCM_CELL_TYPE(str)==SH_STRING_TAG)
  
 +void
 +scm_i_print_stringbuf (SCM exp, SCM port, scm_print_state *pstate) 
 +{
 +  SCM str;
 +
 +  scm_i_pthread_mutex_lock (&stringbuf_write_mutex);
 +  SET_STRINGBUF_SHARED (exp);
 +  scm_i_pthread_mutex_unlock (&stringbuf_write_mutex);
 +
 +  str =  scm_double_cell (RO_STRING_TAG, SCM_UNPACK(exp),
 +                          0, STRINGBUF_LENGTH (exp));
 +
 +  scm_puts ("#<stringbuf ", port);
 +  scm_iprin1 (str, port, pstate);
 +  scm_puts (">", port);
 +}
 +
  SCM scm_nullstr;
  
+ static SCM null_stringbuf;
+ 
+ static void
+ init_null_stringbuf (void)
+ {
+   null_stringbuf = make_stringbuf (0);
+   SET_STRINGBUF_SHARED (null_stringbuf);
+ }
+ 
  /* Create a scheme string with space for LEN 8-bit Latin-1-encoded
     characters.  CHARSP, if not NULL, will be set to location of the
     char array.  If READ_ONLY_P, the returned string is read-only;

diff --cc libguile/strports.c
Simple merge

diff --cc libguile/throw.c
Simple merge