--- a/ApplicationDefinition.st Thu Mar 28 12:21:50 2013 +0000
+++ b/ApplicationDefinition.st Mon Apr 01 13:42:45 2013 +0100
@@ -2255,7 +2255,7 @@
# build all mandatory prerequisite packages (containing superclasses) for this package
prereq:
- $(MAKE) FORCE=@@@FORCE-BUILD@@@ $(REQUIRED_LINK_LIBOBJS)
+ $(MAKE) FORCE=@@@FORCE-BUILD@@@ $(REQUIRED_LIBOBJS)
setup::
@if test -d autopackage; then \
@@ -2933,11 +2933,11 @@
!ApplicationDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.230 2013-03-27 12:18:03 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.231 2013-03-28 12:16:21 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.230 2013-03-27 12:18:03 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.231 2013-03-28 12:16:21 stefan Exp $'
!
version_SVN
--- a/Array.st Thu Mar 28 12:21:50 2013 +0000
+++ b/Array.st Mon Apr 01 13:42:45 2013 +0100
@@ -439,6 +439,16 @@
"Modified: / 07-06-2012 / 11:06:48 / cg"
!
+asNewArray
+ "return the receiver as an unique new array."
+
+ "could be an instance of a subclass..."
+ self class == Array ifTrue:[
+ ^ self copy
+ ].
+ ^ super asArray
+!
+
beImmutable
"make myself write-protected"
@@ -2568,9 +2578,10 @@
!Array class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.156 2013-01-23 17:57:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.157 2013-03-28 23:13:28 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.156 2013-01-23 17:57:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.157 2013-03-28 23:13:28 stefan Exp $'
! !
+
--- a/Behavior.st Thu Mar 28 12:21:50 2013 +0000
+++ b/Behavior.st Mon Apr 01 13:42:45 2013 +0100
@@ -823,7 +823,7 @@
|remaining classesInLoadOrder|
"private classes are not loaded directly, so ignore them"
- remaining := someClasses asIdentitySet reject:[:eachClass| eachClass isPrivate].
+ remaining := someClasses select:[:eachClass| eachClass isPrivate not] as:IdentitySet.
"JV-2011-05-05: Sort the classes by name to get more stable order.
This stabilizes order of classes in generated build files and
makes text-based diffing/merging easier for both human beings
@@ -832,55 +832,55 @@
classesInLoadOrder := OrderedCollection new:(remaining size).
[remaining notEmpty] whileTrue:[
- |thoseWithOtherSuperclasses thoseWhichCanBeLoadedNow|
-
- "find the next class(es) to be loaded.
- Consider first:
- all those, which do not have a superclass in the remaining set.
- and which do not use a shared pool defined in the remaining set"
-
- thoseWithOtherSuperclasses :=
- remaining
- reject:[:eachClass |
- (remaining includes:eachClass superclass)
- or:[eachClass sharedPoolNames contains:[:eachPoolSymbol|
- remaining contains:[:eachRemainingClass| eachPoolSymbol = eachRemainingClass name]
- ]
- ].
- ].
-
- "second: the subset with all those having no private classes,
- or having private classes, whose superclasses are NOT in the remaining set"
-
- thoseWhichCanBeLoadedNow :=
- thoseWithOtherSuperclasses
- reject:[:eachClass |
- eachClass allPrivateClasses contains:[:eachPrivateClass| |superClassesOwner|
- superClassesOwner := eachPrivateClass superclass.
- "take care of classes inheriting from nil or ProtoObject"
- superClassesOwner isBehavior ifTrue:[
- superClassesOwner := superClassesOwner owningClassOrYourself.
- ].
- superClassesOwner ~~ eachClass
- and:[remaining includes:superClassesOwner]
- ].
- ].
-
- thoseWhichCanBeLoadedNow isEmpty ifTrue:[
- thoseWithOtherSuperclasses isEmpty ifTrue:[
- "this does not normally happen"
- self error:'superclass order is cyclic'.
- ] ifFalse:[
- "no class found, that may be loaded - maybe there is a cyclic
- dependency involving private classes.
- If you proceed here, private class dependencies are ignored
- for this pass"
- self error:'load order is cyclic (care for private classes)' mayProceed:true.
- thoseWhichCanBeLoadedNow := thoseWithOtherSuperclasses.
- ].
- ].
- remaining removeAllFoundIn:thoseWhichCanBeLoadedNow.
- classesInLoadOrder addAll:(thoseWhichCanBeLoadedNow asArray sort:[:a :b | a name < b name]).
+ |thoseWithOtherSuperclasses thoseWhichCanBeLoadedNow|
+
+ "find the next class(es) to be loaded.
+ Consider first:
+ all those, which do not have a superclass in the remaining set.
+ and which do not use a shared pool defined in the remaining set"
+
+ thoseWithOtherSuperclasses :=
+ remaining
+ reject:[:eachClass |
+ (remaining includes:eachClass superclass)
+ or:[eachClass sharedPoolNames contains:[:eachPoolSymbol|
+ remaining contains:[:eachRemainingClass| eachPoolSymbol = eachRemainingClass name]
+ ]
+ ].
+ ].
+
+ "second: the subset with all those having no private classes,
+ or having private classes, whose superclasses are NOT in the remaining set"
+
+ thoseWhichCanBeLoadedNow :=
+ thoseWithOtherSuperclasses
+ reject:[:eachClass |
+ eachClass allPrivateClasses contains:[:eachPrivateClass| |superClassesOwner|
+ superClassesOwner := eachPrivateClass superclass.
+ "take care of classes inheriting from nil or ProtoObject"
+ superClassesOwner isBehavior ifTrue:[
+ superClassesOwner := superClassesOwner owningClassOrYourself.
+ ].
+ superClassesOwner ~~ eachClass
+ and:[remaining includes:superClassesOwner]
+ ].
+ ].
+
+ thoseWhichCanBeLoadedNow isEmpty ifTrue:[
+ thoseWithOtherSuperclasses isEmpty ifTrue:[
+ "this does not normally happen"
+ self error:'superclass order is cyclic'.
+ ] ifFalse:[
+ "no class found, that may be loaded - maybe there is a cyclic
+ dependency involving private classes.
+ If you proceed here, private class dependencies are ignored
+ for this pass"
+ self error:'load order is cyclic (care for private classes)' mayProceed:true.
+ thoseWhichCanBeLoadedNow := thoseWithOtherSuperclasses.
+ ].
+ ].
+ remaining removeAllFoundIn:thoseWhichCanBeLoadedNow.
+ classesInLoadOrder addAll:(thoseWhichCanBeLoadedNow asArray sort:[:a :b | a name < b name]).
].
^ classesInLoadOrder
@@ -4892,10 +4892,10 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.332 2013-03-26 17:04:47 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.333 2013-03-28 15:54:34 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.332 2013-03-26 17:04:47 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.333 2013-03-28 15:54:34 stefan Exp $'
! !
--- a/CharacterArray.st Thu Mar 28 12:21:50 2013 +0000
+++ b/CharacterArray.st Mon Apr 01 13:42:45 2013 +0100
@@ -858,8 +858,7 @@
!
trimBlanks
- "return a copy of the receiver without leading
- and trailing spaces.
+ "return a copy of the receiver without leading and trailing spaces.
This is an ST/V compatibility method."
^ self withoutSpaces
@@ -5339,6 +5338,40 @@
"Modified: 2.4.1997 / 18:13:04 / cg"
!
+withSeparatorsCompacted
+ "return a new string with each sequence of whiteSpace replaced by a single space character.
+ Preserves a leading/trailing space."
+
+ ^ self species streamContents:[:s |
+ |skipping|
+
+ skipping := false.
+ 1 to:self size do:[:idx |
+ |char|
+
+ char := self at:idx.
+ char isSeparator ifFalse:[
+ s nextPut:char.
+ skipping := false.
+ ] ifTrue:[
+ skipping ifFalse:[
+ s nextPut:(Character space).
+ skipping := true
+ ].
+ ]
+ ]
+ ]
+
+ "
+ 'hello wwww' withSeparatorsCompacted
+ 'hello wwww' withSeparatorsCompacted
+ ' hello wwww' withSeparatorsCompacted
+ ' hello wwww ' withSeparatorsCompacted
+ ' hello wwww ' withSeparatorsCompacted
+ 'hel lo www w' withSeparatorsCompacted
+ "
+!
+
withTabs
"return a string consisting of the receivers characters
where leading spaces are replaced by tabulator characters (assuming 8-col tabs).
@@ -6306,11 +6339,11 @@
!CharacterArray class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.495 2013-03-13 14:04:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.497 2013-03-28 16:47:25 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.495 2013-03-13 14:04:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.497 2013-03-28 16:47:25 cg Exp $'
! !
--- a/Collection.st Thu Mar 28 12:21:50 2013 +0000
+++ b/Collection.st Mon Apr 01 13:42:45 2013 +0100
@@ -259,6 +259,7 @@
^ self withSize:n
! !
+
!Collection class methodsFor:'Signal constants'!
emptyCollectionSignal
@@ -327,7 +328,6 @@
^ self == Collection
! !
-
!Collection methodsFor:'*ST2JS-compatibility'!
inlineDo: aBlock
@@ -533,6 +533,7 @@
].
! !
+
!Collection methodsFor:'accessing'!
anElement
@@ -1506,7 +1507,7 @@
asIdentitySet
"return a new IdentitySet with the receiver collections elements"
- ^ self addAllNonNilElementsTo:(IdentitySet new:self size)
+ ^ self addAllTo:(IdentitySet new:self size)
!
asIntegerArray
@@ -1546,6 +1547,36 @@
^ self asIntegerArray:LongIntegerArray
!
+asNewArray
+ "return a new Array with the receiver collections elements"
+
+ ^ self asArray
+!
+
+asNewDictionary
+ "return a new Dictionary with the receiver collections elements"
+
+ ^ self asDictionary
+!
+
+asNewIdentitySet
+ "return a new IdentitySet with the receiver collections elements"
+
+ ^ self asIdentitySet
+!
+
+asNewOrderedCollection
+ "return a new OrderedCollection with the receiver collections elements"
+
+ ^ self asOrderedCollection
+!
+
+asNewSet
+ "return a new Set with the receiver collections elements"
+
+ ^ self asSet
+!
+
asOrderedCollection
"return a new OrderedCollection with the receiver collections elements"
@@ -2880,6 +2911,8 @@
May be redefined by some subclasses for optimal performance
(avoiding the creation of intermediate garbage)"
+"/ We do not do this now, since some classes reimplement select or collect....
+"/ ^ self select:selectBlock thenCollect:collectBlock as:self species
^ (self select:selectBlock) collect:collectBlock
"
@@ -2887,6 +2920,27 @@
"
!
+select:selectBlock thenCollect:collectBlock as:aCollectionClass
+ "return a new collection with all elements from the receiver, for which
+ the argument selectBlock evaluates to true.
+ Process the elements throgh collectBlock before adding."
+
+ |newCollection|
+
+ newCollection := aCollectionClass new.
+ self do:[:each |
+ (selectBlock value:each) ifTrue:[newCollection add:(collectBlock value:each)].
+ ].
+ ^ newCollection
+
+ "
+ #(1 2 3 4) select:[:e | e odd] thenCollect:[:e| e*e] as:OrderedCollection
+ (1 to:10) select:[:e | e even] thenCollect:[:e| e*e] as:IdentitySet
+ "
+
+ "Created: / 07-08-2010 / 16:26:15 / cg"
+!
+
select:selectBlock thenDo:doBlock
"combination of select followed by do
Avoids the creation of intermediate garbage"
@@ -4314,6 +4368,19 @@
!Collection methodsFor:'testing'!
+allElementsHaveTheIdenticalValue
+ "true if all elements of the receiver have the same value"
+
+ ^ self identicalValuesComputedBy:[:el | el]
+
+ "
+ #(1 2 3 5 6 7 8 9) allElementsHaveTheIdenticalValue
+ #(1 1 1 1 1 1) allElementsHaveTheIdenticalValue
+ #(1 1 1.0 1.0 1) allElementsHaveTheIdenticalValue
+ #(1 1 1.0 1.0 1) allElementsHaveTheSameValue
+ "
+!
+
allElementsHaveTheSameValue
"true if all elements of the receiver have the same value"
@@ -4338,6 +4405,34 @@
^ self size
!
+identicalValuesComputedBy:aBlock
+ "true if aBlock answers the same value for all elements of the receiver"
+
+ |first valueForFirstElement|
+
+ first := true.
+ self do:[:each |
+ first ifTrue:[
+ first := false.
+ valueForFirstElement := aBlock value:each.
+ ] ifFalse:[
+ valueForFirstElement == (aBlock value:each) ifFalse:[
+ ^ false.
+ ].
+ ].
+ ].
+ ^ true
+
+ "
+ #(1 2 3 5 6 7 8 9) sameValuesComputedBy:[:el | el even]
+ #(1 1 1 1 1 1) sameValuesComputedBy:[:el | el even]
+ #(1 1 1.0 1.0 1) sameValuesComputedBy:[:el | el even]
+ #(1 3 3 15 1) sameValuesComputedBy:[:el | el even]
+ "
+
+ "Created: / 21-12-2011 / 15:59:19 / cg"
+!
+
includes:anElement
"return true, if an object equal to the argument, anObject is in the list.
This compares using #= (i.e. it does not look for the object itself,
@@ -4603,11 +4698,11 @@
!Collection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.295 2013-03-26 16:09:26 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.297 2013-03-28 23:14:55 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.295 2013-03-26 16:09:26 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.297 2013-03-28 23:14:55 stefan Exp $'
! !
--- a/Dictionary.st Thu Mar 28 12:21:50 2013 +0000
+++ b/Dictionary.st Mon Apr 01 13:42:45 2013 +0100
@@ -239,7 +239,7 @@
by aKey -
report an error, if no element is stored under aKey"
- ^ Association key:aKey value:(self at:aKey)
+ ^ self associationAt:aKey ifAbsent:[self errorKeyNotFound:aKey]
!
associationAt:aKey ifAbsent:exceptionBlock
@@ -249,7 +249,14 @@
the original ST80 implementation. The returned assoc is created on the fly,
and not the one stored in the receiver (there are not assocs there)"
- ^ Association key:aKey value:(self at:aKey ifAbsent:[^ exceptionBlock value])
+ |index|
+
+ "/ must return the real key in the assoc - not aKey, which might be equal but not identical
+ index := self find:aKey ifAbsent:0.
+ index ~~ 0 ifTrue:[
+ ^ Association key:(keyArray basicAt:index) value:(valueArray basicAt:index)
+ ].
+ ^ exceptionBlock value
!
associations
@@ -1134,6 +1141,12 @@
^ self
!
+asNewDictionary
+ "return myself as an unique new dictionary"
+
+ ^ self copy
+!
+
associationsOrderedBy:aCollectionOfKeys
"return an OrderedCollection of my key-value pairs, ordered by the given key list"
@@ -2058,10 +2071,10 @@
!Dictionary class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.110 2013-03-26 17:04:43 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.112 2013-03-31 02:36:38 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.110 2013-03-26 17:04:43 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.112 2013-03-31 02:36:38 cg Exp $'
! !
--- a/ExternalBytes.st Thu Mar 28 12:21:50 2013 +0000
+++ b/ExternalBytes.st Mon Apr 01 13:42:45 2013 +0100
@@ -135,7 +135,7 @@
addToMallocList(newPtr, nBytes);
if (@global(TraceMalloc) == true) {
- console_printf("ExternalBytes [info]: realloc %d bytes for %016"_lx_" at: %016"_lx_"\n", nBytes, (INT)ptr, (INT)newPtr);
+ console_printf("ExternalBytes [info]: realloc %d bytes for %"_lx_" at: %"_lx_"\n", nBytes, (INT)ptr, (INT)newPtr);
}
return newPtr;
}
@@ -144,7 +144,7 @@
char *ptr;
{
if (@global(TraceMalloc) == true) {
- console_printf("ExternalBytes: free bytes at: %08x\n", ptr);
+ console_printf("ExternalBytes: free bytes at: %"_lx_"\n", (INT)ptr);
}
removeFromMallocList(ptr);
@@ -1316,11 +1316,11 @@
!ExternalBytes class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ExternalBytes.st,v 1.87 2013-02-05 15:27:51 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ExternalBytes.st,v 1.88 2013-03-29 15:06:53 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ExternalBytes.st,v 1.87 2013-02-05 15:27:51 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ExternalBytes.st,v 1.88 2013-03-29 15:06:53 cg Exp $'
! !
--- a/ExternalLibraryFunction.st Thu Mar 28 12:21:50 2013 +0000
+++ b/ExternalLibraryFunction.st Mon Apr 01 13:42:45 2013 +0100
@@ -923,7 +923,7 @@
ffi_type *__returnType = NULL;
union u {
- int iVal;
+ INT iVal;
float fVal;
double dVal;
void *pointerVal;
@@ -1689,7 +1689,7 @@
!ExternalLibraryFunction class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.94 2013-01-29 16:27:28 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.95 2013-03-29 15:05:53 cg Exp $'
!
version_SVN
--- a/Filename.st Thu Mar 28 12:21:50 2013 +0000
+++ b/Filename.st Mon Apr 01 13:42:45 2013 +0100
@@ -1917,11 +1917,17 @@
!
asURI
- "return the receiver converted to a string"
+ "return the receiver converted to a file URI"
^ FileURI fromFilename:self.
!
+asURL
+ "return an URL-object from myself"
+
+ ^ URL fromString:self pathName.
+!
+
components
"return the receivers filename components - that is the name of each directory
along the pathName (that DOES include the root directory)"
@@ -5930,11 +5936,11 @@
!Filename class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.387 2013-03-25 00:51:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.388 2013-03-29 06:56:47 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.387 2013-03-25 00:51:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.388 2013-03-29 06:56:47 cg Exp $'
! !
--- a/IdentitySet.st Thu Mar 28 12:21:50 2013 +0000
+++ b/IdentitySet.st Mon Apr 01 13:42:45 2013 +0100
@@ -66,6 +66,25 @@
^ super remove:anObject ifAbsent:exceptionBlock
! !
+!IdentitySet methodsFor:'converting'!
+
+asNewIdentitySet
+ "make sure to return myself as a unique new set"
+
+ "could be an instance of a subclass..."
+ self class == IdentitySet ifTrue:[
+ ^ self copy
+ ].
+ ^ super asIdentitySet
+
+ "
+ |s|
+ s := #(1 2 3 4) asIdentitySet.
+ self assert:(s ~~ s asNewIdentitySet).
+ self assert:(s = s asNewIdentitySet).
+ "
+! !
+
!IdentitySet methodsFor:'private'!
collisionsFor:key
@@ -242,6 +261,6 @@
!IdentitySet class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/IdentitySet.st,v 1.34 2013-01-15 16:33:59 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/IdentitySet.st,v 1.35 2013-03-28 23:19:39 stefan Exp $'
! !
--- a/OrderedCollection.st Thu Mar 28 12:21:50 2013 +0000
+++ b/OrderedCollection.st Mon Apr 01 13:42:45 2013 +0100
@@ -1051,6 +1051,24 @@
"Modified: 13.4.1996 / 12:10:56 / cg"
!
+asNewOrderedCollection
+ "return the receiver as an ordered collection.
+ Make sure to return a unique new OrderedCollection"
+
+ "could be an instance of a subclass..."
+ self class == OrderedCollection ifTrue:[
+ ^ self copy
+ ].
+ ^ super asOrderedCollection
+
+ "
+ |s|
+ s := #(1 2 3 4) asOrderedCollection.
+ self assert:(s ~~ s asNewOrderedCollection).
+ self assert:(s = s asNewOrderedCollection).
+ "
+!
+
asOrderedCollection
"return the receiver as an ordered collection"
@@ -1392,6 +1410,7 @@
! !
+
!OrderedCollection methodsFor:'private'!
initContents:size
@@ -1940,6 +1959,6 @@
!OrderedCollection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OrderedCollection.st,v 1.103 2013-03-20 11:47:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OrderedCollection.st,v 1.104 2013-03-28 23:21:40 stefan Exp $'
! !
--- a/ProjectDefinition.st Thu Mar 28 12:21:50 2013 +0000
+++ b/ProjectDefinition.st Mon Apr 01 13:42:45 2013 +0100
@@ -12,11 +12,11 @@
"{ Package: 'stx:libbasic' }"
Object subclass:#ProjectDefinition
- instanceVariableNames:''
- classVariableNames:'LibraryType GUIApplicationType NonGUIApplicationType
- PackagesBeingLoaded Verbose AbbrevDictionary AccessLock'
- poolDictionaries:''
- category:'System-Support-Projects'
+ instanceVariableNames:''
+ classVariableNames:'LibraryType GUIApplicationType NonGUIApplicationType
+ PackagesBeingLoaded Verbose AbbrevDictionary AccessLock'
+ poolDictionaries:''
+ category:'System-Support-Projects'
!
ProjectDefinition class instanceVariableNames:'safeForOverwrittenMethods extensionOverwriteInfo projectIsLoaded'
@@ -27,10 +27,10 @@
!
Object subclass:#AbbrevEntry
- instanceVariableNames:'className fileName category numClassInstVars'
- classVariableNames:''
- poolDictionaries:''
- privateIn:ProjectDefinition
+ instanceVariableNames:'className fileName category numClassInstVars'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ProjectDefinition
!
!ProjectDefinition class methodsFor:'documentation'!
@@ -708,13 +708,6 @@
].
!
-requiredProjects
- ^ Set new
- addAll:self effectivePreRequisites;
- addAll:self subProjects;
- yorself.
-!
-
topRelativePathTo:aBaseFilename inPackage:aPackageID architecture:arch
"Returns the path to stx counting the number of $/ and $: in the package name
and adding for each one '../' to get the ST/X top directory"
@@ -853,10 +846,7 @@
newCode := self classNamesAndAttributes_codeFor:newSpec.
- (compilerOrNil ? self compilerClass)
- compile:newCode
- forClass:self theMetaclass
- inCategory:'description - contents'.
+ self compile:newCode categorized:'description - contents' using:compilerOrNil
!
excludeClasses:toExclude usingCompiler:compilerOrNil
@@ -886,11 +876,43 @@
"Created: / 30-08-2007 / 18:28:28 / cg"
!
+excludeMethods:toRemove usingCompiler:compilerOrNil
+ "exclude (remove from extensionList) a number of methods.
+ Because this requires compilation of my extensionMethodNames-method, a compiler can be passed in,
+ which has to do the job.
+ This is used by the systembrowser to pass in a CodeGeneratorTool with undo support.
+ If nil is passed in, the recurlar compiler is used (no undo support)"
+
+ |oldSpec newSpec newCode extensionMethods|
+
+ oldSpec := self extensionMethodNames.
+ newSpec := oldSpec copy.
+ extensionMethods := self extensionMethods.
+
+ toRemove do:[:eachMethodToRemove |
+ |className selector idx|
+
+ (extensionMethods includes:eachMethodToRemove) ifTrue:[
+ className := eachMethodToRemove mclass name.
+ selector := eachMethodToRemove selector.
+ idx := (1 to:newSpec size-1 by:2) detect:[:i |
+ ((newSpec at:i) = className)
+ and:[ (newSpec at:i+1) = selector ]].
+
+ newSpec := newSpec removeFromIndex:idx toIndex:idx+1
+ ].
+ ].
+
+ newCode := self extensionMethodNames_code_For:newSpec.
+ self compile:newCode categorized:'description - contents' using:compilerOrNil
+!
+
includeClasses:toInclude usingCompiler:compilerOrNil
"include (add to classList) a number of classes.
Because this requires compilation of my classList-method, a compiler can be passed in,
which has to do the job.
- (this is used by the systembrowser to pass in a CodeGeneratorTool with undo support)"
+ This is used by the systembrowser to pass in a CodeGeneratorTool with undo support.
+ If nil is passed in, the recurlar compiler is used (no undo support)"
|oldSpec newSpec|
@@ -920,6 +942,30 @@
self classNamesAndAttributes:newSpec usingCompiler:compilerOrNil
!
+includeMethods:toInclude usingCompiler:compilerOrNil
+ "include (add to extensionList) a number of methods.
+ Because this requires compilation of my extensionMethodNames-method, a compiler can be passed in,
+ which has to do the job.
+ This is used by the systembrowser to pass in a CodeGeneratorTool with undo support.
+ If nil is passed in, the recurlar compiler is used (no undo support)"
+
+ |oldSpec newSpec newCode extensionMethods|
+
+ oldSpec := self extensionMethodNames.
+ newSpec := oldSpec copy.
+ extensionMethods := self extensionMethods.
+
+ toInclude do:[:eachMethodToInclude |
+ (extensionMethods includes:eachMethodToInclude) ifFalse:[
+ newSpec := newSpec copyWith:eachMethodToInclude mclass name.
+ newSpec := newSpec copyWith:eachMethodToInclude selector.
+ ].
+ ].
+
+ newCode := self extensionMethodNames_code_For:newSpec.
+ self compile:newCode categorized:'description - contents' using:compilerOrNil
+!
+
makeClassesAutoloaded:toMakeAutoloaded usingCompiler:compilerOrNil
"include as autoloaded (add to classList) a number of classes.
Because this requires compilation of my classList-method, a compiler can be passed in,
@@ -964,11 +1010,7 @@
|newCode|
newCode := self extensionMethodNames_code.
-
- (compilerOrNil ? self compilerClass)
- compile:newCode
- forClass:self theMetaclass
- inCategory:'description - contents'.
+ self compile:newCode categorized:'description - contents' using:compilerOrNil
! !
@@ -1271,6 +1313,7 @@
]
]
].
+
^ self classNamesAndAttributes_codeFor:newSpec
"
@@ -1386,6 +1429,36 @@
"Modified: / 10-10-2006 / 22:02:42 / cg"
!
+extensionMethodNames_code_For:extensionMethodNames
+ ^ String streamContents:[:s |
+ |spec|
+
+ s nextPutLine:'extensionMethodNames'.
+ s nextPutLine:' "lists the extension methods which are to be included in the project.'.
+ s nextPutLine:' Entries are pairwise elements, consisting of class-name and selector."'.
+ s nextPutLine:''.
+ s nextPutLine:' ^ #('.
+
+ spec := extensionMethodNames pairWiseCollect:[:className :selector | className -> selector ].
+ spec do:[:entry |
+ |mclassName mselector|
+
+ mclassName := entry key asSymbol.
+ (mclassName endsWith:' class') ifTrue:[
+ mclassName := mclassName asString.
+ ].
+ mselector := entry value asSymbol.
+
+ s spaces:8.
+ mclassName storeArrayElementOn:s.
+ s space.
+ mselector storeArrayElementOn:s.
+ s cr.
+ ].
+ s nextPutLine:' )'
+ ].
+!
+
extensionMethodNames_code_ignoreOldEntries:ignoreOldEntries
^ String streamContents:[:s |
|oldSpec|
@@ -2358,6 +2431,7 @@
"Created: / 18-08-2006 / 12:51:38 / cg"
! !
+
!ProjectDefinition class methodsFor:'description - project information'!
applicationAdditionalIconFileNames
@@ -5073,10 +5147,14 @@
!
compile:someCode categorized:category
- Class packageQuerySignal
+ ^ self compile:someCode categorized:category using:nil
+!
+
+compile:someCode categorized:category using:compilerOrNil
+ ^ Class packageQuerySignal
answer:self package
do:[
- self theMetaclass compilerClass
+ (compilerOrNil ? self theMetaclass compilerClass)
compile:someCode
forClass:self theMetaclass
inCategory:category
@@ -6316,15 +6394,19 @@
].
"but subprojects of our prerequisites are also prerequisites"
- def effectiveSubProjects
- select:[:eachSubSubRequisite | eachSubSubRequisite ~= self package and:[ (setOfAllPreRequisites includes:eachSubSubRequisite) not ]]
- thenDo:[:eachSubSubRequisite |
- Verbose == true ifTrue:[
- Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' hasSub ', eachSubSubRequisite).
- ].
- aBlock value:def value:eachSubSubRequisite.
- toAdd add:eachSubSubRequisite
- ].
+"/ SV: - I don't think so. Either we need them, because they have classes being superclasses
+"/ or referenced. Or we include the explicitly. In both cases we do not need thid code.
+"/ But we do not want them only because there is a subProject with examples or tests!!
+
+"/ def effectiveSubProjects
+"/ select:[:eachSubSubRequisite | eachSubSubRequisite ~= self package and:[ (setOfAllPreRequisites includes:eachSubSubRequisite) not ]]
+"/ thenDo:[:eachSubSubRequisite |
+"/ Verbose == true ifTrue:[
+"/ Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' hasSub ', eachSubSubRequisite).
+"/ ].
+"/ aBlock value:def value:eachSubSubRequisite.
+"/ toAdd add:eachSubSubRequisite
+"/ ].
].
]
].
@@ -6509,12 +6591,12 @@
withSubProjectsBoolean ifTrue:[
"my subproject's classes are required"
- self subProjects do:[:eachProjectName |
+ self effectiveSubProjects do:[:eachProjectName |
requiredClasses addAll:(self searchForClassesWithProject:eachProjectName asSymbol)
].
].
- "all superclasses of my classes and my subProject's classes are mandatory"
+ "all superclasses of my classes and my subProject's classes (if required) are mandatory"
requiredClasses do:[:cls |
cls allSuperclassesDo:[:eachSuperclass |
(mandatoryClassesForLoadingWithReasons at: eachSuperclass ifAbsentPut:[OrderedSet new])
@@ -7207,11 +7289,11 @@
!ProjectDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.444 2013-03-27 19:36:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.447 2013-03-30 19:03:50 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.444 2013-03-27 19:36:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.447 2013-03-30 19:03:50 cg Exp $'
!
version_HG
--- a/Registry.st Thu Mar 28 12:21:50 2013 +0000
+++ b/Registry.st Mon Apr 01 13:42:45 2013 +0100
@@ -165,6 +165,15 @@
!Registry methodsFor:'enumerating'!
+detect:aBlock ifNone:exceptionValue
+ registeredObjects notNil ifTrue:[
+ registeredObjects validElementsDo:[:obj |
+ (aBlock value:obj) ifTrue:[^ obj].
+ ].
+ ].
+ ^ exceptionValue value
+!
+
do:aBlock
"evaluate aBlock for each registered object"
@@ -515,9 +524,10 @@
!Registry class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.62 2012-09-11 08:02:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.63 2013-03-31 00:47:22 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.62 2012-09-11 08:02:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.63 2013-03-31 00:47:22 cg Exp $'
! !
+
--- a/Set.st Thu Mar 28 12:21:50 2013 +0000
+++ b/Set.st Mon Apr 01 13:42:45 2013 +0100
@@ -677,6 +677,25 @@
"
! !
+!Set methodsFor:'converting'!
+
+asNewSet
+ "make sure to return a unique new set"
+
+ "could be an instance of a subclass..."
+ self class == Set ifTrue:[
+ ^ self copy
+ ].
+ ^ super asSet
+
+ "
+ |s|
+ s := #(1 2 3 4) asSet.
+ self assert:(s ~~ s asNewSet).
+ self assert:(s = s asNewSet).
+ "
+! !
+
!Set methodsFor:'copying'!
postCopy
@@ -711,6 +730,7 @@
! !
+
!Set methodsFor:'obsolete set operations'!
+ aCollection
@@ -1130,6 +1150,7 @@
^ tally
! !
+
!Set methodsFor:'testing'!
capacity
@@ -1231,11 +1252,11 @@
!Set class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Set.st,v 1.118 2013-03-19 09:22:34 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Set.st,v 1.119 2013-03-28 23:22:26 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Set.st,v 1.118 2013-03-19 09:22:34 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Set.st,v 1.119 2013-03-28 23:22:26 stefan Exp $'
! !
--- a/Smalltalk.st Thu Mar 28 12:21:50 2013 +0000
+++ b/Smalltalk.st Mon Apr 01 13:42:45 2013 +0100
@@ -685,7 +685,9 @@
!
garbageCollect
- ObjectMemory garbageCollect
+ "for Squeak compatibility"
+
+ ObjectMemory garbageCollect
!
garbageCollectMost
@@ -694,9 +696,7 @@
newSpace + freeListSpace is returned."
ObjectMemory scavenge.
- ^ ObjectMemory freeSpace
- + (ObjectMemory newSpaceSize - ObjectMemory newSpaceUsed)
-
+ ^ ObjectMemory freeSpace + (ObjectMemory newSpaceSize - ObjectMemory newSpaceUsed)
!
isMorphic
@@ -7978,11 +7978,11 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1018 2013-03-27 19:13:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1019 2013-03-31 02:49:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1018 2013-03-27 19:13:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1019 2013-03-31 02:49:20 cg Exp $'
!
version_HG
--- a/UninterpretedBytes.st Thu Mar 28 12:21:50 2013 +0000
+++ b/UninterpretedBytes.st Mon Apr 01 13:42:45 2013 +0100
@@ -36,12 +36,13 @@
if (__isByteArrayLike(o)) { \
*(pPtr) = (unsigned char *)__ByteArrayInstPtr(o)->ba_element; \
*(pSize) = __byteArraySize(o); \
- } else if (__qClass(o) == ExternalBytes) { \
+ } else if (__qIsExternalBytesLike(o)) { \
OBJ __sz__ = __externalBytesSize(o); \
if (__isSmallInteger(__sz__)) { \
*(pSize) = __intVal(__sz__); \
*(pPtr) = (unsigned char *)(__externalBytesAddress(o)); \
} else { \
+ *(pSize) = 0; \
*(pPtr) = (unsigned char *)0; \
} \
} else { \
@@ -50,6 +51,7 @@
*(pSize) = __qSize(self) - *(pSize) /* nInstBytes */; \
} \
} else { \
+ *(pSize) = 0; \
*(pPtr) = (unsigned char *)0; \
} \
}
@@ -133,9 +135,9 @@
bytes := self new: sz // 2.
s := aString readStream.
1 to: sz // 2 do: [ :idx |
- hi := s next digitValue.
- lo := s next digitValue.
- bytes at:idx put: ((hi bitShift:4) bitOr: lo)
+ hi := s next digitValue.
+ lo := s next digitValue.
+ bytes at:idx put: ((hi bitShift:4) bitOr: lo)
].
^ bytes
@@ -150,7 +152,7 @@
"
"
Time millisecondsToRun:[
- 1000000 timesRepeat:[ ByteArray fromHexString:'1234FEFF1234FEFF1234FEFF1234FEFF' ]
+ 1000000 timesRepeat:[ ByteArray fromHexString:'1234FEFF1234FEFF1234FEFF1234FEFF' ]
].
"
!
@@ -397,8 +399,8 @@
^ (self byteAt:index) decodeFromBCD
"
- #[ 16r55 ] bcdByteAt:1
- #[ 16r99] bcdByteAt:1
+ #[ 16r55 ] bcdByteAt:1
+ #[ 16r99] bcdByteAt:1
#[ 16rAA] bcdByteAt:1
"
@@ -411,7 +413,7 @@
(i.e. the value n is encoded as: ((n // 10) * 16) + (n \\ 10)"
(aNumber between:0 and:99) ifFalse:[
- self error:'invalid value for BCD encoding'
+ self error:'invalid value for BCD encoding'
].
^ self byteAt:index put:aNumber encodeAsBCD
@@ -453,9 +455,9 @@
|b "{ Class: SmallInteger }"|
aSignedByteValue >= 0 ifTrue:[
- b := aSignedByteValue
+ b := aSignedByteValue
] ifFalse:[
- b := 16r100 + aSignedByteValue
+ b := 16r100 + aSignedByteValue
].
self at:index put:b.
^ aSignedByteValue
@@ -489,7 +491,7 @@
*/
if (__isSmallInteger(index)) {
unsigned char *cp;
- int sz;
+ INT sz;
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
@@ -569,7 +571,7 @@
*/
if (__isSmallInteger(index) && __isFloat(flt)) {
unsigned char *cp;
- int sz;
+ INT sz;
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
@@ -638,7 +640,7 @@
*/
if (__isSmallInteger(index)) {
unsigned char *cp;
- int sz;
+ INT sz;
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
@@ -712,7 +714,7 @@
*/
if (__isSmallInteger(index) && __isShortFloat(sflt)) {
unsigned char *cp;
- int sz;
+ INT sz;
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
@@ -1118,7 +1120,7 @@
*/
if (__isSmallInteger(index)) {
unsigned char *cp;
- int sz;
+ INT sz;
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
@@ -1331,7 +1333,7 @@
*/
if (__isSmallInteger(index)) {
unsigned char *cp;
- int sz;
+ INT sz;
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
@@ -1425,7 +1427,7 @@
*/
if (__isSmallInteger(index)) {
unsigned char *cp;
- int sz;
+ INT sz;
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
@@ -1497,7 +1499,7 @@
%{
if (__isSmallInteger(index)) {
unsigned char *cp;
- int sz;
+ INT sz;
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
@@ -1512,9 +1514,26 @@
if (((INT)cp & (sizeof(pointer)-1)) == 0) {
pointer = ((char **)cp)[0];
RETURN (__MKEXTERNALADDRESS(pointer));
+ } else {
+#if 0
+ printf("cp UNALIGNED (%"_lx_")\n", (INT)cp);
+#endif
}
+ } else {
+#if 0
+ printf("idx(%"_ld_")+(sizeof(pointer)-1) (%d) >= sz (%"_ld_")\n",
+ idx, (int)(sizeof(pointer)-1), sz);
+#endif
}
+ } else {
+#if 0
+ printf("cp is NULL\n");
+#endif
}
+ } else {
+#if 0
+ printf("bad index\n");
+#endif
}
bad:;
%}.
@@ -1531,7 +1550,7 @@
!
pointerAt:index put:value
- "set the pointer starting at index from the signed Integer value.
+ "set the pointer starting at index from the integer or externalAddress value.
The index is a smalltalk index (i.e. 1-based).
Only aligned accesses are allowed.
The value is either an ExternalAddress or ExternalBytes"
@@ -1547,11 +1566,17 @@
pointer = 0;
} else if (value == nil) {
pointer = 0;
- } else goto bad;
+ } else if (__isSmallInteger(value)) {
+ pointer = (OBJ *)__intVal(value);
+ } else {
+ if ((pointer = (OBJ *)__unsignedLongIntVal(value)) == 0) {
+ goto bad;
+ }
+ }
if (__isSmallInteger(index)) {
unsigned char *cp;
- int sz;
+ INT sz;
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
@@ -1630,7 +1655,7 @@
*/
if (__isSmallInteger(index)) {
unsigned char *cp;
- int sz;
+ INT sz;
__fetchBytePointerAndSize__(self, &cp, &sz);
if (cp) {
@@ -2512,142 +2537,142 @@
&& (__isBytes(self) || __isWords(self))
&& __bothSmallInteger(start, stop)
&& __isSmallInteger(repStart)) {
- startIndex = __intVal(start) - 1;
- if (startIndex >= 0) {
- dst = (__ByteArrayInstPtr(self)->ba_element) + startIndex;
- nIndex = __byteArraySize(self);
-
- if ((cls = __qClass(self)) != @global(ByteArray)) {
- int nInst;
-
- nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
- dst += nInst;
- nIndex -= nInst;
- }
-
- stopIndex = __intVal(stop) - 1;
- count = stopIndex - startIndex + 1;
- if (count == 0) {
- RETURN ( self );
- }
-
- if ((count > 0) && (stopIndex < nIndex)) {
- repStartIndex = __intVal(repStart) - 1;
- if (repStartIndex >= 0) {
- if (__isExternalBytesLike(aCollection)) {
- OBJ sz;
-
- src = __externalAddressVal(aCollection);
- if (src == 0) goto fallBack;
-
- sz = __externalBytesSize(aCollection);
- if (__isSmallInteger(sz)) {
- repNIndex = __smallIntegerVal(sz);
- } else {
- repNIndex = repStopIndex+1; /* always enough */
- }
- src = src + repStartIndex;
- } else {
- if (__isStringLike(aCollection)) {
- repNIndex = __stringSize(aCollection);
- } else {
- repNIndex = __qSize(aCollection) - OHDR_SIZE;
- }
- src = (__ByteArrayInstPtr(aCollection)->ba_element) + repStartIndex;
- if ((cls = __qClass(aCollection)) != @global(ByteArray)) {
- int nInst;
-
- nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
- src += nInst;
- repNIndex -= nInst;
- }
- }
- repStopIndex = repStartIndex + (stopIndex - startIndex);
- if (repStopIndex < repNIndex) {
- if (aCollection == self) {
- /* take care of overlapping copy */
- if (src < dst) {
- /* must do a reverse copy */
- src += count;
- dst += count;
- while (count-- > 0) {
- *--dst = *--src;
- }
- RETURN ( self );
- }
- }
+ startIndex = __intVal(start) - 1;
+ if (startIndex >= 0) {
+ dst = (__ByteArrayInstPtr(self)->ba_element) + startIndex;
+ nIndex = __byteArraySize(self);
+
+ if ((cls = __qClass(self)) != @global(ByteArray)) {
+ int nInst;
+
+ nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ dst += nInst;
+ nIndex -= nInst;
+ }
+
+ stopIndex = __intVal(stop) - 1;
+ count = stopIndex - startIndex + 1;
+ if (count == 0) {
+ RETURN ( self );
+ }
+
+ if ((count > 0) && (stopIndex < nIndex)) {
+ repStartIndex = __intVal(repStart) - 1;
+ if (repStartIndex >= 0) {
+ if (__isExternalBytesLike(aCollection)) {
+ OBJ sz;
+
+ src = __externalAddressVal(aCollection);
+ if (src == 0) goto fallBack;
+
+ sz = __externalBytesSize(aCollection);
+ if (__isSmallInteger(sz)) {
+ repNIndex = __smallIntegerVal(sz);
+ } else {
+ repNIndex = repStopIndex+1; /* always enough */
+ }
+ src = src + repStartIndex;
+ } else {
+ if (__isStringLike(aCollection)) {
+ repNIndex = __stringSize(aCollection);
+ } else {
+ repNIndex = __qSize(aCollection) - OHDR_SIZE;
+ }
+ src = (__ByteArrayInstPtr(aCollection)->ba_element) + repStartIndex;
+ if ((cls = __qClass(aCollection)) != @global(ByteArray)) {
+ int nInst;
+
+ nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ src += nInst;
+ repNIndex -= nInst;
+ }
+ }
+ repStopIndex = repStartIndex + (stopIndex - startIndex);
+ if (repStopIndex < repNIndex) {
+ if (aCollection == self) {
+ /* take care of overlapping copy */
+ if (src < dst) {
+ /* must do a reverse copy */
+ src += count;
+ dst += count;
+ while (count-- > 0) {
+ *--dst = *--src;
+ }
+ RETURN ( self );
+ }
+ }
# ifdef bcopy4
- if (((unsigned INT)src & 3) == ((unsigned INT)dst & 3)) {
- int nW;
-
- /* copy unaligned part */
- while (count && ((unsigned INT)src & 3)) {
- *dst++ = *src++;
- count--;
- }
-
- if (count > 0) {
- /* copy aligned part */
- nW = count >> 2;
- bcopy4(src, dst, nW);
- if ((count = count & 3) != 0) {
- /* copy any remaining part */
- src += (nW<<2);
- dst += (nW<<2);
- while (count--) {
- *dst++ = *src++;
- }
- }
- }
- RETURN ( self );
- }
+ if (((unsigned INT)src & 3) == ((unsigned INT)dst & 3)) {
+ int nW;
+
+ /* copy unaligned part */
+ while (count && ((unsigned INT)src & 3)) {
+ *dst++ = *src++;
+ count--;
+ }
+
+ if (count > 0) {
+ /* copy aligned part */
+ nW = count >> 2;
+ bcopy4(src, dst, nW);
+ if ((count = count & 3) != 0) {
+ /* copy any remaining part */
+ src += (nW<<2);
+ dst += (nW<<2);
+ while (count--) {
+ *dst++ = *src++;
+ }
+ }
+ }
+ RETURN ( self );
+ }
# else
# if __POINTER_SIZE__ == 8
- if (((unsigned INT)src & 7) == ((unsigned INT)dst & 7)) {
- /* copy unaligned part */
- while (count && ((unsigned INT)src & 7)) {
- *dst++ = *src++;
- count--;
- }
-
- /* copy aligned part */
- while (count >= 8) {
- ((unsigned INT *)dst)[0] = ((unsigned INT *)src)[0];
- dst += 8;
- src += 8;
- count -= 8;
- }
- while (count--) {
- *dst++ = *src++;
- }
- RETURN ( self );
- }
+ if (((unsigned INT)src & 7) == ((unsigned INT)dst & 7)) {
+ /* copy unaligned part */
+ while (count && ((unsigned INT)src & 7)) {
+ *dst++ = *src++;
+ count--;
+ }
+
+ /* copy aligned part */
+ while (count >= 8) {
+ ((unsigned INT *)dst)[0] = ((unsigned INT *)src)[0];
+ dst += 8;
+ src += 8;
+ count -= 8;
+ }
+ while (count--) {
+ *dst++ = *src++;
+ }
+ RETURN ( self );
+ }
# endif /* 64bit */
# endif /* bcopy4 */
# ifdef FAST_MEMCPY
- bcopy(src, dst, count);
+ bcopy(src, dst, count);
# else
# ifdef __UNROLL_LOOPS__
- while (count >= 8) {
- dst[0] = src[0]; dst[1] = src[1];
- dst[2] = src[2]; dst[3] = src[3];
- dst[4] = src[4]; dst[5] = src[5];
- dst[6] = src[6]; dst[7] = src[7];
- dst += 8; src += 8;
- count -= 8;
- }
+ while (count >= 8) {
+ dst[0] = src[0]; dst[1] = src[1];
+ dst[2] = src[2]; dst[3] = src[3];
+ dst[4] = src[4]; dst[5] = src[5];
+ dst[6] = src[6]; dst[7] = src[7];
+ dst += 8; src += 8;
+ count -= 8;
+ }
# endif /* __UNROLL_LOOPS__ */
- while (count-- > 0) {
- *dst++ = *src++;
- }
+ while (count-- > 0) {
+ *dst++ = *src++;
+ }
# endif
- RETURN ( self );
- }
- }
- }
- }
+ RETURN ( self );
+ }
+ }
+ }
+ }
}
fallBack: ;
#endif
@@ -2660,34 +2685,34 @@
"
#[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
- copy
- replaceFrom:1 to:8
- with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
- startingAt:1
+ copy
+ replaceFrom:1 to:8
+ with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
+ startingAt:1
#[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
- copy
- replaceFrom:3 to:10
- with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
- startingAt:1
+ copy
+ replaceFrom:3 to:10
+ with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
+ startingAt:1
#[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
- copy
- replaceFrom:3 to:4
- with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
- startingAt:1
+ copy
+ replaceFrom:3 to:4
+ with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
+ startingAt:1
#[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
- copy
- replaceFrom:0 to:9
- with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
- startingAt:1
+ copy
+ replaceFrom:0 to:9
+ with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
+ startingAt:1
#[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
- copy
- replaceFrom:1 to:10
- with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
- startingAt:0
+ copy
+ replaceFrom:1 to:10
+ with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
+ startingAt:0
"
!
@@ -2724,14 +2749,14 @@
therefore the change may affect all others referencing the receiver."
^ self
- replaceBytesFrom:1
- to:(replacementCollection size min:self size)
- with:replacementCollection
- startingAt:1
+ replaceBytesFrom:1
+ to:(replacementCollection size min:self size)
+ with:replacementCollection
+ startingAt:1
"
- (ByteArray new:10) replaceBytesWith:'hello'
- (ByteArray new:10) replaceBytesWith:'hello world bla bla bla'
+ (ByteArray new:10) replaceBytesWith:'hello'
+ (ByteArray new:10) replaceBytesWith:'hello world bla bla bla'
"
"Created: / 09-01-2012 / 16:18:10 / cg"
@@ -2746,18 +2771,18 @@
therefore the change may affect all others referencing the receiver."
self class isBytes ifTrue:[
- ((aCollection class == self class)
- or:[aCollection isByteCollection]) ifTrue:[
- ^ self replaceBytesFrom:startIndex to:stopIndex with:aCollection startingAt:repStartIndex
- ].
+ ((aCollection class == self class)
+ or:[aCollection isByteCollection]) ifTrue:[
+ ^ self replaceBytesFrom:startIndex to:stopIndex with:aCollection startingAt:repStartIndex
+ ].
].
^ super replaceFrom:startIndex to:stopIndex with:aCollection startingAt:repStartIndex
"
args: startIndex : <integer>
- stopIndex : <integer>
- replacementCollection : <collection of <bytes> >
- repStartIndex : <integer>
+ stopIndex : <integer>
+ replacementCollection : <collection of <bytes> >
+ repStartIndex : <integer>
returns: self
"
@@ -2964,10 +2989,9 @@
!UninterpretedBytes class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.91 2013-03-26 17:02:41 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.92 2013-03-29 15:10:08 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.91 2013-03-26 17:02:41 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.92 2013-03-29 15:10:08 cg Exp $'
! !
-