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

Holger Hans Peter Freyther <[email protected]>
Newsgroups gmane.comp.lang.smalltalk.gnu.general
Message-ID <[email protected]>
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  <[email protected]>

	* 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  <[email protected]>

	* 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  <[email protected]>
+
+	* kernel/Builtins.st: Use the new built-in for >>#new
+	and >>#new:.
+
 2014-07-26  Holger Hans Peter Freyther  <[email protected]>
 
 	* 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  <[email protected]>
+
+	* 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  <[email protected]>
 
 	* 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
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.