[Help-smalltalk] [PATCH] Add memcmp primitive

[Paolo Bonzini]

If a primitive for memmove is good, a primitive for memcmp is surely 
better than comparing the hash values *just because a C hash computation 
is faster than the Smalltalk loop*!  Plus, it applies also to ByteArray, 
though not to Array.

Paolo

diff --git a/kernel/ByteArray.st b/kernel/ByteArray.st
index 3f700f9..3c440af 100644
--- a/kernel/ByteArray.st
+++ b/kernel/ByteArray.st
@@ -527,6 +527,14 @@ a String''s elements are characters.'>
        self checkIndexableBounds: index put: value
     ]
 
+    = aCollection [
+       "Answer whether the receiver's items match those in aCollection"
+
+       <category: 'basic'>
+       <primitive: VMpr_ArrayedCollection_equal>
+       ^false
+    ]
+
     hash [
        "Answer an hash value for the receiver"
 
diff --git a/kernel/String.st b/kernel/String.st
index 75bb098..f4fa99c 100644
--- a/kernel/String.st
+++ b/kernel/String.st
@@ -72,18 +72,12 @@ or assumed to be the system default.'>
        ^false
     ]
 
-    = aString [
+    = aCollection [
        "Answer whether the receiver's items match those in aCollection"
 
        <category: 'basic'>
-       aString isString ifFalse: [^super = aString].
-
-       "Also a String, no need to check the encoding."
-       self size = aString size ifFalse: [^false].
-       self hash == aString hash ifFalse: [^false].
-       1 to: self size
-           do: [:i | (self at: i) == (aString at: i) ifFalse: [^false]].
-       ^true
+       <primitive: VMpr_ArrayedCollection_equal>
+       ^super = aCollection
     ]
 
     , aString [
diff --git a/libgst/prims.def b/libgst/prims.def
index 8b9bc19..796026a 100644
--- a/libgst/prims.def
+++ b/libgst/prims.def
@@ -3073,6 +3073,49 @@ primitive VMpr_String_hash [checks_receiver]
   PRIM_SUCCEEDED;
 }
 
+/* LargeInteger =
+   ByteArray =
+   String =
+   Array = */
+primitive VMpr_ArrayedCollection_equal [succeed,fail]
+{
+  OOP srcOOP, dstOOP;
+  int dstLen, srcLen;
+  gst_uchar *dstBase, *srcBase;
+  _gst_primitives_executed++;
+
+  srcOOP = POP_OOP ();
+  dstOOP = STACKTOP ();
+  if COMMON (OOP_INT_CLASS (srcOOP) == OOP_INT_CLASS (dstOOP))
+    {
+      intptr_t spec = OOP_INSTANCE_SPEC (srcOOP);
+      if (spec & (~0 << ISP_NUMFIXEDFIELDS))
+       goto bad;
+
+      /* dstEnd is inclusive: (1 to: 1) has length 1 */
+      dstLen = NUM_INDEXABLE_FIELDS (dstOOP);
+      srcLen = NUM_INDEXABLE_FIELDS (srcOOP);
+
+      if (dstLen != srcLen)
+       SET_STACKTOP_BOOLEAN (false);
+      else if UNCOMMON (dstLen == 0)
+       SET_STACKTOP_BOOLEAN (true);
+      else
+       {
+         /* do the comparison */
+         dstBase = (gst_uchar *) OOP_TO_OBJ (dstOOP)->data;
+         srcBase = (gst_uchar *) OOP_TO_OBJ (srcOOP)->data;
+         dstLen <<= _gst_log2_sizes[spec & ISP_SHAPE];
+         SET_STACKTOP_BOOLEAN (!memcmp (dstBase, srcBase, dstLen));
+       }
+      PRIM_SUCCEEDED;
+    }
+
+ bad:
+  UNPOP (1);
+  PRIM_FAILED;
+}
+
 /* LargeInteger primReplaceFrom:to:with:startingAt
    ByteArray replaceFrom:to:withString:startingAt:
    String replaceFrom:to:withByteArray:startingAt:
@@ -3126,8 +3169,8 @@ primitive 
VMpr_ArrayedCollection_replaceFromToWithStartingAt [succeed,fail]
       if COMMON (dstRangeLen > 0)
        {
          /* do the copy */
-         dstBase = STRING_OOP_CHARS (dstOOP);
-         srcBase = STRING_OOP_CHARS (srcOOP);
+         dstBase = (gst_uchar *) OOP_TO_OBJ (dstOOP)->data;
+         srcBase = (gst_uchar *) OOP_TO_OBJ (srcOOP)->data;
          dstStartIndex = (dstStartIndex - 1) << size;
          srcIndex = (srcIndex - 1) << size;
          dstRangeLen <<= size;