<div>Ok, looks like <font face="courier new, monospace">##resolve-referencing-objects</font> is in place now!</div><div><br></div><div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div><font face="courier new, monospace">> (define a "Hello world")</font></div>

<div><font face="courier new, monospace">> (##resolve-referencing-objects a)</font></div><div><font face="courier new, monospace">(#<absent> #<absent> #<absent>)</font></div><div><font face="courier new, monospace">> (list a)</font></div>

<div><font face="courier new, monospace">("Hello world")</font></div><div><font face="courier new, monospace">> (##resolve-referencing-objects a)</font></div><div><font face="courier new, monospace">(#<absent> #<absent> #<absent> ("Hello world"))</font></div>

<div><font face="courier new, monospace">> (vector a)</font></div><div><font face="courier new, monospace">#("Hello world")</font></div><div><font face="courier new, monospace">> (##resolve-referencing-objects a)</font></div>

<div><font face="courier new, monospace">(#<absent> #<absent> #<absent> #("Hello world") ("Hello world"))</font></div><div><font face="courier new, monospace">> 0 1 2</font></div>
<div>
<font face="courier new, monospace">0</font></div><div><font face="courier new, monospace">> 1</font></div><div><font face="courier new, monospace">> 2</font></div><div><font face="courier new, monospace">> (##gc)</font></div>

<div><font face="courier new, monospace">> (##resolve-referencing-objects a)</font></div><div><font face="courier new, monospace">(#<absent> #<absent> #<absent>)</font></div></div><div><br></div></blockquote>

</div><div><br></div><div>Implementation:</div><div><br></div><div>To _kernel.scm row 4388 and on are added:</div><div><br></div><div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div><font face="courier new, monospace">;;;----------------------------------------------------------------------------</font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">;;; Resolver of referencing objects</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">;;; Works for memory-allocated objects only, for details see the conditions for</font></div>

<div><font face="courier new, monospace">;;; the validate_old_obj call in mem.c .</font></div><div><br></div><div><font face="courier new, monospace">; For this procedure to work, up to the point where the explicitly induced GC is made,</font></div>

<div><font face="courier new, monospace">; there must be no other GC.</font></div><div><font face="courier new, monospace">;</font></div><div><font face="courier new, monospace">; (##resolve-referencing-objects obj) => list of the objects that reference obj</font></div>

<div><font face="courier new, monospace">(define (##resolve-referencing-objects obj)</font></div><div><font face="courier new, monospace">  (##declare (not interrupts-enabled))</font></div><div><font face="courier new, monospace"><br>

</font></div><div><font face="courier new, monospace">  ; Set the object to scan for</font></div><div><font face="courier new, monospace">  (##c-code #<<end-of-code</font></div><div><font face="courier new, monospace"><br>

</font></div><div><font face="courier new, monospace">// Note that this variable is declared even if the referencing objects resolver</font></div><div><font face="courier new, monospace">// is not enabled.</font></div><div>

<font face="courier new, monospace">resolve_objects_referencing = ___ARG1;</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">end-of-code</font></div><div><font face="courier new, monospace">   obj)</font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">  ; Trig garbage collection as to perform the scan</font></div><div><font face="courier new, monospace">  (##gc)</font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">  ; Reset the object to scan for setting</font></div><div><font face="courier new, monospace">  (##c-code #<<end-of-code</font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">  resolve_objects_referencing = -1;</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">end-of-code</font></div>

<div><font face="courier new, monospace">   )</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">  ; Simplistic way of indicating to user whether this procedure is implemented.</font></div>

<div><font face="courier new, monospace">  (and (##c-code #<<end-of-code</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">#ifdef ___DEBUG</font></div><div>

<font face="courier new, monospace">___RESULT = ___TRU;</font></div><div><font face="courier new, monospace">#else</font></div><div><font face="courier new, monospace">___RESULT = ___FAL;</font></div><div><font face="courier new, monospace">#endif</font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">end-of-code</font></div><div><font face="courier new, monospace">        )</font></div><div><font face="courier new, monospace">       ; Download the resolved objects and return</font></div>

<div><font face="courier new, monospace">       (let loop ((r '()))</font></div><div><font face="courier new, monospace">         (let ((object (##c-code "___RESULT = get_next_resolved_referencing_object();")))</font></div>

<div><font face="courier new, monospace">           (if object</font></div><div><font face="courier new, monospace">               (loop (cons object r))</font></div><div><font face="courier new, monospace">               r)))))</font></div>

</div></blockquote></div><div><br></div><div>To mem.h row 69 and on are added:</div><div><br></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div><font face="courier new, monospace">extern ___SCMOBJ resolve_objects_referencing;</font></div>

</div><div><div><font face="courier new, monospace">extern ___SCMOBJ get_next_resolved_referencing_object ___PVOID;</font></div></div></blockquote><div><br></div><div><br></div><div>To mem.h are added starting at the following rows:</div>

<div><br></div><div>30:</div><div><br></div><div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">/*</font></div>

<div><font face="courier new, monospace"> * Defining the symbol ENABLE_REFERENCING_OBJECTS_RESOLVER will enable</font></div><div><font face="courier new, monospace"> * the GC to resolve the references to a specified object, see</font></div>

<div><font face="courier new, monospace"> * ##resolve-referencing-objects of _kernel.scm for more info.</font></div><div><font face="courier new, monospace"> */</font></div><div><font face="courier new, monospace">#define ENABLE_REFERENCING_OBJECTS_RESOLVER</font></div>

</div><div><br></div></blockquote></div><div>423:</div><div><br></div><div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div><font face="courier new, monospace">/* Object to look up all references to */</font></div>

<div><font face="courier new, monospace">___WORD resolve_objects_referencing = -1;</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">typedef struct resolved_referencing_object_struct {</font></div>

<div><font face="courier new, monospace">  ___SCMOBJ object;</font></div><div><font face="courier new, monospace">  struct resolved_referencing_object_struct* next;</font></div><div><font face="courier new, monospace">} resolved_referencing_object;</font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">___HIDDEN resolved_referencing_object* resolved_referencing_objects = NULL;</font></div><div><font face="courier new, monospace"><br>

</font></div><div><font face="courier new, monospace">void add_resolved_referencing_object(___SCMOBJ object) {</font></div><div><font face="courier new, monospace">  resolved_referencing_object* r = (resolved_referencing_object*) malloc(sizeof(resolved_referencing_object));</font></div>

<div><font face="courier new, monospace">  r->object = object;</font></div><div><font face="courier new, monospace">  r->next = resolved_referencing_objects;</font></div><div><font face="courier new, monospace">  resolved_referencing_objects = r;</font></div>

<div><font face="courier new, monospace">}</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">// Get next object resolved as referencing resolve_objects_referencing .</font></div>

<div><font face="courier new, monospace">// Used by ##resolve-referencing-objects</font></div><div><font face="courier new, monospace">___SCMOBJ get_next_resolved_referencing_object ___PVOID</font></div><div><font face="courier new, monospace">  {</font></div>

<div><font face="courier new, monospace">    if (resolved_referencing_objects == NULL) {</font></div><div><font face="courier new, monospace">      return ___FAL;</font></div><div><font face="courier new, monospace">    } else {</font></div>

<div><font face="courier new, monospace">      resolved_referencing_object* r = resolved_referencing_objects;</font></div><div><font face="courier new, monospace">      ___SCMOBJ object = r->object;</font></div><div><font face="courier new, monospace">      resolved_referencing_objects = r->next;</font></div>

<div><font face="courier new, monospace">      free(r);</font></div><div><font face="courier new, monospace">      return object;</font></div><div><font face="courier new, monospace">    }</font></div><div><font face="courier new, monospace">  }</font></div>

</div></blockquote></div><div><br></div><div>2184 (replacing the previous ifdef-endif validate_old_obj block):</div><div><br></div><div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div><font face="courier new, monospace">#if defined(ENABLE_CONSISTENCY_CHECKS) || defined(ENABLE_REFERENCING_OBJECTS_RESOLVER)</font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">#ifdef ENABLE_REFERENCING_OBJECTS_RESOLVER</font></div><div><font face="courier new, monospace">          <span style="background-color:rgb(255,255,204)">if (obj == resolve_objects_referencing) {</span></font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">            // This typecasting of container_body to ___SCMOBJ was inspired by the corresponding code in explain_problem .</font></div>

<div><font face="courier new, monospace">            if (reference_location == IN_OBJECT) {</font></div><div><font face="courier new, monospace">              // Reference from other Scheme object's body</font></div>
<div>
<font face="courier new, monospace">              ___WORD container;</font></div><div><font face="courier new, monospace">#if ___tPAIR != ___tSUBTYPED</font></div><div><font face="courier new, monospace">              ___WORD head = container_body[-1];</font></div>

<div><font face="courier new, monospace">              int subtype = ___HD_SUBTYPE(head);</font></div><div><font face="courier new, monospace">              if (subtype == ___sPAIR)</font></div><div><font face="courier new, monospace">                container = ___TAG(container_body-___BODY_OFS,___tPAIR);</font></div>

<div><font face="courier new, monospace">              else</font></div><div><font face="courier new, monospace">#endif</font></div><div><font face="courier new, monospace">              container = ___TAG(container_body-___BODY_OFS,___tSUBTYPED);</font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">              // ___printf("Found match to sought for object %lu : ",resolve_objects_referencing);</font></div>
<div>
<font face="courier new, monospace">              // print_object(container,0,"",0);</font></div><div><font face="courier new, monospace">              // ___printf("\n");</font></div><div><font face="courier new, monospace"><br>

</font></div><div><font face="courier new, monospace">              add_resolved_referencing_object(container);</font></div><div><font face="courier new, monospace">            } else {</font></div><div><font face="courier new, monospace">              // Reference from global variable etc.</font></div>

<div><font face="courier new, monospace">              add_resolved_referencing_object(___ABSENT);</font></div><div><font face="courier new, monospace">            }</font></div><div><font face="courier new, monospace"><br>

</font></div><div><font face="courier new, monospace">          }</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">#endif</font></div><div><font face="courier new, monospace"><br>

</font></div><div><font face="courier new, monospace">#ifdef ENABLE_CONSISTENCY_CHECKS</font></div><div><font face="courier new, monospace">          <span style="background-color:rgb(255,255,204)">if (___DEBUG_SETTINGS_LEVEL(___setup_params.debug_settings) >= 1)</span></font></div>

<div><font face="courier new, monospace">            validate_old_obj (obj);</font></div><div><font face="courier new, monospace">#endif</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">#endif</font></div>

</div></blockquote></div><div><br></div><div>and the <font face="courier new, monospace">#define </font><span style="font-family:'courier new',monospace">ENABLE_CONSISTENCY_CHECKS</span> :s that regard a block that define or set <font face="courier new, monospace">reference_location</font> are replaced with <span style="font-family:'courier new',monospace">#if defined(ENABLE_CONSISTENCY_CHECKS) || defined(ENABLE_REFERENCING_OBJECTS_RESOLVER)</span> .</div>

<div><br></div><div><br></div><div>Compilation of a new ./gsc/gsc (g++):</div><div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div><br></div><div>cd lib</div><div>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</div>

<div>gsc -:~~bin=../bin,~~lib=../lib,~~include=../include -c  _kernel.scm</div><div>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</div>

<div>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</div>

<div>cd ..</div><div>make</div><div><br></div></div></blockquote></div><div><br></div><div>Space for improvement or things to note are:<br></div><div><br></div><div> * <span style="font-family:'courier new',monospace">##resolve-referencing-objects</span> is always compiled, but returns #f if Gambit is not compiled with --enable-debug .</div>

<div><br></div><div>   Possibly some neater or otherwise better degradation of the procedure could be devised for when Gambit is not compiled in debug mode?</div><div><br></div><div> * When compiled with --debug, on the iteration over each memory-allocated object, two checks are always done, namely the two highlighted above.</div>

<div><br></div><div>   These could easily be united to one collective check, by making a global boolean variable sth like <font face="courier new, monospace">perform_individual_object_checks</font> that's set to <font face="courier new, monospace" style="background-color:rgb(255,255,255)">(resolve_objects_referencing != -1) || (___DEBUG_SETTINGS_LEVEL(___setup_params.debug_settings) >= 1)</font> on <font face="courier new, monospace">___garbage_collect</font> .</div>

<div><br></div><div>   Those two checks would then be surrounded by <font face="courier new, monospace">if (perform_individual_object_checks) { .. }</font> .</div><div><br></div><div>   This would save some clock cycles in the ordinary use case, but add ~5 lines of complexity to mem.c .</div>

<div><br></div><div> * Note that object references that are from objects other than Gambit standard objects, are represented as an absent special object.</div><div><br></div><div> * I did not implement this in validate_old_obj as ##resolve-referencing-objects is quite common to use</div>

<div>   and validate_old_obj in contrast looks like a very expensive, special-purpose routine.</div><div><br></div><div><br></div><div>Feedback?</div><div><br></div><div><br></div><div>Mikael</div><div><br></div><br><div class="gmail_quote">

2013/6/18 Marc Feeley <span dir="ltr"><<a href="mailto:feeley@iro.umontreal.ca" target="_blank">feeley@iro.umontreal.ca</a>></span><br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">

Also, your code would be useful to others, so please do a pull request when you are done.<br>
<span class="HOEnZb"><font color="#888888"><br>
Marc<br>
</font></span><div class="HOEnZb"><div class="h5"><br>
On Jun 18, 2013, at 12:00 PM, Mikael <<a href="mailto:mikael.rcv@gmail.com">mikael.rcv@gmail.com</a>> wrote:<br>
<br>
> Ah, yey, your code in explain_problem already provided an example of how to do this!<br>
><br>
> Will write here soon how to do this lookup of referencing objects soon.<br>
><br>
<br>
</div></div></blockquote></div><br>