[Help-smalltalk] [PATCH] libgst: Add built-in for Behavior>>#new and >>#new:

[Holger Hans Peter Freyther]

The addition of calling both basicNew/basicNew: followed by a
call to initialize introduced a noticable slowdown in an
allocation macro benchmark. By making the new >>new/>>new:
a primitive we reduce the cost.

The #initialize symbol is part of the builtin selectors so
we can not blindly allocate it during the construction of
the symbol table but will take the result of the built-in
selectors.

2014-08-02  Holger Hans Peter Freyther  <address@hidden>

        * prims.def: Introduce VMpr_Behavior_newInitialize and
        VMpr_Behavior_newColonInitialize,
        * sym.h: Declare _gst_initialize_symbol.
        * sym.c: Define _gst_initialize_symbol during init and
        restore.

2014-08-02  Holger Hans Peter Freyther  <address@hidden>

        * kernel/Builtins.st: Use the new built-in for >>#new
        and >>#new:.
---
 ChangeLog          |  5 +++++
 kernel/Builtins.st | 16 ++++++++++++---
 libgst/ChangeLog   |  8 ++++++++
 libgst/prims.def   | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++++--
 libgst/sym.c       |  7 +++++++
 libgst/sym.h       |  1 +
 6 files changed, 89 insertions(+), 5 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 9ff96ef..45a210d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2014-08-02  Holger Hans Peter Freyther  <address@hidden>
+
+       * kernel/Builtins.st: Use the new built-in for >>#new
+       and >>#new:.
+
 2014-07-26  Holger Hans Peter Freyther  <address@hidden>
 
        * examples/PackageBuilder.st: Remove PackageBuilder class >>#new.
diff --git a/kernel/Builtins.st b/kernel/Builtins.st
index eb5fa3b..4e1dfa3 100644
--- a/kernel/Builtins.st
+++ b/kernel/Builtins.st
@@ -61,13 +61,23 @@ Behavior extend [
 
     new [
         "Create a new instance of a class with no indexed instance variables"
-        ^self basicNew initialize
+        <primitive: VMpr_Behavior_newInitialize>
+        <category: 'builtin'>
+        self isFixed ifFalse: [ ^(self new: 0) ].
+        ^self primitiveFailed
     ]
 
     new: numInstanceVariables [
         "Create a new instance of a class with indexed instance variables. The
-         instance has numInstanceVariables indexed instance variables."
-        ^(self basicNew: numInstanceVariables) initialize
+        instance has numInstanceVariables indexed instance variables."
+        <primitive: VMpr_Behavior_newColonInitialize>
+        <category: 'builtin'>
+        self isFixed ifTrue: [
+            SystemExceptions.WrongMessageSent signalOn: #new: useInstead: #new
+        ].
+        numInstanceVariables isSmallInteger ifTrue: [ ^self primitiveFailed ].
+
+        ^SystemExceptions.WrongClass signalOn: numInstanceVariables mustBe: 
SmallInteger
     ]
 
 
diff --git a/libgst/ChangeLog b/libgst/ChangeLog
index f294313..a390754 100644
--- a/libgst/ChangeLog
+++ b/libgst/ChangeLog
@@ -1,3 +1,11 @@
+2014-08-02  Holger Hans Peter Freyther  <address@hidden>
+
+       * prims.def: Introduce VMpr_Behavior_newInitialize and
+       VMpr_Behavior_newColonInitialize,
+       * sym.h: Declare _gst_initialize_symbol.
+       * sym.c: Define _gst_initialize_symbol during init and
+       restore.
+
 2014-05-26  Holger Hans Peter Freyther  <address@hidden>
 
        * input.c: Use rl_quote_func_t, rl_dequote_func_t and
diff --git a/libgst/prims.def b/libgst/prims.def
index a67c3fd..91a3f28 100644
--- a/libgst/prims.def
+++ b/libgst/prims.def
@@ -2261,7 +2261,7 @@ primitive VMpr_Object_shallowCopy [succeed]
   PRIM_SUCCEEDED;
 }
 
-/* Behavior basicNew; Behavior new; */
+/* Behavior basicNew */
 primitive VMpr_Behavior_basicNew = 70 [succeed,fail,inlined]
 {
   OOP oop1;
@@ -2283,7 +2283,30 @@ primitive VMpr_Behavior_basicNew = 70 
[succeed,fail,inlined]
   PRIM_FAILED;
 }
 
-/* Behavior new:; Behavior basicNew: */
+/* Behavior Behavior new; */
+primitive VMpr_Behavior_newInitialize [succeed,fail]
+{
+  OOP oop1;
+  _gst_primitives_executed++;
+
+  oop1 = STACKTOP ();
+  if COMMON (RECEIVER_IS_OOP (oop1))
+    {
+      if COMMON (!CLASS_IS_INDEXABLE (oop1))
+       {
+         /* Note: you cannot pass &STACKTOP() because if the stack
+            moves it ain't valid anymore by the time it is set!!! */
+         OOP result;
+         instantiate (oop1, &result);
+         SET_STACKTOP (result);
+         _gst_send_message_internal(_gst_initialize_symbol, 0, result, oop1);
+         PRIM_SUCCEEDED_RELOAD_IP;
+       }
+    }
+  PRIM_FAILED;
+}
+
+/* Behavior basicNew: */
 primitive VMpr_Behavior_basicNewColon = 71 [succeed,fail,inlined]
 {
   OOP oop1;
@@ -2312,6 +2335,36 @@ primitive VMpr_Behavior_basicNewColon = 71 
[succeed,fail,inlined]
   PRIM_FAILED;
 }
 
+/* Behavior new:; */
+primitive VMpr_Behavior_newColonInitialize [succeed,fail]
+{
+  OOP oop1;
+  OOP oop2;
+  _gst_primitives_executed++;
+
+  oop2 = POP_OOP ();
+  oop1 = STACKTOP ();
+  if COMMON (RECEIVER_IS_OOP (oop1) && IS_INT (oop2))
+    {
+      if COMMON (CLASS_IS_INDEXABLE (oop1))
+       {
+         intptr_t arg2;
+         arg2 = TO_INT (oop2);
+         if (arg2 >= 0)
+           {
+             OOP result;
+             instantiate_with (oop1, arg2, &result);
+             SET_STACKTOP (result);
+             _gst_send_message_internal(_gst_initialize_symbol, 0, result, 
oop1);
+             PRIM_SUCCEEDED_RELOAD_IP;
+           }
+       }
+    }
+
+  UNPOP (1);
+  PRIM_FAILED;
+}
+
 /* Object become: */
 primitive VMpr_Object_become [succeed,fail]
 {
diff --git a/libgst/sym.c b/libgst/sym.c
index 672309e..3466d54 100644
--- a/libgst/sym.c
+++ b/libgst/sym.c
@@ -171,6 +171,9 @@ OOP _gst_while_true_colon_symbol = NULL;
 OOP _gst_while_true_symbol = NULL;
 OOP _gst_current_namespace = NULL;
 
+/* Symbols inside the builtin selectors */
+OOP _gst_initialize_symbol = NULL;
+
 OOP temporaries_dictionary = NULL;
 
 /* The list of selectors for the send immediate bytecode.  */
@@ -1571,6 +1574,8 @@ _gst_init_symbols_pass1 (void)
       {
        const char *name = bs->offset + _gst_builtin_selectors_names;
        bs->symbol = alloc_symbol_oop (name, strlen (name));
+        if (strcmp(name, "initialize") == 0)
+          _gst_initialize_symbol = bs->symbol;
         _gst_builtin_selectors[bs->bytecode] = *bs;
       }
 }
@@ -1634,6 +1639,8 @@ _gst_restore_symbols (void)
       {
        const char *name = bs->offset + _gst_builtin_selectors_names;
        bs->symbol = intern_string_fast (name, &currentOOP);
+        if (strcmp(name, "initialize") == 0)
+          _gst_initialize_symbol = bs->symbol;
         _gst_builtin_selectors[bs->bytecode] = *bs;
       }
 }
diff --git a/libgst/sym.h b/libgst/sym.h
index ab23267..e993c9e 100644
--- a/libgst/sym.h
+++ b/libgst/sym.h
@@ -115,6 +115,7 @@ extern OOP _gst_if_false_if_true_symbol ATTRIBUTE_HIDDEN;
 extern OOP _gst_if_false_symbol ATTRIBUTE_HIDDEN;
 extern OOP _gst_if_true_if_false_symbol ATTRIBUTE_HIDDEN;
 extern OOP _gst_if_true_symbol ATTRIBUTE_HIDDEN;
+extern OOP _gst_initialize_symbol ATTRIBUTE_HIDDEN;
 extern OOP _gst_int_symbol ATTRIBUTE_HIDDEN;
 extern OOP _gst_long_double_symbol ATTRIBUTE_HIDDEN;
 extern OOP _gst_long_symbol ATTRIBUTE_HIDDEN;
-- 
2.0.1