* guile.m4: Revert change of Mar 15, and use the new 'no-define'
[bpt/guile.git] / libguile / gdbint.c
index df8e2c4..4879723 100644 (file)
 
 #include <stdio.h>
 #include "_scm.h"
+#include "tag.h"
+#include "strports.h"
+#include "read.h"
+#include "eval.h"
+#include "chars.h"
 
+#include "gdbint.h"
 \f
 /* {Support for debugging with gdb}
  *
 { \
   gdb_output = str; \
   gdb_output_length = strlen (str); \
-}
+} \
+
 
 /* {Gdb interface}
  */
@@ -113,31 +120,60 @@ int gdb_output_length;
 int scm_print_carefully_p;
 
 static SCM gdb_input_port;
+static int port_mark_p, stream_mark_p, string_mark_p;
+
+static SCM tok_buf;
+static int tok_buf_mark_p;
+
 static SCM gdb_output_port;
 static int old_ints, old_gc;
 
-#ifdef __STDC__
-int
-gdb_maybe_valid_type_p (SCM value)
-#else
+
+static void unmark_port SCM_P ((SCM port));
+
+static void
+unmark_port (port)
+     SCM port;
+{
+  SCM stream, string;
+  port_mark_p = SCM_GC8MARKP (port);
+  SCM_CLRGC8MARK (port);
+  stream = SCM_STREAM (port);
+  stream_mark_p = SCM_GCMARKP (stream);
+  SCM_CLRGCMARK (stream);
+  string = SCM_CDR (stream);
+  string_mark_p = SCM_GC8MARKP (string);
+  SCM_CLRGC8MARK (string);
+}
+
+
+static void remark_port SCM_P ((SCM port));
+
+static void
+remark_port (port)
+     SCM port;
+{
+  SCM stream = SCM_STREAM (port);
+  SCM string = SCM_CDR (stream);
+  if (string_mark_p) SCM_SETGC8MARK (string);
+  if (stream_mark_p) SCM_SETGCMARK (stream);
+  if (port_mark_p) SCM_SETGC8MARK (port);
+}
+
+
 int
 gdb_maybe_valid_type_p (value)
      SCM value;
-#endif
 {
   if (SCM_IMP (value) || scm_cellp (value))
     return scm_tag (value) != SCM_MAKINUM (-1);
   return 0;
 }
 
-#ifdef __STDC__
-int
-gdb_read (char *str)
-#else
+
 int
 gdb_read (str)
      char *str;
-#endif
 {
   SCM ans;
   int status = 0;
@@ -170,37 +206,41 @@ gdb_read (str)
          }
     }
   SCM_BEGIN_FOREIGN_BLOCK;
+  unmark_port (gdb_input_port);
   /* Replace string in input port and reset stream */
   ans = SCM_CDR (SCM_STREAM (gdb_input_port));
   SCM_SETCHARS (ans, str);
   SCM_SETLENGTH (ans, strlen (str), scm_tc7_string);
   SCM_SETCAR (SCM_STREAM (gdb_input_port), SCM_INUM0);
   /* Read one object */
-  ans = scm_read (gdb_input_port, SCM_UNDEFINED, SCM_UNDEFINED);
+  tok_buf_mark_p = SCM_GC8MARKP (tok_buf);
+  SCM_CLRGC8MARK (tok_buf);
+  ans = scm_lreadr (&tok_buf, gdb_input_port, &ans);
   if (SCM_GC_P)
     {
-      if (!SCM_IMP (ans))
+      if (SCM_NIMP (ans))
        {
          SEND_STRING ("Non-immediate created during gc.  Memory may be trashed.");
          status = -1;
          goto exit;
        }
     }
+  gdb_result = ans;
   /* Protect answer from future GC */
-  gdb_result = scm_permanent_object (ans);;
+  if (SCM_NIMP (ans))
+    scm_permanent_object (ans);
 exit:
+  if (tok_buf_mark_p)
+    SCM_SETGC8MARK (tok_buf);
+  remark_port (gdb_input_port);
   SCM_END_FOREIGN_BLOCK;
   return status;
 }
 
-#ifdef __STDC__
-int
-gdb_eval (SCM exp)
-#else
+
 int
 gdb_eval (exp)
      SCM exp;
-#endif
 {
   RESET_STRING;
   if (SCM_IMP (exp))
@@ -215,21 +255,17 @@ gdb_eval (exp)
     }
   SCM_BEGIN_FOREIGN_BLOCK;
   {
-    SCM env = scm_top_level_env (SCM_CDR (scm_top_level_lookup_thunk_var));
+    SCM env = scm_top_level_env (SCM_CDR (scm_top_level_lookup_closure_var));
     gdb_result = scm_permanent_object (scm_ceval (exp, env));
   }
   SCM_END_FOREIGN_BLOCK;
   return 0;
 }
 
-#ifdef __STDC__
-int
-gdb_print (SCM obj)
-#else
+
 int
 gdb_print (obj)
      SCM obj;
-#endif
 {
   RESET_STRING;
   SCM_BEGIN_FOREIGN_BLOCK;
@@ -242,15 +278,11 @@ gdb_print (obj)
   return 0;
 }
 
-#ifdef __STDC__
-int
-gdb_binding (SCM name, SCM value)
-#else
+
 int
 gdb_binding (name, value)
      SCM name;
      SCM value;
-#endif
 {
   RESET_STRING;
   if (SCM_GC_P)
@@ -261,7 +293,7 @@ gdb_binding (name, value)
   SCM_BEGIN_FOREIGN_BLOCK;
   {
     SCM vcell = scm_sym2vcell (name,
-                              SCM_CDR (scm_top_level_lookup_thunk_var),
+                              SCM_CDR (scm_top_level_lookup_closure_var),
                               SCM_BOOL_T);
     SCM_SETCDR (vcell, value);
   }
@@ -288,4 +320,6 @@ scm_init_gdbint ()
                        SCM_OPN | SCM_RDNG,
                        s);
   gdb_input_port = scm_permanent_object (port);
+
+  tok_buf = scm_permanent_object (scm_makstr (30L, 0));
 }