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 <hol...@freyther.de>
* 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 <hol...@freyther.de>
* 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 <hol...@freyther.de>
+
+ * kernel/Builtins.st: Use the new built-in for >>#new
+ and >>#new:.
+
2014-07-26 Holger Hans Peter Freyther <hol...@freyther.de>
* 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 <hol...@freyther.de>
+
+ * 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 <hol...@moiji-mobile.com>
* 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, ¤tOOP);
+ 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
_______________________________________________
help-smalltalk mailing list
help-smalltalk@gnu.org
https://lists.gnu.org/mailman/listinfo/help-smalltalk
