Back to index

plt-scheme  4.2.1
backtrace.c
Go to the documentation of this file.
00001 /* 
00002    Provides:
00003       reset_object_traces
00004       register_traced_object
00005       print_traced_objects
00006       print_out_pointer
00007    Requires:
00008       avoid_collection
00009       trace_page_t
00010       find_page 
00011       trace_page_type
00012        TRACE_PAGE_TAGGED
00013        TRACE_PAGE_ARRAY
00014        TRACE_PAGE_TAGGED_ARRAY
00015        TRACE_PAGE_ATOMIC
00016        TRACE_PAGE_XTAGGED
00017        TRACE_PAGE_MALLOCFREE
00018        TRACE_PAGE_BAD
00019       trace_page_is_big
00020       trace_backpointer
00021 */
00022 
00023 
00024 # define MAX_FOUND_OBJECTS 5000
00025 static int found_object_count;
00026 static void *found_objects[MAX_FOUND_OBJECTS];
00027 
00028 static void reset_object_traces()
00029 {
00030   found_object_count = 0;
00031 }
00032 
00033 static void register_traced_object(void *p)
00034 {
00035   if (found_object_count < MAX_FOUND_OBJECTS) {
00036     found_objects[found_object_count++] = p;
00037   }
00038 }
00039 
00040 static void *print_out_pointer(const char *prefix, void *p,
00041                             GC_get_type_name_proc get_type_name,
00042                             GC_get_xtagged_name_proc get_xtagged_name,
00043                             GC_print_tagged_value_proc print_tagged_value)
00044 {
00045   trace_page_t *page;
00046   const char *what;
00047 
00048   page = pagemap_find_page(GC->page_maps, p);
00049   if (!page || (trace_page_type(page) == TRACE_PAGE_BAD)) {
00050     GCPRINT(GCOUTF, "%s??? %p\n", prefix, p);
00051     return NULL;
00052   }
00053   p = trace_pointer_start(page, p);
00054 
00055   if (trace_page_type(page) == TRACE_PAGE_TAGGED) {
00056     Type_Tag tag;
00057     tag = *(Type_Tag *)p;
00058     if ((tag >= 0) && get_type_name && get_type_name(tag)) {
00059       print_tagged_value(prefix, p, 0, 0, 1000, "\n");
00060     } else {
00061       GCPRINT(GCOUTF, "%s<#%d> %p\n", prefix, tag, p);
00062     }
00063     what = NULL;
00064   } else if (trace_page_type(page) == TRACE_PAGE_ARRAY) {
00065     what = "ARRAY";
00066   } else if (trace_page_type(page) == TRACE_PAGE_TAGGED_ARRAY) {
00067     what = "TARRAY";
00068   } else if (trace_page_type(page) == TRACE_PAGE_ATOMIC) {
00069     what = "ATOMIC";
00070   } else if (trace_page_type(page) == TRACE_PAGE_XTAGGED) {
00071     if (get_xtagged_name)
00072       what = get_xtagged_name(p);
00073     else
00074       what = "XTAGGED";
00075   } else if (trace_page_type(page) == TRACE_PAGE_MALLOCFREE) {
00076     what = "MALLOCED";
00077   } else {
00078     what = "?!?";
00079   }
00080 
00081   if (what) {
00082     GCPRINT(GCOUTF, "%s%s%s %p\n", 
00083            prefix, what, 
00084            (trace_page_is_big(page) ? "b" : ""),
00085            p);
00086   }
00087 
00088   return trace_backpointer(page, p);
00089 }
00090 
00091 static void print_traced_objects(int path_length_limit,
00092                              GC_get_type_name_proc get_type_name,
00093                              GC_get_xtagged_name_proc get_xtagged_name,
00094                              GC_print_tagged_value_proc print_tagged_value)
00095 {
00096   int i;
00097   GC->dumping_avoid_collection++;
00098   GCPRINT(GCOUTF, "Begin Trace\n");
00099   for (i = 0; i < found_object_count; i++) {
00100     void *p;
00101     int limit = path_length_limit;
00102     p = found_objects[i];
00103     p = print_out_pointer("==* ", p, get_type_name, get_xtagged_name, print_tagged_value);
00104     while (p && limit) {
00105       p = print_out_pointer(" <- ", p, get_type_name, get_xtagged_name, print_tagged_value);
00106       limit--;
00107     }
00108   }
00109   GCPRINT(GCOUTF, "End Trace\n");
00110   --GC->dumping_avoid_collection;
00111 }