[gambit-list] (##resolve-referencing-objects obj) => list of the objects that reference obj implementation, feedback welcome.

Mikael mikael.rcv at gmail.com
Tue Jun 18 21:27:43 EDT 2013

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
> 1
> 2
> (##gc)
> (##resolve-referencing-objects a)
(#<absent> #<absent> #<absent>)


To _kernel.scm row 4388 and on are added:


;;; Resolver of referencing objects

;;; Works for memory-allocated objects only, for details see the conditions
;;; 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
(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
// is not enabled.
resolve_objects_referencing = ___ARG1;


  ; Trig garbage collection as to perform the scan

  ; Reset the object to scan for setting
  (##c-code #<<end-of-code

  resolve_objects_referencing = -1;


  ; Simplistic way of indicating to user whether this procedure is
  (and (##c-code #<<end-of-code

#ifdef ___DEBUG
___RESULT = ___TRU;
___RESULT = ___FAL;

       ; Download the resolved objects and return
       (let loop ((r '()))
         (let ((object (##c-code "___RESULT =
           (if object
               (loop (cons object 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:


 * 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.


/* 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*)
  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;
      return object;

2184 (replacing the previous ifdef-endif validate_old_obj block):


          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);
              container = ___TAG(container_body-___BODY_OFS,___tSUBTYPED);

              // ___printf("Found match to sought for object %lu :
              // print_object(container,0,"",0);
              // ___printf("\n");

            } else {
              // Reference from global variable etc.



          if (___DEBUG_SETTINGS_LEVEL(___setup_params.debug_settings) >= 1)
            validate_old_obj (obj);


and the #define ENABLE_CONSISTENCY_CHECKS :s that regard a block that
define or set reference_location are replaced with #if

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
cd ..

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.



2013/6/18 Marc Feeley <feeley at 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 at 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.
> >
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mailman.iro.umontreal.ca/pipermail/gambit-list/attachments/20130619/3d40fa34/attachment.htm>

More information about the Gambit-list mailing list