Line number and source file names in stack trace, part 2
Here is the context diff:
*** STk-4.0.1/Lib/error.stk 1999/12/22 21:24:52 1.1
--- STk-4.0.1/Lib/error.stk 1999/12/23 04:51:15
***************
*** 142,148 ****
:side "bottom" :fill "x")
(pack (listbox '.stackview.f.env
! :width 18
:height 10
:font '(Courier -12)
:bd 1
--- 142,148 ----
:side "bottom" :fill "x")
(pack (listbox '.stackview.f.env
! :width 28
:height 10
:font '(Courier -12)
:bd 1
***************
*** 150,156 ****
:expand #f :fill "y" :side "left")
(pack (listbox '.stackview.f.list
! :width 70
:height 10
:font '(Courier -12)
:bd 1
--- 150,156 ----
:expand #f :fill "y" :side "left")
(pack (listbox '.stackview.f.list
! :width 60
:height 10
:font '(Courier -12)
:bd 1
***************
*** 172,181 ****
(.stackview.f.list 'insert 'end
(truncate (format #f "~S" (uncode(car stack))) 150))
(.stackview.f.env 'insert 'end
! (format #f "~A"
! (if (equal? (car env) (global-environment))
! "*global*"
! (address-of (car env))))))
;; Insert a marker to delimit bottom of the stack
(.stackview.f.list 'insert 'end "<<< STACK BOTTOM >>>")
--- 172,182 ----
(.stackview.f.list 'insert 'end
(truncate (format #f "~S" (uncode(car stack))) 150))
(.stackview.f.env 'insert 'end
! (if (equal? (car env) (global-environment))
! "*global*"
! (format #f "File: ~A Line: ~A"
! (source-file-of (car stack))
! (source-line-of (car stack))))))
;; Insert a marker to delimit bottom of the stack
(.stackview.f.list 'insert 'end "<<< STACK BOTTOM >>>")
*** STk-4.0.1/Src/eval.c 1999/12/22 20:11:48 1.1
--- STk-4.0.1/Src/eval.c 1999/12/23 04:28:31
***************
*** 120,125 ****
--- 120,140 ----
/*
+ Scheme debugging information. [add-dbg]
+ Unlike STk_show_eval_stack() below, these functions receive a stack
+ created by STk_user_get_eval_stack().
+ */
+ SCM STk_source_line_of(SCM x) {
+ return STk_makeinteger((long)(x->source_line));
+ }
+
+ SCM STk_source_file_of(SCM x) {
+ return (x->source_filename);
+ }
+
+
+
+ /*
* Eval stack
*
* The eval stack is a stack of the arguments passed to eval. This stack permits
***************
*** 130,136 ****
* will be marked as are all the objects which are in the C stack
* */
! static struct Stack_info {
SCM expr, env;
struct Stack_info *previous;
} *stack = NULL;
--- 145,151 ----
* will be marked as are all the objects which are in the C stack
* */
! static struct Stack_info {
SCM expr, env;
struct Stack_info *previous;
} *stack = NULL;
***************
*** 140,148 ****
int j;
struct Stack_info *p;
! Fprintf(STk_curr_eport, "\nCurrent eval stack:\n__________________\n");
for (p=stack, j=0; p && j<=depth ; p=p->previous, j++) {
! Fprintf(STk_curr_eport, "%3d ", j);
/* if !uncode we are in panic mode (i.e. don't allocate during printing) */
if (uncode)
STk_print(STk_uncode(p->expr), STk_curr_eport, WRT_MODE);
--- 155,184 ----
int j;
struct Stack_info *p;
! Fprintf(STk_curr_eport, "\nCurrent eval stack:\n"
! "%5s %6s %-20s %s\n"
! "__________________________________________________\n",
! "Stack", "Line", "File Name", "Expression"
! );
!
for (p=stack, j=0; p && j<=depth ; p=p->previous, j++) {
! Fprintf(STk_curr_eport, "%5d ", j);
! /* [add-dbg] */
! {
! SCM fn = p->expr->source_filename;
! if (NNULLP(fn)) {
! Fprintf(STk_curr_eport, "%6u ", p->expr->source_line);
! if (TYPE(fn) == tc_string) {
! char *s = CHARS(fn);
! Fprintf(STk_curr_eport, "%-20s ", s);
! }
! else
! Fprintf(STk_curr_eport, "%20s ", "");
! }
! else
! Fprintf(STk_curr_eport, " %26s", "");
! };
!
/* if !uncode we are in panic mode (i.e. don't allocate during printing) */
if (uncode)
STk_print(STk_uncode(p->expr), STk_curr_eport, WRT_MODE);
*** STk-4.0.1/Src/gc.c 1999/12/22 20:29:12 1.1
--- STk-4.0.1/Src/gc.c 1999/12/23 01:51:11
***************
*** 101,106 ****
--- 101,110 ----
ptr->type = tc_free_cell;
ptr->cell_info = 0;
ptr->gc_mark = 0;
+ /* [add-dbg] */
+ ptr->source_line = 0;
+ ptr->source_filename = NIL;
+
CDR(ptr) = (next < heap_end) ? next : STk_freelist;
}
STk_freelist = heap_org;
*** STk-4.0.1/Src/list.c 1999/12/22 19:53:20 1.1
--- STk-4.0.1/Src/list.c 1999/12/23 01:51:11
***************
*** 36,41 ****
--- 36,52 ----
return z;
}
+ PRIMITIVE dbg_STk_cons(SCM file, unsigned int line, SCM x, SCM y) /* [add-dbg] */
+ {
+ SCM z;
+ NEWCELL(z,tc_cons);
+ CAR(z) = x;
+ CDR(z) = y;
+ SOURCE_LINE(z) = line;
+ SOURCE_FILE(z) = file;
+ return z;
+ }
+
PRIMITIVE STk_car(SCM x)
{
if (TYPEP(x, tc_cons)) return CAR(x);
*** STk-4.0.1/Src/primitives.c 1999/12/23 00:34:29 1.1
--- STk-4.0.1/Src/primitives.c 1999/12/23 01:51:12
***************
*** 465,470 ****
--- 465,474 ----
{"c-string->string", tc_subr_1, STk_cstring2string}, /* + */
/**** Section 6.24 (Misc) ****/
+ /* [add-dbg] */
+ {"source-line-of", tc_subr_1, STk_source_line_of},
+ {"source-file-of", tc_subr_1, STk_source_file_of},
+
{"eval-string", tc_subr_1_or_2, STk_eval_string}, /* + */
{"gc", tc_subr_0, STk_gc}, /* + */
{"gc-stats", tc_subr_0, STk_gc_stats}, /* + */
*** STk-4.0.1/Src/read.c 1999/12/22 19:40:03 1.1
--- STk-4.0.1/Src/read.c 1999/12/23 01:51:13
***************
*** 52,63 ****
static SCM read_list(SCM port, char delim, int case_significant)
/* Read a list ended by the `delim' char */
{
! int c;
SCM tmp;
c = flush_ws(port, "End of file inside list");
if (c == delim) return(NIL);
/* Read the car */
Ungetc(c, port);
tmp = read_rec(port, case_significant);
--- 52,67 ----
static SCM read_list(SCM port, char delim, int case_significant)
/* Read a list ended by the `delim' char */
{
! int c, dbg_line;
SCM tmp;
+ SCM dbg_file;
c = flush_ws(port, "End of file inside list");
if (c == delim) return(NIL);
+ dbg_line = STk_line_counter;
+ dbg_file = STk_current_filename;
+
/* Read the car */
Ungetc(c, port);
tmp = read_rec(port, case_significant);
***************
*** 69,75 ****
if (c != delim) Serror("missing close parenthesis", NIL);
return(tmp);
}
! return(Cons(tmp, read_list(port, delim, case_significant)));
}
static void read_word(SCM port, int c, int case_significant)
--- 73,81 ----
if (c != delim) Serror("missing close parenthesis", NIL);
return(tmp);
}
! /* [add-dbg] */
! return(Dbg_Cons(dbg_file, dbg_line,
! tmp, read_list(port, delim, case_significant)));
}
static void read_word(SCM port, int c, int case_significant)
*** STk-4.0.1/Src/stk.h 1999/12/22 19:22:52 1.1
--- STk-4.0.1/Src/stk.h 1999/12/23 01:51:14
***************
*** 144,150 ****
};
#endif
-
struct obj { /* most alignment constraining type first */
union {struct {struct obj * car; struct obj * cdr;} cons;
struct {double data;} flonum;
--- 144,149 ----
***************
*** 177,182 ****
--- 176,184 ----
unsigned char type;
unsigned char gc_mark;
short cell_info;
+
+ unsigned int source_line; /* [add-dbg] Scheme debugging information. */
+ struct obj *source_filename;
};
***************
*** 262,267 ****
--- 264,272 ----
#define tc_stop_extd 127 /* Number of last extended type */
+ #define SOURCE_LINE(x) ((*x).source_line)
+ #define SOURCE_FILE(x) ((*x).source_filename) /* [add-dbg] */
+
#define CAR(x) ((*x).storage_as.cons.car)
#define CDR(x) ((*x).storage_as.cons.cdr)
#define PNAME(x) ((*x).storage_as.symbol.pname)
***************
*** 679,684 ****
--- 684,693 ----
PRIMITIVE STk_user_get_eval_stack(void);
+ /* Debug information [add-dbg] */
+ PRIMITIVE STk_source_line_of(SCM x);
+ PRIMITIVE STk_source_file_of(SCM x);
+
/* Eval hook management */
void STk_init_eval_hook(void);
void STk_reset_eval_hook(void);
***************
*** 848,853 ****
--- 857,863 ----
PRIMITIVE STk_pairp(SCM x);
PRIMITIVE STk_cons(SCM x, SCM y);
+ PRIMITIVE Dbg_STk_cons(SCM x, SCM y); /* [add-dbg] */
PRIMITIVE STk_car(SCM x);
PRIMITIVE STk_cdr(SCM x);
PRIMITIVE STk_setcar(SCM cell, SCM value);
***************
*** 905,910 ****
--- 915,921 ----
#define Cons STk_cons
+ #define Dbg_Cons dbg_STk_cons
#define Reverse STk_reverse
#define LIST1(a) Cons((a), NIL)
#define LIST2(a,b) Cons((a), LIST1(b))
Received on Thu Dec 23 1999 - 07:53:14 CET
This archive was generated by hypermail 2.3.0
: Mon Jul 21 2014 - 19:38:59 CEST