>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