Ok, looks like ##resolve-referencing-objects is in place now!
(define a "Hello world") (##resolve-referencing-objects a)
(#<absent> #<absent> #<absent>)
(list a)
("Hello world")
(##resolve-referencing-objects a)
(#<absent> #<absent> #<absent> ("Hello world"))
(vector a)
#("Hello world")
(##resolve-referencing-objects a)
(#<absent> #<absent> #<absent> #("Hello world") ("Hello world"))
0 1 2
0
1 2 (##gc) (##resolve-referencing-objects a)
(#<absent> #<absent> #<absent>)
Implementation:
To _kernel.scm row 4388 and on are added:
;;;----------------------------------------------------------------------------
;;; Resolver of referencing objects
;;; Works for memory-allocated objects only, for details see the conditions for ;;; the validate_old_obj call in mem.c .
; For this procedure to work, up to the point where the explicitly induced GC is made, ; there must be no other GC. ; ; (##resolve-referencing-objects obj) => list of the objects that reference obj (define (##resolve-referencing-objects obj) (##declare (not interrupts-enabled))
; Set the object to scan for (##c-code #<<end-of-code
// Note that this variable is declared even if the referencing objects resolver // is not enabled. resolve_objects_referencing = ___ARG1;
end-of-code obj)
; Trig garbage collection as to perform the scan (##gc)
; Reset the object to scan for setting (##c-code #<<end-of-code
resolve_objects_referencing = -1;
end-of-code )
; Simplistic way of indicating to user whether this procedure is implemented. (and (##c-code #<<end-of-code
#ifdef ___DEBUG ___RESULT = ___TRU; #else ___RESULT = ___FAL; #endif
end-of-code ) ; Download the resolved objects and return (let loop ((r '())) (let ((object (##c-code "___RESULT = get_next_resolved_referencing_object();"))) (if object (loop (cons object r)) r)))))
To mem.h row 69 and on are added:
extern ___SCMOBJ resolve_objects_referencing; extern ___SCMOBJ get_next_resolved_referencing_object ___PVOID;
To mem.h are added starting at the following rows:
30:
/* * Defining the symbol ENABLE_REFERENCING_OBJECTS_RESOLVER will enable * the GC to resolve the references to a specified object, see * ##resolve-referencing-objects of _kernel.scm for more info. */ #define ENABLE_REFERENCING_OBJECTS_RESOLVER
423:
/* Object to look up all references to */ ___WORD resolve_objects_referencing = -1;
typedef struct resolved_referencing_object_struct { ___SCMOBJ object; struct resolved_referencing_object_struct* next; } resolved_referencing_object;
___HIDDEN resolved_referencing_object* resolved_referencing_objects = NULL;
void add_resolved_referencing_object(___SCMOBJ object) { resolved_referencing_object* r = (resolved_referencing_object*) malloc(sizeof(resolved_referencing_object)); r->object = object; r->next = resolved_referencing_objects; resolved_referencing_objects = r; }
// Get next object resolved as referencing resolve_objects_referencing . // Used by ##resolve-referencing-objects ___SCMOBJ get_next_resolved_referencing_object ___PVOID { if (resolved_referencing_objects == NULL) { return ___FAL; } else { resolved_referencing_object* r = resolved_referencing_objects; ___SCMOBJ object = r->object; resolved_referencing_objects = r->next; free(r); return object; } }
2184 (replacing the previous ifdef-endif validate_old_obj block):
#if defined(ENABLE_CONSISTENCY_CHECKS) || defined(ENABLE_REFERENCING_OBJECTS_RESOLVER)
#ifdef ENABLE_REFERENCING_OBJECTS_RESOLVER if (obj == resolve_objects_referencing) {
// This typecasting of container_body to ___SCMOBJ was inspired by the corresponding code in explain_problem . if (reference_location == IN_OBJECT) { // Reference from other Scheme object's body ___WORD container; #if ___tPAIR != ___tSUBTYPED ___WORD head = container_body[-1]; int subtype = ___HD_SUBTYPE(head); if (subtype == ___sPAIR) container = ___TAG(container_body-___BODY_OFS,___tPAIR); else #endif container = ___TAG(container_body-___BODY_OFS,___tSUBTYPED);
// ___printf("Found match to sought for object %lu : ",resolve_objects_referencing); // print_object(container,0,"",0); // ___printf("\n");
add_resolved_referencing_object(container); } else { // Reference from global variable etc. add_resolved_referencing_object(___ABSENT); }
}
#endif
#ifdef ENABLE_CONSISTENCY_CHECKS if (___DEBUG_SETTINGS_LEVEL(___setup_params.debug_settings) >= 1) validate_old_obj (obj); #endif
#endif
and the #define ENABLE_CONSISTENCY_CHECKS :s that regard a block that define or set reference_location are replaced with #if defined(ENABLE_CONSISTENCY_CHECKS) || defined(ENABLE_REFERENCING_OBJECTS_RESOLVER) .
Compilation of a new ./gsc/gsc (g++):
cd lib g++ -Wno-unused -Wno-write-strings -g -fno-trapping-math -fno-strict-aliasing -fwrapv -fPIC -fno-common -mieee-fp -I"../include" -c -o "mem.o" -I. -DHAVE_CONFIG_H -D___GAMBCDIR=""/usr/local/Gambit-C"" -D___SYS_TYPE_CPU=""i686"" -D___SYS_TYPE_VENDOR=""pc"" -D___SYS_TYPE_OS=""linux-gnu"" -D___CONFIGURE_COMMAND=""./configure '--enable-cplusplus' '--enable-single-host' '--enable-debug'"" -D___OBJ_EXTENSION="".o"" -D___EXE_EXTENSION="""" -D___BAT_EXTENSION="""" -D___PRIMAL mem.c -D___LIBRARY gsc -:~~bin=../bin,~~lib=../lib,~~include=../include -c _kernel.scm gsc -:~~bin=../bin,~~lib=../lib,~~include=../include -f -link -flat -o _gambc.c _kernel.c _system.c _num.c _std.c _eval.c _io.c _nonstd.c _thread.c _repl.c g++ -Wno-unused -Wno-write-strings -g -fno-trapping-math -fno-strict-aliasing -fwrapv -fPIC -fno-common -mieee-fp -I"../include" -c -o "_kernel.o" -I. -DHAVE_CONFIG_H -D___GAMBCDIR=""/usr/local/Gambit-C"" -D___SYS_TYPE_CPU=""i686"" -D___SYS_TYPE_VENDOR=""pc"" -D___SYS_TYPE_OS=""linux-gnu"" -D___CONFIGURE_COMMAND=""./configure '--enable-cplusplus' '--enable-single-host' '--enable-debug'"" -D___OBJ_EXTENSION="".o"" -D___EXE_EXTENSION="""" -D___BAT_EXTENSION="""" -D___PRIMAL _kernel.c -D___LIBRARY cd .. make
Space for improvement or things to note are:
* ##resolve-referencing-objects is always compiled, but returns #f if Gambit is not compiled with --enable-debug .
Possibly some neater or otherwise better degradation of the procedure could be devised for when Gambit is not compiled in debug mode?
* When compiled with --debug, on the iteration over each memory-allocated object, two checks are always done, namely the two highlighted above.
These could easily be united to one collective check, by making a global boolean variable sth like perform_individual_object_checks that's set to (resolve_objects_referencing != -1) || (___DEBUG_SETTINGS_LEVEL(___setup_params.debug_settings) >= 1) on ___garbage_collect .
Those two checks would then be surrounded by if (perform_individual_object_checks) { .. } .
This would save some clock cycles in the ordinary use case, but add ~5 lines of complexity to mem.c .
* Note that object references that are from objects other than Gambit standard objects, are represented as an absent special object.
* I did not implement this in validate_old_obj as ##resolve-referencing-objects is quite common to use and validate_old_obj in contrast looks like a very expensive, special-purpose routine.
Feedback?
Mikael
2013/6/18 Marc Feeley feeley@iro.umontreal.ca
Also, your code would be useful to others, so please do a pull request when you are done.
Marc
On Jun 18, 2013, at 12:00 PM, Mikael mikael.rcv@gmail.com wrote:
Ah, yey, your code in explain_problem already provided an example of how
to do this!
Will write here soon how to do this lookup of referencing objects soon.