>From f9c742d176e8f5c43d49acc5f2fb239ba8e871a3 Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
Date: Fri, 24 Jun 2011 08:11:59 +0200
Subject: [PATCH 01/10] OrderedCollection
---
kernel/OrderColl.st | 11 ++++--
libgst/prims.def | 64 ++++++++++++++++++++++++++++++++++++++++
snprintfv/snprintfv/filament.h | 4 +-
snprintfv/snprintfv/printf.h | 8 ++--
snprintfv/snprintfv/stream.h | 4 +-
5 files changed, 79 insertions(+), 12 deletions(-)
diff --git a/kernel/OrderColl.st b/kernel/OrderColl.st
index 7d15dd4..0adfddc 100644
--- a/kernel/OrderColl.st
+++ b/kernel/OrderColl.st
@@ -508,13 +508,16 @@ on content (such as add:after:)'>
| newOrderedCollection |
newOrderedCollection := self copyEmpty: self basicSize + delta.
- firstIndex to: lastIndex
- do:
- [:index |
- newOrderedCollection basicAt: index + shiftCount put: (self basicAt: index)].
+ newOrderedCollection primReplaceFrom: firstIndex + shiftCount to: lastIndex + shiftCount with: self startingAt: firstIndex.
newOrderedCollection firstIndex: firstIndex + shiftCount
lastIndex: lastIndex + shiftCount.
self become: newOrderedCollection
]
+
+ primReplaceFrom: aFromInteger to: aToInteger with: anOrderedCollection startingAt: aStartInteger [
+
+
+
+ ]
]
diff --git a/libgst/prims.def b/libgst/prims.def
index 5eff664..dbed9c8 100644
--- a/libgst/prims.def
+++ b/libgst/prims.def
@@ -3303,6 +3303,70 @@ primitive VMpr_ArrayedCollection_replaceFromToWithStartingAt [succeed,fail]
UNPOP (4);
PRIM_FAILED;
}
+
+/* OrderedCollection primReplaceFrom:to:with:startingAt:*/
+primitive VMpr_OrderedCollection_replaceFromToWithStartingAt [succeed,fail]
+{
+ OOP srcIndexOOP, srcOOP, dstEndIndexOOP, dstStartIndexOOP, dstOOP;
+ int dstEndIndex, dstStartIndex, srcIndex, dstLen, srcLen, dstRangeLen;
+ gst_uchar *dstBase, *srcBase;
+ _gst_primitives_executed++;
+
+ srcIndexOOP = POP_OOP ();
+ srcOOP = POP_OOP ();
+ dstEndIndexOOP = POP_OOP ();
+ dstStartIndexOOP = POP_OOP ();
+ dstOOP = STACKTOP ();
+ if COMMON (IS_INT (srcIndexOOP) && IS_INT (dstStartIndexOOP)
+ && IS_INT (dstEndIndexOOP) && !IS_INT (srcOOP))
+ {
+ intptr_t srcSpec = OOP_INSTANCE_SPEC (srcOOP);
+ intptr_t dstSpec = OOP_INSTANCE_SPEC (dstOOP);
+ int srcOffset = srcSpec >> ISP_NUMFIXEDFIELDS;
+ int dstOffset = dstSpec >> ISP_NUMFIXEDFIELDS;
+ int size;
+
+ /* Check compatibility. */
+ size = _gst_log2_sizes[srcSpec & ISP_SHAPE];
+ if (size != _gst_log2_sizes[dstSpec & ISP_SHAPE])
+ goto bad;
+ if (((srcSpec & ISP_INDEXEDVARS) == GST_ISP_POINTER)
+ != ((dstSpec & ISP_INDEXEDVARS) == GST_ISP_POINTER))
+ goto bad;
+
+ /* dstEnd is inclusive: (1 to: 1) has length 1 */
+ dstEndIndex = TO_INT (dstEndIndexOOP);
+ dstStartIndex = TO_INT (dstStartIndexOOP);
+ srcIndex = TO_INT (srcIndexOOP);
+ dstOOP = STACKTOP ();
+ dstLen = NUM_INDEXABLE_FIELDS (dstOOP);
+ srcLen = NUM_INDEXABLE_FIELDS (srcOOP);
+ dstRangeLen = dstEndIndex - dstStartIndex + 1;
+
+ if UNCOMMON (dstRangeLen < 0
+ || dstEndIndex > dstLen || dstStartIndex <= 0
+ || srcIndex + dstRangeLen - 1 > srcLen
+ || (srcIndex <= 0 && dstRangeLen > 0))
+ goto bad;
+
+ /* don't do it unless there's something to copy */
+ if COMMON (dstRangeLen > 0)
+ {
+ /* do the copy */
+ dstBase = (gst_uchar *) &(OOP_TO_OBJ (dstOOP)->data[dstOffset]);
+ srcBase = (gst_uchar *) &(OOP_TO_OBJ (srcOOP)->data[srcOffset]);
+ dstStartIndex = (dstStartIndex - 1) << size;
+ srcIndex = (srcIndex - 1) << size;
+ dstRangeLen <<= size;
+ memmove (&dstBase[dstStartIndex], &srcBase[srcIndex], dstRangeLen);
+ }
+ PRIM_SUCCEEDED;
+ }
+
+ bad:
+ UNPOP (4);
+ PRIM_FAILED;
+}
/* Object == */
diff --git a/snprintfv/snprintfv/filament.h b/snprintfv/snprintfv/filament.h
index 4a91eb6..8a7ce6c 100644
--- a/snprintfv/snprintfv/filament.h
+++ b/snprintfv/snprintfv/filament.h
@@ -1,4 +1,4 @@
-#line 1 "../../../snprintfv/snprintfv/filament.in"
+#line 1 "./filament.in"
/* -*- Mode: C -*- */
/* filament.h --- a bit like a string but different =)O|
@@ -118,7 +118,7 @@ extern char * fildelete (Filament *fil);
extern void _fil_extend (Filament *fil, size_t len, boolean copy);
-#line 61 "../../../snprintfv/snprintfv/filament.in"
+#line 61 "./filament.in"
/* Save the overhead of a function call in the great majority of cases. */
#define fil_maybe_extend(fil, len, copy) \
diff --git a/snprintfv/snprintfv/printf.h b/snprintfv/snprintfv/printf.h
index 49a2e9f..1437dd5 100644
--- a/snprintfv/snprintfv/printf.h
+++ b/snprintfv/snprintfv/printf.h
@@ -1,4 +1,4 @@
-#line 1 "../../../snprintfv/snprintfv/printf.in"
+#line 1 "./printf.in"
/* -*- Mode: C -*- */
/* printf.in --- printf clone for argv arrays
@@ -266,7 +266,7 @@ enum
} \
} SNV_STMT_END
-#line 269 "../../../snprintfv/snprintfv/printf.in"
+#line 269 "./printf.in"
/**
* printf_generic_info:
* @pinfo: the current state information for the format
@@ -302,7 +302,7 @@ extern int printf_generic_info (struct printf_info *const pinfo, size_t n, int *
extern int printf_generic (STREAM *stream, struct printf_info *const pinfo, union printf_arg const *args);
-#line 270 "../../../snprintfv/snprintfv/printf.in"
+#line 270 "./printf.in"
/**
* register_printf_function:
* @spec: the character which will trigger @func, cast to an unsigned int.
@@ -789,7 +789,7 @@ extern int snv_vasprintf (char **result, const char *format, va_list ap);
extern int snv_asprintfv (char **result, const char *format, snv_constpointer const args[]);
-#line 271 "../../../snprintfv/snprintfv/printf.in"
+#line 271 "./printf.in"
/* If you don't want to use snprintfv functions for *all* of your string
formatting API, then define COMPILING_SNPRINTFV_C and use the snv_
diff --git a/snprintfv/snprintfv/stream.h b/snprintfv/snprintfv/stream.h
index 496bd33..0bebce1 100644
--- a/snprintfv/snprintfv/stream.h
+++ b/snprintfv/snprintfv/stream.h
@@ -1,4 +1,4 @@
-#line 1 "../../../snprintfv/snprintfv/stream.in"
+#line 1 "./stream.in"
/* -*- Mode: C -*- */
/* stream.h --- customizable stream routines
@@ -180,7 +180,7 @@ extern int stream_puts (char *s, STREAM *stream);
extern int stream_get (STREAM *stream);
-#line 88 "../../../snprintfv/snprintfv/stream.in"
+#line 88 "./stream.in"
#ifdef __cplusplus
#if 0
/* This brace is so that emacs can still indent properly: */
--
1.7.4.1
>From 0a03265376b7ded2e1c47cb43ad7f44a2c6f9987 Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
Date: Mon, 27 Jun 2011 16:32:56 +0200
Subject: [PATCH 02/10] move beConsistent
---
kernel/OrderColl.st | 10 ---------
kernel/SortCollect.st | 51 +++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 51 insertions(+), 10 deletions(-)
diff --git a/kernel/OrderColl.st b/kernel/OrderColl.st
index 0adfddc..63154dc 100644
--- a/kernel/OrderColl.st
+++ b/kernel/OrderColl.st
@@ -61,7 +61,6 @@ on content (such as add:after:)'>
| index |
- self beConsistent.
index := firstIndex.
[ index <= lastIndex ] whileTrue: [
aBlock value: (self basicAt: index).
@@ -72,7 +71,6 @@ on content (such as add:after:)'>
"Answer the first item of the receiver"
- self beConsistent.
^lastIndex >= firstIndex
ifTrue: [self basicAt: firstIndex]
ifFalse: [SystemExceptions.IndexOutOfRange signalOn: self withIndex: 1]
@@ -82,7 +80,6 @@ on content (such as add:after:)'>
"Answer the last item of the receiver"
- self beConsistent.
^lastIndex >= firstIndex
ifTrue: [self basicAt: lastIndex]
ifFalse: [SystemExceptions.IndexOutOfRange signalOn: self withIndex: 0]
@@ -93,7 +90,6 @@ on content (such as add:after:)'>
| index |
- self beConsistent.
index := anIndex + firstIndex - 1.
^(index >= firstIndex and: [index <= lastIndex])
ifTrue: [self basicAt: index]
@@ -105,7 +101,6 @@ on content (such as add:after:)'>
| index |
- self beConsistent.
index := anIndex + firstIndex - 1.
(index >= firstIndex and: [index <= lastIndex])
ifTrue: [^self basicAt: index put: anObject]
@@ -292,7 +287,6 @@ on content (such as add:after:)'>
| answer |
- self beConsistent.
lastIndex < firstIndex
ifTrue: [^SystemExceptions.EmptyCollection signalOn: self].
answer := self basicAt: firstIndex. "Get the element"
@@ -300,7 +294,6 @@ on content (such as add:after:)'>
lastIndex = firstIndex
ifTrue: [self initIndices]
ifFalse: [firstIndex := firstIndex + 1].
- self size < self shrinkSize ifTrue: [self shrink].
^answer
]
@@ -310,7 +303,6 @@ on content (such as add:after:)'>
| answer |
- self beConsistent.
lastIndex < firstIndex
ifTrue: [^SystemExceptions.EmptyCollection signalOn: self].
answer := self basicAt: lastIndex. "Get the element"
@@ -318,7 +310,6 @@ on content (such as add:after:)'>
lastIndex = firstIndex
ifTrue: [self initIndices]
ifFalse: [lastIndex := lastIndex - 1].
- self size < self shrinkSize ifTrue: [self shrink].
^answer
]
@@ -370,7 +361,6 @@ on content (such as add:after:)'>
| answer |
- self beConsistent.
lastIndex < firstIndex
ifTrue: [^SystemExceptions.EmptyCollection signalOn: self].
(anIndex < 1 or: [anIndex > self size])
diff --git a/kernel/SortCollect.st b/kernel/SortCollect.st
index fb5c13e..5e33599 100644
--- a/kernel/SortCollect.st
+++ b/kernel/SortCollect.st
@@ -113,6 +113,56 @@ above criteria -- actually any object which responds to #value:value:.'>
self shouldNotImplement
]
+ first [
+ "Answer the first item of the receiver"
+
+
+ self beConsistent.
+ ^ super first
+ ]
+
+ last [
+ "Answer the last item of the receiver"
+
+
+ self beConsistent.
+ ^ super last
+ ]
+
+ at: anIndex [
+ "Answer the anIndex-th item of the receiver"
+
+
+ self beConsistent.
+ ^ super at: anIndex
+ ]
+
+ do: aBlock [
+ "Evaluate aBlock for all the elements in the collection"
+
+
+ self beConsistent.
+ super do: aBlock
+ ]
+
+ removeFirst [
+ "Remove an object from the start of the receiver. Fail if the receiver
+ is empty"
+
+
+ self beConsistent.
+ ^ super removeFirst
+ ]
+
+ removeLast [
+ "Remove an object from the end of the receiver. Fail if the receiver
+ is empty"
+
+
+ self beConsistent.
+ ^ super removeLast
+ ]
+
last [
"Answer the last item of the receiver"
@@ -282,6 +332,7 @@ above criteria -- actually any object which responds to #value:value:.'>
| answer |
+ self beConsistent.
answer := super basicRemoveAtIndex: anIndex.
"Ensure the invariant that lastOrdered <= lastIndex, otherwise
--
1.7.4.1
>From 85ca6795a63ba4406a0da9e4537d52b1a524daf9 Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
Date: Mon, 27 Jun 2011 17:13:53 +0200
Subject: [PATCH 03/10] beConsistent refactoring
---
kernel/Dictionary.st | 4 ----
kernel/HashedColl.st | 3 ---
kernel/IdentDict.st | 4 ----
kernel/IdentitySet.st | 2 --
kernel/Set.st | 2 --
kernel/WeakObjects.st | 27 +++++++++++++++++++++++++++
6 files changed, 27 insertions(+), 15 deletions(-)
diff --git a/kernel/Dictionary.st b/kernel/Dictionary.st
index 9f2f10e..e5d7914 100644
--- a/kernel/Dictionary.st
+++ b/kernel/Dictionary.st
@@ -568,8 +568,6 @@ certain special cases.'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject key hash scramble bitAnd: (size := self primSize) - 1) + 1.
@@ -585,8 +583,6 @@ certain special cases.'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject hash scramble bitAnd: (size := self primSize) - 1) + 1.
diff --git a/kernel/HashedColl.st b/kernel/HashedColl.st
index 1af0fc0..345e1ec 100644
--- a/kernel/HashedColl.st
+++ b/kernel/HashedColl.st
@@ -196,7 +196,6 @@ give fast responses on their presence in the collection.'>
"Enumerate all the non-nil members of the set"
- self beConsistent.
1 to: self primSize
do: [:i | (self primAt: i) notNil ifTrue: [aBlock value: (self primAt: i)]]
]
@@ -334,8 +333,6 @@ give fast responses on their presence in the collection.'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject hash scramble bitAnd: (size := self primSize) - 1) + 1.
diff --git a/kernel/IdentDict.st b/kernel/IdentDict.st
index 3e7130d..0db6414 100644
--- a/kernel/IdentDict.st
+++ b/kernel/IdentDict.st
@@ -60,8 +60,6 @@ comparision message == to determine equivalence of indices.'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble bitAnd: (size := self primSize) - 1) + 1.
@@ -77,8 +75,6 @@ comparision message == to determine equivalence of indices.'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
diff --git a/kernel/IdentitySet.st b/kernel/IdentitySet.st
index ebe73f5..637e0ea 100644
--- a/kernel/IdentitySet.st
+++ b/kernel/IdentitySet.st
@@ -59,8 +59,6 @@ use the == operator to determine duplication of objects.'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
diff --git a/kernel/Set.st b/kernel/Set.st
index 56fbddf..6ed2d9d 100644
--- a/kernel/Set.st
+++ b/kernel/Set.st
@@ -123,8 +123,6 @@ on my instances.'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject hash scramble bitAnd: (size := self primSize) - 1) + 1.
diff --git a/kernel/WeakObjects.st b/kernel/WeakObjects.st
index 25cf7f9..52eb297 100644
--- a/kernel/WeakObjects.st
+++ b/kernel/WeakObjects.st
@@ -506,6 +506,33 @@ for the garbage collected values'>
(key at: i) isNil
ifFalse: [self whileGrowingAt: (key at: i) put: (val at: i)]]
]
+
+ findElementIndex: anObject [
+ "Tries to see where anObject can be placed as an indexed variable.
+ As soon as nil is found, the index of that slot is answered.
+ anObject also comes from an indexed variable."
+
+
+ self beConsistent.
+ ^ super findElementIndex: anObject
+ ]
+
+ findIndex: anObject [
+ "Tries to see if anObject exists as an indexed variable. As soon as nil
+ or anObject is found, the index of that slot is answered"
+
+
+ self beConsistent.
+ ^ super findIndex: anObject
+ ]
+
+ do: aBlock [
+ "Enumerate all the non-nil members of the set"
+
+
+ self beConsistent.
+ super do: aBlock
+ ]
]
--
1.7.4.1
>From d27e18c1130633c6869d2ccc6a572dbc49e114fe Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
Date: Tue, 28 Jun 2011 15:29:26 +0200
Subject: [PATCH 04/10] change
---
kernel/OrderColl.st | 27 +++++++++++++++++
libgst/dict.c | 2 +-
libgst/prims.def | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 109 insertions(+), 1 deletions(-)
diff --git a/kernel/OrderColl.st b/kernel/OrderColl.st
index 63154dc..c86e2e4 100644
--- a/kernel/OrderColl.st
+++ b/kernel/OrderColl.st
@@ -497,13 +497,40 @@ on content (such as add:after:)'>
| newOrderedCollection |
+ "newOrderedCollection := self copyEmpty: self basicSize + delta.
+ newOrderedCollection firstIndex: firstIndex + shiftCount lastIndex: lastIndex + shiftCount.
+ newOrderedCollection treplaceFrom: 1 to: newOrderedCollection size with: self startingAt: 1.
+ self become: newOrderedCollection."
+
newOrderedCollection := self copyEmpty: self basicSize + delta.
newOrderedCollection primReplaceFrom: firstIndex + shiftCount to: lastIndex + shiftCount with: self startingAt: firstIndex.
newOrderedCollection firstIndex: firstIndex + shiftCount
lastIndex: lastIndex + shiftCount.
+ "newOrderedCollection = newOrderedCollection2 ifFalse: [
+ self inspect.
+ newOrderedCollection inspect.
+ newOrderedCollection2 inspect.
+ self halt ]."
self become: newOrderedCollection
]
+ treplaceFrom: start to: stop with: replacementCollection startingAt: repStart [
+
+
+
+ stderr nextPutAll: start asString.
+ stderr nextPutAll: stop asString.
+ stderr nextPutAll: repStart asString.
+ ^ 'ici' printNl
+ ]
+
+ replaceFrom: start to: stop with: replacementCollection startingAt: repStart [
+
+
+
+ ^ super replaceFrom: start to: stop with: replacementCollection startingAt: repStart
+ ]
+
primReplaceFrom: aFromInteger to: aToInteger with: anOrderedCollection startingAt: aStartInteger [
diff --git a/libgst/dict.c b/libgst/dict.c
index 0b54dbf..0335671 100644
--- a/libgst/dict.c
+++ b/libgst/dict.c
@@ -522,7 +522,7 @@ static const class_definition class_info[] = {
"Interval", "start stop step", NULL, NULL },
{&_gst_ordered_collection_class, &_gst_sequenceable_collection_class,
- GST_ISP_POINTER, false, 2,
+ GST_ISP_POINTER, true, 2,
"OrderedCollection", "firstIndex lastIndex", NULL, NULL },
{&_gst_sorted_collection_class, &_gst_ordered_collection_class,
diff --git a/libgst/prims.def b/libgst/prims.def
index dbed9c8..7b52a17 100644
--- a/libgst/prims.def
+++ b/libgst/prims.def
@@ -3367,6 +3367,87 @@ primitive VMpr_OrderedCollection_replaceFromToWithStartingAt [succeed,fail]
UNPOP (4);
PRIM_FAILED;
}
+
+/* OrderedCollection primReplaceFrom:to:with:startingAt:*/
+primitive VMpr_HackOrderedCollection_replaceFromToWithStartingAt [succeed,fail]
+{
+ OOP srcIndexOOP, srcOOP, dstEndIndexOOP, dstStartIndexOOP, dstOOP;
+ int dstEndIndex, dstStartIndex, srcIndex, dstLen, srcLen, dstRangeLen;
+ gst_uchar *dstBase, *srcBase;
+ _gst_primitives_executed++;
+
+ srcIndexOOP = POP_OOP ();
+ srcOOP = POP_OOP ();
+ dstEndIndexOOP = POP_OOP ();
+ dstStartIndexOOP = POP_OOP ();
+ dstOOP = STACKTOP ();
+ if COMMON (IS_INT (srcIndexOOP) && IS_INT (dstStartIndexOOP)
+ && IS_INT (dstEndIndexOOP) && !IS_INT (srcOOP))
+ {
+ intptr_t srcSpec = OOP_INSTANCE_SPEC (srcOOP);
+ intptr_t dstSpec = OOP_INSTANCE_SPEC (dstOOP);
+ int srcOffset = srcSpec >> ISP_NUMFIXEDFIELDS;
+ int dstOffset = dstSpec >> ISP_NUMFIXEDFIELDS;
+ int size;
+
+ /* Check compatibility. */
+ size = _gst_log2_sizes[srcSpec & ISP_SHAPE];
+ if (size != _gst_log2_sizes[dstSpec & ISP_SHAPE])
+ goto bad;
+ if (((srcSpec & ISP_INDEXEDVARS) == GST_ISP_POINTER)
+ != ((dstSpec & ISP_INDEXEDVARS) == GST_ISP_POINTER))
+ goto bad;
+
+ /* dstEnd is inclusive: (1 to: 1) has length 1 */
+ dstEndIndex = TO_INT (dstEndIndexOOP) + TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) - 1;
+ dstStartIndex = TO_INT (dstStartIndexOOP) + TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) - 1;
+ srcIndex = TO_INT (srcIndexOOP);
+ dstOOP = STACKTOP ();
+ dstLen = TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->lastIndex) -
+ TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) + 1;
+ dstRangeLen = dstEndIndex - dstStartIndex + 1;
+
+ /* OrderedCollection offset */
+ if (OOP_TO_OBJ (srcOOP)->objClass == _gst_ordered_collection_class)
+ {
+ srcIndex += TO_INT (((gst_ordered_collection) OOP_TO_OBJ (srcOOP))->firstIndex) - 1;
+ srcLen = TO_INT (((gst_ordered_collection) OOP_TO_OBJ (srcOOP))->lastIndex) -
+ TO_INT (((gst_ordered_collection) OOP_TO_OBJ (srcOOP))->firstIndex) + 1;
+
+ if (srcIndex + dstRangeLen - 1 > srcLen + TO_INT (((gst_ordered_collection) OOP_TO_OBJ (srcOOP))->firstIndex) - 1)
+ goto bad;
+ }
+ else
+ {
+ srcLen = NUM_INDEXABLE_FIELDS (srcOOP);
+ if (srcIndex + dstRangeLen - 1 > srcLen)
+ goto bad;
+ }
+
+ if UNCOMMON (dstRangeLen < 0
+ || dstEndIndex > dstLen + TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) - 1
+ || dstStartIndex <= 0
+ || (srcIndex <= 0 && dstRangeLen > 0))
+ goto bad;
+
+ /* don't do it unless there's something to copy */
+ if COMMON (dstRangeLen > 0)
+ {
+ /* do the copy */
+ dstBase = (gst_uchar *) &(OOP_TO_OBJ (dstOOP)->data[dstOffset]);
+ srcBase = (gst_uchar *) &(OOP_TO_OBJ (srcOOP)->data[srcOffset]);
+ dstStartIndex = (dstStartIndex - 1) << size;
+ srcIndex = (srcIndex - 1) << size;
+ dstRangeLen <<= size;
+ memmove (&dstBase[dstStartIndex], &srcBase[srcIndex], dstRangeLen);
+ }
+ PRIM_SUCCEEDED;
+ }
+
+ bad:
+ UNPOP (4);
+ PRIM_FAILED;
+}
/* Object == */
--
1.7.4.1
>From c2413767022f48466c1cfe18344cc4004c83c241 Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
Date: Tue, 28 Jun 2011 15:29:37 +0200
Subject: [PATCH 05/10] Revert "change"
This reverts commit d27e18c1130633c6869d2ccc6a572dbc49e114fe.
---
kernel/OrderColl.st | 27 -----------------
libgst/dict.c | 2 +-
libgst/prims.def | 81 ---------------------------------------------------
3 files changed, 1 insertions(+), 109 deletions(-)
diff --git a/kernel/OrderColl.st b/kernel/OrderColl.st
index c86e2e4..63154dc 100644
--- a/kernel/OrderColl.st
+++ b/kernel/OrderColl.st
@@ -497,40 +497,13 @@ on content (such as add:after:)'>
| newOrderedCollection |
- "newOrderedCollection := self copyEmpty: self basicSize + delta.
- newOrderedCollection firstIndex: firstIndex + shiftCount lastIndex: lastIndex + shiftCount.
- newOrderedCollection treplaceFrom: 1 to: newOrderedCollection size with: self startingAt: 1.
- self become: newOrderedCollection."
-
newOrderedCollection := self copyEmpty: self basicSize + delta.
newOrderedCollection primReplaceFrom: firstIndex + shiftCount to: lastIndex + shiftCount with: self startingAt: firstIndex.
newOrderedCollection firstIndex: firstIndex + shiftCount
lastIndex: lastIndex + shiftCount.
- "newOrderedCollection = newOrderedCollection2 ifFalse: [
- self inspect.
- newOrderedCollection inspect.
- newOrderedCollection2 inspect.
- self halt ]."
self become: newOrderedCollection
]
- treplaceFrom: start to: stop with: replacementCollection startingAt: repStart [
-
-
-
- stderr nextPutAll: start asString.
- stderr nextPutAll: stop asString.
- stderr nextPutAll: repStart asString.
- ^ 'ici' printNl
- ]
-
- replaceFrom: start to: stop with: replacementCollection startingAt: repStart [
-
-
-
- ^ super replaceFrom: start to: stop with: replacementCollection startingAt: repStart
- ]
-
primReplaceFrom: aFromInteger to: aToInteger with: anOrderedCollection startingAt: aStartInteger [
diff --git a/libgst/dict.c b/libgst/dict.c
index 0335671..0b54dbf 100644
--- a/libgst/dict.c
+++ b/libgst/dict.c
@@ -522,7 +522,7 @@ static const class_definition class_info[] = {
"Interval", "start stop step", NULL, NULL },
{&_gst_ordered_collection_class, &_gst_sequenceable_collection_class,
- GST_ISP_POINTER, true, 2,
+ GST_ISP_POINTER, false, 2,
"OrderedCollection", "firstIndex lastIndex", NULL, NULL },
{&_gst_sorted_collection_class, &_gst_ordered_collection_class,
diff --git a/libgst/prims.def b/libgst/prims.def
index 7b52a17..dbed9c8 100644
--- a/libgst/prims.def
+++ b/libgst/prims.def
@@ -3367,87 +3367,6 @@ primitive VMpr_OrderedCollection_replaceFromToWithStartingAt [succeed,fail]
UNPOP (4);
PRIM_FAILED;
}
-
-/* OrderedCollection primReplaceFrom:to:with:startingAt:*/
-primitive VMpr_HackOrderedCollection_replaceFromToWithStartingAt [succeed,fail]
-{
- OOP srcIndexOOP, srcOOP, dstEndIndexOOP, dstStartIndexOOP, dstOOP;
- int dstEndIndex, dstStartIndex, srcIndex, dstLen, srcLen, dstRangeLen;
- gst_uchar *dstBase, *srcBase;
- _gst_primitives_executed++;
-
- srcIndexOOP = POP_OOP ();
- srcOOP = POP_OOP ();
- dstEndIndexOOP = POP_OOP ();
- dstStartIndexOOP = POP_OOP ();
- dstOOP = STACKTOP ();
- if COMMON (IS_INT (srcIndexOOP) && IS_INT (dstStartIndexOOP)
- && IS_INT (dstEndIndexOOP) && !IS_INT (srcOOP))
- {
- intptr_t srcSpec = OOP_INSTANCE_SPEC (srcOOP);
- intptr_t dstSpec = OOP_INSTANCE_SPEC (dstOOP);
- int srcOffset = srcSpec >> ISP_NUMFIXEDFIELDS;
- int dstOffset = dstSpec >> ISP_NUMFIXEDFIELDS;
- int size;
-
- /* Check compatibility. */
- size = _gst_log2_sizes[srcSpec & ISP_SHAPE];
- if (size != _gst_log2_sizes[dstSpec & ISP_SHAPE])
- goto bad;
- if (((srcSpec & ISP_INDEXEDVARS) == GST_ISP_POINTER)
- != ((dstSpec & ISP_INDEXEDVARS) == GST_ISP_POINTER))
- goto bad;
-
- /* dstEnd is inclusive: (1 to: 1) has length 1 */
- dstEndIndex = TO_INT (dstEndIndexOOP) + TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) - 1;
- dstStartIndex = TO_INT (dstStartIndexOOP) + TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) - 1;
- srcIndex = TO_INT (srcIndexOOP);
- dstOOP = STACKTOP ();
- dstLen = TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->lastIndex) -
- TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) + 1;
- dstRangeLen = dstEndIndex - dstStartIndex + 1;
-
- /* OrderedCollection offset */
- if (OOP_TO_OBJ (srcOOP)->objClass == _gst_ordered_collection_class)
- {
- srcIndex += TO_INT (((gst_ordered_collection) OOP_TO_OBJ (srcOOP))->firstIndex) - 1;
- srcLen = TO_INT (((gst_ordered_collection) OOP_TO_OBJ (srcOOP))->lastIndex) -
- TO_INT (((gst_ordered_collection) OOP_TO_OBJ (srcOOP))->firstIndex) + 1;
-
- if (srcIndex + dstRangeLen - 1 > srcLen + TO_INT (((gst_ordered_collection) OOP_TO_OBJ (srcOOP))->firstIndex) - 1)
- goto bad;
- }
- else
- {
- srcLen = NUM_INDEXABLE_FIELDS (srcOOP);
- if (srcIndex + dstRangeLen - 1 > srcLen)
- goto bad;
- }
-
- if UNCOMMON (dstRangeLen < 0
- || dstEndIndex > dstLen + TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) - 1
- || dstStartIndex <= 0
- || (srcIndex <= 0 && dstRangeLen > 0))
- goto bad;
-
- /* don't do it unless there's something to copy */
- if COMMON (dstRangeLen > 0)
- {
- /* do the copy */
- dstBase = (gst_uchar *) &(OOP_TO_OBJ (dstOOP)->data[dstOffset]);
- srcBase = (gst_uchar *) &(OOP_TO_OBJ (srcOOP)->data[srcOffset]);
- dstStartIndex = (dstStartIndex - 1) << size;
- srcIndex = (srcIndex - 1) << size;
- dstRangeLen <<= size;
- memmove (&dstBase[dstStartIndex], &srcBase[srcIndex], dstRangeLen);
- }
- PRIM_SUCCEEDED;
- }
-
- bad:
- UNPOP (4);
- PRIM_FAILED;
-}
/* Object == */
--
1.7.4.1
>From e55e2f6fbb651f0f5534b84d92c15331bdf7346c Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
Date: Tue, 28 Jun 2011 15:47:12 +0200
Subject: [PATCH 06/10] beConsistent bug
---
kernel/BindingDict.st | 2 -
kernel/Collection.st | 16 ------------
kernel/Dictionary.st | 1 -
kernel/LookupTable.st | 6 ----
kernel/SeqCollect.st | 1 -
kernel/WeakObjects.st | 65 ++++++-------------------------------------------
6 files changed, 8 insertions(+), 83 deletions(-)
diff --git a/kernel/BindingDict.st b/kernel/BindingDict.st
index 66d58f2..bbc2da9 100644
--- a/kernel/BindingDict.st
+++ b/kernel/BindingDict.st
@@ -238,8 +238,6 @@ more speed.'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
diff --git a/kernel/Collection.st b/kernel/Collection.st
index 4aff642..948b62f 100644
--- a/kernel/Collection.st
+++ b/kernel/Collection.st
@@ -320,21 +320,6 @@ of objects.'>
^self isEmpty ifTrue: [#()] ifFalse: [self anyOne species join: self]
]
- beConsistent [
- "This method is private, but it is quite interesting so it is
- documented. It ensures that a collection is in a consistent
- state before attempting to iterate on it; its presence reduces
- the number of overrides needed by collections who try to
- amortize their execution times. The default implementation
- does nothing, so it is optimized out by the virtual machine
- and so it loses very little on the performance side. Note
- that descendants of Collection have to call it explicitly
- since #do: is abstract in Collection."
-
-
-
- ]
-
readStream [
"Answer a stream that gives elements of the receiver"
@@ -571,7 +556,6 @@ of objects.'>
| instVars output object |
- self beConsistent.
aStream
nextPutAll: 'An instance of ';
print: self class;
diff --git a/kernel/Dictionary.st b/kernel/Dictionary.st
index e5d7914..2022647 100644
--- a/kernel/Dictionary.st
+++ b/kernel/Dictionary.st
@@ -435,7 +435,6 @@ certain special cases.'>
| class instVars i |
- self beConsistent.
class := self class.
instVars := class allInstVarNames.
aStream nextPutAll: 'An instance of '.
diff --git a/kernel/LookupTable.st b/kernel/LookupTable.st
index fdcb111..d1444e0 100644
--- a/kernel/LookupTable.st
+++ b/kernel/LookupTable.st
@@ -153,7 +153,6 @@ equality comparison message #= to determine equivalence of indices.'>
"Pass each key in the LookupTable to aBlock."
- self beConsistent.
1 to: self primSize
do: [:i | (self primAt: i) notNil ifTrue: [aBlock value: (self primAt: i)]]
]
@@ -162,7 +161,6 @@ equality comparison message #= to determine equivalence of indices.'>
"Pass each value in the LookupTable to aBlock."
- self beConsistent.
1 to: self primSize
do: [:i | (self primAt: i) notNil ifTrue: [aBlock value: (self valueAt: i)]]
]
@@ -326,8 +324,6 @@ equality comparison message #= to determine equivalence of indices.'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject hash scramble bitAnd: (size := self primSize) - 1) + 1.
@@ -343,8 +339,6 @@ equality comparison message #= to determine equivalence of indices.'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject hash scramble bitAnd: (size := self primSize) - 1) + 1.
diff --git a/kernel/SeqCollect.st b/kernel/SeqCollect.st
index f810fa1..d79ddaa 100644
--- a/kernel/SeqCollect.st
+++ b/kernel/SeqCollect.st
@@ -59,7 +59,6 @@ some access and manipulation methods.'>
| instVars object output |
- self beConsistent.
aStream
nextPutAll: 'An instance of ';
print: self class;
diff --git a/kernel/WeakObjects.st b/kernel/WeakObjects.st
index 52eb297..9fe1978 100644
--- a/kernel/WeakObjects.st
+++ b/kernel/WeakObjects.st
@@ -289,41 +289,6 @@ one of them, I swiftly remove all.'>
super mourn: anObject key
]
-
- findElementIndex: anObject [
- "Tries to see if anObject exists as an indexed variable. As soon as nil
- is found, the index of that slot is answered"
-
-
- | index size element |
- self beConsistent.
-
- "Sorry for the lack of readability, but I want speed... :-)"
- index := (anObject key hash scramble bitAnd: (size := self primSize) - 1) + 1.
-
- [(element := self primAt: index) isNil
- ifTrue: [^index].
- index == size ifTrue: [index := 1] ifFalse: [index := index + 1]]
- repeat
- ]
-
- findIndex: anObject [
- "Tries to see if anObject exists as an indexed variable. As soon as nil
- or anObject is found, the index of that slot is answered"
-
-
- | index size element |
- self beConsistent.
-
- "Sorry for the lack of readability, but I want speed... :-)"
- index := (anObject identityHash scramble
- bitAnd: (size := self primSize) - 1) + 1.
-
- [((element := self primAt: index) isNil or: [element key = anObject])
- ifTrue: [^index].
- index == size ifTrue: [index := 1] ifFalse: [index := index + 1]]
- repeat
- ]
]
@@ -526,6 +491,14 @@ for the garbage collected values'>
^ super findIndex: anObject
]
+ keysDo: aBlock [
+ "Pass each key in the LookupTable to aBlock."
+
+
+ self beConsistent.
+ super keysDo: aBlock
+ ]
+
do: aBlock [
"Enumerate all the non-nil members of the set"
@@ -560,8 +533,6 @@ encounter one of them, I swiftly remove all the garbage collected keys'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
@@ -598,24 +569,6 @@ for the garbage collected keys'>
^anObject identityHash
]
-
- findIndex: anObject [
- "Tries to see if anObject exists as an indexed variable. As soon as nil
- or anObject is found, the index of that slot is answered"
-
-
- | index size element |
- self beConsistent.
-
- "Sorry for the lack of readability, but I want speed... :-)"
- index := (anObject identityHash scramble
- bitAnd: (size := self primSize) - 1) + 1.
-
- [((element := self primAt: index) isNil or: [element key == anObject])
- ifTrue: [^index].
- index == size ifTrue: [index := 1] ifFalse: [index := index + 1]]
- repeat
- ]
]
@@ -650,8 +603,6 @@ for the garbage collected values'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
--
1.7.4.1
>From e7c64f6356750bc5d090126b54e0df5699dfd5da Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
Date: Tue, 28 Jun 2011 15:47:26 +0200
Subject: [PATCH 07/10] Revert "beConsistent bug"
This reverts commit e55e2f6fbb651f0f5534b84d92c15331bdf7346c.
---
kernel/BindingDict.st | 2 +
kernel/Collection.st | 16 ++++++++++++
kernel/Dictionary.st | 1 +
kernel/LookupTable.st | 6 ++++
kernel/SeqCollect.st | 1 +
kernel/WeakObjects.st | 65 +++++++++++++++++++++++++++++++++++++++++++------
6 files changed, 83 insertions(+), 8 deletions(-)
diff --git a/kernel/BindingDict.st b/kernel/BindingDict.st
index bbc2da9..66d58f2 100644
--- a/kernel/BindingDict.st
+++ b/kernel/BindingDict.st
@@ -238,6 +238,8 @@ more speed.'>
| index size element |
+ self beConsistent.
+
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
diff --git a/kernel/Collection.st b/kernel/Collection.st
index 948b62f..4aff642 100644
--- a/kernel/Collection.st
+++ b/kernel/Collection.st
@@ -320,6 +320,21 @@ of objects.'>
^self isEmpty ifTrue: [#()] ifFalse: [self anyOne species join: self]
]
+ beConsistent [
+ "This method is private, but it is quite interesting so it is
+ documented. It ensures that a collection is in a consistent
+ state before attempting to iterate on it; its presence reduces
+ the number of overrides needed by collections who try to
+ amortize their execution times. The default implementation
+ does nothing, so it is optimized out by the virtual machine
+ and so it loses very little on the performance side. Note
+ that descendants of Collection have to call it explicitly
+ since #do: is abstract in Collection."
+
+
+
+ ]
+
readStream [
"Answer a stream that gives elements of the receiver"
@@ -556,6 +571,7 @@ of objects.'>
| instVars output object |
+ self beConsistent.
aStream
nextPutAll: 'An instance of ';
print: self class;
diff --git a/kernel/Dictionary.st b/kernel/Dictionary.st
index 2022647..e5d7914 100644
--- a/kernel/Dictionary.st
+++ b/kernel/Dictionary.st
@@ -435,6 +435,7 @@ certain special cases.'>
| class instVars i |
+ self beConsistent.
class := self class.
instVars := class allInstVarNames.
aStream nextPutAll: 'An instance of '.
diff --git a/kernel/LookupTable.st b/kernel/LookupTable.st
index d1444e0..fdcb111 100644
--- a/kernel/LookupTable.st
+++ b/kernel/LookupTable.st
@@ -153,6 +153,7 @@ equality comparison message #= to determine equivalence of indices.'>
"Pass each key in the LookupTable to aBlock."
+ self beConsistent.
1 to: self primSize
do: [:i | (self primAt: i) notNil ifTrue: [aBlock value: (self primAt: i)]]
]
@@ -161,6 +162,7 @@ equality comparison message #= to determine equivalence of indices.'>
"Pass each value in the LookupTable to aBlock."
+ self beConsistent.
1 to: self primSize
do: [:i | (self primAt: i) notNil ifTrue: [aBlock value: (self valueAt: i)]]
]
@@ -324,6 +326,8 @@ equality comparison message #= to determine equivalence of indices.'>
| index size element |
+ self beConsistent.
+
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject hash scramble bitAnd: (size := self primSize) - 1) + 1.
@@ -339,6 +343,8 @@ equality comparison message #= to determine equivalence of indices.'>
| index size element |
+ self beConsistent.
+
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject hash scramble bitAnd: (size := self primSize) - 1) + 1.
diff --git a/kernel/SeqCollect.st b/kernel/SeqCollect.st
index d79ddaa..f810fa1 100644
--- a/kernel/SeqCollect.st
+++ b/kernel/SeqCollect.st
@@ -59,6 +59,7 @@ some access and manipulation methods.'>
| instVars object output |
+ self beConsistent.
aStream
nextPutAll: 'An instance of ';
print: self class;
diff --git a/kernel/WeakObjects.st b/kernel/WeakObjects.st
index 9fe1978..52eb297 100644
--- a/kernel/WeakObjects.st
+++ b/kernel/WeakObjects.st
@@ -289,6 +289,41 @@ one of them, I swiftly remove all.'>
super mourn: anObject key
]
+
+ findElementIndex: anObject [
+ "Tries to see if anObject exists as an indexed variable. As soon as nil
+ is found, the index of that slot is answered"
+
+
+ | index size element |
+ self beConsistent.
+
+ "Sorry for the lack of readability, but I want speed... :-)"
+ index := (anObject key hash scramble bitAnd: (size := self primSize) - 1) + 1.
+
+ [(element := self primAt: index) isNil
+ ifTrue: [^index].
+ index == size ifTrue: [index := 1] ifFalse: [index := index + 1]]
+ repeat
+ ]
+
+ findIndex: anObject [
+ "Tries to see if anObject exists as an indexed variable. As soon as nil
+ or anObject is found, the index of that slot is answered"
+
+
+ | index size element |
+ self beConsistent.
+
+ "Sorry for the lack of readability, but I want speed... :-)"
+ index := (anObject identityHash scramble
+ bitAnd: (size := self primSize) - 1) + 1.
+
+ [((element := self primAt: index) isNil or: [element key = anObject])
+ ifTrue: [^index].
+ index == size ifTrue: [index := 1] ifFalse: [index := index + 1]]
+ repeat
+ ]
]
@@ -491,14 +526,6 @@ for the garbage collected values'>
^ super findIndex: anObject
]
- keysDo: aBlock [
- "Pass each key in the LookupTable to aBlock."
-
-
- self beConsistent.
- super keysDo: aBlock
- ]
-
do: aBlock [
"Enumerate all the non-nil members of the set"
@@ -533,6 +560,8 @@ encounter one of them, I swiftly remove all the garbage collected keys'>
| index size element |
+ self beConsistent.
+
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
@@ -569,6 +598,24 @@ for the garbage collected keys'>
^anObject identityHash
]
+
+ findIndex: anObject [
+ "Tries to see if anObject exists as an indexed variable. As soon as nil
+ or anObject is found, the index of that slot is answered"
+
+
+ | index size element |
+ self beConsistent.
+
+ "Sorry for the lack of readability, but I want speed... :-)"
+ index := (anObject identityHash scramble
+ bitAnd: (size := self primSize) - 1) + 1.
+
+ [((element := self primAt: index) isNil or: [element key == anObject])
+ ifTrue: [^index].
+ index == size ifTrue: [index := 1] ifFalse: [index := index + 1]]
+ repeat
+ ]
]
@@ -603,6 +650,8 @@ for the garbage collected values'>
| index size element |
+ self beConsistent.
+
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
--
1.7.4.1
>From 915a3ff5c5d22db041f83a7412f74948a4584e1a Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
Date: Tue, 28 Jun 2011 15:54:30 +0200
Subject: [PATCH 08/10] beConsis
---
kernel/BindingDict.st | 2 --
kernel/Collection.st | 1 -
kernel/SortCollect.st | 8 ++++++++
kernel/WeakObjects.st | 14 ++++++++------
4 files changed, 16 insertions(+), 9 deletions(-)
diff --git a/kernel/BindingDict.st b/kernel/BindingDict.st
index 66d58f2..bbc2da9 100644
--- a/kernel/BindingDict.st
+++ b/kernel/BindingDict.st
@@ -238,8 +238,6 @@ more speed.'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
diff --git a/kernel/Collection.st b/kernel/Collection.st
index 4aff642..9f389b8 100644
--- a/kernel/Collection.st
+++ b/kernel/Collection.st
@@ -571,7 +571,6 @@ of objects.'>
| instVars output object |
- self beConsistent.
aStream
nextPutAll: 'An instance of ';
print: self class;
diff --git a/kernel/SortCollect.st b/kernel/SortCollect.st
index 5e33599..6b4ca31 100644
--- a/kernel/SortCollect.st
+++ b/kernel/SortCollect.st
@@ -781,5 +781,13 @@ above criteria -- actually any object which responds to #value:value:.'>
ifFalse: [high := mid - 1]].
^low
]
+
+ examineOn: aStream [
+ "Print all the instance variables and objects in the receiver on aStream"
+
+
+ self beConsistent.
+ super examineOn: aStream
+ ]
]
diff --git a/kernel/WeakObjects.st b/kernel/WeakObjects.st
index 52eb297..097f033 100644
--- a/kernel/WeakObjects.st
+++ b/kernel/WeakObjects.st
@@ -296,8 +296,6 @@ one of them, I swiftly remove all.'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject key hash scramble bitAnd: (size := self primSize) - 1) + 1.
@@ -313,8 +311,6 @@ one of them, I swiftly remove all.'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
@@ -533,6 +529,14 @@ for the garbage collected values'>
self beConsistent.
super do: aBlock
]
+
+ examineOn: aStream [
+ "Print all the instance variables and objects in the receiver on aStream"
+
+
+ self beConsistent.
+ super examineOn: aStream
+ ]
]
@@ -605,8 +609,6 @@ for the garbage collected keys'>
| index size element |
- self beConsistent.
-
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
--
1.7.4.1
>From fca90f6e24e37a009fb968f3c32edb7ee5c736bb Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
Date: Tue, 28 Jun 2011 15:54:40 +0200
Subject: [PATCH 09/10] Revert "beConsis"
This reverts commit 915a3ff5c5d22db041f83a7412f74948a4584e1a.
---
kernel/BindingDict.st | 2 ++
kernel/Collection.st | 1 +
kernel/SortCollect.st | 8 --------
kernel/WeakObjects.st | 14 ++++++--------
4 files changed, 9 insertions(+), 16 deletions(-)
diff --git a/kernel/BindingDict.st b/kernel/BindingDict.st
index bbc2da9..66d58f2 100644
--- a/kernel/BindingDict.st
+++ b/kernel/BindingDict.st
@@ -238,6 +238,8 @@ more speed.'>
| index size element |
+ self beConsistent.
+
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
diff --git a/kernel/Collection.st b/kernel/Collection.st
index 9f389b8..4aff642 100644
--- a/kernel/Collection.st
+++ b/kernel/Collection.st
@@ -571,6 +571,7 @@ of objects.'>
| instVars output object |
+ self beConsistent.
aStream
nextPutAll: 'An instance of ';
print: self class;
diff --git a/kernel/SortCollect.st b/kernel/SortCollect.st
index 6b4ca31..5e33599 100644
--- a/kernel/SortCollect.st
+++ b/kernel/SortCollect.st
@@ -781,13 +781,5 @@ above criteria -- actually any object which responds to #value:value:.'>
ifFalse: [high := mid - 1]].
^low
]
-
- examineOn: aStream [
- "Print all the instance variables and objects in the receiver on aStream"
-
-
- self beConsistent.
- super examineOn: aStream
- ]
]
diff --git a/kernel/WeakObjects.st b/kernel/WeakObjects.st
index 097f033..52eb297 100644
--- a/kernel/WeakObjects.st
+++ b/kernel/WeakObjects.st
@@ -296,6 +296,8 @@ one of them, I swiftly remove all.'>
| index size element |
+ self beConsistent.
+
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject key hash scramble bitAnd: (size := self primSize) - 1) + 1.
@@ -311,6 +313,8 @@ one of them, I swiftly remove all.'>
| index size element |
+ self beConsistent.
+
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
@@ -529,14 +533,6 @@ for the garbage collected values'>
self beConsistent.
super do: aBlock
]
-
- examineOn: aStream [
- "Print all the instance variables and objects in the receiver on aStream"
-
-
- self beConsistent.
- super examineOn: aStream
- ]
]
@@ -609,6 +605,8 @@ for the garbage collected keys'>
| index size element |
+ self beConsistent.
+
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject identityHash scramble
bitAnd: (size := self primSize) - 1) + 1.
--
1.7.4.1
>From c2a4057a2f48ac4e270d2a4c26b14d6dc21fa49a Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
Date: Wed, 29 Jun 2011 18:11:35 +0200
Subject: [PATCH 10/10] primitive for replaceFrom:to:with:startingAt:
---
kernel/OrderColl.st | 13 ++++++----
kernel/SortCollect.st | 45 ++++++++++++++++++++++++++++++++++
libgst/dict.c | 4 +-
libgst/prims.def | 34 ++++++++++++++++++++-----
packages/stinst/parser/OrderedSet.st | 18 +++++++++++++-
5 files changed, 99 insertions(+), 15 deletions(-)
diff --git a/kernel/OrderColl.st b/kernel/OrderColl.st
index 63154dc..9e9e2cd 100644
--- a/kernel/OrderColl.st
+++ b/kernel/OrderColl.st
@@ -266,7 +266,9 @@ on content (such as add:after:)'>
Answer newObject"
- self makeRoomFirstFor: 1.
+ "self makeRoomFirstFor: 1."
+ firstIndex <= 1
+ ifTrue: [ self growBy: self growSize shiftBy: self growSize ].
firstIndex := firstIndex - 1.
^self basicAt: firstIndex put: newObject
]
@@ -498,16 +500,17 @@ on content (such as add:after:)'>
| newOrderedCollection |
newOrderedCollection := self copyEmpty: self basicSize + delta.
- newOrderedCollection primReplaceFrom: firstIndex + shiftCount to: lastIndex + shiftCount with: self startingAt: firstIndex.
newOrderedCollection firstIndex: firstIndex + shiftCount
lastIndex: lastIndex + shiftCount.
+ newOrderedCollection replaceFrom: 1 to: self size with: self startingAt: 1.
self become: newOrderedCollection
]
- primReplaceFrom: aFromInteger to: aToInteger with: anOrderedCollection startingAt: aStartInteger [
-
+ replaceFrom: aFromInteger to: aToInteger with: anOrderedCollection startingAt: aStartInteger [
+
-
+
+ ^ super replaceFrom: aFromInteger to: aToInteger with: anOrderedCollection startingAt: aStartInteger
]
]
diff --git a/kernel/SortCollect.st b/kernel/SortCollect.st
index 5e33599..cb589a3 100644
--- a/kernel/SortCollect.st
+++ b/kernel/SortCollect.st
@@ -781,5 +781,50 @@ above criteria -- actually any object which responds to #value:value:.'>
ifFalse: [high := mid - 1]].
^low
]
+
+ growBy: delta shiftBy: shiftCount [
+ "Make room for delta more places in the collection, shifting the old
+ contents by shiftCount places"
+
+
+ | newOrderedCollection |
+ newOrderedCollection := self copyEmpty: self basicSize + delta.
+ newOrderedCollection firstIndex: firstIndex + shiftCount
+ lastIndex: lastIndex + shiftCount.
+ newOrderedCollection primReplaceFrom: 1 to: self size with: self startingAt: 1.
+ self become: newOrderedCollection
+ ]
+
+ primReplaceFrom: aFromInteger to: aToInteger with: anOrderedCollection startingAt: aStartInteger [
+
+
+ "Cannot be used for #replaceFrom:to:with:startingAt: because anOrderedCollection isn't sorted"
+
+ self error: 'Blabla'
+ ]
+
+ replaceFrom: start to: stop with: replacementCollection startingAt: repStart [
+ "Replace the items from start to stop with replacementCollection's items
+ from repStart to repStart+stop-start"
+
+
+ | delta maxStop minStop |
+ minStop := start - 1.
+ maxStop := self size min: minStop + replacementCollection size.
+ (minStop <= stop and: [stop <= maxStop])
+ ifFalse:
+ [^SystemExceptions.ArgumentOutOfRange
+ signalOn: stop
+ mustBeBetween: minStop
+ and: maxStop].
+ delta := start - repStart.
+ repStart > start
+ ifTrue: [
+ start to: stop do: [:i |
+ self at: i put: (replacementCollection at: i - delta)] ]
+ ifFalse: [
+ stop to: start by: -1 do: [:i |
+ self at: i put: (replacementCollection at: i - delta)] ]
+ ]
]
diff --git a/libgst/dict.c b/libgst/dict.c
index 0b54dbf..ea8d6af 100644
--- a/libgst/dict.c
+++ b/libgst/dict.c
@@ -522,11 +522,11 @@ static const class_definition class_info[] = {
"Interval", "start stop step", NULL, NULL },
{&_gst_ordered_collection_class, &_gst_sequenceable_collection_class,
- GST_ISP_POINTER, false, 2,
+ GST_ISP_POINTER, true, 2,
"OrderedCollection", "firstIndex lastIndex", NULL, NULL },
{&_gst_sorted_collection_class, &_gst_ordered_collection_class,
- GST_ISP_POINTER, false, 3,
+ GST_ISP_POINTER, true, 3,
"SortedCollection", "lastOrdered sorted sortBlock",
"DefaultSortBlock",
NULL },
diff --git a/libgst/prims.def b/libgst/prims.def
index dbed9c8..87c985f 100644
--- a/libgst/prims.def
+++ b/libgst/prims.def
@@ -3335,19 +3335,39 @@ primitive VMpr_OrderedCollection_replaceFromToWithStartingAt [succeed,fail]
goto bad;
/* dstEnd is inclusive: (1 to: 1) has length 1 */
- dstEndIndex = TO_INT (dstEndIndexOOP);
- dstStartIndex = TO_INT (dstStartIndexOOP);
+ dstEndIndex = TO_INT (dstEndIndexOOP) + TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) - 1;
+ dstStartIndex = TO_INT (dstStartIndexOOP) + TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) - 1;
srcIndex = TO_INT (srcIndexOOP);
dstOOP = STACKTOP ();
- dstLen = NUM_INDEXABLE_FIELDS (dstOOP);
- srcLen = NUM_INDEXABLE_FIELDS (srcOOP);
+ dstLen = TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->lastIndex) -
+ TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) + 1;
dstRangeLen = dstEndIndex - dstStartIndex + 1;
+ /* OrderedCollection offset */
+ if (OOP_TO_OBJ (srcOOP)->objClass == _gst_ordered_collection_class || OOP_TO_OBJ (srcOOP)->objClass == _gst_sorted_collection_class)
+ {
+ srcIndex += TO_INT (((gst_ordered_collection) OOP_TO_OBJ (srcOOP))->firstIndex) - 1;
+ srcLen = TO_INT (((gst_ordered_collection) OOP_TO_OBJ (srcOOP))->lastIndex) -
+ TO_INT (((gst_ordered_collection) OOP_TO_OBJ (srcOOP))->firstIndex) + 1;
+
+ if (srcIndex < TO_INT (((gst_ordered_collection) OOP_TO_OBJ (srcOOP))->firstIndex) - 1
+ || srcIndex + dstRangeLen - 1 < srcLen + TO_INT (((gst_ordered_collection) OOP_TO_OBJ (srcOOP))->firstIndex) - 1)
+ goto bad;
+ }
+ else
+ {
+ srcLen = NUM_INDEXABLE_FIELDS (srcOOP);
+ if (srcIndex + dstRangeLen - 1 > srcLen)
+ goto bad;
+ }
+
if UNCOMMON (dstRangeLen < 0
- || dstEndIndex > dstLen || dstStartIndex <= 0
- || srcIndex + dstRangeLen - 1 > srcLen
+ || dstStartIndex < TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) - 1
+ || dstEndIndex < TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) - 1
+ || dstEndIndex > dstLen + TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) - 1
+ || dstStartIndex <= TO_INT (((gst_ordered_collection) OOP_TO_OBJ (dstOOP))->firstIndex) - 1
|| (srcIndex <= 0 && dstRangeLen > 0))
- goto bad;
+ goto bad;
/* don't do it unless there's something to copy */
if COMMON (dstRangeLen > 0)
diff --git a/packages/stinst/parser/OrderedSet.st b/packages/stinst/parser/OrderedSet.st
index fe00345..1af9db1 100644
--- a/packages/stinst/parser/OrderedSet.st
+++ b/packages/stinst/parser/OrderedSet.st
@@ -343,11 +343,27 @@ already present.'>
| uSet |
uSet := unorderedSet.
- super growBy: delta shiftBy: shiftCount.
+ self privGrowBy: delta shiftBy: shiftCount.
"effectively copy after #become: invocation"
unorderedSet := uSet
]
+ privGrowBy: delta shiftBy: shiftCount [
+ "Make room for delta more places in the collection, shifting the old
+ contents by shiftCount places"
+
+
+ | newOrderedCollection |
+ newOrderedCollection := self copyEmpty: self basicSize + delta.
+ firstIndex to: lastIndex
+ do:
+ [:index |
+ newOrderedCollection basicAt: index + shiftCount put: (self basicAt: index)].
+ newOrderedCollection firstIndex: firstIndex + shiftCount
+ lastIndex: lastIndex + shiftCount.
+ self become: newOrderedCollection
+ ]
+
unorderedSet: aSet [
unorderedSet := aSet
--
1.7.4.1