[Help-smalltalk] Method hook

[Gwenael Casaccio]

Hi Paolo,

Here is the patch which add an hook to the VM to
warm the image side when the compiler add a new
method ;)

Cheers,
Gwen

diff --git a/kernel/Builtins.st b/kernel/Builtins.st
index 86b660e..edc74f1 100644
--- a/kernel/Builtins.st
+++ b/kernel/Builtins.st
@@ -33,6 +33,7 @@
 
 
 Object extend [
+
     class [
         "Answer the class to which the receiver belongs"
         <primitive: VMpr_Object_class>
@@ -43,7 +44,7 @@ Object extend [
         
 
 Behavior extend [
-    
+   
     new [
         "Create a new instance of a class with no indexed instance variables"
         <primitive: VMpr_Behavior_basicNew>
@@ -67,7 +68,7 @@ Behavior extend [
         <primitive: VMpr_Behavior_basicNewColon>
         <category: 'builtin'>
         self isFixed ifTrue: [
-    	SystemExceptions.WrongMessageSent signalOn: #new: useInstead: #new
+	SystemExceptions.WrongMessageSent signalOn: #new: useInstead: #new
         ].
         numInstanceVariables isSmallInteger ifTrue: [ ^self primitiveFailed ].
     
@@ -81,7 +82,7 @@ Behavior extend [
         <primitive: VMpr_Behavior_basicNewColon>
         <category: 'builtin'>
         self isFixed ifTrue: [
-    	SystemExceptions.WrongMessageSent signalOn: #basicNew: useInstead: #basicNew
+	SystemExceptions.WrongMessageSent signalOn: #basicNew: useInstead: #basicNew
         ].
         numInstanceVariables isSmallInteger ifTrue: [ ^self primitiveFailed ].
     
diff --git a/libgst/comp.c b/libgst/comp.c
index 76fcd4b..fad88e6 100644
--- a/libgst/comp.c
+++ b/libgst/comp.c
@@ -443,6 +443,7 @@ void
 _gst_install_initial_methods (void)
 {
   const char *methodsForString;
+  const char *hookForString;
 
   /* Define the termination method first of all, because
      compiling #methodsFor: will invoke an evaluation
@@ -465,6 +466,19 @@ _gst_install_initial_methods (void)
 
   install_method (termination_method);
 
+  /* Define the installedMethod hook */
+  hookForString = "\n\
+installMethod: aCompiledMethod [\n\
+]";
+
+  _gst_set_compilation_class (_gst_behavior_class);
+  _gst_set_compilation_category (_gst_string_new ("compiling methods"));
+  _gst_push_smalltalk_string (_gst_string_new (hookForString));
+  _gst_parse_stream (true);
+  _gst_pop_stream (true);
+
+  _gst_reset_compilation_category ();
+
   methodsForString = "\n\
 methodsFor: aCategoryString [\n\
     \"Calling this method prepares the parser to receive methods \n\
@@ -918,7 +932,11 @@ _gst_compile_method (tree_node method,
       INC_ADD_OOP (methodOOP);
 
       if (install)
-	install_method (methodOOP);
+        {
+	  install_method (methodOOP);
+
+          _gst_msg_sendf (NULL, "%v %o installMethod: %o", _gst_this_class, methodOOP);
+        }
 
       _gst_latest_compiled_method = methodOOP;	/* reachable by the
 						   root set */

_______________________________________________
help-smalltalk mailing list
help-smalltalk@gnu.org
http://lists.gnu.org/mailman/listinfo/help-smalltalk