#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}
*/
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;
}
}
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))
}
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;
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)
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);
}
SCM_OPN | SCM_RDNG,
s);
gdb_input_port = scm_permanent_object (port);
+
+ tok_buf = scm_permanent_object (scm_makstr (30L, 0));
}