[PATCH 0/4] fix problems accessing sp

The first two patches fix some problems where the context stack was being
accessed with a 0-based index, or with a wrong sp.  This "worked" because
of another bug in checking the index of #basicAt: and #basicAt:put:
whenever a class had both fixed and indexed instance variables.
Interestingly, the check worked for the JIT compiler but was broken in
the interpreter, hence the bugs were already visible but only in the JIT.

To make a better fix for patch 2, I would really like to bump the
version of the image format, and remove the "receiver" variable of
contexts.  Instead, the receiver would always be in the first stack
slot.  This removes the case where the stack is empty, and simplifies
things a bit.  It can be done later, though.

Please test these patches more so that we can apply them and also
fix the JIT.  Thanks!

Paolo

Paolo Bonzini (4):
  fix off by one sp for PUSH_LITERAL/MAKE_DIRTY_BLOCK combined bytecode
  fix off-by-one using ContextPart's sp instance variable
  tweak index_oop_spec and index_oop_put_spec index computations
  fix overflow check for #basicAt: and #basicAt:put:

 ChangeLog             |  6 ++++++
 kernel/BlkClosure.st  |  9 ++++++---
 kernel/ContextPart.st | 10 ++++++----
 libgst/ChangeLog      | 22 ++++++++++++++++++++++
 libgst/dict.inl       | 44 ++++++++++++++++++++++++--------------------
 libgst/genvm-parse.y  | 12 ++++++++++--
 libgst/vm.def         |  4 ++++
 7 files changed, 78 insertions(+), 29 deletions(-)

--
1.8.3.1


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

libgst:
2013-10-07  Paolo Bonzini  <[hidden email]>

        * libgst/genvm-parse.def: Emit definitions for UNDO_PREPARE_STACK.
        * libgst/vm.def: Wrap calls to _gst_make_block_closure with
        PREPARE_STACK and UNDO_PREPARE_STACK.  Otherwise, the sp
        that empty_context_stack saves in the context is off by one.
---
 libgst/ChangeLog     |  7 +++++++
 libgst/genvm-parse.y | 12 ++++++++++--
 libgst/vm.def        |  4 ++++
 3 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/libgst/ChangeLog b/libgst/ChangeLog
index c3bee00..822f86c 100644
--- a/libgst/ChangeLog
+++ b/libgst/ChangeLog
@@ -1,3 +1,10 @@
+2013-10-07  Paolo Bonzini  <[hidden email]>
+
+ * libgst/genvm-parse.def: Emit definitions for UNDO_PREPARE_STACK.
+ * libgst/vm.def: Wrap calls to _gst_make_block_closure with
+ PREPARE_STACK and UNDO_PREPARE_STACK.  Otherwise, the sp
+ that empty_context_stack saves in the context is off by one.
+
 2013-08-09  Holger Hans Peter Freyther  <[hidden email]>
 
  * libgst/cint.c: Bind link, fsync, fdatasync and sync for
diff --git a/libgst/genvm-parse.y b/libgst/genvm-parse.y
index 483171c..691d9d4 100644
--- a/libgst/genvm-parse.y
+++ b/libgst/genvm-parse.y
@@ -625,6 +625,12 @@ emit_operation_invocation (operation_info *op, struct id_list *args, int sp, int
       filprintf (out_fil, "#define PREPARE_STACK() do { \\\n");
       emit_stack_update (sp, deepest_write, "    ", "; \\");
       filprintf (out_fil, "  } while (0)\n");
+      if (sp >= 0)
+        {
+          filprintf (out_fil, "#define UNDO_PREPARE_STACK() do { \\\n");
+          emit_stack_update (-sp, 0, "    ", "; \\");
+          filprintf (out_fil, "  } while (0)\n");
+        }
     }
 
   if (op->needs_branch_label)
@@ -644,8 +650,10 @@ emit_operation_invocation (operation_info *op, struct id_list *args, int sp, int
     filprintf (out_fil, "#undef BRANCH_LABEL\n\n");
 
   if (op->needs_prepare_stack)
-    filprintf (out_fil, "#undef PREPARE_STACK\n");
-
+    {
+      filprintf (out_fil, "#undef PREPARE_STACK\n");
+      filprintf (out_fil, "#undef UNDO_PREPARE_STACK\n");
+    }
   emit_id_list (op->read, "\n#undef ", "#undef ", "\n");
   emit_id_list (op->in, "\n#undef ", "#undef ", "\n");
   emit_id_list (op->out, "\n#undef ", "#undef ", "\n");
diff --git a/libgst/vm.def b/libgst/vm.def
index fb0b61b..7d48bdf 100644
--- a/libgst/vm.def
+++ b/libgst/vm.def
@@ -828,12 +828,15 @@ operation POP_STACK_TOP ( tos -- ) {
 }
 
 operation MAKE_DIRTY_BLOCK ( block -- closure ) {
+  PREPARE_STACK ();
   EXPORT_REGS ();
   closure = _gst_make_block_closure (block);
   IMPORT_REGS();
+  UNDO_PREPARE_STACK ();
 }
 
 operation RETURN_METHOD_STACK_TOP ( val -- val ) {
+  /* The current context dies here, so the stack need not be prepared.  */
   EXPORT_REGS ();
   if UNCOMMON (!unwind_method ())
     {
@@ -849,6 +852,7 @@ operation RETURN_METHOD_STACK_TOP ( val -- val ) {
 }
 
 operation RETURN_CONTEXT_STACK_TOP ( val -- val ) {
+  /* The current context dies here, so the stack need not be prepared.  */
   EXPORT_REGS ();
   unwind_context ();
   IMPORT_REGS ();
--
1.8.3.1



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

2013-10-07  Paolo Bonzini  <[hidden email]>

        * kernel/BlkClosure.st: Fix off-by-one using the sp variable
        of contexts.
        * kernel/ContextPart.st: Likewise.
---
 ChangeLog             |  6 ++++++
 kernel/BlkClosure.st  |  9 ++++++---
 kernel/ContextPart.st | 10 ++++++----
 3 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 907cd71..cd33f5d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2013-10-07  Paolo Bonzini  <[hidden email]>
+
+ * kernel/BlkClosure.st: Fix off-by-one using the sp variable
+ of contexts.
+ * kernel/ContextPart.st: Likewise.
+
 2013-09-28  Holger Hans Peter Freyther  <[hidden email]>
 
  * kernel/DirPackage.st: Add PackageLoader>>#insertPackage:
diff --git a/kernel/BlkClosure.st b/kernel/BlkClosure.st
index af85fbc..7f79ab4 100644
--- a/kernel/BlkClosure.st
+++ b/kernel/BlkClosure.st
@@ -173,9 +173,12 @@ creation of Processes from blocks.'>
         top := parent isNil
     ifTrue: [nil]
     ifFalse: [
- parent sp == 0
-    ifTrue: [parent receiver]
-    ifFalse: [parent at: parent sp]].
+                        "This is really ugly.  The right solution would be
+                         to move the receiver into the first stack slot,
+                         so that sp is guaranteed to be non-negative."
+ parent sp == -1
+    ifTrue: [parent instVarAt: parent class instSize]
+    ifFalse: [parent at: parent sp + 1]].
         self value. top]
     parent: parent.
     ]
diff --git a/kernel/ContextPart.st b/kernel/ContextPart.st
index e8a160c..2c6d5e8 100644
--- a/kernel/ContextPart.st
+++ b/kernel/ContextPart.st
@@ -435,7 +435,8 @@ methods that can be used in inspection or debugging.'>
     ]
 
     sp [
- "Answer the current stack pointer into the receiver"
+ "Answer the current stack pointer into the receiver.  Note that the
+ sp value is zero-based."
 
  "This funny implementation thwarts the interpreter's optimizing effort"
 
@@ -471,9 +472,9 @@ methods that can be used in inspection or debugging.'>
  makes them valid *before* they become accessible."
 
  <category: 'accessing'>
- self at: sp + 1 put: nil.
+ self at: self size + 1 put: nil.
  sp := sp + 1.
- self at: sp put: anObject.
+ self at: self size put: anObject.
     ]
 
     sp: newSP [
@@ -487,7 +488,8 @@ methods that can be used in inspection or debugging.'>
  <category: 'accessing'>
  newSP isSmallInteger
     ifFalse: [^SystemExceptions.WrongClass signalOn: newSP mustBe: SmallInteger].
- newSP > sp ifTrue: [sp + 1 to: newSP do: [:i | self at: i put: nil]].
+ newSP > sp ifTrue: [
+    self size + 1 to: newSP + 1 do: [:i | self at: i put: nil]].
  sp := newSP
     ]
 
--
1.8.3.1



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

libgst:
2013-10-07  Paolo Bonzini  <[hidden email]>

        * libgst/dict.inl: In index_oop_spec and index_oop_put_spec,
        move index decrement after the scaling by sizeof(type) and the
        overflow test. This prepares for fixing the overflow test.
---
 libgst/ChangeLog |  6 ++++++
 libgst/dict.inl  | 20 ++++++++++----------
 2 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/libgst/ChangeLog b/libgst/ChangeLog
index 822f86c..d49cfa2 100644
--- a/libgst/ChangeLog
+++ b/libgst/ChangeLog
@@ -1,5 +1,11 @@
 2013-10-07  Paolo Bonzini  <[hidden email]>
 
+ * libgst/dict.inl: In index_oop_spec and index_oop_put_spec,
+ move index decrement after the scaling by sizeof(type) and the
+ overflow test. This prepares for fixing the overflow test.
+
+2013-10-07  Paolo Bonzini  <[hidden email]>
+
  * libgst/genvm-parse.def: Emit definitions for UNDO_PREPARE_STACK.
  * libgst/vm.def: Wrap calls to _gst_make_block_closure with
  PREPARE_STACK and UNDO_PREPARE_STACK.  Otherwise, the sp
diff --git a/libgst/dict.inl b/libgst/dict.inl
index 434906a..3b029b0 100644
--- a/libgst/dict.inl
+++ b/libgst/dict.inl
@@ -985,8 +985,6 @@ index_oop_spec (OOP oop,
   if UNCOMMON (index < 1)
     return (NULL);
 
-  index--;
-
 #define DO_INDEX_OOP(type, dest) \
     /* Find the number of bytes in the object.  */ \
     maxByte = NUM_WORDS (object) * sizeof (PTR); \
@@ -998,9 +996,11 @@ index_oop_spec (OOP oop,
       + (instanceSpec >> ISP_NUMFIXEDFIELDS) * sizeof (PTR); \
  \
     /* Check that we're on bounds.  */ \
-    if UNCOMMON (index + sizeof(type) > maxByte) \
+    if UNCOMMON (index > maxByte) \
       return (NULL); \
  \
+    index -= sizeof(type); \
+ \
     /* Use a cast if unaligned accesses are supported, else memcpy.  */ \
     src = ((char *) object->data) + index; \
     if (sizeof (type) <= sizeof (PTR)) \
@@ -1085,10 +1085,10 @@ index_oop_spec (OOP oop,
       case GST_ISP_POINTER:
         maxIndex = NUM_WORDS (object);
         index += instanceSpec >> ISP_NUMFIXEDFIELDS;
-        if UNCOMMON (index >= maxIndex)
+        if UNCOMMON (index > maxIndex)
   return (NULL);
 
-        return (object->data[index]);
+        return (object->data[index - 1]);
     }
 #undef DO_INDEX_OOP
 
@@ -1117,8 +1117,6 @@ index_oop_put_spec (OOP oop,
   if UNCOMMON (index < 1)
     return (false);
 
-  index--;
-
 #define DO_INDEX_OOP_PUT(type, cond, src) \
     if COMMON (cond) \
       { \
@@ -1132,9 +1130,11 @@ index_oop_put_spec (OOP oop,
           + (instanceSpec >> ISP_NUMFIXEDFIELDS) * sizeof (PTR); \
  \
         /* Check that we're on bounds.  */ \
-        if UNCOMMON (index + sizeof(type) > maxByte) \
+        if UNCOMMON (index > maxByte) \
           return (false); \
  \
+        index -= sizeof(type); \
+ \
         /* Use a cast if unaligned accesses are ok, else memcpy.  */ \
         if (sizeof (type) <= sizeof (PTR)) \
   { \
@@ -1251,10 +1251,10 @@ index_oop_put_spec (OOP oop,
       case GST_ISP_POINTER:
         maxIndex = NUM_WORDS (object);
         index += instanceSpec >> ISP_NUMFIXEDFIELDS;
-        if UNCOMMON (index >= maxIndex)
+        if UNCOMMON (index > maxIndex)
   return (false);
 
-        object->data[index] = value;
+        object->data[index - 1] = value;
         return (true);
     }
 #undef DO_INDEX_OOP_PUT
--
1.8.3.1



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

libgst:
2013-10-07  Paolo Bonzini  <[hidden email]>

        * libgst/dict.inl: Fix overflow check in index_oop_spec and
        index_oop_put_spec.  This use the trick of converting
        (a < x || a > y) to (a - x > y - x).  Adjusting "index" after
        the check helps because we can compare with "> maxByte" instead
        of ">= maxByte + sizeof(type) - 1".  On the other hand, we
        have to do a somewhat ugly adjust to base.
---
 libgst/ChangeLog |  9 +++++++++
 libgst/dict.inl  | 32 ++++++++++++++++++--------------
 2 files changed, 27 insertions(+), 14 deletions(-)

diff --git a/libgst/ChangeLog b/libgst/ChangeLog
index d49cfa2..cf5275d 100644
--- a/libgst/ChangeLog
+++ b/libgst/ChangeLog
@@ -1,5 +1,14 @@
 2013-10-07  Paolo Bonzini  <[hidden email]>
 
+ * libgst/dict.inl: Fix overflow check in index_oop_spec and
+ index_oop_put_spec.  This use the trick of converting
+ (a < x || a > y) to (a - x > y - x).  Adjusting "index" after
+ the check helps because we can compare with "> maxByte" instead
+ of ">= maxByte + sizeof(type) - 1".  On the other hand, we
+ have to do a somewhat ugly adjust to base.
+
+2013-10-07  Paolo Bonzini  <[hidden email]>
+
  * libgst/dict.inl: In index_oop_spec and index_oop_put_spec,
  move index decrement after the scaling by sizeof(type) and the
  overflow test. This prepares for fixing the overflow test.
diff --git a/libgst/dict.inl b/libgst/dict.inl
index 3b029b0..528f870 100644
--- a/libgst/dict.inl
+++ b/libgst/dict.inl
@@ -979,7 +979,7 @@ index_oop_spec (OOP oop,
         size_t index,
  intptr_t instanceSpec)
 {
-  size_t maxIndex, maxByte;
+  size_t maxIndex, maxByte, base;
   char *src;
 
   if UNCOMMON (index < 1)
@@ -991,12 +991,12 @@ index_oop_spec (OOP oop,
     if (sizeof (type) <= sizeof (PTR)) \
       maxByte -= (oop->flags & EMPTY_BYTES); \
  \
-    index = \
-      index * sizeof(type) \
-      + (instanceSpec >> ISP_NUMFIXEDFIELDS) * sizeof (PTR); \
+    base = (instanceSpec >> ISP_NUMFIXEDFIELDS) * sizeof (PTR); \
+    index = base + index * sizeof(type); \
  \
     /* Check that we're on bounds.  */ \
-    if UNCOMMON (index > maxByte) \
+    base += sizeof(type); \
+    if UNCOMMON (index - base > maxByte - base) \
       return (NULL); \
  \
     index -= sizeof(type); \
@@ -1084,8 +1084,10 @@ index_oop_spec (OOP oop,
 
       case GST_ISP_POINTER:
         maxIndex = NUM_WORDS (object);
-        index += instanceSpec >> ISP_NUMFIXEDFIELDS;
-        if UNCOMMON (index > maxIndex)
+        base = instanceSpec >> ISP_NUMFIXEDFIELDS;
+        index += base;
+        base++;
+        if UNCOMMON (index - base > maxIndex - base)
   return (NULL);
 
         return (object->data[index - 1]);
@@ -1112,7 +1114,7 @@ index_oop_put_spec (OOP oop,
     OOP value,
     intptr_t instanceSpec)
 {
-  size_t maxIndex;
+  size_t maxIndex, base;
 
   if UNCOMMON (index < 1)
     return (false);
@@ -1125,12 +1127,12 @@ index_oop_put_spec (OOP oop,
         if (sizeof (type) <= sizeof (PTR)) \
           maxByte -= (oop->flags & EMPTY_BYTES); \
  \
-        index = \
-          index * sizeof(type) \
-          + (instanceSpec >> ISP_NUMFIXEDFIELDS) * sizeof (PTR); \
+          base = (instanceSpec >> ISP_NUMFIXEDFIELDS) * sizeof (PTR); \
+          index = base + index * sizeof(type); \
  \
         /* Check that we're on bounds.  */ \
-        if UNCOMMON (index > maxByte) \
+        base += sizeof(type); \
+        if UNCOMMON (index - base > maxByte - base) \
           return (false); \
  \
         index -= sizeof(type); \
@@ -1250,8 +1252,10 @@ index_oop_put_spec (OOP oop,
 
       case GST_ISP_POINTER:
         maxIndex = NUM_WORDS (object);
-        index += instanceSpec >> ISP_NUMFIXEDFIELDS;
-        if UNCOMMON (index > maxIndex)
+        base = instanceSpec >> ISP_NUMFIXEDFIELDS;
+        index += base;
+        base++;
+        if UNCOMMON (index - base > maxIndex - base)
   return (false);
 
         object->data[index - 1] = value;
--
1.8.3.1


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

Il 07/10/2013 10:17, Paolo Bonzini ha scritto:
I pushed this series together with a testcase from Gwen.

Paolo

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