From b005fd8c0e62a4488e6c51ea4615656f911677fd Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 10 Mar 1993 17:20:04 +0000 Subject: [PATCH] Add new primitive GC-TRACE-REFERENCES which will compute the set of objects that point to a given object. This primitive is implemented only when the compile-time flag ENABLE_GC_DEBUGGING_TOOLS is set. --- v7/src/microcode/fasdump.c | 10 ++++- v7/src/microcode/gccode.h | 79 ++++++++++++++++++++++++++++++-------- v7/src/microcode/gcloop.c | 16 +++++++- v7/src/microcode/memmag.c | 72 +++++++++++++++++++++++++++++++++- v7/src/microcode/purify.c | 10 ++++- 5 files changed, 164 insertions(+), 23 deletions(-) diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c index d232e8ada..dc886959f 100644 --- a/v7/src/microcode/fasdump.c +++ b/v7/src/microcode/fasdump.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: fasdump.c,v 9.54 1993/02/11 02:18:59 adams Exp $ +$Id: fasdump.c,v 9.55 1993/03/10 17:19:29 cph Exp $ -Copyright (c) 1987-1992 Massachusetts Institute of Technology +Copyright (c) 1987-93 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -133,6 +133,9 @@ DEFUN (DumpLoop, (Scan, mode), fast SCHEME_OBJECT * Scan AND int mode) { fast SCHEME_OBJECT *To, *Old, Temp, New_Address, *Fixes; long result; +#ifdef ENABLE_GC_DEBUGGING_TOOLS + SCHEME_OBJECT object_referencing; +#endif To = NewFree; Fixes = Fixup; @@ -140,6 +143,9 @@ DEFUN (DumpLoop, (Scan, mode), fast SCHEME_OBJECT * Scan AND int mode) for ( ; Scan != To; Scan++) { Temp = *Scan; +#ifdef ENABLE_GC_DEBUGGING_TOOLS + object_referencing = Temp; +#endif Switch_by_GC_Type (Temp) { diff --git a/v7/src/microcode/gccode.h b/v7/src/microcode/gccode.h index d3751d9ff..2e902d994 100644 --- a/v7/src/microcode/gccode.h +++ b/v7/src/microcode/gccode.h @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: gccode.h,v 9.46 1992/12/05 03:33:24 cph Exp $ +$Id: gccode.h,v 9.47 1993/03/10 17:19:44 cph Exp $ -Copyright (c) 1987-92 Massachusetts Institute of Technology +Copyright (c) 1987-93 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -250,33 +250,82 @@ do \ /* GC Type handlers. These do the actual work. */ +#ifdef ENABLE_GC_DEBUGGING_TOOLS + +extern SCHEME_OBJECT gc_object_referenced; +extern SCHEME_OBJECT gc_objects_referencing; +extern unsigned long gc_objects_referencing_count; +extern SCHEME_OBJECT * gc_objects_referencing_scan; +extern SCHEME_OBJECT * gc_objects_referencing_end; + +#define TRANSPORT_ONE_THING(transport_code) \ +{ \ + if ((gc_object_referenced == (*Old)) \ + && (gc_objects_referencing != SHARP_F)) \ + { \ + gc_objects_referencing_count += 1; \ + if (gc_objects_referencing_scan != gc_objects_referencing_end) \ + { \ + UPDATE_GC_OBJECTS_REFERENCING (); \ + (*gc_objects_referencing_scan++) = object_referencing; \ + } \ + } \ + transport_code; \ +} + +#define UPDATE_GC_OBJECTS_REFERENCING() \ +{ \ + if (BROKEN_HEART_P (MEMORY_REF (gc_objects_referencing, 0))) \ + { \ + SCHEME_OBJECT new = \ + (MAKE_OBJECT_FROM_OBJECTS \ + (gc_objects_referencing, \ + (MEMORY_REF (gc_objects_referencing, 0)))); \ + gc_objects_referencing_scan = \ + (VECTOR_LOC \ + (new, \ + (gc_objects_referencing_scan \ + - (VECTOR_LOC (gc_objects_referencing, 0))))); \ + gc_objects_referencing_end = \ + (VECTOR_LOC (new, (VECTOR_LENGTH (new)))); \ + gc_objects_referencing = new; \ + } \ +} + +#else + +#define TRANSPORT_ONE_THING(transport_code) transport_code + +#endif + + #define Transport_Cell() \ { \ - (*To++) = (*Old); \ + TRANSPORT_ONE_THING ((*To++) = (*Old)); \ Pointer_End (); \ } #define Transport_Pair() \ { \ - (*To++) = (*Old++); \ - (*To++) = (*Old); \ + TRANSPORT_ONE_THING ((*To++) = (*Old++)); \ + TRANSPORT_ONE_THING ((*To++) = (*Old)); \ Pointer_End (); \ } #define Transport_Triple() \ { \ - (*To++) = (*Old++); \ - (*To++) = (*Old++); \ - (*To++) = (*Old); \ + TRANSPORT_ONE_THING ((*To++) = (*Old++)); \ + TRANSPORT_ONE_THING ((*To++) = (*Old++)); \ + TRANSPORT_ONE_THING ((*To++) = (*Old)); \ Pointer_End (); \ } #define Transport_Quadruple() \ { \ - (*To++) = (*Old++); \ - (*To++) = (*Old++); \ - (*To++) = (*Old++); \ - (*To++) = (*Old); \ + TRANSPORT_ONE_THING ((*To++) = (*Old++)); \ + TRANSPORT_ONE_THING ((*To++) = (*Old++)); \ + TRANSPORT_ONE_THING ((*To++) = (*Old++)); \ + TRANSPORT_ONE_THING ((*To++) = (*Old)); \ Pointer_End (); \ } @@ -336,7 +385,7 @@ do \ } \ CHECK_TRANSPORT_VECTOR_TERMINATION (); \ while (To != Scan) \ - (*To++) = (*Old++); \ + TRANSPORT_ONE_THING ((*To++) = (*Old++)); \ Scan = Saved_Scan; \ } @@ -356,7 +405,7 @@ do \ return (PRIM_INTERRUPT); \ } \ while (To != Scan) \ - (*To++) = (*Old++); \ + TRANSPORT_ONE_THING ((*To++) = (*Old++)); \ Scan = Saved_Scan; \ } @@ -422,7 +471,7 @@ extern SCHEME_OBJECT Weak_Chain; long Car_Type = (OBJECT_TYPE (*Old)); \ (*To++) = (OBJECT_NEW_TYPE (TC_NULL, (*Old))); \ Old += 1; \ - (*To++) = (*Old); \ + TRANSPORT_ONE_THING ((*To++) = (*Old)); \ *Old = (OBJECT_NEW_TYPE (Car_Type, Weak_Chain)); \ Weak_Chain = Temp; \ Pointer_End (); \ diff --git a/v7/src/microcode/gcloop.c b/v7/src/microcode/gcloop.c index d429e8027..62bee7668 100644 --- a/v7/src/microcode/gcloop.c +++ b/v7/src/microcode/gcloop.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gcloop.c,v 9.39 1992/02/18 17:30:10 jinx Exp $ +$Id: gcloop.c,v 9.40 1993/03/10 17:19:52 cph Exp $ -Copyright (c) 1987-1992 Massachusetts Institute of Technology +Copyright (c) 1987-93 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -70,6 +70,12 @@ SCHEME_OBJECT * (gc_scan_history [GC_SCAN_HISTORY_SIZE]), * (gc_to_history [GC_SCAN_HISTORY_SIZE]); +SCHEME_OBJECT gc_object_referenced = SHARP_F; +SCHEME_OBJECT gc_objects_referencing = SHARP_F; +unsigned long gc_objects_referencing_count; +SCHEME_OBJECT * gc_objects_referencing_scan; +SCHEME_OBJECT * gc_objects_referencing_end; + static int gc_scan_history_index; #define INITIALIZE_GC_HISTORY() \ @@ -118,6 +124,9 @@ DEFUN (GCLoop, AND SCHEME_OBJECT ** To_Pointer) { fast SCHEME_OBJECT *To, *Old, Temp, *Low_Constant, New_Address; +#ifdef ENABLE_GC_DEBUGGING_TOOLS + SCHEME_OBJECT object_referencing; +#endif INITIALIZE_GC_HISTORY (); To = *To_Pointer; @@ -125,6 +134,9 @@ DEFUN (GCLoop, for ( ; Scan != To; Scan++) { Temp = *Scan; +#ifdef ENABLE_GC_DEBUGGING_TOOLS + object_referencing = Temp; +#endif HANDLE_GC_TRAP(); Switch_by_GC_Type(Temp) diff --git a/v7/src/microcode/memmag.c b/v7/src/microcode/memmag.c index 0949b75bb..56b5a27d8 100644 --- a/v7/src/microcode/memmag.c +++ b/v7/src/microcode/memmag.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/memmag.c,v 9.47 1992/01/15 03:35:48 jinx Exp $ +$Id: memmag.c,v 9.48 1993/03/10 17:19:58 cph Exp $ -Copyright (c) 1987-92 Massachusetts Institute of Technology +Copyright (c) 1987-93 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -338,6 +338,32 @@ DEFUN_VOID (GC) *Free++ = Current_State_Point; *Free++ = Fluid_Bindings; +#ifdef ENABLE_GC_DEBUGGING_TOOLS + if (gc_objects_referencing != SHARP_F) + { + MEMORY_SET + (gc_objects_referencing, 0, + (MAKE_OBJECT + (TC_MANIFEST_NM_VECTOR, + (OBJECT_DATUM (MEMORY_REF (gc_objects_referencing, 0)))))); + { + SCHEME_OBJECT * scan = (VECTOR_LOC (gc_objects_referencing, 0)); + SCHEME_OBJECT * end = + (VECTOR_LOC (gc_objects_referencing, + (VECTOR_LENGTH (gc_objects_referencing)))); + while (scan < end) + (*scan++) = SHARP_F; + } + *Free++ = gc_objects_referencing; + gc_objects_referencing_count = 0; + gc_objects_referencing_scan = + (VECTOR_LOC (gc_objects_referencing, 1)); + gc_objects_referencing_end = + (VECTOR_LOC (gc_objects_referencing, + (VECTOR_LENGTH (gc_objects_referencing)))); + } +#endif + /* The 4 step GC */ Result = (GCLoop (Constant_Space, &Free)); @@ -363,6 +389,29 @@ DEFUN_VOID (GC) Microcode_Termination (TERM_BROKEN_HEART); } +#ifdef ENABLE_GC_DEBUGGING_TOOLS + if (gc_objects_referencing != SHARP_F) + { + UPDATE_GC_OBJECTS_REFERENCING (); + MEMORY_SET + (gc_objects_referencing, 0, + (MAKE_OBJECT + (TC_MANIFEST_VECTOR, + (OBJECT_DATUM (MEMORY_REF (gc_objects_referencing, 0)))))); + VECTOR_SET (gc_objects_referencing, 0, + (LONG_TO_UNSIGNED_FIXNUM (gc_objects_referencing_count))); + { + SCHEME_OBJECT * end = gc_objects_referencing_scan; + Result = (GCLoop ((VECTOR_LOC (gc_objects_referencing, 1)), (&end))); + if ((end != Result) || (end != gc_objects_referencing_scan)) + { + fprintf (stderr, "\nGC-3: Heap Scan ended too early.\n"); + Microcode_Termination (TERM_BROKEN_HEART); + } + } + } +#endif + Fix_Weak_Chain (); /* Make the microcode registers point to the copies in new-space. */ @@ -455,3 +504,22 @@ DEFINE_PRIMITIVE ("GARBAGE-COLLECT", Prim_garbage_collect, 1, 1, 0) /* The following comment is by courtesy of LINT, your friendly sponsor. */ /*NOTREACHED*/ } + +DEFINE_PRIMITIVE ("GC-TRACE-REFERENCES", Prim_gc_trace_references, 2, 2, 0) +{ + PRIMITIVE_HEADER (2); + { + SCHEME_OBJECT objects_referencing = (ARG_REF (2)); + if (! ((objects_referencing == SHARP_F) + || ((VECTOR_P (objects_referencing)) + && ((VECTOR_LENGTH (objects_referencing)) >= 1)))) + error_wrong_type_arg (2); +#ifdef ENABLE_GC_DEBUGGING_TOOLS + gc_object_referenced = (ARG_REF (1)); + gc_objects_referencing = objects_referencing; +#else /* not ENABLE_GC_DEBUGGING_TOOLS */ + error_external_return (); +#endif /* not ENABLE_GC_DEBUGGING_TOOLS */ + } + PRIMITIVE_RETURN (UNSPECIFIC); +} diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c index 1eaed08f2..fac805ce2 100644 --- a/v7/src/microcode/purify.c +++ b/v7/src/microcode/purify.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.47 1992/02/18 17:30:22 jinx Exp $ +$Id: purify.c,v 9.48 1993/03/10 17:20:04 cph Exp $ -Copyright (c) 1988-1992 Massachusetts Institute of Technology +Copyright (c) 1988-93 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -90,12 +90,18 @@ DEFUN (PurifyLoop, int GC_Mode) { fast SCHEME_OBJECT *To, *Old, Temp, *Low_Constant, New_Address; +#ifdef ENABLE_GC_DEBUGGING_TOOLS + SCHEME_OBJECT object_referencing; +#endif To = *To_Pointer; Low_Constant = Constant_Space; for ( ; Scan != To; Scan++) { Temp = *Scan; +#ifdef ENABLE_GC_DEBUGGING_TOOLS + object_referencing = Temp; +#endif Switch_by_GC_Type(Temp) { case TC_BROKEN_HEART: -- 2.25.1