[Help-smalltalk] PATCH1/2: byte code profiling for gst: recording

[Derek Zhou]

Capture the raw profile in a data structure to be post-processed later. Diffed 
against 3,1 git head from yesterday.

diff --git a/kernel/CompiledBlk.st b/kernel/CompiledBlk.st
index 96a2b8d..31dc219 100644
--- a/kernel/CompiledBlk.st
+++ b/kernel/CompiledBlk.st
@@ -217,7 +217,7 @@ CompiledCode subclass: CompiledBlock [
 
        <category: 'printing'>
        aStream
-           nextPutAll: '[] in ';
+           nextPutAll: '[%1] in ' % {self hash};
            print: method
     ]
 
diff --git a/kernel/SysDict.st b/kernel/SysDict.st
index 03b451c..df80da1 100644
--- a/kernel/SysDict.st
+++ b/kernel/SysDict.st
@@ -242,5 +242,34 @@ My instance also helps keep track of dependencies between 
objects.'>
        <category: 'testing'>
        ^true
     ]
+
+    profilerOn [
+       "Turn on the profiler"
+
+       <category: 'profiling'>
+       <primitive: VMpr_SystemDictionary_profilerOn>
+    ]
+
+    profilerOff [
+       "Turn off the profiler"
+
+       <category: 'profiling'>
+       <primitive: VMpr_SystemDictionary_profilerOff>
+    ]
+
+    resetProfiler [
+       "Reset the profiler, clear all previous profiling data"
+
+       <category: 'profiling'>
+       <primitive: VMpr_SystemDictionary_resetProfiler>
+    ]
+
+    rawProfile [
+       "Return the raw profile, which is an IdentityDictionary, keyed off
+         all the methods"
+
+       <category: 'profiling'>
+       <primitive: VMpr_SystemDictionary_rawProfile>
+    ]
 ]
 
diff --git a/libgst/dict.c b/libgst/dict.c
index 75fdaaa..1435b30 100644
--- a/libgst/dict.c
+++ b/libgst/dict.c
@@ -201,6 +201,12 @@ static ssize_t identity_dictionary_find_key (OOP 
identityDictionaryOOP,
 static size_t identity_dictionary_find_key_or_nil (OOP identityDictionaryOOP,
                                                   OOP keyOOP);
 
+/* assume the value is an integer already or key does not exist, increase the
+   value by inc or set the value to inc */
+static int _gst_identity_dictionary_at_inc (OOP identityDictionaryOOP,
+                                            OOP keyOOP,
+                                            int inc);
+
 /* Create a new instance of CLASSOOP (an IdentityDictionary subclass)
    and answer it.  */
 static OOP identity_dictionary_new (OOP classOOP,
@@ -2181,3 +2187,85 @@ _gst_set_file_stream_file (OOP fileStreamOOP,
     isPipe == -1 ? _gst_nil_oop :
     isPipe ? _gst_true_oop : _gst_false_oop;
 }
+
+/*
+  profiling routine. 
+  The profiler use a simple data structure to store the cost and the call 
+  graph, which is a 2 level IdentityDictionary. First level keys are the 
+  compiled_method or compiled_block, and the second level key is the 
+  compiled_method or compiled_block that it calls. Values are the number of 
+  calls made. There is a special key "true" in the second level whose 
+  corresponding value is the accumalative cost for this method
+ */
+/* This is the entry point of the profiler. */
+void 
+_gst_record_profile (OOP newMethod, int ipOffset)
+{
+  OOP profile = _gst_identity_dictionary_at(_gst_raw_profile, 
+                                            _gst_this_method);
+  if UNCOMMON (IS_NIL(profile))
+    {
+      profile = identity_dictionary_new(_gst_method_dictionary_class,
+                                       6);
+      _gst_identity_dictionary_at_put(_gst_raw_profile, _gst_this_method, 
+                                      profile);
+    }
+  _gst_identity_dictionary_at_inc(profile, _gst_true_oop, 
+                                  _gst_bytecode_counter);
+  _gst_bytecode_counter = 0;
+  /* if ipOffset is 0 then it is a callin not a return so we also record 
+     the call */
+  if (ipOffset == 0) 
+    _gst_identity_dictionary_at_inc(profile, newMethod, 1);
+}
+
+/* allocate a new profile and the old one (if any) will be gabage collected
+   the add_smalltalk call is necessary so the new one will survive GC
+ */
+void
+_gst_reset_profiler ()
+{
+  _gst_raw_profile = identity_dictionary_new(_gst_method_dictionary_class, 
+                                             256);
+  add_smalltalk ("RawProfile", _gst_raw_profile);
+}
+
+/* assume the value is an integer already or key does not exist, increase the
+   value by inc or set the value to inc */
+int
+_gst_identity_dictionary_at_inc (OOP identityDictionaryOOP,
+                                OOP keyOOP,
+                                int inc)
+{
+  gst_identity_dictionary identityDictionary;
+  intptr_t index;
+  int oldValue;
+
+  identityDictionary =
+    (gst_identity_dictionary) OOP_TO_OBJ (identityDictionaryOOP);
+
+  /* Never make dictionaries too full! For simplicity, we do this even
+     if the key is present in the dictionary (because it will most
+     likely resolve some collisions and make things faster).  */
+
+  if UNCOMMON (TO_INT (identityDictionary->tally) >
+              TO_INT (identityDictionary->objSize) * 3 / 8)
+    identityDictionary =
+      _gst_grow_identity_dictionary (identityDictionaryOOP);
+
+  index =
+    identity_dictionary_find_key_or_nil (identityDictionaryOOP, keyOOP);
+
+  if UNCOMMON (IS_NIL (identityDictionary->keys[index - 1]))
+    {
+      identityDictionary->tally = INCR_INT (identityDictionary->tally);
+      oldValue = 0;
+    }
+  else 
+    oldValue= TO_INT(identityDictionary->keys[index]);
+  
+  identityDictionary->keys[index - 1] = keyOOP;
+  identityDictionary->keys[index] = FROM_INT(inc+oldValue);
+
+  return (oldValue);
+}
diff --git a/libgst/dict.h b/libgst/dict.h
index 439d976..d130f08 100644
--- a/libgst/dict.h
+++ b/libgst/dict.h
@@ -664,4 +664,12 @@ extern mst_Boolean _gst_init_dictionary_on_image_load 
(mst_Boolean prim_table_ma
 extern int _gst_resolve_primitive_name (char *name) 
   ATTRIBUTE_HIDDEN;
 
+/* This is the entry point of the profiler */
+extern void _gst_record_profile (OOP newMethod, int ipOffset);
+
+/* allocate a new profile and the old one (if any) will be gabage collected
+   the add_smalltalk call is necessary so the new one will survive GC
+ */
+extern void _gst_reset_profiler ();
+
 #endif /* GST_DICT_H */
diff --git a/libgst/interp-bc.inl b/libgst/interp-bc.inl
index 34e68e4..f28bbef 100644
--- a/libgst/interp-bc.inl
+++ b/libgst/interp-bc.inl
@@ -160,7 +160,12 @@
 #define GET_CONTEXT_IP(ctx)    TO_INT((ctx)->ipOffset)
 
 #define SET_THIS_METHOD(method, ipOffset) do {                         \
-  gst_compiled_method _method = (gst_compiled_method)                  \
+  gst_compiled_method _method;                                          \
+  if UNCOMMON (_gst_profiler_on)                                        \
+    {                                                                   \
+      _gst_record_profile (method, ipOffset);                           \
+    }                                                                   \
+  _method = (gst_compiled_method)                                      \
     OOP_TO_OBJ (_gst_this_method = (method));                          \
                                                                        \
   method_base = _method->bytecodes;                                    \
diff --git a/libgst/interp.c b/libgst/interp.c
index e859806..e7f7861 100644
--- a/libgst/interp.c
+++ b/libgst/interp.c
@@ -171,6 +171,12 @@ unsigned long _gst_cache_misses = 0;
 /* The number of cache lookups - either hits or misses */
 unsigned long _gst_sample_counter = 0;
 
+/* When true, this indicates that the byte code profiler is on.  */
+mst_Boolean _gst_profiler_on = false; 
+
+/* The OOP for an IdentityDictionary that store the raw profile */
+OOP _gst_raw_profile = NULL;
+
 #ifdef ENABLE_JIT_TRANSLATION
 #define method_base            0
 char *native_ip = NULL;
diff --git a/libgst/interp.h b/libgst/interp.h
index 770c238..1aef8d0 100644
--- a/libgst/interp.h
+++ b/libgst/interp.h
@@ -301,6 +301,14 @@ extern OOP _gst_self
 extern OOP _gst_this_context_oop 
   ATTRIBUTE_HIDDEN;
 
+/* When true, this indicates that the byte code profiler is on.  */
+extern mst_Boolean _gst_profiler_on 
+  ATTRIBUTE_HIDDEN;
+
+/* The OOP for an IdentityDictionary that store the raw profile */
+extern OOP _gst_raw_profile
+  ATTRIBUTE_HIDDEN;
+
 /* The type used to hold the instruction pointer.  For the JIT, this
    is an offset from a location which is deemed the `base' of
    native-compiled methods (because this way it will fit in a
diff --git a/libgst/prims.def b/libgst/prims.def
index c05aa0f..d80efd9 100644
--- a/libgst/prims.def
+++ b/libgst/prims.def
@@ -5935,6 +5935,41 @@ primitive VMpr_ObjectMemory_gcPrimitives :
   PRIM_SUCCEEDED;
 }
 
+/* SystemDictionary profilerOn */
+
+primitive VMpr_SystemDictionary_profilerOn [succeed]
+{
+  if (!_gst_raw_profile) 
+    _gst_reset_profiler();
+  _gst_bytecode_counter = 0;
+  _gst_profiler_on = true;
+  PRIM_SUCCEEDED;
+}
+
+/* SystemDictionary profilerOff */
+
+primitive VMpr_SystemDictionary_profilerOff [succeed]
+{
+  _gst_profiler_on = false;
+  PRIM_SUCCEEDED;
+}
+
+/* SystemDictionary resetProfiler */
+
+primitive VMpr_SystemDictionary_resetProfiler [succeed]
+{
+  _gst_reset_profiler();
+  PRIM_SUCCEEDED;
+}
+
+/* SystemDictionary rawProfile */
+
+primitive VMpr_SystemDictionary_rawProfile [succeed]
+{
+  SET_STACKTOP (_gst_raw_profile);
+  PRIM_SUCCEEDED;
+}
+
 
 #undef INT_BIN_OP
 #undef BOOL_BIN_OP