[PATCH] Add memcmp primitive

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;

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