* symbols.c (scm_sysintern0): New function. Contains the core of

old scm_sysintern but doesn't take a second value argument.
(scm_sysintern): Now uses scm_sysintern0.
(scm_sysintern_no_module_lookup): Renamed to
scm_sysintern0_no_module_lookup and doesn't take a second value
argument any longer.

* symbols.h (scm_sysintern0: Added declaration.

* options.c (scm_init_opts): Use scm_sysintern0 instead of
scm_sysintern when interning option keys.  Otherwise we risk
destroying the values of already interned variables.

* symbols.c (scm_sym2vcell): Bugfix: Treat definedp as
scheme-level boolean (use SCM_NFALSEP).

* backtrace.c (scm_init_backtrace): Make Scheme-level variable
`the-last-stack'.
(scm_backtrace): New function. (C version of old function from
boot-9.scm) Motivation: Make it possible to display backtraces
without depending on boot-9.scm.  (I'm uncertain if this
motivation is good enough...)

* root.h (scm_root_state): Add member the_last_stack_var.
(scm_the_stack_var): Defined to scm_root->the_last_stack_var.

* root.c (mark_root): Mark scm_the_last_stack_var.

* init.c (scm_start_stack): Initialize scm_the_last_stack_var to
SCM_BOOL_F.

libguile/ChangeLog

@@ -1,3 +1,36 @@
+Mon Feb 10 00:08:08 1997  Mikael Djurfeldt  <mdj@kenneth>
+
+	* symbols.c (scm_sysintern0): New function.  Contains the core of
+ 	old scm_sysintern but doesn't take a second value argument.
+	(scm_sysintern): Now uses scm_sysintern0.
+	(scm_sysintern_no_module_lookup): Renamed to
+ 	scm_sysintern0_no_module_lookup and doesn't take a second value
+ 	argument any longer.
+
+	* symbols.h (scm_sysintern0: Added declaration.
+	
+	* options.c (scm_init_opts): Use scm_sysintern0 instead of
+ 	scm_sysintern when interning option keys.  Otherwise we risk
+ 	destroying the values of already interned variables.
+
+	* symbols.c (scm_sym2vcell): Bugfix: Treat definedp as
+	scheme-level boolean (use SCM_NFALSEP).
+
+	* backtrace.c (scm_init_backtrace): Make Scheme-level variable
+ 	`the-last-stack'.
+	(scm_backtrace): New function. (C version of old function from
+ 	boot-9.scm) Motivation: Make it possible to display backtraces
+ 	without depending on boot-9.scm.  (I'm uncertain if this
+ 	motivation is good enough...)
+
+	* root.h (scm_root_state): Add member the_last_stack_var.
+	(scm_the_stack_var): Defined to scm_root->the_last_stack_var.
+
+	* root.c (mark_root): Mark scm_the_last_stack_var.
+
+	* init.c (scm_start_stack): Initialize scm_the_last_stack_var to
+ 	SCM_BOOL_F.
+
 Sun Feb  9 18:04:41 1997  Mikael Djurfeldt  <mdj@kenneth>
 
 	* throw.c (mark_lazy_catch, free_lazy_catch): Removed.

libguile/backtrace.c

@@ -427,10 +427,45 @@ scm_display_backtrace (stack, port, first, depth)
   return SCM_UNSPECIFIED;
 }
 
+SCM_GLOBAL (scm_has_shown_backtrace_hint_p_var, "has-shown-backtrace-hint?");
+
+SCM_PROC(s_backtrace, "backtrace", 0, 0, 0, scm_backtrace);
+SCM
+scm_backtrace ()
+{
+  if (SCM_NFALSEP (SCM_CDR (scm_the_last_stack_var)))
+    {
+      scm_newline (scm_cur_outp);
+      scm_display_backtrace (SCM_CDR (scm_the_last_stack_var),
+			     scm_cur_outp,
+			     SCM_UNDEFINED,
+			     SCM_UNDEFINED);
+      scm_newline (scm_cur_outp);
+      if (SCM_FALSEP (SCM_CDR (scm_has_shown_backtrace_hint_p_var))
+	  && !SCM_BACKTRACE_P)
+	{
+	  scm_gen_puts (scm_regular_string,
+			"Type \"(debug-enable 'backtrace)\" if you would like a backtrace
+automatically if an error occurs in the future.\n",
+			scm_cur_outp);
+	  SCM_SETCDR (scm_has_shown_backtrace_hint_p_var, SCM_BOOL_T);
+	}
+    }
+  else
+    {
+      scm_gen_puts (scm_regular_string,
+		    "No backtrace available.\n",
+		    scm_cur_outp);
+    }
+  return SCM_UNSPECIFIED;
+}
+
 
 
 void
 scm_init_backtrace ()
 {
+  scm_the_last_stack_var = scm_sysintern ("the-last-stack", SCM_BOOL_F);
+
 #include "backtrace.x"
 }

libguile/init.c

@@ -138,6 +138,8 @@ scm_start_stack (base)
   scm_top_level_lookup_closure_var = SCM_BOOL_F;
   scm_system_transformer = SCM_BOOL_F;
 
+  scm_the_last_stack_var = SCM_BOOL_F;
+  
   /* Create an object to hold the root continuation.
    */
   SCM_NEWCELL (scm_rootcont);

libguile/options.c

@@ -211,8 +211,7 @@ scm_init_opts (func, options, n)
 
   for (i = 0; i < n; ++i)
     {
-      options[i].name =	(char *) SCM_CAR (scm_sysintern (options[i].name,
-							 SCM_UNDEFINED));
+      options[i].name =	(char *) SCM_CAR (scm_sysintern0 (options[i].name));
       options[i].doc = (char *) scm_permanent_object (scm_take0str
 						      (options[i].doc));
     }

libguile/root.c

@@ -85,6 +85,7 @@ mark_root (root)
   scm_gc_mark (s->def_errp);
   scm_gc_mark (s->top_level_lookup_closure_var);
   scm_gc_mark (s->system_transformer);
+  scm_gc_mark (s->the_last_stack_var);
   return SCM_ROOT_STATE (root) -> parent;
 }
 

libguile/root.h

@@ -112,6 +112,8 @@ typedef struct scm_root_state
   SCM system_transformer;
   SCM top_level_lookup_closure_var;
 
+  SCM the_last_stack_var;
+
   SCM handle;			/* The root object for this root state */
   SCM parent;			/* The parent root object */
 } scm_root_state;
@@ -138,7 +140,8 @@ typedef struct scm_root_state
 #define scm_top_level_lookup_closure_var \
                                        (scm_root->top_level_lookup_closure_var)
 #define scm_system_transformer		(scm_root->system_transformer)
-
+#define scm_the_last_stack_var		(scm_root->the_last_stack_var)
+     
 #ifdef USE_THREADS
 #define scm_root ((scm_root_state *) SCM_THREAD_LOCAL_DATA)
 #define scm_set_root(new_root) SCM_SET_THREAD_LOCAL_DATA (new_root)

libguile/symbols.c

@@ -144,7 +144,7 @@ scm_sym2vcell (sym, thunk, definep)
 	  z = SCM_CAR (lsym);
 	  if (SCM_CAR (z) == sym)
 	    {
-	      if (definep)
+	      if (SCM_NFALSEP (definep))
 		{
 		  /* Move handle from scm_weak_symhash to scm_symhash. */
 		  *lsymp = SCM_CDR (lsym);
@@ -356,19 +356,16 @@ scm_intern0 (name)
 }
 
 
-/* Intern the symbol named NAME in scm_symhash, and give it the value VAL.
-   NAME is null-terminated.  */
+/* Intern the symbol named NAME in scm_symhash, NAME is null-terminated.  */
 SCM 
-scm_sysintern_no_module_lookup (name, val)
+scm_sysintern0_no_module_lookup (name)
      char *name;
-     SCM val;
 {
   SCM easy_answer;
   SCM_DEFER_INTS;
   easy_answer = scm_intern_obarray_soft (name, strlen (name), scm_symhash, 1);
   if (SCM_NIMP (easy_answer))
     {
-      SCM_SETCDR (easy_answer, val);
       SCM_ALLOW_INTS;
       return easy_answer;
     }
@@ -381,7 +378,7 @@ scm_sysintern_no_module_lookup (name, val)
       SCM_NEWCELL (lsym);
       SCM_SETLENGTH (lsym, (long) len, scm_tc7_ssymbol);
       SCM_SETCHARS (lsym, name);
-      lsym = scm_cons (lsym, val);
+      lsym = scm_cons (lsym, SCM_UNDEFINED);
       SCM_VELTS (scm_symhash)[scm_hash] = scm_cons (lsym, SCM_VELTS (scm_symhash)[scm_hash]);
       SCM_ALLOW_INTS;
       return lsym;
@@ -401,6 +398,15 @@ SCM
 scm_sysintern (name, val)
      char *name;
      SCM val;
+{
+  SCM vcell = scm_sysintern0 (name);
+  SCM_SETCDR (vcell, val);
+  return vcell;
+}
+
+SCM
+scm_sysintern0 (name)
+     char *name;
 {
   SCM lookup_proc;
   if (scm_can_use_top_level_lookup_closure_var && 
@@ -410,11 +416,10 @@ scm_sysintern (name, val)
       SCM vcell = scm_sym2vcell (sym, lookup_proc, SCM_BOOL_T);
       if (vcell == SCM_BOOL_F)
 	  scm_misc_error ("sysintern", "can't define variable", sym);
-      SCM_SETCDR (vcell, val);
       return vcell;
     }
   else
-    return scm_sysintern_no_module_lookup (name, val);
+    return scm_sysintern0_no_module_lookup (name);
 }
 
 SCM_PROC(s_symbol_p, "symbol?", 1, 0, 0, scm_symbol_p);

libguile/symbols.h

@@ -112,6 +112,7 @@ extern SCM scm_intern_obarray SCM_P ((char *name, scm_sizet len, SCM obarray));
 extern SCM scm_intern SCM_P ((char *name, scm_sizet len));
 extern SCM scm_intern0 SCM_P ((char * name));
 extern SCM scm_sysintern SCM_P ((char *name, SCM val));
+extern SCM scm_sysintern0 SCM_P ((char *name));
 extern SCM scm_symbol_p SCM_P ((SCM x));
 extern SCM scm_symbol_to_string SCM_P ((SCM s));
 extern SCM scm_string_to_symbol SCM_P ((SCM s));