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

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  <[hidden email]>

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

        * 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  <[hidden email]>
+
+ * kernel/Builtins.st: Use the new built-in for >>#new
+ and >>#new:.
+
 2014-07-26  Holger Hans Peter Freyther  <[hidden email]>
 
  * 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  <[hidden email]>
+
+ * 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  <[hidden email]>
 
  * 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


_______________________________________________
help-smalltalk mailing list
[hidden email]
https://lists.gnu.org/mailman/listinfo/help-smalltalk

On Sat, Aug 02, 2014 at 08:42:45PM +0200, Holger Hans Peter Freyther wrote:


This does break the jit in the processor scheduler.

Program received signal SIGSEGV, Segmentation fault.
next_scheduled_process () at interp.c:1972
1972  if (is_process_ready (get_scheduled_process ()))
(gdb) bt
#0  next_scheduled_process () at interp.c:1972
#1  0xb7f69025 in suspend_process (processOOP=0xb3bb2800) at interp.c:1456
#2  0xb7f69e0f in _gst_terminate_process (processOOP=<optimized out>) at interp.c:1466
#3  _gst_interpret (processOOP=0xb3c16f28) at interp-jit.inl:405
#4  0xb7f6b121 in _gst_nvmsg_send (receiver=0xb3bb2800, sendSelector=0xb3c16f00, args=0x0,
    sendArgs=0) at interp.c:2318
#5  0xb7f14952 in _gst_execute_statements (receiverOOP=0xb3bb2800, method=0xb3c16f00,
    undeclared=true, quiet=true) at comp.c:586
#6  0xb7f06140 in execute_doit (p=0xbffff574, temps=0x0, stmts=0x81a883c,
    receiverOOP=0xb3bb2800, undeclared=true, quiet=false) at gst-parse.c:592
#7  0xb7f07234 in parse_eval_definition (p=0xb3bb2800) at gst-parse.c:756
#8  0xb7f086f7 in parse_scoped_definition (first_stmt=<optimized out>, p=<optimized out>)
    at gst-parse.c:668
#9  parse_doit (p=0xbffff574, fail_at_eof=(true | unknown: 3086476424)) at gst-parse.c:624
#10 0xb7f08d8c in parse_chunks (p=p@entry=0xbffff574) at gst-parse.c:475
#11 0xb7f091af in _gst_parse_chunks (currentNamespace=0x0) at gst-parse.c:449
#12 0xb7f0ad92 in _gst_parse_stream (currentNamespace=0x0) at lex.c:1209
#13 0xb7f35b2e in _gst_process_file (
    fileName=0xb7f7e01d <standard_files+1053> "ObjMemory.st", dir=GST_DIR_KERNEL)
    at input.c:855


I wonder if the SET_STACKTOP is correct before calling the internal
method?

I can't use _gst_intern_string() until a lot later in the setup. I wondered
if we should change the builtin.perf file add a INITIALIZE_SPECIAL as well
(and while we are at it, I find it strange that do: didn't show up in there
at all.

_______________________________________________
help-smalltalk mailing list
[hidden email]
https://lists.gnu.org/mailman/listinfo/help-smalltalk

On Sat, Aug 02, 2014 at 09:01:36PM +0200, Holger Hans Peter Freyther wrote:
> On Sat, Aug 02, 2014 at 08:42:45PM +0200, Holger Hans Peter Freyther wrote:

Dear Paolo,

Okay, before things go wrong Behavior_newInitialize is called while the
processor scheduler is being created.

Created...
(ip 16)ProcessorScheduler>>#initialize
(ip 52)ObjectMemory class>>#initialize
(ip 6)UndefinedObject>>#executeStatements
(ip 0)<bottom>
Created...
(ip 22)ProcessorScheduler>>#initialize
(ip 52)ObjectMemory class>>#initialize
(ip 6)UndefinedObject>>#executeStatements
(ip 0)<bottom>
Created...
(ip 4)Process class>>#on:at:suspend:
(ip 16)BlockClosure>>#forkAt:
(ip 42)ProcessorScheduler>>#initialize
(ip 52)ObjectMemory class>>#initialize
(ip 6)UndefinedObject>>#executeStatements
(ip 0)<bottom>
Created...
(ip 4)Semaphore class>>#forMutualExclusion
(ip 8)[] in Object class>>#finalSemaphore
(ip 8)[] in BlockClosure>>#valueWithoutPreemption
(ip 6)<unwind> BlockClosure>>#ensure:
(ip 10)BlockClosure>>#valueWithoutPreemption
(ip 14)Process class(Object class)>>#finalSemaphore
(ip 8)Process(Object)>>#addToBeFinalized
(ip 34)Process>>#onBlock:at:suspend:
(ip 12)Process class>>#on:at:suspend:
(ip 16)BlockClosure>>#forkAt:
(ip 42)ProcessorScheduler>>#initialize
(ip 52)ObjectMemory class>>#initialize
(ip 6)UndefinedObject>>#executeStatements
(ip 0)<bottom>
No runnable processNo more native? CallinProcess new "<-0x4c3e8d50>" 0
No more native? nil 0

Program received signal SIGSEGV, Segmentation fault.
next_scheduled_process () at interp.c:1980
1980  if (is_process_ready (get_scheduled_process ()))



        if (!native_ip)
          {
            OOP activeProcessOOP = get_scheduled_process ();
            printf("No more native? %O %d\n",
                        activeProcessOOP, is_process_terminating(processOOP));
            gst_callin_process process = (gst_callin_process) OOP_TO_OBJ (activeProcessOOP);
            process->returnedValue = POP_OOP ();
            _gst_terminate_process (activeProcessOOP);
          }


So it appears that get_scheduled_process is NIL as the callin
process we execute is not known. I just don't understand how this
is different to the code that executes basicNew/initialize from
Smalltalk..

So is the issue with native_ip being 0 here or that we are using
the get_scheduled_process.

holger

_______________________________________________
help-smalltalk mailing list
[hidden email]
https://lists.gnu.org/mailman/listinfo/help-smalltalk

On Sun, Aug 03, 2014 at 10:56:19AM +0200, Holger Hans Peter Freyther wrote:

Dear Paolo,

> Okay, before things go wrong Behavior_newInitialize is called while the
> processor scheduler is being created.

valgrind is giving me these with the plain JIT (without my patch
as far as I can see)



==13940== Invalid read of size 4
==13940==    at 0x40CE5E6: sync_wait_process (interp.c:1697)
==13940==    by 0x884D7FF: ???
==13940==    by 0x40CF6AE: _gst_nvmsg_send (interp.c:2318)
==13940==    by 0x404B069: _gst_execute_statements (comp.c:588)
==13940==    by 0x403D3C4: execute_doit (gst-parse.c:592)
==13940==    by 0x403DBFA: make_attribute (gst-parse.c:801)
==13940==    by 0x403F2B6: parse_attribute (gst-parse.c:1497)
==13940==    by 0x403F126: parse_attributes (gst-parse.c:1461)
==13940==    by 0x403ED35: parse_method (gst-parse.c:1333)
==13940==    by 0x403E090: parse_class_definition (gst-parse.c:907)
==13940==    by 0x403D885: parse_scoped_definition (gst-parse.c:718)
==13940==    by 0x403D51E: parse_doit (gst-parse.c:624)


Program received signal SIGTRAP, Trace/breakpoint trap.
sync_wait_process (semaphoreOOP=0x884e460, processOOP=0x410bb64) at interp.c:1697
1697  if (TO_INT (sem->signals) <= 0)
(gdb) bt
#0  sync_wait_process (semaphoreOOP=0x884e460, processOOP=0x410bb64) at interp.c:1697
#1  0x0884d800 in ?? ()
#2  0x040cf5b4 in _gst_nvmsg_send (receiver=0x884d800, sendSelector=0x8852fe8, args=0x0,
    sendArgs=0) at interp.c:2318
#3  0x0404b052 in _gst_execute_statements (receiverOOP=0x884d800, method=0x480c1b0,
    undeclared=false, quiet=true) at comp.c:588
#4  0x0403d3c5 in execute_doit (p=0xbecae4cc, temps=0x0, stmts=0x480c174,
    receiverOOP=0x884d800, undeclared=false, quiet=true) at gst-parse.c:592
#5  0x0403dbfb in make_attribute (p=0xbecae4cc, classOOP=0x884d800,
    attribute_keywords=0x480c138) at gst-parse.c:801
#6  0x0403f2b7 in parse_attribute (p=0xbecae4cc) at gst-parse.c:1497
#7  0x0403f127 in parse_attributes (p=0xbecae4cc, prev_attrs=0x480c090) at gst-parse.c:1461
#8  0x0403ed36 in parse_method (p=0xbecae4cc, at_end=93) at gst-parse.c:1333
#9  0x0403e091 in parse_class_definition (p=0xbecae4cc, classOOP=0x884e460, extend=true)
    at gst-parse.c:907
#10 0x0403d886 in parse_scoped_definition (p=0xbecae4cc, first_stmt=0x480be00)
    at gst-parse.c:718
#11 0x0403d51f in parse_doit (p=0xbecae4cc, fail_at_eof=false) at gst-parse.c:624
#12 0x0403cd07 in parse_chunks (p=0xbecae4cc) at gst-parse.c:475
#13 0x0403cbfd in _gst_parse_chunks (currentNamespace=0x0) at gst-parse.c:449
#14 0x04042df0 in _gst_parse_stream (currentNamespace=0x0) at lex.c:1209
#15 0x04087987 in _gst_process_file (fileName=0x40e7000 <standard_files> "Builtins.st",
    dir=GST_DIR_KERNEL) at input.c:855
#16 0x0403bb7d in load_standard_files () at files.c:582
#17 0x0403b9c2 in _gst_initialize (
    kernel_dir=0x448dc10 "/home/ich/source/smalltalk/smalltalk-jit/kernel",
    image_file=0x40e7696 "gst.im", flags=11) at files.c:524
#18 0x0403acfb in gst_initialize (kernel_dir=0x0, image_file=0x0, flags=3) at gstpub.c:156
#19 0x0804929b in main (argc=2, argv=0xbecae844) at main.c:386
(gdb) c
Continuing.

so this jump just doesn't make any sense. Would you have some time to
go through this with me? :}

_______________________________________________
help-smalltalk mailing list
[hidden email]
https://lists.gnu.org/mailman/listinfo/help-smalltalk

On Sat, Aug 16, 2014 at 09:57:06PM +0200, Holger Hans Peter Freyther wrote:

Hi,


> valgrind is giving me these with the plain JIT (without my patch
> as far as I can see)
>
>
>
> ==13940== Invalid read of size 4
> ==13940==    at 0x40CE5E6: sync_wait_process (interp.c:1697)
> ==13940==    by 0x884D7FF: ???

this is so odd.

mst_Boolean
emit_method_prolog (OOP methodOOP,
                    gst_compiled_method method)

...
  /* Prepare new state */
  jit_movi_i (JIT_R0, stack_depth);
  jit_movi_i (JIT_V2, header.numArgs);
  jit_prepare (2);
  jit_pusharg_p (JIT_V2);
  jit_pusharg_p (JIT_R0);
  jit_finish (PTR_ACTIVATE_NEW_CONTEXT);
  jit_retval (JIT_R0);

jit_finish(PTR_ACTIVATE_NEW_CONTEXT) is generating the bad "call"
to the middle of sync_wait_process. The runtime code has been
initialized as far as I can see though.

Is this more an issue of valgrind?



        if (!native_ip)
          {
            OOP activeProcessOOP = get_scheduled_process ();

              {
                 gst_callin_process process = (gst_callin_process) OOP_TO_OBJ (activeProcessOOP);
                 process->returnedValue = POP_OOP ();
                 _gst_terminate_process (activeProcessOOP);
              }
          }


It appears possible (or due the valgrind issue) that the currently
active process is suspended when native_ip == 0 and that during the
bootstrap no other process is runnable. Do you remember why we have
not used processOOP at this point?


holger

_______________________________________________
help-smalltalk mailing list
[hidden email]
https://lists.gnu.org/mailman/listinfo/help-smalltalk

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  <[hidden email]>

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

        * 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 441b0b3..65b7513 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2014-08-02  Holger Hans Peter Freyther  <[hidden email]>
+
+ * kernel/Builtins.st: Use the new built-in for >>#new
+ and >>#new:.
+
 2014-08-16  Holger Hans Peter Freyther  <[hidden email]>
 
  * kernel/URL.st: Use keyValue instead of value.
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  <[hidden email]>
+
+ * 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  <[hidden email]>
 
  * input.c: Use rl_quote_func_t, rl_dequote_func_t and
diff --git a/libgst/prims.def b/libgst/prims.def
index a67c3fd..431ec2b 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,reload_ip]
+{
+  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,reload_ip]
+{
+  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.1.0


_______________________________________________
help-smalltalk mailing list
[hidden email]
https://lists.gnu.org/mailman/listinfo/help-smalltalk

On Fri, Sep 12, 2014 at 09:44:31PM +0200, Holger Hans Peter Freyther wrote:

> +primitive VMpr_Behavior_newInitialize [succeed,fail,reload_ip]
> +primitive VMpr_Behavior_newColonInitialize [succeed,fail,reload_ip]

*sigh* I was missing the reload_ip here. So xlat.c was never emitting
the check for seeing if the ip has been changed. I only noticed this
by creating a "Semaphore class >> #new" that will call basicNew and
initialize to bootstrap my image and then noticing that >>#initialize
of the RecursionLock would never be called. That was a tricky one.

It would be incredible nice to have an early emergency evaluator and
if we could step through the bootstrap process..

Any objections to the patch? It makes up the speed decrease I created
by going through the >>#initialize method.

holger


_______________________________________________
help-smalltalk mailing list
[hidden email]
https://lists.gnu.org/mailman/listinfo/help-smalltalk