#label nodes are now reported in compiled stack traces

diff --git a/TODO.txt b/TODO.txt
index 07432dffaa201806c68b030fc047f8cbf8956293..6c0e9b85c0e0e2ab5c6ebe1bc68070af5ad64886 100644 (file)
--- a/TODO.txt
+++ b/TODO.txt
@@ -27,8 +27,7 @@
 - inspector where slot values can be changed
 - compiled call traces:
   - should be independent of whenever the runtime was built with
-    -fomit-frame-pointer or not
-  - doesn't show #labels
+    -fomit-frame-pointer or not (ppc and amd64)
   - we don't know if signal handlers run with the same stack or not
 - use crc32 instead of modification date in reload-modules
 - models: don't do redundant work

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 5049739043733a57eeb6fe335b5f10dd9ee4a398..f63cbeb7c61238d42dc3c6f7e7673e86241dd20b 100644 (file)
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -206,6 +206,7 @@ call
     { "become" "kernel-internals"           }
     { "array>vector" "vectors"              }
     { "<string>" "strings"                  }
+    { "xt-map" "kernel-internals"           }
 } dup length 3 swap [ + ] map-with [ make-primitive ] 2each
 
 FORGET: make-primitive

diff --git a/core/compiler/generator/generator.factor b/core/compiler/generator/generator.factor
index 66d9da93ad53981b9aa1b35a1804d362de4e8177..70063b148ec02f3096383363018022a9faff7997 100644 (file)
--- a/core/compiler/generator/generator.factor
+++ b/core/compiler/generator/generator.factor
@@ -39,17 +39,20 @@ UNION: #terminal
 : generate-code ( node quot -- )
     over stack-reserve %prologue call ; inline
 
-: init-generator ( -- )
+: init-generator ( word -- )
+    #! The first entry in the literal table is the word itself,
+    #! this is for compiled call traces
     V{ } clone relocation-table set
     V{ } clone literal-table set
     V{ } clone label-table set 
-    V{ } clone word-table set ;
+    V{ } clone word-table set
+    literal-table get push ;
 
 : generate-1 ( word node quot -- )
     #! Generate the code, then dump three vectors to pass to
     #! add-compiled-block.
     pick f save-xt [
-        init-generator
+        pick init-generator
         init-templates
         generate-code
         generate-labels

diff --git a/core/compiler/inference/known-words.factor b/core/compiler/inference/known-words.factor
index fcc351da03f9103211b993e5d4df3e2e6d8fd3bc..b815913a520bd627b7b85755f834f8e501c6f383 100644 (file)
--- a/core/compiler/inference/known-words.factor
+++ b/core/compiler/inference/known-words.factor
@@ -362,6 +362,8 @@ t over set-effect-terminated?
 
 \ <quotation> { integer } { quotation } <effect> "inferred-effect" set-word-prop
 
+\ xt-map { } { array } <effect> "inferred-effect" set-word-prop
+
 ! Dynamic scope inference
 : if-tos-literal ( quot -- )
     peek-d dup value? [ value-literal swap call ] [ 2drop ] if ;

diff --git a/core/compiler/inference/words.factor b/core/compiler/inference/words.factor
index 1aee57160656a6c5ae4906b4ecd04ec7fed530c5..ff5a050ebc60b22a229a11ad7cf384bf554a4b2f 100644 (file)
--- a/core/compiler/inference/words.factor
+++ b/core/compiler/inference/words.factor
@@ -48,10 +48,13 @@ TUPLE: no-effect word ;
 : add-recursive-state ( word label -- )
     2array recursive-state [ swap add ] change ;
 
+: block-label ( word -- newword )
+    word-name " - inlined" append f <word> ;
+
 : inline-block ( word -- node-block data )
     [
         copy-inference nest-node
-        gensym 2dup add-recursive-state
+        dup block-label 2dup add-recursive-state
         #label >r word-def infer-quot r>
         unnest-node
     ] make-hash ;

diff --git a/core/debugger.factor b/core/debugger.factor
index 843c493ac9a396f14265fed5e42a2d60eeea46f6..c8ce092dd2e643ca81d9aaff1b7eb9189950cb9d 100644 (file)
--- a/core/debugger.factor
+++ b/core/debugger.factor
@@ -20,22 +20,11 @@ IN: kernel-internals
     [ error-handler ] 5 setenv
     \ kernel-error 12 setenv ;
 
-: code-heap-start 17 getenv ;
-: code-heap-end 18 getenv ;
-
-: <xt-map> ( -- xtmap )
-    [
-        f code-heap-start 2array ,
-           all-words [ compiled? ] subset
-           [ dup word-xt 2array , ] each
-        f  code-heap-end 2array ,
-    ] { } make sort-values ;
-
 : find-xt ( xt xtmap -- word )
     [ second - ] binsearch* first ;
 
 : symbolic-stack-trace ( seq -- seq )
-    <xt-map> swap [ dup pick find-xt 2array ] map nip ;
+    xt-map 2 group swap [ dup rot find-xt 2array ] map-with ;
 
 IN: errors
 
@@ -61,15 +50,11 @@ M: string error. print ;
 
 : word-xt. ( xt word -- )
     "Compiled: " write dup pprint bl
-    "(offset " write word-xt - >hex write ")" write ;
-
-: bare-xt. ( xt -- )
-    "C code: " write xt. ;
+    "(offset " write word-xt - >hex write ")" print ;
 
 : :trace
-    error-stack-trace get symbolic-stack-trace <reversed> [
-        first2 [ word-xt. ] [ bare-xt. ] if* terpri
-    ] each ;
+    error-stack-trace get symbolic-stack-trace <reversed>
+    [ first2 word-xt. ] each ;
 
 : :c ( -- )
     error-continuation get continuation-call callstack. :trace ;

diff --git a/vm/compiler.c b/vm/compiler.c
index b8f3366499a8c17b63ff8bcb48beaae854d4cca2..06fbbba1d99f8f3aed753d5d1b10b34e61307f67 100644 (file)
--- a/vm/compiler.c
+++ b/vm/compiler.c
@@ -292,3 +292,34 @@ void primitive_finalize_compile(void)
                iterate_code_heap_step(xt_to_compiled(xt),finalize_code_block);
        }
 }
+
+void primitive_xt_map(void)
+{
+       GROWABLE_ARRAY(array);
+       F_BLOCK *scan = (F_BLOCK *)compiling.base;
+
+       while(scan)
+       {
+               if(scan->status != B_FREE)
+               {
+                       F_COMPILED *compiled = (F_COMPILED *)(scan + 1);
+                       CELL code_start = (CELL)(compiled + 1);
+                       CELL literal_start = code_start
+                               + compiled->code_length
+                               + compiled->reloc_length;
+
+                       CELL word = get_literal(literal_start,0);
+                       GROWABLE_ADD(array,word);
+                       REGISTER_ARRAY(array);
+                       CELL xt = allot_cell(code_start);
+                       UNREGISTER_ARRAY(array);
+                       GROWABLE_ADD(array,xt);
+               }
+
+               scan = next_block(&compiling,scan);
+       }
+
+       GROWABLE_TRIM(array);
+
+       dpush(tag_object(array));
+}

diff --git a/vm/compiler.h b/vm/compiler.h
index b794266bd6e96202ff7d5d118f99e87078b8eb34..5fc6b946a5173bd6373d4a6efc08c8563b79b6a8 100644 (file)
--- a/vm/compiler.h
+++ b/vm/compiler.h
@@ -42,3 +42,4 @@ void relocate_code_block(F_COMPILED *relocating, CELL code_start,
        CELL reloc_start, CELL literal_start, CELL words_start, CELL words_end);
 void primitive_add_compiled_block(void);
 void primitive_finalize_compile(void);
+void primitive_xt_map(void);

diff --git a/vm/factor.c b/vm/factor.c
index a66cad08752fa5594575f2f291002f0d0258d461..6a7474dc8f6bd119f96bf4fba98c1ede13c34769 100644 (file)
--- a/vm/factor.c
+++ b/vm/factor.c
@@ -25,8 +25,6 @@ void init_factor(const char* image,
        userenv[GEN_ENV] = tag_fixnum(gen_count);
        userenv[IMAGE_ENV] = tag_object(from_char_string(image));
        userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(CELL));
-       userenv[CODE_HEAP_START_ENV] = allot_cell(compiling.base);
-       userenv[CODE_HEAP_END_ENV] = allot_cell(compiling.limit);
 }
 
 INLINE bool factor_arg(const char* str, const char* arg, CELL* value)

diff --git a/vm/primitives.c b/vm/primitives.c
index 9c09975b123edb8e04491219a60c5fe8d018ab0f..65c5ce5d02e95c0165a02e324e5983fbd4b9770e 100644 (file)
--- a/vm/primitives.c
+++ b/vm/primitives.c
@@ -173,7 +173,8 @@ void* primitives[] = {
        primitive_clone,
        primitive_become,
        primitive_array_to_vector,
-       primitive_string
+       primitive_string,
+       primitive_xt_map
 };
 
 CELL primitive_to_xt(CELL primitive)

diff --git a/vm/run.h b/vm/run.h
index 033c6389afb1a879bb12c2251ca371cbf892fcfd..59f0864572682441dd785a16e7c81c8b03f9d592 100644 (file)
--- a/vm/run.h
+++ b/vm/run.h
@@ -12,24 +12,24 @@ CELL callframe_end;
 
 #define USER_ENV 32
 
-#define CELL_SIZE_ENV       1 /* sizeof(CELL) */
-#define NLX_VECTOR_ENV      2 /* non-local exit hook, used by library only */
-#define NAMESTACK_ENV       3 /* used by library only */
-#define GLOBAL_ENV          4
-#define BREAK_ENV           5
-#define CATCHSTACK_ENV      6 /* used by library only */
-#define CPU_ENV             7
-#define BOOT_ENV            8
-#define CALLCC_1_ENV        9 /* used by library only */
-#define ARGS_ENV            10
-#define OS_ENV              11
-#define ERROR_ENV           12 /* a marker consed onto kernel errors */
-#define IN_ENV              13
-#define OUT_ENV             14
-#define GEN_ENV             15 /* set to gen_count */
-#define IMAGE_ENV           16 /* image name */
-#define CODE_HEAP_START_ENV 17 /* start of code heap, used by :trace */
-#define CODE_HEAP_END_ENV   18 /* end of code heap, used by :trace */
+typedef enum {
+       CELL_SIZE_ENV      = 1, /* sizeof(CELL) */
+       NLX_VECTOR_ENV,         /* non-local exit hook, used by library only */
+       NAMESTACK_ENV,          /* used by library only */
+       GLOBAL_ENV,             
+       BREAK_ENV,              
+       CATCHSTACK_ENV,         /* used by library only */
+       CPU_ENV,                
+       BOOT_ENV,               
+       CALLCC_1_ENV,           /* used by library only */
+       ARGS_ENV,               
+       OS_ENV,                 
+       ERROR_ENV,              /* a marker consed onto kernel errors */
+       IN_ENV,                 
+       OUT_ENV,                
+       GEN_ENV,                /* set to gen_count */
+       IMAGE_ENV               /* image name */
+} F_ENVTYPE;
 
 /* TAGGED user environment data; see getenv/setenv prims */
 DLLEXPORT CELL userenv[USER_ENV];
@@ -151,7 +151,7 @@ void primitive_clone(void);
 /* Runtime errors */
 typedef enum
 {
-       ERROR_EXPIRED,
+       ERROR_EXPIRED = 0,
        ERROR_IO,
        ERROR_UNDEFINED_WORD,
        ERROR_TYPE,