--- a/AbstractTime.st Thu Sep 15 12:05:35 2011 +0100
+++ b/AbstractTime.st Tue Sep 20 11:11:19 2011 +0100
@@ -263,6 +263,12 @@
^ TimeConversionError
! !
+!AbstractTime class methodsFor:'format strings'!
+
+defaultFormatString
+ ^ '%h:%m:%s'
+! !
+
!AbstractTime class methodsFor:'private-instance creation'!
fromOSTime:osTime
@@ -1181,9 +1187,10 @@
!AbstractTime class methodsFor:'documentation'!
version
- ^ '$Id: AbstractTime.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: AbstractTime.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/AbstractTime.st,v 1.73 2011/01/24 19:55:34 stefan Exp §'
+ ^ 'Header: /cvs/stx/stx/libbasic/AbstractTime.st,v 1.74 2011/09/15 08:42:47 ca Exp '
! !
+
--- a/Annotation.st Thu Sep 15 12:05:35 2011 +0100
+++ b/Annotation.st Tue Sep 20 11:11:19 2011 +0100
@@ -71,9 +71,9 @@
initialize
"Invoked at system start or when the class is dynamically loaded."
- Pragma := self.
+ Smalltalk at:#Pragma put:self.
- "Modified: / 20-08-2011 / 21:21:24 / cg"
+ "Modified: / 09-09-2011 / 07:16:26 / cg"
! !
!Annotation class methodsFor:'instance creation'!
@@ -104,7 +104,10 @@
method:method key:key arguments:arguments
- ^(self respondsTo: key)
+ ^
+ "/ cg: do not react on all those methods inherited from Object (such as inline:)
+ "/ self respondsTo: key)
+ (self class includesSelector:key)
ifTrue:
[self
perform: key
@@ -565,13 +568,18 @@
!Annotation class methodsFor:'documentation'!
+version
+ ^ '$Id: Annotation.st 10690 2011-09-20 10:11:19Z vranyj1 $'
+!
+
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.4 2011/09/05 02:42:25 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.6 2011/09/09 05:16:45 cg Exp §'
!
version_SVN
- ^ '$Id: Annotation.st 10686 2011-09-07 16:25:40Z vranyj1 $'
+ ^ '$Id: Annotation.st 10690 2011-09-20 10:11:19Z vranyj1 $'
! !
Annotation initialize!
+
--- a/ApplicationDefinition.st Thu Sep 15 12:05:35 2011 +0100
+++ b/ApplicationDefinition.st Tue Sep 20 11:11:19 2011 +0100
@@ -942,7 +942,6 @@
mappings := super make_dot_proto_mappings.
mappings
- at: 'TOP' put: ( self pathToTop_unix );
at: 'NSI_FILENAME' put: self nsiFilename ;
at: 'APPLICATION' put: self applicationName;
at: 'APPLICATION_PACKAGE' put: self package printString "applicationPackage";
@@ -1711,6 +1710,7 @@
%(ADDITIONAL_RULES)
+%(ADDITIONAL_HEADERRULES)
clean::
-del genDate.exe
@@ -1741,7 +1741,7 @@
# ENDMAKEDEPEND --- do not remove this line
'.
- "Modified: / 07-08-2011 / 13:37:22 / cg"
+ "Modified: / 12-09-2011 / 15:45:47 / cg"
!
bc_dot_mak_app_source_rules
@@ -2147,6 +2147,8 @@
%(ADDITIONAL_RULES_SVN)
+%(ADDITIONAL_HEADERRULES)
+
clean::
-rm -f *.so %(APPLICATION).$(O)
@@ -2161,6 +2163,7 @@
"Modified: / 09-08-2006 / 16:50:23 / fm"
"Created: / 29-09-2006 / 23:47:07 / cg"
"Modified: / 24-06-2009 / 21:40:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 12-09-2011 / 15:45:32 / cg"
!
make_dot_proto_app_source_rules
@@ -2780,10 +2783,11 @@
!ApplicationDefinition class methodsFor:'documentation'!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.178 2011/08/07 11:37:33 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.180 2011/09/13 11:41:51 stefan Exp '
!
version_SVN
^ '$ Id: ApplicationDefinition.st 10645 2011-06-09 15:28:45Z vranyj1 $'
! !
+
--- a/ByteArray.st Thu Sep 15 12:05:35 2011 +0100
+++ b/ByteArray.st Tue Sep 20 11:11:19 2011 +0100
@@ -163,8 +163,16 @@
+
+
!ByteArray class methodsFor:'queries'!
+elementByteSize
+ ^ 1
+
+ "Created: / 15-09-2011 / 14:12:53 / cg"
+!
+
isBuiltInClass
"return true if this class is known by the run-time-system.
Here, true is returned for myself, false for subclasses."
@@ -175,7 +183,6 @@
! !
-
!ByteArray methodsFor:'Compatibility-Squeak'!
bitXor:aByteArray
@@ -1895,7 +1902,7 @@
mask = 0xFF;
break;
default:
- printf("invalid depth in compressPixels\n");
+ console_printf("invalid depth in compressPixels\n");
goto fail;
}
if (map) {
@@ -1904,7 +1911,7 @@
* all possible byte-values (i.e. its size must be >= 256)
*/
if ((__qSize(aMapByteArray) - OHDR_SIZE) < 256) {
- printf("invalid map in compressPixels\n");
+ console_printf("invalid map in compressPixels\n");
goto fail;
}
}
@@ -2061,7 +2068,7 @@
mask = 0xFF;
break;
default:
- printf("invalid depth in expandPixels\n");
+ console_printf("expandPixels: invalid depth\n");
goto fail;
}
ncells = mask + 1;
@@ -2071,7 +2078,7 @@
* (i.e. 2 raisedTo:nBitsPerPixel)
*/
if ((__qSize(aMapByteArray) - OHDR_SIZE) < ncells) {
- printf("invalid map in expandPixels\n");
+ console_printf("expandPixels: invalid map\n");
goto fail;
}
}
@@ -2121,12 +2128,12 @@
}
RETURN ( self );
}
- printf("buffer size: self:%d expect at least:%d\n",
+ console_printf("expandPixels: buffer size: self:%d expect at least:%d\n",
__byteArraySize(self), srcBytes);
- printf("buffer size: arg:%d expect at least:%d\n",
+ console_printf("expandPixels: buffer size: arg:%d expect at least:%d\n",
__byteArraySize(aByteArray), dstBytes);
}
- printf("invalid args\n");
+ console_printf("expandPixels: invalid args\n");
fail: ;
%}.
@@ -2543,8 +2550,8 @@
"return a printed representation of the receiver for displaying"
(self class == ByteArray and:[aGCOrStream isStream or:[aGCOrStream == Transcript]]) ifTrue:[
- self storeOn:aGCOrStream.
- ^ self
+ self storeOn:aGCOrStream.
+ ^ self
].
^ super displayOn:aGCOrStream
@@ -2593,11 +2600,11 @@
s := '' writeStream.
self do:[:byteOrCharacter |
- |byte|
- byte := byteOrCharacter isCharacter
- ifTrue:[byteOrCharacter codePoint]
- ifFalse:[byteOrCharacter].
- byte printOn:s base:16 size:2 fill:$0.
+ |byte|
+ byte := byteOrCharacter isCharacter
+ ifTrue:[byteOrCharacter codePoint]
+ ifFalse:[byteOrCharacter].
+ byte printOn:s base:16 size:2 fill:$0.
].
^ s contents.
@@ -2905,7 +2912,6 @@
"
! !
-
!ByteArray methodsFor:'searching'!
indexOf:aByte startingAt:start
@@ -2961,7 +2967,6 @@
"
! !
-
!ByteArray methodsFor:'testing'!
isByteArray
@@ -2989,9 +2994,10 @@
!ByteArray class methodsFor:'documentation'!
version
- ^ '$Id: ByteArray.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: ByteArray.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.204 2011/01/18 17:09:02 cg Exp §'
+ ^ 'Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.206 2011/09/15 13:11:51 cg Exp '
! !
+
--- a/Class.st Thu Sep 15 12:05:35 2011 +0100
+++ b/Class.st Tue Sep 20 11:11:19 2011 +0100
@@ -474,6 +474,7 @@
! !
+
!Class methodsFor:'Compatibility-Dolphin'!
defaultCategoryForDolphinClasses
@@ -5253,6 +5254,18 @@
"Modified: / 4.2.2000 / 01:58:56 / cg"
!
+associations
+ |assocs|
+
+ assocs := OrderedCollection new.
+ self associationsDo:[:eachAssoc |
+ assocs add:eachAssoc
+ ].
+ ^ assocs
+
+ "Created: / 12-09-2011 / 10:15:11 / cg"
+!
+
associationsDo:aBlock
"evaluate aBlock for all of my simulated classVarName->value associations"
@@ -5273,6 +5286,12 @@
^ class classVarAt:aKey put:something
!
+bindingOf:aKey
+ ^ self associationAt:aKey
+
+ "Created: / 12-09-2011 / 09:41:18 / cg"
+!
+
keys
^ class classVarNames collect:[:nm | nm asSymbol]
@@ -5316,10 +5335,11 @@
!Class class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Class.st,v 1.589 2011/09/04 09:13:42 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Class.st,v 1.590 2011/09/12 08:18:01 cg Exp §'
!
version_SVN
^ '$ Id: Class.st 10643 2011-06-08 21:53:07Z vranyj1 $'
! !
+
--- a/ClassBuilder.st Thu Sep 15 12:05:35 2011 +0100
+++ b/ClassBuilder.st Tue Sep 20 11:11:19 2011 +0100
@@ -18,8 +18,9 @@
oldClass oldPoolDictionaries oldSuperClass oldClassVars
oldInstVars realNewName buildPrivateClass buildingPrivateClass
nameKey newSuperClass superClassChange newClassVars newInstVars
- classVarChange instVarChange recompileGlobalAccessTo
- oldClassToBecomeNew oldClassInstVars newClassInstVars'
+ newPoolDictionaries classVarChange instVarChange poolChange
+ recompileGlobalAccessTo oldClassToBecomeNew oldClassInstVars
+ newClassInstVars'
classVariableNames:'LastNamespace LastNamespaceName LastClassesInNameSpace
LastClassNamesInNameSpace'
poolDictionaries:''
@@ -662,6 +663,9 @@
newClassInstVars := newClass class instanceVariableString asCollectionOfWords.
oldClassVars := oldClass classVariableString asCollectionOfWords.
newClassVars := newClass classVariableString asCollectionOfWords.
+ oldPoolDictionaries := oldClass sharedPoolNames.
+ newPoolDictionaries := newClass sharedPoolNames.
+ poolChange := (oldPoolDictionaries ~= newPoolDictionaries).
"/ We are on the bright side of life, if the instance layout and inheritance do not change.
"/ In this case, we can go ahead and patch the class object.
@@ -673,15 +677,13 @@
Class flushSubclassInfoFor:oldSuperClass.
Class flushSubclassInfoFor:newSuperClass.
- oldPoolDictionaries := oldClass sharedPoolNames.
-
superClassChange ifFalse:[
(oldClass instSize == newClass instSize) ifTrue:[
(oldClass flags == newClass flags) ifTrue:[
(oldClass name = newClass name) ifTrue:[
(oldInstVars = newInstVars) ifTrue:[
(oldClassInstVars = newClassInstVars) ifTrue:[
- (oldPoolDictionaries = newClass sharedPoolNames) ifTrue:[
+ poolChange ifFalse:[
self handleEasyNewClass:newClass.
^ oldClass
]
@@ -697,7 +699,7 @@
"Created: / 26-05-1996 / 11:55:26 / cg"
"Modified: / 18-03-1999 / 18:23:31 / stefan"
- "Modified: / 19-08-2011 / 01:00:46 / cg"
+ "Modified: / 15-09-2011 / 13:47:56 / cg"
!
newSubclassOf:baseClass type:typeOfClass instanceVariables:instanceVariables from:oldClassArg
@@ -898,7 +900,8 @@
and:[newSuperClass notNil
and:[oldSuperClass allClassVarNames = newSuperClass allClassVarNames
and:[oldSuperClass name = newSuperClass name
- and:[oldClassVars = newClassVars]]]])
+ and:[oldClassVars = newClassVars
+ and:[poolChange not]]]]])
ifTrue:[
"/ Transcript showCR:'keep class methods (same classvars)'.
@@ -931,6 +934,8 @@
oldClass allClassVarNames do:[:nm | changeSet1 add:nm].
newClass allClassVarNames do:[:nm | changeSet1 add:nm].
+ oldPoolDictionaries do:[:eachPoolName | |eachPool| eachPool := Smalltalk at:eachPoolName. eachPool allClassVarNames do:[:nm | changeSet1 add:nm]].
+ newPoolDictionaries do:[:eachPoolName | |eachPool| eachPool := Smalltalk at:eachPoolName. eachPool allClassVarNames do:[:nm | changeSet1 add:nm]].
"/ Smalltalk silentLoading ifFalse:[
"/ Transcript showCR:'recompiling class methods accessing any classvar or super ...'.
@@ -948,7 +953,7 @@
"/ same superclass, find out which classvars have changed
classVarChange := oldClassVars ~= newClassVars.
- classVarChange ifTrue:[
+ (classVarChange or:[poolChange]) ifTrue:[
oldClassVars do:[:nm |
(newClassVars includes:nm) ifFalse:[
changeSet1 add:nm
@@ -959,6 +964,8 @@
changeSet1 add:nm
]
].
+ oldPoolDictionaries do:[:eachPoolName | |eachPool| eachPool := Smalltalk at:eachPoolName. eachPool allClassVarNames do:[:nm | changeSet1 add:nm]].
+ newPoolDictionaries do:[:eachPoolName | |eachPool| eachPool := Smalltalk at:eachPoolName. eachPool allClassVarNames do:[:nm | changeSet1 add:nm]].
"/ must recompile some class-methods
@@ -1094,7 +1101,7 @@
].
].
- "Modified: / 11-07-2010 / 16:37:34 / cg"
+ "Modified: / 15-09-2011 / 14:40:39 / cg"
!
flagsForVariable:variable pointers:pointers words:words
@@ -1268,7 +1275,9 @@
and:[(oldSuperClass isNil or:[newSuperClass notNil and:[oldSuperClass name = newSuperClass name]])
and:[(oldClassVars = newClassVars)
and:[(oldInstVars = newInstVars)
- and:[oldClass comment = newClass comment]]]]) ifFalse:[
+ and:[poolChange not
+ and:[(oldPoolDictionaries = newClass sharedPoolNames)
+ and:[oldClass comment = newClass comment]]]]]]) ifFalse:[
newClass addChangeRecordForClass:newClass.
]
].
@@ -1377,7 +1386,7 @@
"Created: / 26-05-1996 / 11:55:26 / cg"
"Modified: / 18-03-1999 / 18:23:31 / stefan"
- "Modified: / 22-10-2006 / 00:44:48 / cg"
+ "Modified: / 15-09-2011 / 13:49:01 / cg"
!
handleNewlyCreatedClass:newClass
@@ -2328,16 +2337,17 @@
!ClassBuilder class methodsFor:'documentation'!
version
- ^ '$Id: ClassBuilder.st 10686 2011-09-07 16:25:40Z vranyj1 $'
+ ^ '$Id: ClassBuilder.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.107 2011/09/07 13:50:53 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.108 2011/09/15 13:11:05 cg Exp '
!
version_SVN
- ^ '$Id: ClassBuilder.st 10686 2011-09-07 16:25:40Z vranyj1 $'
+ ^ '$Id: ClassBuilder.st 10690 2011-09-20 10:11:19Z vranyj1 $'
! !
ClassBuilder initialize!
+
--- a/ClassDescription.st Thu Sep 15 12:05:35 2011 +0100
+++ b/ClassDescription.st Tue Sep 20 11:11:19 2011 +0100
@@ -941,6 +941,24 @@
^ self instVarOffsetOf:aVariableName
"Created: / 27-03-2007 / 08:37:31 / cg"
+!
+
+instVarIndexFor:aVariableName ifAbsent:exceptionValue
+ "alias for #instVarOffsetOf: for VW compatibility."
+
+ |idx|
+
+ idx := self instVarOffsetOf:aVariableName.
+ idx isNil ifTrue:[ ^ exceptionValue value ].
+ ^ idx
+
+ "
+ Point instVarIndexFor:#x
+ Point instVarIndexFor:#x ifAbsent:[123] 1
+ Point instVarIndexFor:#z ifAbsent:[123]
+ "
+
+ "Created: / 12-09-2011 / 08:44:19 / cg"
! !
!ClassDescription methodsFor:'accessing'!
@@ -1679,27 +1697,34 @@
cat := oldMethod category.
code := self sourceCodeAt:aSelector.
- Class methodRedefinitionNotification answer:#keep do:[
- (aCompilerClass respondsTo:#compile:forClass:inCategory:)
- ifTrue:[
- "/ ST/X's compiler
- aCompilerClass compile:code forClass:self inCategory:cat
- ] ifFalse:[
- "/ some other (TGEN) compiler
- aCompilerClass new
- compile:code
- in:self
- notifying:nil
- ifFail:[].
+ Error handle:[:ex |
+ "/ dont want to loose code !!
+ Transcript showCR:ex description.
+ newMethod := oldMethod class trapMethodForNumArgs:(oldMethod numArgs).
+ newMethod source:code.
+ ] do:[
+ Class methodRedefinitionNotification answer:#keep do:[
+ (aCompilerClass respondsTo:#compile:forClass:inCategory:)
+ ifTrue:[
+ "/ ST/X's compiler
+ aCompilerClass compile:code forClass:self inCategory:cat
+ ] ifFalse:[
+ "/ some other (TGEN) compiler
+ aCompilerClass new
+ compile:code
+ in:self
+ notifying:nil
+ ifFail:[].
+ ].
].
].
newMethod := self compiledMethodAt:aSelector.
newMethod setPackage:oldPackage.
]
- "Created: / 1.4.1997 / 23:43:34 / stefan"
- "Modified: / 30.10.1997 / 17:12:50 / cg"
- "Modified: / 4.3.1998 / 13:01:55 / stefan"
+ "Created: / 01-04-1997 / 23:43:34 / stefan"
+ "Modified: / 04-03-1998 / 13:01:55 / stefan"
+ "Modified: / 08-09-2011 / 05:37:12 / cg"
!
recompileAll
@@ -4128,11 +4153,11 @@
!ClassDescription class methodsFor:'documentation'!
version
- ^ '$Id: ClassDescription.st 10686 2011-09-07 16:25:40Z vranyj1 $'
+ ^ '$Id: ClassDescription.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.218 2011/09/05 02:57:12 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.220 2011/09/12 06:45:01 cg Exp §'
! !
ClassDescription initialize!
@@ -4140,3 +4165,4 @@
ClassDescription::ClassRedefinitionNotification initialize!
+
--- a/Collection.st Thu Sep 15 12:05:35 2011 +0100
+++ b/Collection.st Tue Sep 20 11:11:19 2011 +0100
@@ -259,6 +259,7 @@
^ self withSize:n
! !
+
!Collection class methodsFor:'Signal constants'!
emptyCollectionSignal
@@ -313,8 +314,6 @@
^ self == Collection
! !
-
-
!Collection methodsFor:'Compatibility-Dolphin'!
identityIncludes:anObject
@@ -356,6 +355,12 @@
!Collection methodsFor:'Compatibility-Squeak'!
+, aCollection
+ ^ self copy addAll: aCollection; yourself
+
+ "Created: / 14-09-2011 / 16:32:06 / cg"
+!
+
addIfNotPresent:anObject
"Include anObject as one of the receiver's elements, but only if there
is no such element already. Anwser anObject."
@@ -372,6 +377,14 @@
^ self anElement
!
+associationsDo: aBlock
+ "cg: I think this is bad, but - well..."
+
+ self do: aBlock
+
+ "Created: / 12-09-2011 / 09:21:58 / cg"
+!
+
difference: aCollection
"Answer the set-theoretic difference of two collections."
@@ -481,6 +494,7 @@
].
! !
+
!Collection methodsFor:'accessing'!
anElement
@@ -2334,6 +2348,31 @@
"Modified: / 22-01-2011 / 09:12:22 / cg"
!
+fold: binaryBlock
+ "Evaluate the block with the first two elements of the receiver,
+ then with the result of the first evaluation and the next element,
+ and so on. Answer the result of the final evaluation. If the receiver
+ is empty, raise an error. If the receiver has a single element, answer
+ that element."
+
+ | firstValue nextValue |
+ firstValue := nextValue := Object new. "something that can't be in the receiver"
+ self do:
+ [:each |
+ nextValue := firstValue == nextValue
+ ifTrue: [each]
+ ifFalse: [binaryBlock value: nextValue value: each]].
+ ^nextValue == firstValue
+ ifTrue: [self emptyCollectionError]
+ ifFalse: [nextValue]
+
+ "
+ #('if' 'it' 'is' 'to' 'be' 'it' 'is' 'up' 'to' 'me') fold: [:a :b | a, ' ', b]
+ "
+
+ "Created: / 14-09-2011 / 16:29:53 / cg"
+!
+
inject:thisValue into:binaryBlock
"starting with thisValue for value, pass this value and each element
to binaryBlock, replacing value with the result returned from the block
@@ -4070,10 +4109,15 @@
!Collection class methodsFor:'documentation'!
+version
+ ^ '$Id: Collection.st 10690 2011-09-20 10:11:19Z vranyj1 $'
+!
+
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Collection.st,v 1.262 2011/08/20 20:20:06 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Collection.st,v 1.265 2011/09/14 16:40:49 cg Exp §'
! !
Collection initialize!
+
--- a/DoubleArray.st Thu Sep 15 12:05:35 2011 +0100
+++ b/DoubleArray.st Tue Sep 20 11:11:19 2011 +0100
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic' }"
ArrayedCollection variableDoubleSubclass:#DoubleArray
@@ -83,6 +82,17 @@
"
! !
+
+
+!DoubleArray class methodsFor:'queries'!
+
+elementByteSize
+ ^ 8
+
+ "Created: / 15-09-2011 / 14:12:46 / cg"
+! !
+
+
!DoubleArray methodsFor:'queries'!
defaultElement
@@ -92,5 +102,6 @@
!DoubleArray class methodsFor:'documentation'!
version
- ^ '$Id: DoubleArray.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: DoubleArray.st 10690 2011-09-20 10:11:19Z vranyj1 $'
! !
+
--- a/ExternalBytes.st Thu Sep 15 12:05:35 2011 +0100
+++ b/ExternalBytes.st Tue Sep 20 11:11:19 2011 +0100
@@ -56,7 +56,7 @@
}
}
if (! found) {
- printf("EXTBYTES [warning]: **** free: alien %lx (allocated somewhere else ?))\n", (long)ptr);
+ console_printf("ExternalBytes [warning]: **** free: alien %lx (allocated somewhere else ?))\n", (long)ptr);
}
}
}
@@ -75,7 +75,7 @@
found = 0;
for (this=mallocList; this; this=this->next) {
if (this->chunk == ptr) {
- printf("EXTBYTES [warning]: **** %016lx already allocated (freed somewhere else ?)\n", (long)ptr);
+ console_printf("ExternalBytes [warning]: **** %016lx already allocated (freed somewhere else ?)\n", (long)ptr);
found++;
}
}
@@ -98,7 +98,7 @@
ptr = malloc(nBytes);
if (@global(TraceMalloc) == true) {
- printf("EXTBYTES [info]: allocated %d bytes at: %016lx\n", nBytes, (long)ptr);
+ console_printf("ExternalBytes [info]: allocated %d bytes at: %016lx\n", nBytes, (long)ptr);
}
addToMallocList(ptr, nBytes);
@@ -129,7 +129,7 @@
addToMallocList(newPtr, nBytes);
if (@global(TraceMalloc) == true) {
- printf("EXTBYTES [info]: realloc %d bytes for %016lx at: %016lx\n", nBytes, (long)ptr, (long)newPtr);
+ console_printf("ExternalBytes [info]: realloc %d bytes for %016lx at: %016lx\n", nBytes, (long)ptr, (long)newPtr);
}
return newPtr;
}
@@ -138,7 +138,7 @@
char *ptr;
{
if (@global(TraceMalloc) == true) {
- printf("EXTBYTES: free bytes at: %08x\n", ptr);
+ console_printf("ExternalBytes: free bytes at: %08x\n", ptr);
}
removeFromMallocList(ptr);
@@ -154,7 +154,7 @@
n++;
amount += this->size;
}
- printf("EXTBYTES [info]: allocated %d blocks with %d bytes overall\n", n, amount);
+ console_printf("ExternalBytes [info]: allocated %d blocks with %d bytes overall\n", n, amount);
}
%}
@@ -483,7 +483,7 @@
struct mallocList *entry;
for (entry = mallocList; entry; entry=entry->next) {
- printf(" %lx (%d)\n", (long)entry->chunk, entry->size);
+ console_printf(" %lx (%d)\n", (long)entry->chunk, entry->size);
}
%}
"
@@ -508,10 +508,10 @@
struct mallocList *entry;
while ((entry = mallocList) != (struct mallocList *)0) {
- if (@global(TraceMalloc) == true ) {
- printf("EXTBYTES [info]: **** forced free of %lx (%d)\n", (long)entry->chunk, entry->size);
- }
- __stx_free(entry->chunk);
+ if (@global(TraceMalloc) == true ) {
+ console_printf("ExternalBytes [info]: **** forced free of %lx (%d)\n", (long)entry->chunk, entry->size);
+ }
+ __stx_free(entry->chunk);
}
%}
!
@@ -752,8 +752,8 @@
idx := 1.
s := WriteStream on:String new.
[(byte := self at:idx) ~~ 0] whileTrue:[
- s nextPut:(Character value:byte).
- idx := idx + 1.
+ s nextPut:(Character value:byte).
+ idx := idx + 1.
].
^ s contents
!
@@ -766,8 +766,8 @@
idx := 1.
s := WriteStream on:Unicode16String new.
[(word := self unsignedShortAt:idx) ~~ 0] whileTrue:[
- s nextPut:(Character value:word).
- idx := idx + 2.
+ s nextPut:(Character value:word).
+ idx := idx + 2.
].
^ s contents
!
@@ -1081,24 +1081,24 @@
"/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
"/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
(aGCOrStream isStream and:[aGCOrStream ~~ Transcript]) ifFalse:[
- ^ super displayOn:aGCOrStream
+ ^ super displayOn:aGCOrStream
].
aGCOrStream nextPutAll:self className.
addr := self address.
addr isNil ifTrue:[
- aGCOrStream nextPutAll:'[free]'.
+ aGCOrStream nextPutAll:'[free]'.
] ifFalse:[
- size notNil ifTrue:[
- aGCOrStream nextPutAll:'[sz:'.
- size printOn:aGCOrStream.
- aGCOrStream space.
- ] ifFalse:[
- aGCOrStream nextPut:$[.
- ].
- aGCOrStream nextPutAll:'at:'.
- addr printOn:aGCOrStream base:16.
- aGCOrStream nextPut:$].
+ size notNil ifTrue:[
+ aGCOrStream nextPutAll:'[sz:'.
+ size printOn:aGCOrStream.
+ aGCOrStream space.
+ ] ifFalse:[
+ aGCOrStream nextPut:$[.
+ ].
+ aGCOrStream nextPutAll:'at:'.
+ addr printOn:aGCOrStream base:16.
+ aGCOrStream nextPut:$].
].
"Modified: / 24.2.2000 / 19:02:19 / cg"
@@ -1305,11 +1305,12 @@
!ExternalBytes class methodsFor:'documentation'!
version
- ^ '$Id: ExternalBytes.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: ExternalBytes.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ExternalBytes.st,v 1.80 2011/01/05 15:11:14 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ExternalBytes.st,v 1.81 2011/09/15 12:22:19 cg Exp §'
! !
ExternalBytes initialize!
+
--- a/ExternalStream.st Thu Sep 15 12:05:35 2011 +0100
+++ b/ExternalStream.st Tue Sep 20 11:11:19 2011 +0100
@@ -1948,10 +1948,10 @@
|elementSize n|
elementSize := aContainer class elementByteSize.
- n := self nextBytes:nElements*elementSize into:aContainer startingAt:index.
+ n := self nextBytes:nElements*elementSize into:aContainer startingAt:index*elementSize.
^ n // elementSize
- "Modified: / 15-02-2011 / 11:04:22 / cg"
+ "Modified: / 15-09-2011 / 14:00:55 / cg"
!
readOnly
@@ -2438,14 +2438,20 @@
"{ Pragma: +optSpace }"
- ^ OpenError newException
+ |exClass|
+
+ exClass := (lastErrorNumber == (OperatingSystem errorNumberFor:#ERROR_FILE_NOT_FOUND))
+ ifTrue:[ FileDoesNotExistException ]
+ ifFalse:[ OpenError ].
+
+ ^ exClass newException
errorCode:lastErrorNumber;
errorString:(' : ' , (OperatingSystem errorTextForNumber:lastErrorNumber));
parameter:self;
raiseRequest
- "Modified: / 28.1.1998 / 14:37:42 / stefan"
- "Modified: / 8.5.1999 / 20:12:12 / cg"
+ "Modified: / 28-01-1998 / 14:37:42 / stefan"
+ "Modified: / 09-09-2011 / 09:16:40 / cg"
!
openError:errorNumber
@@ -2453,12 +2459,20 @@
"{ Pragma: +optSpace }"
- ^ OpenError newException
+ |exClass|
+
+ exClass := (errorNumber == OperatingSystem errorNumberFor:#ERROR_FILE_NOT_FOUND)
+ ifTrue:[ FileDoesNotExistException ]
+ ifFalse:[ OpenError ].
+
+ ^ exClass newException
errorCode:errorNumber;
errorString:(' : ' , (OperatingSystem errorTextForNumber:errorNumber));
parameter:self;
raiseRequest
"/ in:thisContext sender
+
+ "Modified: / 09-09-2011 / 07:22:49 / cg"
!
readError
@@ -5692,11 +5706,12 @@
!ExternalStream class methodsFor:'documentation'!
version
- ^ '$Id: ExternalStream.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: ExternalStream.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.342 2011/02/15 10:04:34 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.344 2011/09/15 13:12:35 cg Exp §'
! !
ExternalStream initialize!
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/FileDoesNotExistException.st Tue Sep 20 11:11:19 2011 +0100
@@ -0,0 +1,19 @@
+"{ Package: 'stx:libbasic' }"
+
+OpenError subclass:#FileDoesNotExistException
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Exceptions-Errors'
+!
+
+
+!FileDoesNotExistException class methodsFor:'documentation'!
+
+version
+ ^ '$Id: FileDoesNotExistException.st 10690 2011-09-20 10:11:19Z vranyj1 $'
+!
+
+version_CVS
+ ^ '§Header: /cvs/stx/stx/libbasic/FileDoesNotExistException.st,v 1.1 2011/09/09 05:13:24 cg Exp §'
+! !
\ No newline at end of file
--- a/FloatArray.st Thu Sep 15 12:05:35 2011 +0100
+++ b/FloatArray.st Tue Sep 20 11:11:19 2011 +0100
@@ -50,6 +50,18 @@
"
! !
+
+
+
+!FloatArray class methodsFor:'queries'!
+
+elementByteSize
+ ^ 4
+
+ "Created: / 15-09-2011 / 14:12:39 / cg"
+! !
+
+
!FloatArray methodsFor:'arithmetic'!
* anObject
@@ -699,8 +711,6 @@
"
! !
-
-
!FloatArray methodsFor:'queries'!
absMax
@@ -994,9 +1004,10 @@
!FloatArray class methodsFor:'documentation'!
version
- ^ '$Id: FloatArray.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: FloatArray.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/FloatArray.st,v 1.26 2009/12/01 22:11:19 cg Exp §'
+ ^ 'Header: /cvs/stx/stx/libbasic/FloatArray.st,v 1.27 2011/09/15 13:11:52 cg Exp '
! !
+
--- a/GetOpt.st Thu Sep 15 12:05:35 2011 +0100
+++ b/GetOpt.st Tue Sep 20 11:11:19 2011 +0100
@@ -18,7 +18,7 @@
"
"{ Package: 'stx:libbasic' }"
-IdentityDictionary subclass:#GetOpt
+Dictionary subclass:#GetOpt
instanceVariableNames:'defaultBlock'
classVariableNames:''
poolDictionaries:''
@@ -105,19 +105,22 @@
example
"
- | commandLine commandLineArguments files searchPath outputPath verbose |
+ | commandLine commandLineArguments files searchPath outputPath verbose foo level |
- commandLine := '-I /foo/bar -o bla.x -v file1 file2 file3'.
+ commandLine := '-I /foo/bar -level 1 --foo -o bla.x -v file1 file2 file3'.
commandLineArguments := commandLine asCollectionOfWords.
files := OrderedCollection new.
searchPath := OrderedCollection new.
outputPath := nil.
- verbose := false.
+ verbose := foo := false.
+ level := nil.
GetOpt new
at: $I put: [ :opt :arg | searchPath add: arg ];
at: $o put: [ :opt :arg | outputPath := arg ];
at: $v put: [ :opt | verbose := true ];
+ at: '-foo' put: [ :opt | foo := true ];
+ at: 'level' put: [ :opt :arg | level := arg ];
at: $? put: [ :opt | self error: 'illegal option: -' , opt asString ];
default: [ :arg | files add: arg ];
parse: commandLineArguments startingAt: 1.
@@ -126,6 +129,8 @@
Transcript show:'searchPath: '; showCR:searchPath.
Transcript show:'outputPath: '; showCR:outputPath.
Transcript show:'verbose: '; showCR:verbose.
+ Transcript show:'foo: '; showCR:foo.
+ Transcript show:'level: '; showCR:level.
"
! !
@@ -173,31 +178,62 @@
!
parseOption: option with: rest
- | block |
- block := self at: option second ifAbsent: [self at: $? ifAbsent: [^defaultBlock value: option]].
- ^block arity = 1
+ | block longOption |
+
+ "/ cg: changed to support non-single-character args (--foo)
+ block := self at: option second ifAbsent:nil.
+ block isNil ifTrue:[
+ option size > 2 ifTrue:[
+ longOption := option copyFrom:2.
+ block := self at: longOption ifAbsent:nil.
+ block notNil ifTrue:[
+ "/ a long option; never take rest of option as argument
+ block arity = 1
+ ifTrue: [ ^ block value: longOption ]
+ ifFalse: [
+ rest atEnd
+ ifTrue: [self error: 'argument missing to option ' , longOption].
+ ^ block value: longOption value: rest next
+ ]
+ ]
+ ].
+ block isNil ifTrue:[
+ block := self at: $? ifAbsent: nil.
+ block isNil ifTrue:[
+ ^ defaultBlock value: option
+ ]
+ ]
+ ].
+ ^ block arity = 1
ifTrue: [self applyOption: option to: block]
ifFalse: [self applyOption: option to: block with: rest]
+
+ "Modified: / 19-09-2011 / 10:07:57 / cg"
! !
!GetOpt methodsFor:'private'!
-applyOption: anOption to: unaryBlock
- ^anOption size = 2
+applyOption: anOption to: unaryBlock
+ ^anOption size == 2
ifTrue: [unaryBlock value: anOption second]
ifFalse: [self error: 'option ' , anOption , ' should not have an argument']
+
+ "Modified: / 19-09-2011 / 10:03:31 / cg"
!
-applyOption: anOption to: binaryBlock with: rest
- ^anOption size = 2
+applyOption: anOption to: binaryBlock with: rest
+ ^anOption size == 2
ifTrue: [rest atEnd
ifTrue: [self error: 'argument missing to option ' , anOption]
ifFalse: [binaryBlock value: anOption second value: rest next]]
ifFalse: [binaryBlock value: anOption second value: (anOption copyFrom: 3)]
+
+ "Modified: / 19-09-2011 / 10:06:05 / cg"
! !
!GetOpt class methodsFor:'documentation'!
version
- ^ '$Id: GetOpt.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: GetOpt.st 10690 2011-09-20 10:11:19Z vranyj1 $'
! !
+
--- a/LibraryDefinition.st Thu Sep 15 12:05:35 2011 +0100
+++ b/LibraryDefinition.st Tue Sep 20 11:11:19 2011 +0100
@@ -316,6 +316,7 @@
%(MAKE_PREREQUISITES)
%(ADDITIONAL_RULES)
+%(ADDITIONAL_HEADERRULES)
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
%(DEPENDENCIES)
@@ -324,7 +325,7 @@
"Created: / 09-08-2006 / 11:44:20 / fm"
"Modified: / 09-08-2006 / 19:59:32 / fm"
- "Modified: / 14-09-2006 / 15:48:18 / cg"
+ "Modified: / 12-09-2011 / 15:44:53 / cg"
!
extensionLine_libInit_dot_cc
@@ -452,6 +453,8 @@
%(ADDITIONAL_RULES_SVN)
+%(ADDITIONAL_HEADERRULES)
+
# add more install actions here
install::
@@ -504,8 +507,8 @@
"Created: / 08-08-2006 / 20:45:36 / fm"
"Modified: / 09-08-2006 / 16:50:23 / fm"
- "Modified: / 14-09-2006 / 15:48:02 / cg"
"Modified: / 24-06-2009 / 21:39:29 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 12-09-2011 / 15:45:09 / cg"
!
vc_dot_def
@@ -690,9 +693,10 @@
!LibraryDefinition class methodsFor:'documentation'!
version
- ^ '$Id: LibraryDefinition.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: LibraryDefinition.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/LibraryDefinition.st,v 1.100 2011/02/08 09:04:09 cg Exp §'
+ ^ 'Header: /cvs/stx/stx/libbasic/LibraryDefinition.st,v 1.101 2011/09/12 14:15:41 cg Exp '
! !
+
--- a/Make.proto Thu Sep 15 12:05:35 2011 +0100
+++ b/Make.proto Tue Sep 20 11:11:19 2011 +0100
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libbasic/Make.proto,v 1.243 2011/09/07 08:59:08 cg Exp $
+# $Header: /cvs/stx/stx/libbasic/Make.proto,v 1.244 2011/09/09 05:15:47 cg Exp $
#
# DO NOT EDIT
# automagically generated from the projectDefinition: stx_libbasic.
@@ -371,6 +371,7 @@
$(OUTDIR)BadLiteralsError.$(O) BadLiteralsError.$(H): BadLiteralsError.st $(INCLUDE_TOP)/stx/libbasic/InvalidCodeError.$(H) $(INCLUDE_TOP)/stx/libbasic/ExecutionError.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)DecodingError.$(O) DecodingError.$(H): DecodingError.st $(INCLUDE_TOP)/stx/libbasic/CharacterEncoderError.$(H) $(INCLUDE_TOP)/stx/libbasic/ConversionError.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)EncodingError.$(O) EncodingError.$(H): EncodingError.st $(INCLUDE_TOP)/stx/libbasic/CharacterEncoderError.$(H) $(INCLUDE_TOP)/stx/libbasic/ConversionError.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)FileDoesNotExistException.$(O) FileDoesNotExistException.$(H): FileDoesNotExistException.st $(INCLUDE_TOP)/stx/libbasic/OpenError.$(H) $(INCLUDE_TOP)/stx/libbasic/StreamError.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)FileStream.$(O) FileStream.$(H): FileStream.st $(INCLUDE_TOP)/stx/libbasic/ExternalStream.$(H) $(INCLUDE_TOP)/stx/libbasic/ReadWriteStream.$(H) $(INCLUDE_TOP)/stx/libbasic/WriteStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PositionableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)InvalidByteCodeError.$(O) InvalidByteCodeError.$(H): InvalidByteCodeError.st $(INCLUDE_TOP)/stx/libbasic/InvalidCodeError.$(H) $(INCLUDE_TOP)/stx/libbasic/ExecutionError.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)InvalidInstructionError.$(O) InvalidInstructionError.$(H): InvalidInstructionError.st $(INCLUDE_TOP)/stx/libbasic/InvalidCodeError.$(H) $(INCLUDE_TOP)/stx/libbasic/ExecutionError.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
@@ -402,3 +403,4 @@
+
--- a/Make.spec Thu Sep 15 12:05:35 2011 +0100
+++ b/Make.spec Tue Sep 20 11:11:19 2011 +0100
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libbasic/Make.spec,v 1.120 2011/09/07 08:58:40 cg Exp $
+# $Header: /cvs/stx/stx/libbasic/Make.spec,v 1.121 2011/09/09 05:15:35 cg Exp $
#
# DO NOT EDIT
# automagically generated from the projectDefinition: stx_libbasic.
@@ -346,6 +346,7 @@
AbortAllOperationWantedQuery \
Complex \
ConfigurableFeatures \
+ FileDoesNotExistException \
WIN32_CLASSES= \
CharacterEncoderImplementations::MS_Baltic \
@@ -658,6 +659,7 @@
$(OUTDIR)AbortAllOperationWantedQuery.$(O) \
$(OUTDIR)Complex.$(O) \
$(OUTDIR)ConfigurableFeatures.$(O) \
+ $(OUTDIR)FileDoesNotExistException.$(O) \
WIN32_OBJS= \
$(OUTDIR)CharacterEncoderImplementations__MS_Baltic.$(O) \
@@ -676,3 +678,4 @@
+
--- a/Method.st Thu Sep 15 12:05:35 2011 +0100
+++ b/Method.st Tue Sep 20 11:11:19 2011 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -47,7 +47,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -88,27 +88,27 @@
[Instance variables:]
- source <String> the source itself (if sourcePosition isNil)
- or the fileName where the source is found
-
- sourcePosition <Integer> the position of the methods chunk in the file
-
- category <Symbol> the methods category
- package <Symbol> the package, in which the methods was defined
- mclass <Class> the class in which I am defined
- indexed slots literals
+ source <String> the source itself (if sourcePosition isNil)
+ or the fileName where the source is found
+
+ sourcePosition <Integer> the position of the methods chunk in the file
+
+ category <Symbol> the methods category
+ package <Symbol> the package, in which the methods was defined
+ mclass <Class> the class in which I am defined
+ indexed slots literals
[Class variables:]
- PrivateMethodSignal raised on privacy violation (see docu)
-
- LastFileReference weak reference to the last sourceFile
- LastSourceFileName to speedup source access via NFS
+ PrivateMethodSignal raised on privacy violation (see docu)
+
+ LastFileReference weak reference to the last sourceFile
+ LastSourceFileName to speedup source access via NFS
WARNING: layout known by compiler and runtime system - dont change
[author:]
- Claus Gittinger
+ Claus Gittinger
"
!
@@ -167,13 +167,13 @@
Be warned and send me suggestions & critics (constructive ;-)
Late note (Feb 2000):
- the privacy feature has new been in ST/X for some years and was NOT heavily
- used - neither at eXept, nor by customers.
- In Smalltalk, it seems to be a very questionable feature, actually limiting
- code reusability.
- The privacy features are left in the system to demonstrate that it can be
- done in Smalltalk (for religious C++ fans ... to avoid useless discussions)
- (the check is not expensive, w.r.t. the VM runtime behavior).
+ the privacy feature has new been in ST/X for some years and was NOT heavily
+ used - neither at eXept, nor by customers.
+ In Smalltalk, it seems to be a very questionable feature, actually limiting
+ code reusability.
+ The privacy features are left in the system to demonstrate that it can be
+ done in Smalltalk (for religious C++ fans ... to avoid useless discussions)
+ (the check is not expensive, w.r.t. the VM runtime behavior).
"
! !
@@ -183,23 +183,23 @@
"create signals"
PrivateMethodSignal isNil ifTrue:[
- "EXPERIMENTAL"
- PrivateMethodSignal := ExecutionError newSignalMayProceed:true.
- PrivateMethodSignal nameClass:self message:#privateMethodSignal.
- PrivateMethodSignal notifierString:'attempt to execute private/protected method'.
+ "EXPERIMENTAL"
+ PrivateMethodSignal := ExecutionError newSignalMayProceed:true.
+ PrivateMethodSignal nameClass:self message:#privateMethodSignal.
+ PrivateMethodSignal notifierString:'attempt to execute private/protected method'.
].
LastFileLock isNil ifTrue:[
- LastFileLock := RecursionLock new name:'Method-LastFile'.
- LastMethodSourcesLock := RecursionLock new name:'Method-LastMethodSources'.
-
- "LastFileReference used to be a WeakArray. The problem was, that
- during some operations (generating project definition methods), lots of
- methods and classes are accessed. GC (scavenge) is done heavily,
- while finalization is a low prio process, so that the file limit
- is reached before finalization did close the old streams."
- LastFileReference := Array new:1.
- LastFileReference at:1 put:nil.
+ LastFileLock := RecursionLock new name:'Method-LastFile'.
+ LastMethodSourcesLock := RecursionLock new name:'Method-LastMethodSources'.
+
+ "LastFileReference used to be a WeakArray. The problem was, that
+ during some operations (generating project definition methods), lots of
+ methods and classes are accessed. GC (scavenge) is done heavily,
+ while finalization is a low prio process, so that the file limit
+ is reached before finalization did close the old streams."
+ LastFileReference := Array new:1.
+ LastFileReference at:1 put:nil.
].
CompilationLock := RecursionLock new name:'MethodCompilation'.
@@ -210,7 +210,7 @@
lastMethodSourcesLock
LastMethodSourcesLock isNil ifTrue:[
- self initialize
+ self initialize
].
^ LastMethodSourcesLock
! !
@@ -251,13 +251,13 @@
|nA argNames|
(nA := aSelector numArgs) == 1 ifTrue:[
- argNames := #('arg')
+ argNames := #('arg')
] ifFalse:[
- argNames := (1 to:nA) collect:[:i | 'arg' , i printString].
+ argNames := (1 to:nA) collect:[:i | 'arg' , i printString].
].
^ self
- methodDefinitionTemplateForSelector:aSelector
- andArgumentNames:argNames.
+ methodDefinitionTemplateForSelector:aSelector
+ andArgumentNames:argNames.
"
Method methodDefinitionTemplateForSelector:#foo
@@ -270,15 +270,15 @@
"given a selector, return a prototype definition string"
aSelector numArgs > 0 ifTrue:[
- aSelector isKeyword ifTrue:[
- ^ String streamContents:[:stream |
- aSelector keywords with:argNames do:[:eachKeyword :eachArgName|
- stream nextPutAll:eachKeyword; nextPutAll:eachArgName; space.
- ].
- stream backStep. "remove the last space"
- ].
- ].
- ^ aSelector , ' ' , (argNames at:1)
+ aSelector isKeyword ifTrue:[
+ ^ String streamContents:[:stream |
+ aSelector keywords with:argNames do:[:eachKeyword :eachArgName|
+ stream nextPutAll:eachKeyword; nextPutAll:eachArgName; space.
+ ].
+ stream backStep. "remove the last space"
+ ].
+ ].
+ ^ aSelector , ' ' , (argNames at:1)
].
^ aSelector
@@ -312,8 +312,8 @@
flushSourceStreamCache
LastFileLock critical:[
- LastSourceFileName := LastMethodSources := nil.
- LastFileReference at:1 put:0.
+ LastSourceFileName := LastMethodSources := nil.
+ LastFileReference at:1 put:0.
].
"
@@ -323,12 +323,57 @@
"Created: 9.2.1996 / 19:05:28 / cg"
! !
+!Method class methodsFor:'trap methods'!
+
+trapMethodForNumArgs:numArgs
+ |trapSel|
+
+ trapSel := #(
+ #'invalidCodeObject'
+ #'invalidCodeObjectWith:'
+ #'invalidCodeObjectWith:with:'
+ #'invalidCodeObjectWith:with:with:'
+ #'invalidCodeObjectWith:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:with:with:'
+ ) at:(numArgs + 1).
+
+ ^ self compiledMethodAt:trapSel.
+
+ "Created: / 04-11-1996 / 21:58:58 / cg"
+ "Modified: / 08-09-2011 / 05:35:33 / cg"
+ "Modified: / 14-09-2011 / 11:23:09 / sr"
+! !
+
!Method methodsFor:'Compatibility-Squeak'!
+pragmaAt:aKey
+ ^ self annotationAt:aKey
+
+ "Created: / 11-09-2011 / 18:09:05 / cg"
+!
+
pragmas
^ self annotations
"Created: / 05-09-2011 / 23:12:24 / cg"
+!
+
+propertyValueAt:aKey
+ "for now - no properties"
+
+ ^ nil
+
+ "Created: / 12-09-2011 / 08:42:02 / cg"
! !
!Method methodsFor:'Compatibility-VW'!
@@ -354,18 +399,18 @@
| index |
index := self annotationIndexOf: annotation key.
index
- ifNil:
- [annotations := annotations
- ifNil:[Array with: annotation]
- ifNotNil:[annotations copyWith:annotation]]
- ifNotNil:
- [annotations at: index put: annotation].
+ ifNil:
+ [annotations := annotations
+ ifNil:[Array with: annotation]
+ ifNotNil:[annotations copyWith:annotation]]
+ ifNotNil:
+ [annotations at: index put: annotation].
"/ annotation annotatesMethod: self.
"
- (Object >> #yourself) annotateWith: (Annotation namespace: 'Fictious').
- (Object >> #yourself) annotations.
- (Object >> #yourself) annotationAt: #namespace:
+ (Object >> #yourself) annotateWith: (Annotation namespace: 'Fictious').
+ (Object >> #yourself) annotations.
+ (Object >> #yourself) annotationAt: #namespace:
"
"Created: / 19-05-2010 / 16:20:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -381,7 +426,7 @@
^self annotationAtIndex: index.
"
- (Object >> #yourself) annotationAt: #namespace:
+ (Object >> #yourself) annotationAt: #namespace:
"
"Created: / 19-05-2010 / 16:16:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -415,9 +460,9 @@
annotationsAt: key
^OrderedCollection streamContents:
- [:annotStream|
- self annotationsAt: key do:
- [:annot|annotStream nextPut: annot]]
+ [:annotStream|
+ self annotationsAt: key do:
+ [:annot|annotStream nextPut: annot]]
"Created: / 16-07-2010 / 11:41:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -427,9 +472,9 @@
| annots |
annots := OrderedCollection new: 1.
self annotationsDo:
- [:annot|
- annot key == key ifTrue:
- [block value: annot]]
+ [:annot|
+ annot key == key ifTrue:
+ [block value: annot]]
"Created: / 16-07-2010 / 11:48:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -437,9 +482,9 @@
annotationsAt: key1 orAt: key2
^OrderedCollection streamContents:
- [:annotStream|
- self annotationsAt: key1 orAt: key2 do:
- [:annot|annotStream nextPut: annot]]
+ [:annotStream|
+ self annotationsAt: key1 orAt: key2 do:
+ [:annot|annotStream nextPut: annot]]
"Created: / 16-07-2010 / 11:41:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -449,9 +494,9 @@
| annots |
annots := OrderedCollection new: 1.
self annotationsDo:
- [:annot|
- (annot key == key1 or:[annot key == key2]) ifTrue:
- [block value: annot]]
+ [:annot|
+ (annot key == key1 or:[annot key == key2]) ifTrue:
+ [block value: annot]]
"Created: / 16-07-2010 / 11:47:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -460,7 +505,7 @@
annotations ifNil:[^nil].
1 to: annotations size do:
- [:i|aBlock value: (self annotationAtIndex: i)].
+ [:i|aBlock value: (self annotationAtIndex: i)].
"Created: / 02-07-2010 / 22:33:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 11-07-2010 / 19:38:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -478,18 +523,18 @@
|newCategory oldCategory cls|
aStringOrSymbol notNil ifTrue:[
- newCategory := aStringOrSymbol.
- newCategory ~= (oldCategory := category) ifTrue:[
- self setCategory:newCategory.
-
- cls := self mclass.
- cls notNil ifTrue:[
- cls addChangeRecordForMethodCategory:self category:newCategory.
- self changed:#category with:oldCategory. "/ will vanish
- cls changed:#organization with:self selector. "/ will vanish
- Smalltalk changed:#methodCategory with:(Array with:cls with:self with:oldCategory).
- ]
- ]
+ newCategory := aStringOrSymbol.
+ newCategory ~= (oldCategory := category) ifTrue:[
+ self setCategory:newCategory.
+
+ cls := self mclass.
+ cls notNil ifTrue:[
+ cls addChangeRecordForMethodCategory:self category:newCategory.
+ self changed:#category with:oldCategory. "/ will vanish
+ cls changed:#organization with:self selector. "/ will vanish
+ Smalltalk changed:#methodCategory with:(Array with:cls with:self with:oldCategory).
+ ]
+ ]
]
"Modified: / 25-09-2007 / 16:15:24 / cg"
@@ -571,12 +616,12 @@
sourceCode is not lost."
source notNil ifTrue:[
- sourcePosition notNil ifTrue:[
- "/ this looks wierd - but (self source) will retrieve the external source
- "/ (from the file) and store it. So afterwards, we will have the string and
- "/ sourcePosition will be nil
- self source:(self source)
- ]
+ sourcePosition notNil ifTrue:[
+ "/ this looks wierd - but (self source) will retrieve the external source
+ "/ (from the file) and store it. So afterwards, we will have the string and
+ "/ sourcePosition will be nil
+ self source:(self source)
+ ]
].
!
@@ -606,12 +651,12 @@
nsA ifNotNil:[^nsA nameSpace].
^(lang := self programmingLanguage) isSmalltalk
- ifTrue:[nil]
- ifFalse:[lang].
+ ifTrue:[nil]
+ ifFalse:[lang].
"
- (Method >> #nameSpace) nameSpace
- (Object >> #yourself) nameSpace
+ (Method >> #nameSpace) nameSpace
+ (Object >> #yourself) nameSpace
"
@@ -631,8 +676,8 @@
| ns |
^(ns := self nameSpace)
- ifNotNil:[ns name]
- ifNil:['']
+ ifNotNil:[ns name]
+ ifNil:['']
!
originalMethodIfWrapped
@@ -649,7 +694,7 @@
Overrides ifNil:[^nil].
^(Overrides includesKey: self)
- ifTrue:[Overrides at: self]
+ ifTrue:[Overrides at: self]
"Created: / 17-06-2009 / 19:09:58 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
@@ -673,12 +718,12 @@
package notNil ifTrue:[ ^ package ].
(cls := self mclass) isNil ifTrue:[
- ^ PackageId noProjectID.
+ ^ PackageId noProjectID.
].
"/ set it.
package := cls getPackage.
package isNil ifTrue:[
- ^ PackageId noProjectID.
+ ^ PackageId noProjectID.
].
^ package
@@ -691,25 +736,25 @@
|cls oldPackage newPackage|
aSymbol == PackageId noProjectID ifTrue:[
- newPackage := nil
+ newPackage := nil
] ifFalse:[
- newPackage := aSymbol
+ newPackage := aSymbol
].
package ~~ newPackage ifTrue:[
- oldPackage := package.
- "/ this is required, because otherwise I would no longer be able to
- "/ reconstruct my sourcecode (as the connection to the source-file is lost).
- self makeLocalStringSource.
- package := newPackage.
-
- cls := self mclass.
-
- self changed:#package. "/ will vanish
- cls changed:#methodPackage with:self selector. "/ will vanish
-
- Smalltalk changed:#projectOrganization with:(Array with:cls with:self with:oldPackage).
- cls addChangeRecordForMethodPackage:self package:newPackage.
+ oldPackage := package.
+ "/ this is required, because otherwise I would no longer be able to
+ "/ reconstruct my sourcecode (as the connection to the source-file is lost).
+ self makeLocalStringSource.
+ package := newPackage.
+
+ cls := self mclass.
+
+ self changed:#package. "/ will vanish
+ cls changed:#methodPackage with:self selector. "/ will vanish
+
+ Smalltalk changed:#projectOrganization with:(Array with:cls with:self with:oldPackage).
+ cls addChangeRecordForMethodPackage:self package:newPackage.
]
"Modified: / 23-11-2006 / 17:01:02 / cg"
@@ -727,7 +772,7 @@
"set the methods category (without change notification)"
aStringOrSymbol notNil ifTrue:[
- category := aStringOrSymbol asSymbol
+ category := aStringOrSymbol asSymbol
]
"Modified: / 13.11.1998 / 23:55:05 / cg"
@@ -753,68 +798,68 @@
source isNil ifTrue:[^ nil].
self class lastMethodSourcesLock critical:[
- LastMethodSources notNil ifTrue:[
- chunk := LastMethodSources at:self ifAbsent:nil.
- ].
+ LastMethodSources notNil ifTrue:[
+ chunk := LastMethodSources at:self ifAbsent:nil.
+ ].
].
chunk notNil ifTrue:[
- ^ chunk
+ ^ chunk
].
LastFileLock
- critical:[
- "have to protect sourceStream from being closed as a side effect
- of some other process fetching some the source from a different source file"
-
- sourceStream := self sourceStreamUsingCache:true.
- sourceStream notNil ifTrue:[
- [
- chunk := self sourceChunkFromStream:sourceStream.
- ] on:DecodingError do:[:ex|
- "CharacterEncoder>>#guessEncoding is not fail safe - retry with plain unencoded data"
-
- ('DecodingError ignored when reading <1p> (<2p>)' expandMacrosWith:self whoString with:ex description) infoPrintCR.
- sourceStream := self rawSourceStreamUsingCache:true.
- ex restart.
- ].
- ].
- ]
- timeoutMs:100
- ifBlocking:[
- "take care if LastFileLock is not available - maybe we are
- called by a debugger while someone holds the lock.
- Use uncached source streams"
- sourceStream := self sourceStreamUsingCache:false.
- sourceStream notNil ifTrue:[
- [
- chunk := self sourceChunkFromStream:sourceStream.
- sourceStream close.
- ] on:DecodingError do:[:ex|
- "CharacterEncoder>>#guessEncoding is not fail safe - retry with plain unencoded data"
- ('DecodingError ignored when reading <1p> (<2p>)' expandMacrosWith:self whoString with:ex description) infoPrintCR.
- sourceStream close.
- sourceStream := self rawSourceStreamUsingCache:false.
- ex restart.
- ].
- ].
- ].
+ critical:[
+ "have to protect sourceStream from being closed as a side effect
+ of some other process fetching some the source from a different source file"
+
+ sourceStream := self sourceStreamUsingCache:true.
+ sourceStream notNil ifTrue:[
+ [
+ chunk := self sourceChunkFromStream:sourceStream.
+ ] on:DecodingError do:[:ex|
+ "CharacterEncoder>>#guessEncoding is not fail safe - retry with plain unencoded data"
+
+ ('DecodingError ignored when reading <1p> (<2p>)' expandMacrosWith:self whoString with:ex description) infoPrintCR.
+ sourceStream := self rawSourceStreamUsingCache:true.
+ ex restart.
+ ].
+ ].
+ ]
+ timeoutMs:100
+ ifBlocking:[
+ "take care if LastFileLock is not available - maybe we are
+ called by a debugger while someone holds the lock.
+ Use uncached source streams"
+ sourceStream := self sourceStreamUsingCache:false.
+ sourceStream notNil ifTrue:[
+ [
+ chunk := self sourceChunkFromStream:sourceStream.
+ sourceStream close.
+ ] on:DecodingError do:[:ex|
+ "CharacterEncoder>>#guessEncoding is not fail safe - retry with plain unencoded data"
+ ('DecodingError ignored when reading <1p> (<2p>)' expandMacrosWith:self whoString with:ex description) infoPrintCR.
+ sourceStream close.
+ sourceStream := self rawSourceStreamUsingCache:false.
+ ex restart.
+ ].
+ ].
+ ].
"Cache the source of recently used methods"
chunk notNil ifTrue:[
- UserPreferences current keepMethodSourceCode ifTrue:[
- source := chunk.
- sourcePosition := nil.
- ^ source.
- ].
-
- CacheDictionary notNil ifTrue:[
- self class lastMethodSourcesLock critical:[
- LastMethodSources isNil ifTrue:[
- LastMethodSources := CacheDictionary new:50.
- ].
- LastMethodSources at:self put:chunk.
- ]
- ].
+ UserPreferences current keepMethodSourceCode ifTrue:[
+ source := chunk.
+ sourcePosition := nil.
+ ^ source.
+ ].
+
+ CacheDictionary notNil ifTrue:[
+ self class lastMethodSourcesLock critical:[
+ LastMethodSources isNil ifTrue:[
+ LastMethodSources := CacheDictionary new:50.
+ ].
+ LastMethodSources at:self put:chunk.
+ ]
+ ].
].
^ chunk
@@ -952,7 +997,7 @@
INT f = __intVal(__INST(flags));
if (f & F_RESTRICTED) {
- RETURN (true);
+ RETURN (true);
}
#endif
%}.
@@ -983,15 +1028,15 @@
INT p;
if (aSymbol == @symbol(public))
- p = 0;
+ p = 0;
else if (aSymbol == @symbol(protected))
- p = F_PRIVATE;
+ p = F_PRIVATE;
else if (aSymbol == @symbol(private))
- p = F_CLASSPRIVATE;
+ p = F_CLASSPRIVATE;
else if (aSymbol == @symbol(ignored))
- p = F_IGNORED;
+ p = F_IGNORED;
else
- RETURN(false); /* illegal symbol */
+ RETURN(false); /* illegal symbol */
f = (f & ~M_PRIVACY) | p;
@@ -1029,18 +1074,18 @@
# ifdef F_PRIVATE
case F_PRIVATE:
- RETURN (@symbol(protected));
- break;
+ RETURN (@symbol(protected));
+ break;
# endif
# ifdef F_CLASSPRIVATE
case F_CLASSPRIVATE:
- RETURN (@symbol(private));
- break;
+ RETURN (@symbol(private));
+ break;
# endif
# ifdef F_IGNORED
case F_IGNORED:
- RETURN (@symbol(ignored));
- break;
+ RETURN (@symbol(ignored));
+ break;
# endif
}
#endif
@@ -1067,19 +1112,19 @@
oldPrivacy := self privacy.
(self setPrivacy:aSymbol flushCaches:true) ifTrue:[
- |myClass mySelector|
-
- myClass := self mclass.
- mySelector := self selector.
-
- self changed:#privacy. "/ will vanish
- myClass notNil ifTrue:[
- mySelector notNil ifTrue:[
- myClass changed:#methodPrivacy with:mySelector. "/ will vanish
- Smalltalk changed:#privacyOfMethod with:(Array with:myClass with:self with:oldPrivacy).
- myClass addChangeRecordForMethodPrivacy:self.
- ]
- ]
+ |myClass mySelector|
+
+ myClass := self mclass.
+ mySelector := self selector.
+
+ self changed:#privacy. "/ will vanish
+ myClass notNil ifTrue:[
+ mySelector notNil ifTrue:[
+ myClass changed:#methodPrivacy with:mySelector. "/ will vanish
+ Smalltalk changed:#privacyOfMethod with:(Array with:myClass with:self with:oldPrivacy).
+ myClass addChangeRecordForMethodPrivacy:self.
+ ]
+ ]
]
"Modified: / 23-11-2006 / 17:03:20 / cg"
@@ -1106,12 +1151,12 @@
old = f;
if (aBoolean == true)
- f |= F_RESTRICTED;
+ f |= F_RESTRICTED;
else
- f &= ~F_RESTRICTED;
+ f &= ~F_RESTRICTED;
__INST(flags) = __mkSmallInteger(f);
if (old & F_RESTRICTED)
- RETURN(true);
+ RETURN(true);
#endif
%}.
^ false
@@ -1166,13 +1211,13 @@
"/ no need to flush, if changing from private to public
"/
doFlush ifTrue:[
- (aSymbol == #public and:[old ~~ #ignored]) ifFalse:[
- (sel := self selector) notNil ifTrue:[
- ObjectMemory flushCachesForSelector:sel
- ] ifFalse:[
- ObjectMemory flushCaches.
- ].
- ].
+ (aSymbol == #public and:[old ~~ #ignored]) ifFalse:[
+ (sel := self selector) notNil ifTrue:[
+ ObjectMemory flushCachesForSelector:sel
+ ] ifFalse:[
+ ObjectMemory flushCaches.
+ ].
+ ].
].
^ true
! !
@@ -1193,17 +1238,17 @@
|mthd|
byteCode notNil ifTrue:[
- "
- is already a bytecoded method
- "
- ^ self
+ "
+ is already a bytecoded method
+ "
+ ^ self
].
ParserFlags
- withSTCCompilation:#never
- do:[
- mthd := self asExecutableMethod.
- ].
+ withSTCCompilation:#never
+ do:[
+ mthd := self asExecutableMethod.
+ ].
^ mthd
"Created: 24.10.1995 / 14:02:32 / cg"
@@ -1214,10 +1259,10 @@
|mthd|
ParserFlags
- withSTCCompilation:#never
- do:[
- mthd := self asExecutableMethodWithSource:newSource.
- ].
+ withSTCCompilation:#never
+ do:[
+ mthd := self asExecutableMethodWithSource:newSource.
+ ].
^ mthd
"Created: 24.10.1995 / 14:02:32 / cg"
@@ -1236,23 +1281,23 @@
|temporaryMethod sourceString|
byteCode notNil ifTrue:[
- "
- is already a bytecoded method
- "
- ^ self
+ "
+ is already a bytecoded method
+ "
+ ^ self
].
sourceString := self source.
sourceString isNil ifTrue:[
- 'Method [warning]: cannot generate bytecode (no source for compilation)' errorPrintCR.
- ^ nil
+ 'Method [warning]: cannot generate bytecode (no source for compilation)' errorPrintCR.
+ ^ nil
].
temporaryMethod := self asExecutableMethodWithSource:sourceString.
(temporaryMethod isNil or:[temporaryMethod == #Error]) ifTrue:[
- 'Method [warning]: cannot generate bytecode (contains primitive code or error)' errorPrintCR.
- ^ nil.
+ 'Method [warning]: cannot generate bytecode (contains primitive code or error)' errorPrintCR.
+ ^ nil.
].
"/
"/ try to save a bit of memory, by sharing the source (whatever it is)
@@ -1266,8 +1311,8 @@
cls := self containingClass.
cls isNil ifTrue:[
- 'Method [warning]: cannot generate bytecode (no class for compilation)' errorPrintCR.
- ^ nil
+ 'Method [warning]: cannot generate bytecode (no class for compilation)' errorPrintCR.
+ ^ nil
].
"we have to sequentialize this using a lock-semaphore,
@@ -1277,53 +1322,53 @@
(happened when autoloading animation demos)
"
CompilationLock critical:[
- "
- dont want this to go into the changes file,
- dont want output on Transcript and definitely
- dont want a lazy method ...
- "
- Class withoutUpdatingChangesDo:[
- |silent lazy|
-
- silent := Smalltalk silentLoading:true.
- lazy := Compiler compileLazy:false.
-
- [
- |compiler|
-
- Class nameSpaceQuerySignal answer:(cls nameSpace)
- do:[
- compiler := cls compilerClass.
-
- "/
- "/ kludge - have to make ST/X's compiler protocol
- "/ be compatible to ST-80's
- "/
- (compiler respondsTo:#compile:forClass:inCategory:notifying:install:)
- ifTrue:[
- temporaryMethod := compiler
- compile:newSource
- forClass:cls
- inCategory:(self category)
- notifying:nil
- install:false.
- ] ifFalse:[
- temporaryMethod := compiler new
- compile:newSource
- in:cls
- notifying:nil
- ifFail:nil
- ].
- ].
- ] ensure:[
- Compiler compileLazy:lazy.
- Smalltalk silentLoading:silent.
- ]
- ].
+ "
+ dont want this to go into the changes file,
+ dont want output on Transcript and definitely
+ dont want a lazy method ...
+ "
+ Class withoutUpdatingChangesDo:[
+ |silent lazy|
+
+ silent := Smalltalk silentLoading:true.
+ lazy := Compiler compileLazy:false.
+
+ [
+ |compiler|
+
+ Class nameSpaceQuerySignal answer:(cls nameSpace)
+ do:[
+ compiler := cls compilerClass.
+
+ "/
+ "/ kludge - have to make ST/X's compiler protocol
+ "/ be compatible to ST-80's
+ "/
+ (compiler respondsTo:#compile:forClass:inCategory:notifying:install:)
+ ifTrue:[
+ temporaryMethod := compiler
+ compile:newSource
+ forClass:cls
+ inCategory:(self category)
+ notifying:nil
+ install:false.
+ ] ifFalse:[
+ temporaryMethod := compiler new
+ compile:newSource
+ in:cls
+ notifying:nil
+ ifFail:nil
+ ].
+ ].
+ ] ensure:[
+ Compiler compileLazy:lazy.
+ Smalltalk silentLoading:silent.
+ ]
+ ].
].
(temporaryMethod isNil or:[temporaryMethod == #Error]) ifTrue:[
- 'Method [warning]: cannot generate bytecode (contains primitive code or error)' errorPrintCR.
- ^ nil.
+ 'Method [warning]: cannot generate bytecode (contains primitive code or error)' errorPrintCR.
+ ^ nil.
].
"/
"/ try to save a bit of memory, by sharing the source (whatever it is)
@@ -1346,7 +1391,7 @@
aCopy := super copy.
sourcePosition notNil ifTrue:[
- aCopy source:(self source)
+ aCopy source:(self source)
].
aCopy mclass:nil.
^ aCopy
@@ -1379,7 +1424,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Modified: 4.11.1996 / 22:45:06 / cg"
!
@@ -1388,7 +1433,7 @@
"{ Pragma: +optSpace }"
"When recompiling classes after a definition-change, all
- uncompilable methods (with 1 arg) will be bound to this method here,
+ uncompilable methods (with 2 args) will be bound to this method here,
so that evaluating such an uncompilable method will trigger an error."
%{
@@ -1398,10 +1443,9 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
-
- "Created: 4.11.1996 / 21:16:16 / cg"
- "Modified: 4.11.1996 / 22:45:12 / cg"
+ raiseErrorString:'invalid method - not executable'.
+
+ "Created: / 14-09-2011 / 11:23:49 / sr"
!
invalidCodeObjectWith:arg with:arg2
@@ -1418,7 +1462,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:16:41 / cg"
"Modified: 4.11.1996 / 22:45:15 / cg"
@@ -1438,7 +1482,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:16:51 / cg"
"Modified: 4.11.1996 / 22:45:18 / cg"
@@ -1458,7 +1502,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:00 / cg"
"Modified: 4.11.1996 / 22:45:22 / cg"
@@ -1478,7 +1522,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:09 / cg"
"Modified: 4.11.1996 / 22:45:25 / cg"
@@ -1498,7 +1542,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:17 / cg"
"Modified: 4.11.1996 / 22:45:28 / cg"
@@ -1518,7 +1562,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:25 / cg"
"Modified: 4.11.1996 / 22:45:31 / cg"
@@ -1538,7 +1582,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:32 / cg"
"Modified: 4.11.1996 / 22:45:38 / cg"
@@ -1558,7 +1602,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:37 / cg"
"Modified: 4.11.1996 / 22:45:41 / cg"
@@ -1578,7 +1622,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:45 / cg"
"Modified: 4.11.1996 / 22:45:44 / cg"
@@ -1598,7 +1642,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:52 / cg"
"Modified: 4.11.1996 / 22:45:47 / cg"
@@ -1618,7 +1662,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 20:51:28 / cg"
"Modified: 4.11.1996 / 22:46:01 / cg"
@@ -1638,7 +1682,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:18:09 / cg"
"Modified: 4.11.1996 / 22:45:57 / cg"
@@ -1658,7 +1702,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:18:17 / cg"
"Modified: 4.11.1996 / 22:45:55 / cg"
@@ -1678,7 +1722,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:18:22 / cg"
"Modified: 4.11.1996 / 22:45:52 / cg"
@@ -1727,8 +1771,8 @@
*/
%}.
^ InvalidCodeError
- raiseRequestWith:self
- errorString:'invalid method - not compiled'.
+ raiseRequestWith:self
+ errorString:'invalid method - not compiled'.
"Modified: 4.11.1996 / 22:58:02 / cg"
!
@@ -1747,8 +1791,8 @@
*/
%}.
^ InvalidCodeError
- raiseRequestWith:self
- errorString:'invalid method - unloaded'.
+ raiseRequestWith:self
+ errorString:'invalid method - unloaded'.
"Created: 4.11.1996 / 22:57:54 / cg"
"Modified: 4.11.1996 / 22:58:28 / cg"
@@ -1771,30 +1815,30 @@
classAndSelector := self who.
classAndSelector isNil ifTrue:[
- "
- not anchored in any class.
- check if wrapped (to be more informative in inspectors)
- "
- m := self wrapper.
- m notNil ifTrue:[
- classAndSelector := m who.
- wrapped := true.
- ]
+ "
+ not anchored in any class.
+ check if wrapped (to be more informative in inspectors)
+ "
+ m := self wrapper.
+ m notNil ifTrue:[
+ classAndSelector := m who.
+ wrapped := true.
+ ]
].
classAndSelector notNil ifTrue:[
- (classAndSelector methodClass) name printOn:aStream.
- aStream nextPutAll:' '.
- (classAndSelector methodSelector) printOn:aStream.
+ (classAndSelector methodClass) name printOn:aStream.
+ aStream nextPutAll:' '.
+ (classAndSelector methodSelector) printOn:aStream.
] ifFalse:[
- "
- sorry, a method which is nowhere anchored
- "
- aStream nextPutAll:'unbound'
+ "
+ sorry, a method which is nowhere anchored
+ "
+ aStream nextPutAll:'unbound'
].
aStream nextPut:$).
wrapped ifTrue:[
- aStream nextPutAll:'; wrapped'
+ aStream nextPutAll:'; wrapped'
].
"
@@ -1816,7 +1860,7 @@
who := self who.
who notNil ifTrue:[
- ^ who methodClass name , ' >> ' , (who methodSelector storeString)
+ ^ who methodClass name , ' >> ' , (who methodSelector storeString)
].
^ 'unboundMethod'
@@ -1836,17 +1880,18 @@
any raw annotation array is lazily
initialized"
- | annotation args |
+ | annotationOrArray annotation args |
+
annotations ifNil:[^nil].
- annotation := annotations at: index.
- annotation isArray ifTrue:[
- args := annotation size == 2
- ifTrue:[annotation second]
+ annotationOrArray := annotation := annotations at: index.
+ annotationOrArray isArray ifTrue:[
+ args := annotationOrArray size == 2
+ ifTrue:[annotationOrArray second]
ifFalse:[#()].
args isArray ifFalse:[args := Array with: args].
annotation := Annotation
method:self
- key: annotation first
+ key: annotationOrArray first
arguments: args.
annotation isUnknown ifFalse:[
annotations at: index put: annotation.
@@ -1857,7 +1902,8 @@
"Created: / 02-07-2010 / 22:30:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 11-07-2010 / 19:39:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 05-09-2011 / 08:50:43 / cg"
+ "Modified: / 09-09-2011 / 05:00:52 / cg"
+ "Modified (format): / 12-09-2011 / 09:34:48 / cg"
!
annotationIndexOf: key
@@ -1868,10 +1914,10 @@
annotations ifNil:[^nil].
annotations keysAndValuesDo:
- [:index :annotationOrArray|
- annotationOrArray isArray
- ifTrue: [annotationOrArray first == key ifTrue:[^index]]
- ifFalse:[annotationOrArray key == key ifTrue:[^index]]].
+ [:index :annotationOrArray|
+ annotationOrArray isArray
+ ifTrue: [annotationOrArray first == key ifTrue:[^index]]
+ ifFalse:[annotationOrArray key == key ifTrue:[^index]]].
^nil.
"Created: / 19-05-2010 / 16:40:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -1884,14 +1930,14 @@
|lastStream|
(package notNil and:[package ~= PackageId noProjectID]) ifTrue:[
- LastFileLock critical:[
- lastStream := LastFileReference at:1.
- (lastStream notNil and:[lastStream ~= 0 and:[lastStream isOpen]]) ifTrue:[
- lastStream close.
- ].
- LastSourceFileName := package,'/',source.
- LastFileReference at:1 put:aStream.
- ].
+ LastFileLock critical:[
+ lastStream := LastFileReference at:1.
+ (lastStream notNil and:[lastStream ~= 0 and:[lastStream isOpen]]) ifTrue:[
+ lastStream close.
+ ].
+ LastSourceFileName := package,'/',source.
+ LastFileReference at:1 put:aStream.
+ ].
].
!
@@ -1917,29 +1963,29 @@
|dir fileName aStream|
package notNil ifTrue:[
- "/
- "/ old: look in 'source/<filename>'
- "/ this is still kept in order to find user-private
- "/ classes in her currentDirectory.
- "/
- fileName := Smalltalk getSourceFileName:(package copyReplaceAll:$: with:$/) , '/' , source.
- fileName notNil ifTrue:[
- aStream := fileName asFilename readStreamOrNil.
- aStream notNil ifTrue:[^ aStream].
- ].
- "/
- "/ new: look in package-dir
- "/
- dir := Smalltalk getPackageDirectoryForPackage:package.
- dir notNil ifTrue:[
- fileName := dir construct:source.
- aStream := fileName asFilename readStreamOrNil.
- aStream notNil ifTrue:[^ aStream].
- ].
+ "/
+ "/ old: look in 'source/<filename>'
+ "/ this is still kept in order to find user-private
+ "/ classes in her currentDirectory.
+ "/
+ fileName := Smalltalk getSourceFileName:(package copyReplaceAll:$: with:$/) , '/' , source.
+ fileName notNil ifTrue:[
+ aStream := fileName asFilename readStreamOrNil.
+ aStream notNil ifTrue:[^ aStream].
+ ].
+ "/
+ "/ new: look in package-dir
+ "/
+ dir := Smalltalk getPackageDirectoryForPackage:package.
+ dir notNil ifTrue:[
+ fileName := dir construct:source.
+ aStream := fileName asFilename readStreamOrNil.
+ aStream notNil ifTrue:[^ aStream].
+ ].
].
fileName := Smalltalk getSourceFileName:source.
fileName notNil ifTrue:[
- aStream := fileName asFilename readStreamOrNil.
+ aStream := fileName asFilename readStreamOrNil.
].
^ aStream
!
@@ -1961,28 +2007,28 @@
sourcePosition isNil ifTrue:[^ source readStream].
usingCacheBoolean ifTrue:[
- (package notNil and:[package ~= PackageId noProjectID]) ifTrue:[
- "/ keep the last source file open, because open/close
- "/ operations maybe slow on NFS-mounted file systems.
- "/ Since the reference to the file is weak, it will be closed
- "/ automatically if the file is not referenced for a while.
- "/ Neat trick.
-
- LastFileLock critical:[
- aStream := LastFileReference at:1.
- (aStream isNil or:[aStream == 0 or:[aStream isOpen not]]) ifTrue:[
- aStream := nil.
- LastFileReference at:1 put:nil.
- ].
- (aStream notNil and:[LastSourceFileName ~= (package,'/',source)]) ifTrue:[
- aStream := nil.
- ].
- ].
-
- aStream notNil ifTrue:[
- ^ aStream
- ].
- ].
+ (package notNil and:[package ~= PackageId noProjectID]) ifTrue:[
+ "/ keep the last source file open, because open/close
+ "/ operations maybe slow on NFS-mounted file systems.
+ "/ Since the reference to the file is weak, it will be closed
+ "/ automatically if the file is not referenced for a while.
+ "/ Neat trick.
+
+ LastFileLock critical:[
+ aStream := LastFileReference at:1.
+ (aStream isNil or:[aStream == 0 or:[aStream isOpen not]]) ifTrue:[
+ aStream := nil.
+ LastFileReference at:1 put:nil.
+ ].
+ (aStream notNil and:[LastSourceFileName ~= (package,'/',source)]) ifTrue:[
+ aStream := nil.
+ ].
+ ].
+
+ aStream notNil ifTrue:[
+ ^ aStream
+ ].
+ ].
].
"/ a negative sourcePosition indicates
@@ -1993,33 +2039,33 @@
"/ and having a clue for which file is meant later.
sourcePosition < 0 ifTrue:[
- aStream := source asFilename readStreamOrNil.
- aStream isNil ifTrue:[
- "/ search in some standard places
- fileName := Smalltalk getSourceFileName:source.
- fileName notNil ifTrue:[
- aStream := fileName asFilename readStreamOrNil.
- ].
- ].
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
+ aStream := source asFilename readStreamOrNil.
+ aStream isNil ifTrue:[
+ "/ search in some standard places
+ fileName := Smalltalk getSourceFileName:source.
+ fileName notNil ifTrue:[
+ aStream := fileName asFilename readStreamOrNil.
+ ].
+ ].
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
].
"/
"/ if there is no SourceManager, look in local standard places first
"/
(Class tryLocalSourceFirst or:[(mgr := Smalltalk at:#SourceCodeManager) isNil]) ifTrue:[
- aStream := self localSourceStream.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
+ aStream := self localSourceStream.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
].
"/
@@ -2027,39 +2073,39 @@
"/
who := self who.
who notNil ifTrue:[
- myClass := who methodClass.
-
- (package notNil and:[package ~= myClass package]) ifTrue:[
- "/ I am an extension
- mgr notNil ifTrue:[
- "/ try to get the source using my package information ...
- mod := package asPackageId module.
- dir := package asPackageId directory.
- aStream := mgr streamForExtensionFile:source package:package directory:dir module:mod cache:true.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
- ].
- "/ consult the local fileSystem
- aStream := self localSourceStream.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ]
- ].
-
- aStream := myClass sourceStreamFor:source.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
+ myClass := who methodClass.
+
+ (package notNil and:[package ~= myClass package]) ifTrue:[
+ "/ I am an extension
+ mgr notNil ifTrue:[
+ "/ try to get the source using my package information ...
+ mod := package asPackageId module.
+ dir := package asPackageId directory.
+ aStream := mgr streamForExtensionFile:source package:package directory:dir module:mod cache:true.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
+ ].
+ "/ consult the local fileSystem
+ aStream := self localSourceStream.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ]
+ ].
+
+ aStream := myClass sourceStreamFor:source.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
].
"/
@@ -2067,49 +2113,49 @@
"/ (if there is a source-code manager - otherwise, we already did that)
"/
(mgr notNil and:[Class tryLocalSourceFirst not]) ifTrue:[
- aStream := self localSourceStream.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
+ aStream := self localSourceStream.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
].
"/
"/ final chance: try current directory
"/
aStream isNil ifTrue:[
- aStream := source asFilename readStreamOrNil.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
+ aStream := source asFilename readStreamOrNil.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
].
(who isNil and:[source notNil]) ifTrue:[
- "/
- "/ mhmh - seems to be a method which used to be in some
- "/ class, but has been overwritten by another or removed.
- "/ (i.e. it has no containing class anyMore)
- "/ try to guess the class from the sourceFileName.
- "/ and retry.
- "/
- className := Smalltalk classNameForFile:source.
- (classNameSymbol := className asSymbolIfInterned) notNil ifTrue:[
- myClass := Smalltalk at:classNameSymbol ifAbsent:nil.
- myClass notNil ifTrue:[
- aStream := myClass sourceStreamFor:source.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
- ]
- ]
+ "/
+ "/ mhmh - seems to be a method which used to be in some
+ "/ class, but has been overwritten by another or removed.
+ "/ (i.e. it has no containing class anyMore)
+ "/ try to guess the class from the sourceFileName.
+ "/ and retry.
+ "/
+ className := Smalltalk classNameForFile:source.
+ (classNameSymbol := className asSymbolIfInterned) notNil ifTrue:[
+ myClass := Smalltalk at:classNameSymbol ifAbsent:nil.
+ myClass notNil ifTrue:[
+ aStream := myClass sourceStreamFor:source.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
+ ]
+ ]
].
^ nil
@@ -2128,9 +2174,9 @@
sourceChunkFromStream:aStream
PositionError handle:[:ex |
- ^ nil
+ ^ nil
] do:[
- aStream position1Based:(sourcePosition ? 1) abs.
+ aStream position1Based:(sourcePosition ? 1) abs.
].
^ aStream nextChunk.
!
@@ -2145,7 +2191,7 @@
rawStream := self rawSourceStreamUsingCache:usingCacheBoolean.
rawStream isNil ifTrue:[
- ^ nil.
+ ^ nil.
].
"/ see if its utf8 encoded...
@@ -2165,7 +2211,7 @@
OBJ nr = 0;
if (f & F_PRIMITIVE) {
- nr = __INST(code_);
+ nr = __INST(code_);
}
RETURN (nr);
#endif
@@ -2219,15 +2265,15 @@
src := self source.
src notNil ifTrue:[
- parser := Parser
- parseMethod:src
- in:self containingClass
- ignoreErrors:true
- ignoreWarnings:true.
-
- (parser notNil and:[parser ~~ #Error]) ifTrue:[
- ^ parser usedInstVars
- ].
+ parser := Parser
+ parseMethod:src
+ in:self containingClass
+ ignoreErrors:true
+ ignoreWarnings:true.
+
+ (parser notNil and:[parser ~~ #Error]) ifTrue:[
+ ^ parser usedInstVars
+ ].
].
^ #() "/ actually: unknown
@@ -2243,11 +2289,11 @@
|who|
mclass notNil ifTrue:[
- "/ check if this (cached) info is still valid ...
- (mclass containsMethod:self) ifTrue:[
- ^ mclass
- ].
- mclass := nil.
+ "/ check if this (cached) info is still valid ...
+ (mclass containsMethod:self) ifTrue:[
+ ^ mclass
+ ].
+ mclass := nil.
].
who := self who.
@@ -2271,38 +2317,38 @@
|newMethod function|
(self
- literalsDetect:[:lit |
- #(
- #'invoke'
- #'invokeWith:'
- #'invokeWith:with:'
- #'invokeWith:with:with:'
- #'invokeWith:with:with:with:'
- #'invokeWithArguments:'
- #'invokeCPPVirtualOn:'
- #'invokeCPPVirtualOn:with:'
- #'invokeCPPVirtualOn:with:with:'
- #'invokeCPPVirtualOn:with:with:with:'
- #'invokeCPPVirtualOn:with:with:with:with:'
- #'invokeCPPVirtualOn:withArguments:'
- ) includes:lit
- ]
- ifNone:nil) notNil
+ literalsDetect:[:lit |
+ #(
+ #'invoke'
+ #'invokeWith:'
+ #'invokeWith:with:'
+ #'invokeWith:with:with:'
+ #'invokeWith:with:with:with:'
+ #'invokeWithArguments:'
+ #'invokeCPPVirtualOn:'
+ #'invokeCPPVirtualOn:with:'
+ #'invokeCPPVirtualOn:with:with:'
+ #'invokeCPPVirtualOn:with:with:with:'
+ #'invokeCPPVirtualOn:with:with:with:with:'
+ #'invokeCPPVirtualOn:withArguments:'
+ ) includes:lit
+ ]
+ ifNone:nil) notNil
ifTrue:[
- "/ sigh - for stc-compiled code, this does not work:
- function := self literalsDetect:[:lit | lit isExternalLibraryFunction] ifNone:nil.
- function isNil ifTrue:[
- "/ parse it and ask the parser
- newMethod := Compiler compile:self source forClass:self mclass install:false.
- function := newMethod literalsDetect:[:lit | lit isExternalLibraryFunction] ifNone:nil.
- ].
- ^ function
+ "/ sigh - for stc-compiled code, this does not work:
+ function := self literalsDetect:[:lit | lit isExternalLibraryFunction] ifNone:nil.
+ function isNil ifTrue:[
+ "/ parse it and ask the parser
+ newMethod := Compiler compile:self source forClass:self mclass install:false.
+ function := newMethod literalsDetect:[:lit | lit isExternalLibraryFunction] ifNone:nil.
+ ].
+ ^ function
].
^ nil
"
(IDispatchPointer compiledMethodAt:#'invokeGetTypeInfo:_:_:')
- externalLibraryFunction
+ externalLibraryFunction
"
!
@@ -2332,7 +2378,7 @@
"
Method allInstancesDo:[:m |
- (m hasAnyResource:#(image canvas)) ifTrue:[self halt]
+ (m hasAnyResource:#(image canvas)) ifTrue:[self halt]
].
"
!
@@ -2369,10 +2415,10 @@
src := self source.
src notNil ifTrue:[
- (src includesString:(String with:$% with:${) "<- no constant here - to avoid trouble with stupid scanners" ) ifFalse:[
- "/ cannot contain primitive code.
- ^ false
- ]
+ (src includesString:(String with:$% with:${) "<- no constant here - to avoid trouble with stupid scanners" ) ifFalse:[
+ "/ cannot contain primitive code.
+ ^ false
+ ]
].
"/ ok; it may or may not ...
@@ -2408,7 +2454,7 @@
"
Method allInstancesDo:[:m |
- (m hasResource:#image) ifTrue:[self halt]
+ (m hasResource:#image) ifTrue:[self halt]
].
"
@@ -2489,20 +2535,20 @@
m := self trapMethodForNumArgs:(self numArgs).
(m notNil and:[self ~~ m]) ifTrue:[
- (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
- (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
+ (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
+ (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
].
m := Method compiledMethodAt:#uncompiledCodeObject.
(m notNil and:[self ~~ m]) ifTrue:[
- (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
- (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
+ (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
+ (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
].
m := Method compiledMethodAt:#unloadedCodeObject.
(m notNil and:[self ~~ m]) ifTrue:[
- (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
- (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
+ (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
+ (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
].
^ false
@@ -2626,13 +2672,13 @@
parserClass := self parserClass.
sourceString := self source.
(parserClass notNil and:[sourceString notNil]) ifTrue:[
- parser := parserClass parseMethodArgAndVarSpecificationSilent:sourceString.
- (parser isNil or:[parser == #Error]) ifTrue:[^ nil].
- argNames := parser methodArgs.
- varNames := parser methodVars.
- argNames isNil ifTrue:[^ varNames].
- varNames isNil ifTrue:[^ argNames].
- ^ (argNames , varNames)
+ parser := parserClass parseMethodArgAndVarSpecificationSilent:sourceString.
+ (parser isNil or:[parser == #Error]) ifTrue:[^ nil].
+ argNames := parser methodArgs.
+ varNames := parser methodVars.
+ argNames isNil ifTrue:[^ varNames].
+ varNames isNil ifTrue:[^ argNames].
+ ^ (argNames , varNames)
].
^ nil
@@ -2666,30 +2712,30 @@
line := (text at:2).
nQuote := line occurrencesOf:(Character doubleQuote).
(nQuote == 2) ifTrue:[
- qIndex := line indexOf:(Character doubleQuote).
- qIndex2 := line indexOf:(Character doubleQuote) startingAt:(qIndex + 1).
- ^ line copyFrom:(qIndex + 1) to:(qIndex2 - 1)
+ qIndex := line indexOf:(Character doubleQuote).
+ qIndex2 := line indexOf:(Character doubleQuote) startingAt:(qIndex + 1).
+ ^ line copyFrom:(qIndex + 1) to:(qIndex2 - 1)
].
(nQuote == 1) ifTrue:[
- qIndex := line indexOf:(Character doubleQuote).
- comment := line copyFrom:(qIndex + 1).
- (line indexOf:$/ startingAt:qIndex) == (qIndex+1) ifTrue:[
- "/ an EOL comment
- ^ (comment copyFrom:2) withoutSeparators
- ].
-
- "/ not an EOL comment
- index := 3.
- line := text at:index.
- nQuote := line occurrencesOf:(Character doubleQuote).
- [nQuote ~~ 1] whileTrue:[
- comment := comment , Character cr asString , line withoutSpaces.
- index := index + 1.
- line := text at:index.
- nQuote := line occurrencesOf:(Character doubleQuote)
- ].
- qIndex := line indexOf:(Character doubleQuote).
- ^ comment , Character cr asString , (line copyTo:(qIndex - 1)) withoutSpaces
+ qIndex := line indexOf:(Character doubleQuote).
+ comment := line copyFrom:(qIndex + 1).
+ (line indexOf:$/ startingAt:qIndex) == (qIndex+1) ifTrue:[
+ "/ an EOL comment
+ ^ (comment copyFrom:2) withoutSeparators
+ ].
+
+ "/ not an EOL comment
+ index := 3.
+ line := text at:index.
+ nQuote := line occurrencesOf:(Character doubleQuote).
+ [nQuote ~~ 1] whileTrue:[
+ comment := comment , Character cr asString , line withoutSpaces.
+ index := index + 1.
+ line := text at:index.
+ nQuote := line occurrencesOf:(Character doubleQuote)
+ ].
+ qIndex := line indexOf:(Character doubleQuote).
+ ^ comment , Character cr asString , (line copyTo:(qIndex - 1)) withoutSpaces
].
^ nil
@@ -2702,8 +2748,8 @@
"return the string that defines the method and the arguments"
^ Method
- methodDefinitionTemplateForSelector:self selector
- andArgumentNames:self methodArgNames
+ methodDefinitionTemplateForSelector:self selector
+ andArgumentNames:self methodArgNames
"
(self compiledMethodAt:#printOn:) methodDefinitionTemplate
@@ -2746,8 +2792,8 @@
list size == 0 ifTrue:[^ nil].
histLine := list last.
^ Timestamp
- fromDate:histLine date
- andTime:histLine time
+ fromDate:histLine date
+ andTime:histLine time
"
(Method compiledMethodAt:#modificationTime) modificationTime
@@ -2771,8 +2817,8 @@
| mth |
mth := self overriddenMethod.
[ mth notNil ] whileTrue:
- [mth == aMethod ifTrue:[^true].
- mth := mth overriddenMethod].
+ [mth == aMethod ifTrue:[^true].
+ mth := mth overriddenMethod].
^false
"Modified: / 18-06-2009 / 12:15:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
@@ -2787,7 +2833,7 @@
"
(Method compiledMethodAt:#parse:return:or:)
- parse:#'parseMethodSilent:' return:#sentMessages or:#()
+ parse:#'parseMethodSilent:' return:#sentMessages or:#()
"
!
@@ -2845,15 +2891,15 @@
src := self source.
src isNil ifTrue:[
- ^ nil "/ actually: dont know
+ ^ nil "/ actually: dont know
].
self parserClass isNil ifTrue:[
- ^ nil
+ ^ nil
].
parser := self parserClass parseMethod: src.
(parser isNil or: [parser == #Error]) ifTrue:[
- ^ nil "/ actually error
+ ^ nil "/ actually error
].
^ annotations := parser annotations.
@@ -2867,19 +2913,19 @@
src := self source.
src isNil ifTrue:[
- ^ nil "/ actually: dont know
+ ^ nil "/ actually: dont know
].
(src findString:'resource:') == 0 ifTrue:[
- ^ nil "/ actually: error
+ ^ nil "/ actually: error
].
"/ no need to parse all - only interested in resource-info
self parserClass isNil ifTrue:[
- ^ nil
+ ^ nil
].
parser := self parserClass parseMethodArgAndVarSpecificationSilent:src in:nil.
parser isNil ifTrue:[
- ^ nil "/ actually error
+ ^ nil "/ actually error
].
^ parser primitiveResources.
!
@@ -2896,15 +2942,15 @@
cls isNil ifTrue:[ ^ nil ].
ChangeSet current reverseDo:[:change |
- (change isMethodChange
- and:[ (change selector == sel)
- and:[ change changeClass == cls ]])
- ifTrue:[
- previous := change previousVersion.
- previous notNil ifTrue:[
- ^ previous
- ]
- ]
+ (change isMethodChange
+ and:[ (change selector == sel)
+ and:[ change changeClass == cls ]])
+ ifTrue:[
+ previous := change previousVersion.
+ previous notNil ifTrue:[
+ ^ previous
+ ]
+ ]
].
^ nil.
@@ -2954,28 +3000,28 @@
versions := OrderedCollection new.
ChangeSet current reverseDo:[:change |
- (change isMethodChange
- and:[ (change selector == sel)
- and:[ change changeClass == cls ]])
- ifTrue:[
- versions addFirst:change.
- lastChange := change.
- ]
+ (change isMethodChange
+ and:[ (change selector == sel)
+ and:[ change changeClass == cls ]])
+ ifTrue:[
+ versions addFirst:change.
+ lastChange := change.
+ ]
].
lastChange notNil ifTrue:[
- last := lastChange previousVersion.
- last notNil ifTrue:[
- firstSrc := last source.
- (firstSrc size > 0
- and:[ firstSrc ~= lastChange source]) ifTrue:[
- versions addFirst:(MethodChange
- className:lastChange className
- selector:lastChange selector
- source:firstSrc
- category:lastChange category).
- ]
- ]
+ last := lastChange previousVersion.
+ last notNil ifTrue:[
+ firstSrc := last source.
+ (firstSrc size > 0
+ and:[ firstSrc ~= lastChange source]) ifTrue:[
+ versions addFirst:(MethodChange
+ className:lastChange className
+ selector:lastChange selector
+ source:firstSrc
+ category:lastChange category).
+ ]
+ ]
].
^ versions
!
@@ -2999,9 +3045,9 @@
|resources|
(resources := self resources) notNil ifTrue:[
- resources keysAndValuesDo:[:key :val|
- ^ key
- ].
+ resources keysAndValuesDo:[:key :val|
+ ^ key
+ ].
].
^ nil
!
@@ -3015,8 +3061,8 @@
resources := IdentityDictionary new.
self annotationsAt: #resource: orAt: #resource:value: do:
- [:annot|
- resources at: annot type put: annot value ? true].
+ [:annot|
+ resources at: annot type put: annot value ? true].
^resources
"Modified: / 16-07-2010 / 11:49:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -3052,7 +3098,7 @@
with aSelectorSymbol as selector."
(self referencesLiteral:aSelectorSymbol) ifTrue:[
- ^ self messagesSent includesIdentical:aSelectorSymbol
+ ^ self messagesSent includesIdentical:aSelectorSymbol
].
^ false
!
@@ -3134,53 +3180,53 @@
nil is returned for unbound methods.
ST/X special notice:
- returns an instance of MethodWhoInfo, which
- responds to #methodClass and #methodSelector query messages.
- For backward- (& ST-80) compatibility, the returned object also
- responds to #at:1 and #at:2 messages.
+ returns an instance of MethodWhoInfo, which
+ responds to #methodClass and #methodSelector query messages.
+ For backward- (& ST-80) compatibility, the returned object also
+ responds to #at:1 and #at:2 messages.
Implementation notice:
- Since there is no information of the containing class
- in the method, we have to do a search here.
-
- Normally, this is not a problem, except when a method is
- accepted in the debugger or redefined from within a method
- (maybe done indirectly, if #doIt is done recursively)
- - the information about which class the original method was
- defined in is lost in this case.
+ Since there is no information of the containing class
+ in the method, we have to do a search here.
+
+ Normally, this is not a problem, except when a method is
+ accepted in the debugger or redefined from within a method
+ (maybe done indirectly, if #doIt is done recursively)
+ - the information about which class the original method was
+ defined in is lost in this case.
Problem:
- this is heavily called for in the debugger to create
- a readable context walkback. For unbound methods, it is
- slow, since the search (over all classes) will always fail.
+ this is heavily called for in the debugger to create
+ a readable context walkback. For unbound methods, it is
+ slow, since the search (over all classes) will always fail.
Q: should we add a backref from the method to the class
- and/or add a subclass of Method for unbound ones ?
+ and/or add a subclass of Method for unbound ones ?
Q2: if so, what about the bad guy then, who copies methods around to
- other classes ?"
+ other classes ?"
|classes cls sel fn clsName checkBlock|
mclass notNil ifTrue:[
- sel := mclass selectorAtMethod:self.
- sel notNil ifTrue:[
- ^ MethodWhoInfo class:mclass selector:sel
- ].
- "/ flush outdated mclass info
- mclass := nil.
+ sel := mclass selectorAtMethod:self.
+ sel notNil ifTrue:[
+ ^ MethodWhoInfo class:mclass selector:sel
+ ].
+ "/ flush outdated mclass info
+ mclass := nil.
].
checkBlock := [:cls |
- |sel|
-
- sel := cls selectorAtMethod:self.
- sel notNil ifTrue:[
- LastWhoClass := cls theNonMetaclass name.
- mclass isNil ifTrue:[
- mclass := cls
- ].
- ^ MethodWhoInfo class:cls selector:sel
- ].
+ |sel|
+
+ sel := cls selectorAtMethod:self.
+ sel notNil ifTrue:[
+ LastWhoClass := cls theNonMetaclass name.
+ mclass isNil ifTrue:[
+ mclass := cls
+ ].
+ ^ MethodWhoInfo class:cls selector:sel
+ ].
].
"
@@ -3188,15 +3234,15 @@
extract the className from it and try that class first.
"
(fn := self sourceFilename) notNil ifTrue:[
- clsName := fn asFilename nameWithoutSuffix.
- clsName := clsName asSymbolIfInterned.
- clsName notNil ifTrue:[
- cls := Smalltalk at:clsName ifAbsent:nil.
- cls notNil ifTrue:[
- checkBlock value:cls theNonMetaclass.
- checkBlock value:cls theMetaclass.
- ]
- ].
+ clsName := fn asFilename nameWithoutSuffix.
+ clsName := clsName asSymbolIfInterned.
+ clsName notNil ifTrue:[
+ cls := Smalltalk at:clsName ifAbsent:nil.
+ cls notNil ifTrue:[
+ checkBlock value:cls theNonMetaclass.
+ checkBlock value:cls theMetaclass.
+ ]
+ ].
].
"
@@ -3206,11 +3252,11 @@
being garbage collected)
"
LastWhoClass notNil ifTrue:[
- cls := Smalltalk at:LastWhoClass ifAbsent:nil.
- cls notNil ifTrue:[
- checkBlock value:cls theNonMetaclass.
- checkBlock value:cls theMetaclass.
- ]
+ cls := Smalltalk at:LastWhoClass ifAbsent:nil.
+ cls notNil ifTrue:[
+ checkBlock value:cls theNonMetaclass.
+ checkBlock value:cls theMetaclass.
+ ]
].
"
@@ -3222,8 +3268,8 @@
instance methods are usually more common - search those first
"
classes do:[:cls |
- checkBlock value:cls theNonMetaclass.
- checkBlock value:cls theMetaclass.
+ checkBlock value:cls theNonMetaclass.
+ checkBlock value:cls theMetaclass.
].
LastWhoClass := nil.
@@ -3253,11 +3299,11 @@
|m cls|
Object
- subclass:#FunnyClass
- instanceVariableNames:'foo'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'.
+ subclass:#FunnyClass
+ instanceVariableNames:'foo'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'.
cls := Smalltalk at:#FunnyClass.
Smalltalk removeClass:cls.
@@ -3276,7 +3322,7 @@
Thats the WrapperMethod which contains myself."
WrappedMethod allInstancesDo:[:m |
- m originalMethod == self ifTrue:[^ m].
+ m originalMethod == self ifTrue:[^ m].
].
^ nil
!
@@ -3342,31 +3388,10 @@
!
trapMethodForNumArgs:numArgs
- |trapSel|
-
- trapSel := #(
- #'invalidCodeObject'
- #'invalidCodeObjectWith:'
- #'invalidCodeObjectWith:with:'
- #'invalidCodeObjectWith:with:with:'
- #'invalidCodeObjectWith:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:with:with:'
- ) at:(numArgs + 1).
-
- ^ Method compiledMethodAt:trapSel.
-
- "Created: 4.11.1996 / 21:58:58 / cg"
- "Modified: 4.11.1996 / 23:18:05 / cg"
+ ^ self class trapMethodForNumArgs:numArgs
+
+ "Created: / 04-11-1996 / 21:58:58 / cg"
+ "Modified: / 08-09-2011 / 05:35:48 / cg"
! !
!Method::MethodWhoInfo class methodsFor:'documentation'!
@@ -3378,17 +3403,17 @@
This was done, since a smalltalk method cannot return multiple
values, but 2 values had to be returned from that method.
Thus, the who-interface was used as:
- info := <someMethod> who.
- class := info at:1.
- sel := info at:2.
+ info := <someMethod> who.
+ class := info at:1.
+ sel := info at:2.
Sure, this is ugly coding style, and the system has been changed to return
an object (an instance of MethodWhoInfo) which responds to the two
messages: #methodClass and #methodSelector.
This allows to write things much more intuitive:
- info := <someMethod> who.
- class := info methodClass.
- sel := info methodSelector.
+ info := <someMethod> who.
+ class := info methodClass.
+ sel := info methodSelector.
However, to be backward compatible, the returned object still responds to
the #at: message, but only allows inices of 1 and 2 to be used.
@@ -3397,10 +3422,10 @@
classes.
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Method
+ Method
"
! !
@@ -3449,10 +3474,10 @@
"simulate the old behavior (when Method>>who returned an array)"
index == 1 ifTrue:[
- ^ myClass
+ ^ myClass
].
index == 2 ifTrue:[
- ^ mySelector
+ ^ mySelector
].
"/ sigh - full compatibility ?
@@ -3494,12 +3519,12 @@
parserClass := something.
!
-parserClass:parserClassArg method:methodArg
+parserClass:parserClassArg method:methodArg
parserClass := parserClassArg.
method := methodArg.
!
-parserClass:parserClassArg method:methodArg parser:parserArg
+parserClass:parserClassArg method:methodArg parser:parserArg
parserClass := parserClassArg.
method := methodArg.
parser := parserArg.
@@ -3533,12 +3558,12 @@
parserClass := something.
!
-parserClass:parserClassArg method:methodArg
+parserClass:parserClassArg method:methodArg
parserClass := parserClassArg.
method := methodArg.
!
-parserClass:parserClassArg method:methodArg parser:parserArg
+parserClass:parserClassArg method:methodArg parser:parserArg
parserClass := parserClassArg.
method := methodArg.
parser := parserArg.
@@ -3549,11 +3574,11 @@
!Method class methodsFor:'documentation'!
version
- ^ '$Id: Method.st 10686 2011-09-07 16:25:40Z vranyj1 $'
+ ^ '$Id: Method.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Method.st,v 1.369 2011/09/07 09:17:12 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Method.st,v 1.377 2011/09/14 09:25:43 sr Exp §'
!
version_SVN
@@ -3563,3 +3588,4 @@
Method initialize!
+
--- a/Notification.st Thu Sep 15 12:05:35 2011 +0100
+++ b/Notification.st Tue Sep 20 11:11:19 2011 +0100
@@ -12,7 +12,7 @@
"{ Package: 'stx:libbasic' }"
GenericException subclass:#Notification
- instanceVariableNames:''
+ instanceVariableNames:'tag'
classVariableNames:''
poolDictionaries:''
category:'Kernel-Exceptions'
@@ -275,6 +275,24 @@
"Created: / 25.7.1999 / 23:25:59 / stefan"
! !
+!Notification methodsFor:'accessing'!
+
+tag
+ "for squeak compatibility"
+
+ ^ tag
+
+ "Modified (comment): / 11-09-2011 / 16:40:54 / cg"
+!
+
+tag:aSzmbol
+ "for squeak compatibility"
+
+ tag := aSzmbol.
+
+ "Modified (format): / 11-09-2011 / 16:41:01 / cg"
+! !
+
!Notification methodsFor:'default actions'!
defaultAction
@@ -340,11 +358,12 @@
!Notification class methodsFor:'documentation'!
version
- ^ '$Id: Notification.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: Notification.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Notification.st,v 1.26 2011/05/09 08:22:54 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Notification.st,v 1.27 2011/09/11 14:41:10 cg Exp §'
! !
Notification initialize!
+
--- a/Object.st Thu Sep 15 12:05:35 2011 +0100
+++ b/Object.st Tue Sep 20 11:11:19 2011 +0100
@@ -266,7 +266,6 @@
"Modified: / 4.8.1999 / 08:54:06 / stefan"
! !
-
!Object class methodsFor:'Compatibility-ST80'!
rootError
@@ -529,8 +528,6 @@
-
-
!Object methodsFor:'Compatibility-Dolphin'!
stbFixup: anSTBInFiler at: newObjectIndex
@@ -4892,11 +4889,11 @@
thisContext isRecursive ifTrue:[
'Severe error: signalInterrupt while processing a signalInterrupt.' errorPrintCR.
'Terminating process ' errorPrint. Processor activeProcess errorPrintCR.
- GenericException handle:[:ex |
- "/ ignore any error during termination
- ] do:[
- Processor activeProcess terminate.
- ].
+"/ GenericException handle:[:ex |
+"/ "/ ignore any error during termination
+"/ ] do:[
+"/ Processor activeProcess terminate.
+"/ ].
Processor activeProcess terminateNoSignal.
].
@@ -5048,7 +5045,7 @@
"action == #ignore"
].
- "Modified: / 10-08-2011 / 19:58:20 / cg"
+ "Modified: / 15-09-2011 / 16:38:14 / cg"
!
spyInterrupt
@@ -8999,6 +8996,15 @@
"Created: 12.5.1996 / 10:56:50 / cg"
!
+isTextView
+ "return true, if the receiver is some kind of textView;
+ false is returned here - the method is only redefined in TextViews."
+
+ ^ false
+
+ "Modified (comment): / 08-09-2011 / 05:12:37 / cg"
+!
+
isTimestamp
^ false
!
@@ -9446,7 +9452,7 @@
!Object class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Object.st,v 1.674 2011/09/05 02:52:39 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Object.st,v 1.676 2011/09/15 14:39:02 cg Exp §'
!
version_SVN
@@ -9458,3 +9464,4 @@
+
--- a/PackageId.st Thu Sep 15 12:05:35 2011 +0100
+++ b/PackageId.st Tue Sep 20 11:11:19 2011 +0100
@@ -152,7 +152,7 @@
!PackageId methodsFor:'queries'!
directory
- "return the directory component. Thats the rest after the colon.
+ "return the directory component. That's the rest after the colon.
The module is typically used to define the project-path or project-id within its
sourcecode repository (which is selected via the module)."
@@ -175,6 +175,7 @@
"Created: / 18-08-2006 / 12:15:33 / cg"
"Modified: / 28-11-2006 / 11:39:14 / cg"
+ "Modified (comment): / 19-09-2011 / 11:01:08 / cg"
!
isModuleId
@@ -206,7 +207,7 @@
!
module
- "return the module component. Thats the first component up to the colon.
+ "return the module component. That's the first component up to the colon.
The module is typically used to select a corresponding sourcecode repository."
|idx|
@@ -224,6 +225,7 @@
"Created: / 18-08-2006 / 12:13:53 / cg"
"Modified: / 27-12-2006 / 11:51:25 / cg"
+ "Modified (comment): / 19-09-2011 / 11:01:15 / cg"
!
parentPackage
@@ -279,9 +281,10 @@
!PackageId class methodsFor:'documentation'!
version
- ^ '$Id: PackageId.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: PackageId.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/PackageId.st,v 1.16 2009/10/22 15:43:27 cg Exp §'
+ ^ 'Header: /cvs/stx/stx/libbasic/PackageId.st,v 1.17 2011/09/19 14:07:09 cg Exp '
! !
+
--- a/ProjectDefinition.st Thu Sep 15 12:05:35 2011 +0100
+++ b/ProjectDefinition.st Tue Sep 20 11:11:19 2011 +0100
@@ -229,7 +229,7 @@
"answer all (recursive) prerequisite project ids of myself - in random order."
^ self allPreRequisitesWithParentDo:[:parent :prereq |
- prereq = self package ifTrue:[ Transcript showCR:('oops: %1 depends on itself' bindWith:prereq) ].
+ prereq = self package ifTrue:[ Transcript showCR:('oops: %1 depends on itself' bindWith:prereq) ].
]
"
@@ -302,7 +302,7 @@
allPreRequisitesWithParentDo:aBlock
"answer all (recursive) prerequisite project ids of myself - in random order.
- If we exclude a project, but one of our prerequisite projects depends on it,
+ If we exclude a project, but one of our prerequisite projects depends on it,
then what ????"
|setOfAllPreRequisites toAdd|
@@ -318,34 +318,34 @@
"/ toAdd addAll:self effectiveSubProjects.
[toAdd notEmpty] whileTrue:[
- |aPreRequisiteProjectID def|
-
- aPreRequisiteProjectID := toAdd removeFirst.
- (setOfAllPreRequisites includes:aPreRequisiteProjectID) ifFalse:[
- setOfAllPreRequisites add:aPreRequisiteProjectID.
-
- def := self definitionClassForPackage:aPreRequisiteProjectID.
- def isNil ifTrue:[
- Transcript showCR:'ProjectDefinition ', aPreRequisiteProjectID, ' is missing - cannot find its preRequisites.'.
- ] ifFalse:[
- def effectivePreRequisites
- select:[:eachSubPreRequisite | (setOfAllPreRequisites includes:eachSubPreRequisite) not]
- thenDo:[:eachSubPreRequisite |
- Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' requires ', eachSubPreRequisite).
- aBlock value:def value:eachSubPreRequisite.
- toAdd add:eachSubPreRequisite
- ].
-
- "but subprojects of our prerequisites are also prerequisites"
- def effectiveSubProjects
- select:[:eachSubSubRequisite | eachSubSubRequisite ~= self package and:[ (setOfAllPreRequisites includes:eachSubSubRequisite) not ]]
- thenDo:[:eachSubSubRequisite |
- Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' hasSub ', eachSubSubRequisite).
- aBlock value:def value:eachSubSubRequisite.
- toAdd add:eachSubSubRequisite
- ].
- ].
- ]
+ |aPreRequisiteProjectID def|
+
+ aPreRequisiteProjectID := toAdd removeFirst.
+ (setOfAllPreRequisites includes:aPreRequisiteProjectID) ifFalse:[
+ setOfAllPreRequisites add:aPreRequisiteProjectID.
+
+ def := self definitionClassForPackage:aPreRequisiteProjectID.
+ def isNil ifTrue:[
+ Transcript showCR:'ProjectDefinition ', aPreRequisiteProjectID, ' is missing - cannot find its preRequisites.'.
+ ] ifFalse:[
+ def effectivePreRequisites
+ select:[:eachSubPreRequisite | (setOfAllPreRequisites includes:eachSubPreRequisite) not]
+ thenDo:[:eachSubPreRequisite |
+ Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' requires ', eachSubPreRequisite).
+ aBlock value:def value:eachSubPreRequisite.
+ toAdd add:eachSubPreRequisite
+ ].
+
+ "but subprojects of our prerequisites are also prerequisites"
+ def effectiveSubProjects
+ select:[:eachSubSubRequisite | eachSubSubRequisite ~= self package and:[ (setOfAllPreRequisites includes:eachSubSubRequisite) not ]]
+ thenDo:[:eachSubSubRequisite |
+ Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' hasSub ', eachSubSubRequisite).
+ aBlock value:def value:eachSubSubRequisite.
+ toAdd add:eachSubSubRequisite
+ ].
+ ].
+ ]
].
^ setOfAllPreRequisites.
@@ -1113,23 +1113,23 @@
|suite classes|
suite := TestSuite named:self package.
- classes := self classes
- select:[:each |
+ classes := self classes
+ select:[:each |
[
each isLoaded ifFalse:[each autoload].
(each isTestCaseLike) and:[ each isAbstract not ]
] on: Autoload autoloadFailedSignal do:[
false
]
- ].
+ ].
classes := classes asSortedCollection:[:a :b | a name <= b name ].
- classes do: [:eachClass |
- | tests |
-
- tests := eachClass suite tests.
- tests := tests reject:[:test|self shouldExcludeTest: test].
- suite addTests: tests
+ classes do: [:eachClass |
+ | tests |
+
+ tests := eachClass suite tests.
+ tests := tests reject:[:test|self shouldExcludeTest: test].
+ suite addTests: tests
].
^ suite
@@ -1157,18 +1157,18 @@
"needs everything else (especially the compiler etc.) to be initialized.
Therefore, its not invoked by #initialize, but instead explicitely,
by Smalltalk"
-
+
|isStandAloneApp|
isStandAloneApp := Smalltalk isStandAloneApp.
self allSubclassesDo:[:eachProjectDefinitionClass |
- eachProjectDefinitionClass isAbstract ifFalse:[
- isStandAloneApp ifFalse:[
- eachProjectDefinitionClass installAutoloadedClasses.
- ].
- eachProjectDefinitionClass projectIsLoaded:true.
- ]
+ eachProjectDefinitionClass isAbstract ifFalse:[
+ isStandAloneApp ifFalse:[
+ eachProjectDefinitionClass installAutoloadedClasses.
+ ].
+ eachProjectDefinitionClass projectIsLoaded:true.
+ ]
].
"
@@ -1186,62 +1186,62 @@
classesToFixClassFileName := OrderedCollection new.
self autoloaded_classNames do:[:className |
- |cls|
-
- "/ 'install as autoloaded: ' errorPrint. className errorPrintCR.
- (cls := Smalltalk classNamed:className) isNil ifTrue:[
- Error handle:[:ex |
- (self name,' [warning]: failed to install autoloaded: ',className) errorPrintCR.
- (self name,' [info]: reason: ',ex description) errorPrintCR.
- "/ thisContext fullPrintAll.
- ] do:[
- cls := Smalltalk
- installAutoloadedClassNamed:className
- category:'* as yet unknown category *'
- package:self package
- revision:nil
- ].
- cls notNil ifTrue:[
- classesToFixClassFileName add:cls.
- ].
- ].
+ |cls|
+
+ "/ 'install as autoloaded: ' errorPrint. className errorPrintCR.
+ (cls := Smalltalk classNamed:className) isNil ifTrue:[
+ Error handle:[:ex |
+ (self name,' [warning]: failed to install autoloaded: ',className) errorPrintCR.
+ (self name,' [info]: reason: ',ex description) errorPrintCR.
+ "/ thisContext fullPrintAll.
+ ] do:[
+ cls := Smalltalk
+ installAutoloadedClassNamed:className
+ category:'* as yet unknown category *'
+ package:self package
+ revision:nil
+ ].
+ cls notNil ifTrue:[
+ classesToFixClassFileName add:cls.
+ ].
+ ].
].
Smalltalk addStartBlock:[
- |abbrevs|
-
- abbrevs := self abbrevs.
- "/ patch the classFileNames
- classesToFixClassFileName do:[:cls |
- |entry classFilenameFromAbbreviations|
-
- entry := abbrevs at:cls name ifAbsent:nil.
- entry notNil ifTrue:[
- classFilenameFromAbbreviations := entry fileName.
- classFilenameFromAbbreviations notNil ifTrue:[
- classFilenameFromAbbreviations := classFilenameFromAbbreviations,'.st'.
- (classFilenameFromAbbreviations ~= cls getClassFilename) ifTrue:[
- cls setClassFilename:classFilenameFromAbbreviations
- ].
- ].
- ]
- ].
-
- "/ patch the categories
- Class withoutUpdatingChangesDo:[
- |entry|
-
- self classNames do:[:nm |
- |cls|
-
- ((cls := Smalltalk at: nm) notNil
- and:[ cls isLoaded not
- and:[ (entry := abbrevs at:cls name ifAbsent:[nil]) notNil
- ]]) ifTrue:[
- cls category: (entry category)
- ]
- ]
- ]
+ |abbrevs|
+
+ abbrevs := self abbrevs.
+ "/ patch the classFileNames
+ classesToFixClassFileName do:[:cls |
+ |entry classFilenameFromAbbreviations|
+
+ entry := abbrevs at:cls name ifAbsent:nil.
+ entry notNil ifTrue:[
+ classFilenameFromAbbreviations := entry fileName.
+ classFilenameFromAbbreviations notNil ifTrue:[
+ classFilenameFromAbbreviations := classFilenameFromAbbreviations,'.st'.
+ (classFilenameFromAbbreviations ~= cls getClassFilename) ifTrue:[
+ cls setClassFilename:classFilenameFromAbbreviations
+ ].
+ ].
+ ]
+ ].
+
+ "/ patch the categories
+ Class withoutUpdatingChangesDo:[
+ |entry|
+
+ self classNames do:[:nm |
+ |cls|
+
+ ((cls := Smalltalk at: nm) notNil
+ and:[ cls isLoaded not
+ and:[ (entry := abbrevs at:cls name ifAbsent:[nil]) notNil
+ ]]) ifTrue:[
+ cls category: (entry category)
+ ]
+ ]
+ ]
].
@@ -1321,76 +1321,76 @@
newSpec := OrderedCollection new.
ignoreOldEntries ifFalse:[
- oldSpec do:[:oldEntry |
- |newEntry className cls |
-
- newEntry := oldEntry copy.
- className := newEntry first.
-
- (ignored includes:className) ifFalse:[
- cls := Smalltalk classNamed:className.
- ignoreOldDefinition ifTrue:[
- (cls notNil and:[cls isLoaded not]) ifTrue:[
- (newEntry includes:#autoload) ifFalse:[
- newEntry := newEntry copyWith:#autoload.
- ].
- ].
- ].
- cls notNil ifTrue:[
- "JV @ 2010-06-19
- Force merge default class attributes with existing ones"
- newEntry := self mergeDefaultClassAttributesFor: cls with: newEntry.
- newSpec add:newEntry.
- ]
- ].
- ].
+ oldSpec do:[:oldEntry |
+ |newEntry className cls |
+
+ newEntry := oldEntry copy.
+ className := newEntry first.
+
+ (ignored includes:className) ifFalse:[
+ cls := Smalltalk classNamed:className.
+ ignoreOldDefinition ifTrue:[
+ (cls notNil and:[cls isLoaded not]) ifTrue:[
+ (newEntry includes:#autoload) ifFalse:[
+ newEntry := newEntry copyWith:#autoload.
+ ].
+ ].
+ ].
+ cls notNil ifTrue:[
+ "JV @ 2010-06-19
+ Force merge default class attributes with existing ones"
+ newEntry := self mergeDefaultClassAttributesFor: cls with: newEntry.
+ newSpec add:newEntry.
+ ]
+ ].
+ ].
].
self searchForClasses do:[:eachClass |
- |className attributes oldSpecEntry oldAttributes newEntry|
-
- className := eachClass name.
- (ignored includes:className) ifFalse:[
- oldSpecEntry := oldSpec detect:[:entry | entry first = className] ifNone:nil.
-
- (ignoreOldEntries or:[ oldSpecEntry isNil]) ifTrue:[
- (eachClass isLoaded not or:[eachClass isPrivate not]) ifTrue:[
- (self additionalClassNamesAndAttributes includes:className) ifFalse:[
- (oldSpecEntry size > 1) ifTrue:[
- oldAttributes := oldSpecEntry copyFrom:2.
- ].
-
- ignoreOldDefinition ifTrue:[
- "take autoload attribute from classes state in the image"
- oldAttributes notNil ifTrue:[
- attributes := oldAttributes copyWithout:#autoload.
- ] ifFalse:[
- attributes := #()
- ].
- eachClass isLoaded ifFalse:[
- attributes := attributes copyWith:#autoload.
- ].
- ] ifFalse:[
- "keep any existing attribute"
- oldAttributes notNil ifTrue:[
- attributes := oldAttributes.
- ] ifFalse:[
- attributes := eachClass isLoaded ifTrue:[ #() ] ifFalse:[ #(autoload) ].
- ].
- ].
- "JV @ 2010-06-19
- Support fo additional class attributes and programming language attribute"
- attributes := self mergeDefaultClassAttributesFor: eachClass with: attributes.
-
- newEntry := Array with:className.
- attributes notEmptyOrNil ifTrue:[
- newEntry := newEntry , attributes.
- ].
- newSpec add:newEntry
- ]
- ]
- ]
- ]
+ |className attributes oldSpecEntry oldAttributes newEntry|
+
+ className := eachClass name.
+ (ignored includes:className) ifFalse:[
+ oldSpecEntry := oldSpec detect:[:entry | entry first = className] ifNone:nil.
+
+ (ignoreOldEntries or:[ oldSpecEntry isNil]) ifTrue:[
+ (eachClass isLoaded not or:[eachClass isPrivate not]) ifTrue:[
+ (self additionalClassNamesAndAttributes includes:className) ifFalse:[
+ (oldSpecEntry size > 1) ifTrue:[
+ oldAttributes := oldSpecEntry copyFrom:2.
+ ].
+
+ ignoreOldDefinition ifTrue:[
+ "take autoload attribute from classes state in the image"
+ oldAttributes notNil ifTrue:[
+ attributes := oldAttributes copyWithout:#autoload.
+ ] ifFalse:[
+ attributes := #()
+ ].
+ eachClass isLoaded ifFalse:[
+ attributes := attributes copyWith:#autoload.
+ ].
+ ] ifFalse:[
+ "keep any existing attribute"
+ oldAttributes notNil ifTrue:[
+ attributes := oldAttributes.
+ ] ifFalse:[
+ attributes := eachClass isLoaded ifTrue:[ #() ] ifFalse:[ #(autoload) ].
+ ].
+ ].
+ "JV @ 2010-06-19
+ Support fo additional class attributes and programming language attribute"
+ attributes := self mergeDefaultClassAttributesFor: eachClass with: attributes.
+
+ newEntry := Array with:className.
+ attributes notEmptyOrNil ifTrue:[
+ newEntry := newEntry , attributes.
+ ].
+ newSpec add:newEntry
+ ]
+ ]
+ ]
+ ]
].
^ self classNamesAndAttributes_codeFor:newSpec
@@ -2050,6 +2050,49 @@
"Created: / 22-08-2006 / 23:59:32 / cg"
!
+additionalHeaderRulesUsingTemplate:template pathConverter:pathConverter
+ "rules for header files (of autoloaded classes).
+ For each extended class, which is autoloaded (and therefore, we will not find a header file for it),
+ generate a rule to create the header file only."
+
+ ^ String streamContents:[:s |
+ (self extensionClassesWithSuperclasses:true) do:[:eachExtendedClass |
+ |headerFileDirPath baseFilename|
+
+ (eachExtendedClass isLoaded not or:[eachExtendedClass wasAutoloaded]) ifTrue:[
+ headerFileDirPath := self perform:pathConverter with:eachExtendedClass package.
+ baseFilename := self filenameForClass:eachExtendedClass.
+
+ s nextPutAll:(template
+ bindWith:headerFileDirPath
+ with:baseFilename).
+ ]
+ ].
+ ].
+
+ "Created: / 12-09-2011 / 16:23:52 / cg"
+!
+
+additionalHeaderRules_bc_dot_mak
+ "rules for header files (of autoloaded classes)"
+
+ ^ self
+ additionalHeaderRulesUsingTemplate:(self singleHeaderRuleTemplate_bc_dot_mak)
+ pathConverter:#pathToPackage_win32:
+
+ "Created: / 12-09-2011 / 15:44:09 / cg"
+!
+
+additionalHeaderRules_make_dot_proto
+ "rules for header files (of autoloaded classes)"
+
+ ^ self
+ additionalHeaderRulesUsingTemplate:(self singleHeaderRuleTemplate_make_dot_proto)
+ pathConverter:#pathToPackage_unix:
+
+ "Created: / 12-09-2011 / 15:44:28 / cg"
+!
+
additionalLinkLibraries_bc_dot_mak
"allows for additional static libraries to be added to the bc.mak file.
Subclasses may redefine this"
@@ -2235,6 +2278,32 @@
"Created: / 22-08-2006 / 23:53:33 / cg"
!
+singleHeaderRuleTemplate_bc_dot_mak
+ "rules for header files (of autoloaded classes)"
+
+ ^ '
+%1\%2.$(H):
+ pushd %1 \
+ & $(STC) $(FFLAGS) $(STCFLAGS) $(STC_MSGFORMAT) $(DBGFLAGS) $(DEFS) -C -headerOnly %2.st \
+ & popd
+'
+
+ "Created: / 12-09-2011 / 15:55:49 / cg"
+!
+
+singleHeaderRuleTemplate_make_dot_proto
+ "rules for header files (of autoloaded classes)"
+
+ ^ '
+%1/%2.$(H):
+ pushd %1 \
+ & $(STC) $(FFLAGS) $(STCFLAGS) $(STC_MSGFORMAT) $(DBGFLAGS) $(DEFS) -C -headerOnly %2.st \
+ & popd
+'
+
+ "Created: / 12-09-2011 / 15:55:57 / cg"
+!
+
stcOptimizationOptions
"see the stc reference / stc usage for options.
For now, the following variants are useful:
@@ -3191,6 +3260,7 @@
at: 'PRIMARY_TARGET' put: (self primaryTarget_bc_dot_mak);
at: 'ADDITIONAL_BASE_ADDRESS_DEFINITION' put: (self additionalBaseAddressDefinition_bc_dot_mak ? '');
at: 'ADDITIONAL_DEFINITIONS' put: (self additionalDefinitions_bc_dot_mak ? '');
+ at: 'ADDITIONAL_HEADERRULES' put: (self additionalHeaderRules_bc_dot_mak);
at: 'ADDITIONAL_RULES' put: (self additionalRules_bc_dot_mak ? '');
at: 'ADDITIONAL_TARGETS' put: (self additionalTargets_bc_dot_mak ? '');
at: 'ADDITIONAL_LINK_LIBRARIES' put: (self additionalLinkLibraries_bc_dot_mak ? '');
@@ -3201,7 +3271,7 @@
^ d
"Created: / 18-08-2006 / 11:43:39 / cg"
- "Modified: / 24-11-2010 / 20:15:05 / cg"
+ "Modified: / 12-09-2011 / 15:43:30 / cg"
!
bmake_dot_mak_mappings
@@ -3267,6 +3337,7 @@
at: 'HEADEROUTPUTARG' put: (self headerFileOutputArg);
at: 'PRIMARY_TARGET' put: (self primaryTarget_make_dot_proto);
at: 'ADDITIONAL_DEFINITIONS' put: (self additionalDefinitions_make_dot_proto);
+ at: 'ADDITIONAL_HEADERRULES' put: (self additionalHeaderRules_make_dot_proto);
at: 'ADDITIONAL_RULES' put: (self additionalRules_make_dot_proto);
at: 'ADDITIONAL_RULES_SVN' put: (self additionalRulesSvn_make_dot_proto);
at: 'ADDITIONAL_TARGETS' put: (self additionalTargets_make_dot_proto);
@@ -3282,9 +3353,9 @@
"Created: / 09-08-2006 / 11:20:45 / fm"
"Modified: / 09-08-2006 / 16:44:48 / fm"
- "Modified: / 14-09-2006 / 18:57:52 / cg"
"Modified: / 24-06-2009 / 21:50:13 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 22-08-2009 / 12:03:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 12-09-2011 / 15:43:06 / cg"
!
make_dot_spec_mappings
@@ -3420,7 +3491,7 @@
classNamesByCategory
"answer a dictionary
- category -> classNames topological sorted"
+ category -> classNames topological sorted"
|pivateClassesOf sorter classes classNames mapping|
@@ -3431,57 +3502,57 @@
classes do:[:each | pivateClassesOf at:each put:(each allPrivateClasses)].
sorter := [:a :b |
- "/ a must come before b iff:
- "/ b is a subclass of a
- "/ b has a private class which is a subclass of a
- "/ a is a sharedPool, used by b
-
- |mustComeBefore pivateClassesOfB|
-
- mustComeBefore := false.
- mustComeBefore := (a isSharedPool and:[(b sharedPoolNames includes: a name)]).
- mustComeBefore := mustComeBefore or:[b isSubclassOf:a].
- mustComeBefore ifFalse:[
- pivateClassesOfB := pivateClassesOf at:b ifAbsent:[ #() ].
- pivateClassesOfB do:[:eachClassInB |
- mustComeBefore := mustComeBefore or:[eachClassInB isSubclassOf:a]
- ].
- ].
- mustComeBefore
+ "/ a must come before b iff:
+ "/ b is a subclass of a
+ "/ b has a private class which is a subclass of a
+ "/ a is a sharedPool, used by b
+
+ |mustComeBefore pivateClassesOfB|
+
+ mustComeBefore := false.
+ mustComeBefore := (a isSharedPool and:[(b sharedPoolNames includes: a name)]).
+ mustComeBefore := mustComeBefore or:[b isSubclassOf:a].
+ mustComeBefore ifFalse:[
+ pivateClassesOfB := pivateClassesOf at:b ifAbsent:[ #() ].
+ pivateClassesOfB do:[:eachClassInB |
+ mustComeBefore := mustComeBefore or:[eachClassInB isSubclassOf:a]
+ ].
+ ].
+ mustComeBefore
].
classes topologicalSort:sorter.
OperatingSystem knownPlatformNames do:[:platformID |
- |prefix depClasses depClassNames|
-
- prefix := platformID asUppercase.
- depClasses := self compiled_classesForArchitecture:platformID.
- depClasses notEmpty ifTrue:[
- (self compiled_classNamesForPlatform:platformID)
- select:[:nm | (Smalltalk at:nm ifAbsent:nil) isNil]
- thenDo:[:nm | Transcript showCR:nm].
- (depClasses includes:nil) ifTrue:[
- (Dialog confirm:'Dependencies might be incorrect (some classes are not present).\\Continue anyway ?' withCRs)
- ifFalse:[
- AbortOperationRequest raise.
- ].
- depClassNames := self compiled_classNamesForPlatform:platformID.
- ] ifFalse:[
- depClasses topologicalSort:sorter.
- depClassNames := depClasses collect:[:eachClass| eachClass name].
- ].
- mapping at:prefix put:depClassNames.
- ].
-
- classNames := classes collect:[:eachClass| eachClass name].
- self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do: [:nm :attr |
- (attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
- classNames add:nm.
- ].
- ].
-
- mapping at:'COMMON' put:classNames.
+ |prefix depClasses depClassNames|
+
+ prefix := platformID asUppercase.
+ depClasses := self compiled_classesForArchitecture:platformID.
+ depClasses notEmpty ifTrue:[
+ (self compiled_classNamesForPlatform:platformID)
+ select:[:nm | (Smalltalk at:nm ifAbsent:nil) isNil]
+ thenDo:[:nm | Transcript showCR:nm].
+ (depClasses includes:nil) ifTrue:[
+ (Dialog confirm:'Dependencies might be incorrect (some classes are not present).\\Continue anyway ?' withCRs)
+ ifFalse:[
+ AbortOperationRequest raise.
+ ].
+ depClassNames := self compiled_classNamesForPlatform:platformID.
+ ] ifFalse:[
+ depClasses topologicalSort:sorter.
+ depClassNames := depClasses collect:[:eachClass| eachClass name].
+ ].
+ mapping at:prefix put:depClassNames.
+ ].
+
+ classNames := classes collect:[:eachClass| eachClass name].
+ self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do: [:nm :attr |
+ (attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
+ classNames add:nm.
+ ].
+ ].
+
+ mapping at:'COMMON' put:classNames.
].
^ mapping
@@ -4445,6 +4516,7 @@
self hasAllClassesLoaded ifFalse:[
self breakPoint:#cg.
].
+ self installAutoloadedClasses.
self classes do:[:cls | cls autoload ].
].
@@ -4457,6 +4529,8 @@
"Verbose := true
stx_goodies_soap_xe hasAllExtensionsLoaded
"
+
+ "Modified: / 12-09-2011 / 16:57:53 / cg"
!
load
@@ -4476,26 +4550,26 @@
|newStuffHasBeenLoaded meOrMySecondIncarnation|
self projectIsLoaded ifTrue:[
- asAutoloaded ifFalse:[
- "/ to be considered !!
+ asAutoloaded ifFalse:[
+ "/ to be considered !!
"/ self isFullyLoaded ifFalse:[
"/ self hasAllExtensionsLoaded ifFalse:[
"/ self loadExtensions.
"/ ].
"/ self loadAllAutoloadedClasses
"/ ].
- ].
- ^ false
+ ].
+ ^ false
].
thisContext isRecursive ifTrue:[self breakPoint:#cg. ^ false]. "/ avoid endless loops
newStuffHasBeenLoaded := false.
(self infoPrinting and:[Smalltalk silentLoading not]) ifTrue:[
- "/ thisContext fullPrintAll.
- Transcript showCR:('loading %1%2...'
- bindWith:(asAutoloaded ifTrue:['as autoloaded '] ifFalse:[''])
- with:self name).
+ "/ thisContext fullPrintAll.
+ Transcript showCR:('loading %1%2...'
+ bindWith:(asAutoloaded ifTrue:['as autoloaded '] ifFalse:[''])
+ with:self name).
].
self rememberOverwrittenExtensionMethods.
@@ -4506,32 +4580,32 @@
meOrMySecondIncarnation := self.
Class withoutUpdatingChangesDo:[
- self activityNotification:'Loading prerequisities'.
- self loadPreRequisitesAsAutoloaded:asAutoloaded.
-
- self checkPrerequisitesForLoading.
-
- asAutoloaded ifFalse:[
- self loadClassLibrary.
- "/ could have overloaded my first incarnation
- meOrMySecondIncarnation := (Smalltalk at:(self name)) ? self.
- meOrMySecondIncarnation ~~ self ifTrue:[
- meOrMySecondIncarnation fetchSlotsFrom:self.
- ].
- ].
-
- self hasAllExtensionsLoaded ifFalse:[
- self activityNotification:'Loading extensions'.
- newStuffHasBeenLoaded := newStuffHasBeenLoaded | meOrMySecondIncarnation loadExtensions.
- ].
- self hasAllClassesLoaded ifFalse:[
- self activityNotification:'Loading classes'.
- newStuffHasBeenLoaded := newStuffHasBeenLoaded | (meOrMySecondIncarnation loadAllClassesAsAutoloaded:asAutoloaded).
- ].
+ self activityNotification:'Loading prerequisities'.
+ self loadPreRequisitesAsAutoloaded:asAutoloaded.
+
+ self checkPrerequisitesForLoading.
+
+ asAutoloaded ifFalse:[
+ self loadClassLibrary.
+ "/ could have overloaded my first incarnation
+ meOrMySecondIncarnation := (Smalltalk at:(self name)) ? self.
+ meOrMySecondIncarnation ~~ self ifTrue:[
+ meOrMySecondIncarnation fetchSlotsFrom:self.
+ ].
+ ].
+
+ self hasAllExtensionsLoaded ifFalse:[
+ self activityNotification:'Loading extensions'.
+ newStuffHasBeenLoaded := newStuffHasBeenLoaded | meOrMySecondIncarnation loadExtensions.
+ ].
+ self hasAllClassesLoaded ifFalse:[
+ self activityNotification:'Loading classes'.
+ newStuffHasBeenLoaded := newStuffHasBeenLoaded | (meOrMySecondIncarnation loadAllClassesAsAutoloaded:asAutoloaded).
+ ].
"/ no, don't load subProjects here - will lead to a recursion, which leads
"/ to some classes being loaded from source (soap)
- self activityNotification:'Loading sub projects'.
- meOrMySecondIncarnation loadSubProjectsAsAutoloaded:asAutoloaded.
+ self activityNotification:'Loading sub projects'.
+ meOrMySecondIncarnation loadSubProjectsAsAutoloaded:asAutoloaded.
].
self activityNotification:('Executing post-load action for %1' bindWith:self package).
@@ -4541,7 +4615,7 @@
meOrMySecondIncarnation projectIsLoaded:true.
meOrMySecondIncarnation ~~ self ifTrue:[
- self projectIsLoaded:true.
+ self projectIsLoaded:true.
].
self activityNotification:('Done (%1).' bindWith:self package).
@@ -4607,29 +4681,29 @@
|abbrevs|
AccessLock critical:[
- |mustRead file|
-
- AbbrevDictionary isNil ifTrue:[
- AbbrevDictionary := WeakIdentityDictionary new.
- ].
-
- mustRead := false.
- abbrevs := AbbrevDictionary at:self ifAbsent:[ mustRead := true. Dictionary new ].
-
- mustRead ifTrue:[
- file := self packageDirectory / 'abbrev.stc'.
- file exists ifTrue: [
- file readingFileDo:[:stream |
- Smalltalk
- withAbbreviationsFromStream:stream
- do:[:nm :fn :pkg :cat :sz|
- abbrevs at: nm put: (AbbrevEntry new className:nm fileName:fn category:cat numClassInstVars:sz)
- ]
- ]
- ].
- ].
+ |mustRead file|
+
+ AbbrevDictionary isNil ifTrue:[
+ AbbrevDictionary := WeakIdentityDictionary new.
+ ].
+
+ mustRead := false.
+ abbrevs := AbbrevDictionary at:self ifAbsent:[ mustRead := true. Dictionary new ].
+
+ mustRead ifTrue:[
+ file := self packageDirectory / 'abbrev.stc'.
+ file exists ifTrue: [
+ file readingFileDo:[:stream |
+ Smalltalk
+ withAbbreviationsFromStream:stream
+ do:[:nm :fn :pkg :cat :sz|
+ abbrevs at: nm put: (AbbrevEntry new className:nm fileName:fn category:cat numClassInstVars:sz)
+ ]
+ ]
+ ].
+ ].
].
-
+
^abbrevs
"Created: / 06-03-2011 / 18:25:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -5306,6 +5380,7 @@
savedOverwrittenMethodForClass:aClass selector:aSelector
"return one of my saved original methods"
+ safeForOverwrittenMethods isNil ifTrue:[^ nil].
^ safeForOverwrittenMethods at:(aClass name,'>>',aSelector) ifAbsent:nil
! !
@@ -5503,28 +5578,28 @@
"Handle smalltalk classes specially to provide backward compatibility"
lang isSmalltalk ifTrue:[
- entry := self abbrevs at: className ifAbsent:[nil].
-
- asAutoloaded ifTrue:[
- category := entry isNil ifTrue:[#autoloaded] ifFalse:[entry category].
- numClassInstVars := entry isNil ifTrue:[0] ifFalse:[entry numClassInstVars].
- cls := Smalltalk
- installAutoloadedClassNamed: className
- category: category
- package: self package
- revision: nil
- numClassInstVars:numClassInstVars.
- entry notNil ifTrue:[
- cls setClassFilename:(entry fileName,'.st').
- ].
- ^ cls.
- ].
- ^ Smalltalk
- fileInClass:className
- package:self package
- initialize:false
- lazy:false
- silent:true
+ entry := self abbrevs at: className ifAbsent:[nil].
+
+ asAutoloaded ifTrue:[
+ category := entry isNil ifTrue:[#autoloaded] ifFalse:[entry category].
+ numClassInstVars := entry isNil ifTrue:[0] ifFalse:[entry numClassInstVars].
+ cls := Smalltalk
+ installAutoloadedClassNamed: className
+ category: category
+ package: self package
+ revision: nil
+ numClassInstVars:numClassInstVars.
+ entry notNil ifTrue:[
+ cls setClassFilename:(entry fileName,'.st').
+ ].
+ ^ cls.
+ ].
+ ^ Smalltalk
+ fileInClass:className
+ package:self package
+ initialize:false
+ lazy:false
+ silent:true
].
"For non-smalltalk language do"
@@ -5913,42 +5988,42 @@
requiredClasses := (self searchForClassesWithProject: packageId) asSet.
withSubProjectsBoolean ifTrue:[
- "my subproject's classes are required"
- self subProjects do:[:eachProjectName |
- requiredClasses addAll: (self searchForClassesWithProject:eachProjectName asSymbol)
- ].
+ "my subproject's classes are required"
+ self subProjects do:[:eachProjectName |
+ requiredClasses addAll: (self searchForClassesWithProject:eachProjectName asSymbol)
+ ].
].
"all superclasses of my classes and my subProject's classes are required"
requiredClasses do:[:cls |
- cls allSuperclassesDo:[:eachSuperclass |
- (usedClassesWithReasons at: eachSuperclass ifAbsentPut:[OrderedSet new])
- add: (eachSuperclass name, ' - superclass of ', cls name).
- ]
+ cls allSuperclassesDo:[:eachSuperclass |
+ (usedClassesWithReasons at: eachSuperclass ifAbsentPut:[OrderedSet new])
+ add: (eachSuperclass name, ' - superclass of ', cls name).
+ ]
].
"all classes referenced by my classes or my subproject's classes
are required. But:
- only search for locals refered to by my methods (assuming that superclasses'
- prerequisites are specified in their package)."
+ only search for locals refered to by my methods (assuming that superclasses'
+ prerequisites are specified in their package)."
self addReferencesToClassesFromGlobalsIn:requiredClasses to:usedClassesWithReasons.
self addReferencesToClassesFromGlobalsInMethods:(self searchForExtensionsWithProject:self package) to:usedClassesWithReasons.
"all classes for which I define extensions are required"
self allExtensionClasses do:[:eachExtendedClass |
- (usedClassesWithReasons at:eachExtendedClass ifAbsentPut:[OrderedSet new])
- add: (eachExtendedClass name, ' - extended').
- eachExtendedClass allSuperclassesDo:[:eachSuperclass |
- (usedClassesWithReasons at: eachSuperclass ifAbsentPut:[OrderedSet new])
- add: (eachSuperclass name, ' - superclass of extended ', eachExtendedClass name).
- ]
+ (usedClassesWithReasons at:eachExtendedClass ifAbsentPut:[OrderedSet new])
+ add: (eachExtendedClass name, ' - extended').
+ eachExtendedClass allSuperclassesDo:[:eachSuperclass |
+ (usedClassesWithReasons at: eachSuperclass ifAbsentPut:[OrderedSet new])
+ add: (eachSuperclass name, ' - superclass of extended ', eachExtendedClass name).
+ ]
].
"don't put classes from subProjects into the required list"
ignoredPackages := (self siblingsAreSubProjects
- ifTrue:[ self searchForSiblingProjects ]
- ifFalse:[ self searchForSubProjects ]) asSet.
+ ifTrue:[ self searchForSiblingProjects ]
+ ifFalse:[ self searchForSubProjects ]) asSet.
ignoredPackages add:self package.
ignoredPackages add:PackageId noProjectID.
@@ -5956,11 +6031,11 @@
"now map classes to packages and collect the reasons"
requiredPackageReasons := Dictionary new.
usedClassesWithReasons keysAndValuesDo:[:usedClass :reasonsPerClass | |usedClassPackage|
- usedClassPackage := usedClass package.
- (ignoredPackages includes:usedClassPackage) ifFalse:[
- (requiredPackageReasons at:usedClassPackage ifAbsentPut:[OrderedSet new])
- addAll:reasonsPerClass.
- ].
+ usedClassPackage := usedClass package.
+ (ignoredPackages includes:usedClassPackage) ifFalse:[
+ (requiredPackageReasons at:usedClassPackage ifAbsentPut:[OrderedSet new])
+ addAll:reasonsPerClass.
+ ].
].
^ requiredPackageReasons
@@ -6126,26 +6201,26 @@
classes := IdentitySet new.
self extensionMethodNames pairWiseDo:[:className :selector |
- |mthdCls extendedClass|
-
- mthdCls := Smalltalk classNamed:className.
- (mthdCls notNil and:[mthdCls isLoaded]) ifTrue:[
- extendedClass := mthdCls theNonMetaclass.
- (classes includes:extendedClass) ifFalse:[
- withSuperclassesBoolean ifTrue:[
- extendedClass withAllSuperclassesDo:[:eachClass |
- classes add:eachClass.
- ].
- ] ifFalse:[
- classes add:extendedClass.
- ].
- ].
- ].
+ |mthdCls extendedClass|
+
+ mthdCls := Smalltalk classNamed:className.
+ (mthdCls notNil and:[mthdCls isLoaded]) ifTrue:[
+ extendedClass := mthdCls theNonMetaclass.
+ (classes includes:extendedClass) ifFalse:[
+ withSuperclassesBoolean ifTrue:[
+ extendedClass withAllSuperclassesDo:[:eachClass |
+ classes add:eachClass.
+ ].
+ ] ifFalse:[
+ classes add:extendedClass.
+ ].
+ ].
+ ].
].
^ classes.
"
- stx_libboss extensionClasses
+ stx_libboss extensionClasses
"
"Created: / 06-09-2011 / 10:17:06 / cg"
@@ -6173,7 +6248,7 @@
^ self allExtensionClasses collect:[:eachClass| eachClass package]
"
- stx_libboss extensionPackages
+ stx_libboss extensionPackages
"
"Modified: / 06-09-2011 / 10:20:47 / cg"
@@ -6342,7 +6417,7 @@
!ProjectDefinition class methodsFor:'sanity checks'!
validateDescription
- |emptyProjects nonProjects emptyOrNonProjects|
+ |emptyProjects nonProjects emptyOrNonProjects classesInImage classesInDescription onlyInImage onlyInDescription|
emptyProjects := Set withAll:self subProjects.
Smalltalk allClassesDo:[:cls |
@@ -6369,12 +6444,29 @@
].
].
- self validateDescription_extensions.
-
- "Modified: / 19-09-2006 / 20:30:39 / cg"
- "Modified: / 11-08-2011 / 18:51:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
+ classesInImage := Smalltalk allClasses select:[:cls | cls package = self package].
+ classesInDescription := self classes asIdentitySet.
+ classesInImage ~= classesInDescription ifTrue:[
+ onlyInImage := (classesInImage reject:[:cls | classesInDescription includes:cls]).
+ onlyInImage notEmpty ifTrue:[
+ Transcript show:'only in image: '; showCR:onlyInImage
+ ].
+ onlyInDescription := (classesInDescription reject:[:cls | classesInImage includes:cls]).
+ onlyInDescription notEmpty ifTrue:[
+ Transcript show:'only in description: '; showCR:onlyInDescription
+ ].
+ (Dialog confirm:'The set of classes in the image is different from the listed classes in the project definition.\\Proceed?' withCRs) ifFalse:[
+ AbortSignal raiseRequest
+ ]
+ ].
+
+ "
+ squeak_vmMaker validateDescription
+ "
+
+ "Modified: / 17-09-2011 / 15:48:42 / cg"
+
+!
validateDescription_extensions
"
@@ -6438,6 +6530,7 @@
"Created: / 11-08-2011 / 18:51:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ProjectDefinition class methodsFor:'testing'!
isApplicationDefinition
@@ -6485,7 +6578,7 @@
^ className
!
-className:classNameArg fileName:fileNameArg category:categoryArg numClassInstVars:numClassInstVarsArg
+className:classNameArg fileName:fileNameArg category:categoryArg numClassInstVars:numClassInstVarsArg
className := classNameArg.
fileName := fileNameArg.
category := categoryArg.
@@ -6507,16 +6600,17 @@
!ProjectDefinition class methodsFor:'documentation'!
version
- ^ '$Id: ProjectDefinition.st 10686 2011-09-07 16:25:40Z vranyj1 $'
+ ^ '$Id: ProjectDefinition.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.351 2011/09/07 09:11:06 cg Exp §'
+ ^ 'Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.360 2011/09/18 11:05:14 cg Exp '
!
version_SVN
- ^ '$Id: ProjectDefinition.st 10686 2011-09-07 16:25:40Z vranyj1 $'
+ ^ '$Id: ProjectDefinition.st 10690 2011-09-20 10:11:19Z vranyj1 $'
! !
ProjectDefinition initialize!
+
--- a/SequenceableCollection.st Thu Sep 15 12:05:35 2011 +0100
+++ b/SequenceableCollection.st Tue Sep 20 11:11:19 2011 +0100
@@ -380,6 +380,9 @@
^ self == SequenceableCollection
! !
+
+
+
!SequenceableCollection methodsFor:'Compatibility-Squeak'!
allButFirst
@@ -660,6 +663,7 @@
^ self replaceFrom:start to:stop with:anArray startingAt:repStart
! !
+
!SequenceableCollection methodsFor:'accessing'!
after:anObject
@@ -3612,6 +3616,28 @@
"
!
+copyUpThrough:element
+ "return a new collection consisting of the receiver elements
+ up-to (and including) the first occurrence of element;
+ or to the end, if element is not included"
+
+ |idx|
+
+ idx := self indexOf:element.
+ idx == 0 ifTrue:[^ self copy]. "question: is this ok?"
+ ^ self copyFrom:1 to:idx
+
+ "
+ #($a $b $c $d $e $f $g) copyUpThrough:$d
+ '1234567890' copyUpThrough:$5
+ '1234567890' copyUpThrough:$a
+ '1234567890' copyUpThrough:$1
+ '123456789' copyUpThrough:$0
+ "
+
+ "Created: / 14-09-2011 / 16:28:16 / cg"
+!
+
copyUpTo:element
"return a new collection consisting of the receiver elements
up-to (but excluding) the first occurrence of element;
@@ -7898,7 +7924,8 @@
!SequenceableCollection class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.306 2011/06/30 15:40:20 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.307 2011/09/14 14:28:30 cg Exp §'
! !
SequenceableCollection initialize!
+
--- a/SharedPool.st Thu Sep 15 12:05:35 2011 +0100
+++ b/SharedPool.st Tue Sep 20 11:11:19 2011 +0100
@@ -45,6 +45,40 @@
"
! !
+!SharedPool class methodsFor:'Compatibility-Squeak'!
+
+bindingOf: varName
+ "Answer the binding of some variable resolved in the scope of the receiver"
+
+ | aSymbol binding |
+
+ "/ self shouldImplement. "not yet finished"
+ aSymbol := varName asSymbol.
+
+ "First look in classVar dictionary."
+ binding := self classPool bindingOf: aSymbol.
+ binding notNil ifTrue:[^binding].
+
+ "Next look in shared pools."
+ self sharedPools do:[:pool |
+ binding := pool bindingOf: aSymbol.
+ binding notNil ifTrue:[^binding].
+ ].
+
+ "subclassing and environment are not preserved"
+ ^nil
+
+ "Modified: / 12-09-2011 / 09:40:36 / cg"
+!
+
+bindingsDo: aBlock
+ self classVarNames do:[:eachKey |
+ aBlock value:(eachKey -> (self classVarAt:eachKey))
+ ].
+
+ "Modified: / 12-09-2011 / 09:42:00 / cg"
+! !
+
!SharedPool class methodsFor:'Compatibility-V''Age'!
declareConstant:constantName value:value
@@ -86,7 +120,6 @@
"Modified: / 15-01-2011 / 14:20:58 / cg"
! !
-
!SharedPool class methodsFor:'misc ui support'!
iconInBrowserSymbol
@@ -113,33 +146,12 @@
^ self classVarAt:name
!
-bindingOf: varName
- "Answer the binding of some variable resolved in the scope of the receiver"
-
- | aSymbol binding |
-
- self shouldImplement. "not yet finished"
- aSymbol := varName asSymbol.
-
- "First look in classVar dictionary."
- binding := self classPool bindingOf: aSymbol.
- binding notNil ifTrue:[^binding].
+at:name put:aValue
+ "set a pool variable by name"
- "Next look in shared pools."
- self sharedPools do:[:pool |
- binding := pool bindingOf: aSymbol.
- binding notNil ifTrue:[^binding].
- ].
+ ^ self classVarAt:name put:aValue
- "subclassing and environment are not preserved"
- ^nil
-
- "Modified: / 08-08-2010 / 14:46:09 / cg"
-!
-
-bindingsDo: aBlock
-self halt:'unfinished implementation'.
- ^ self classPool bindingsDo: aBlock
+ "Created: / 08-09-2011 / 05:48:16 / cg"
!
classBindingOf: varName
@@ -157,6 +169,15 @@
"
!
+keyAtValue:value ifAbsent:exceptionValue
+ self keysDo:[:k |
+ (self at:k) == value ifTrue:[ ^ k ].
+ ].
+ ^ exceptionValue value
+
+ "Created: / 08-09-2011 / 05:51:10 / cg"
+!
+
keys
^ self classVarNames
@@ -190,9 +211,10 @@
!SharedPool class methodsFor:'documentation'!
version
- ^ '$Id: SharedPool.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: SharedPool.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/SharedPool.st,v 1.15 2011/01/15 13:21:03 cg Exp §'
+ ^ 'Header: /cvs/stx/stx/libbasic/SharedPool.st,v 1.18 2011/09/12 08:22:19 cg Exp '
! !
+
--- a/Smalltalk.st Thu Sep 15 12:05:35 2011 +0100
+++ b/Smalltalk.st Tue Sep 20 11:11:19 2011 +0100
@@ -515,20 +515,21 @@
"sent from VM via #initializeModules"
Error handle:[:ex |
- ClassesFailedToInitialize isNil ifTrue:[
- ClassesFailedToInitialize := IdentitySet new.
- ].
- ClassesFailedToInitialize add:aClass.
- ('Smalltalk [warning]: error during initialize of ' , aClass name,': ', ex description printString) errorPrintCR.
- ex suspendedContext fullPrintAll.
- (Smalltalk commandLineArguments includes:'--debug') ifTrue:[
- ex reject
- ].
+ ClassesFailedToInitialize isNil ifTrue:[
+ ClassesFailedToInitialize := IdentitySet new.
+ ].
+ ClassesFailedToInitialize add:aClass.
+ ('Smalltalk [warning]: error during initialize of ' , aClass name,': ', ex description printString) errorPrintCR.
+ ex suspendedContext fullPrintAll.
+ '------------------------------------------------' errorPrintCR.
+ (Smalltalk commandLineArguments includes:'--debug') ifTrue:[
+ ex reject
+ ].
] do:[
- aClass initialize
- ].
-
- "Modified: / 23-10-2006 / 16:29:19 / cg"
+ aClass initialize
+ ].
+
+ "Modified: / 11-09-2011 / 17:01:32 / cg"
!
initializeModules
@@ -7674,11 +7675,11 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Id: Smalltalk.st 10686 2011-09-07 16:25:40Z vranyj1 $'
+ ^ '$Id: Smalltalk.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.975 2011/09/04 07:34:07 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.976 2011/09/11 15:01:45 cg Exp §'
!
version_SVN
@@ -7689,3 +7690,4 @@
+
--- a/Symbol.st Thu Sep 15 12:05:35 2011 +0100
+++ b/Symbol.st Tue Sep 20 11:11:19 2011 +0100
@@ -184,10 +184,34 @@
! !
+
+
+
!Symbol methodsFor:'Compatibility-Squeak'!
isUnary
^ self isUnarySelector
+!
+
+precedence
+ "the precedence in an expression; 0 is highest;
+ unary < binary < keyword"
+
+ self size = 0
+ ifTrue: [^ 0].
+ self first isLetter
+ ifFalse: [^ 2].
+ self last = $:
+ ifTrue: [^ 3].
+ ^ 1
+
+ "
+ self assert:(#foo precedence < #+ precedence).
+ self assert:(#+ precedence < #key: precedence).
+ self assert:(#foo precedence < #key: precedence).
+ "
+
+ "Created: / 12-09-2011 / 14:53:54 / cg"
! !
!Symbol methodsFor:'Compatibility-VW'!
@@ -735,9 +759,10 @@
!Symbol class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.95 2011/06/30 19:08:16 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.96 2011/09/13 09:46:44 cg Exp §'
!
version_SVN
^ '$ Id: Symbol.st 10648 2011-06-23 15:55:10Z vranyj1 $'
! !
+
--- a/Timestamp.st Thu Sep 15 12:05:35 2011 +0100
+++ b/Timestamp.st Tue Sep 20 11:11:19 2011 +0100
@@ -289,7 +289,6 @@
"Modified: / 13.7.1999 / 12:37:57 / stefan"
! !
-
!Timestamp class methodsFor:'Compatibility-Squeak'!
current
@@ -323,6 +322,14 @@
"Modified (comment): / 20-08-2011 / 16:52:10 / cg"
! !
+!Timestamp class methodsFor:'format strings'!
+
+defaultFormatString
+ ^ '%(year)-%(month)-%(day) %h:%m:%s.%i'
+
+ "Created: / 16-01-2011 / 11:23:36 / cg"
+! !
+
!Timestamp class methodsFor:'obsolete'!
day:d month:m year:y hour:h minutes:min seconds:s
@@ -989,6 +996,7 @@
"Modified: / 05-10-2010 / 16:05:32 / cg"
! !
+
!Timestamp methodsFor:'accessing'!
day
@@ -1904,6 +1912,8 @@
"
! !
+
+
!Timestamp methodsFor:'testing'!
isTimestamp
@@ -2692,13 +2702,14 @@
!Timestamp class methodsFor:'documentation'!
version
- ^ '$Id: Timestamp.st 10672 2011-08-20 20:29:33Z vranyj1 $'
+ ^ '$Id: Timestamp.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Timestamp.st,v 1.140 2011/08/20 16:45:03 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Timestamp.st,v 1.141 2011/09/15 08:42:09 ca Exp §'
! !
Timestamp initialize!
+
--- a/UserPreferences.st Thu Sep 15 12:05:35 2011 +0100
+++ b/UserPreferences.st Tue Sep 20 11:11:19 2011 +0100
@@ -1579,7 +1579,9 @@
waitCursorVisibleTime
"anser the time (in ms), how long a wait cursor should be visible at least"
- ^ 200
+ ^ 100
+
+ "Modified: / 12-09-2011 / 11:08:53 / cg"
!
workAroundRenderingBugOnVista
@@ -3680,7 +3682,7 @@
!UserPreferences class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.288 2011/09/07 09:18:28 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.289 2011/09/12 10:11:56 cg Exp §'
!
version_SVN
@@ -3690,3 +3692,4 @@
+
--- a/abbrev.stc Thu Sep 15 12:05:35 2011 +0100
+++ b/abbrev.stc Tue Sep 20 11:11:19 2011 +0100
@@ -382,4 +382,5 @@
AbortAllOperationWantedQuery AbortAllOperationWantedQuery stx:libbasic 'Kernel-Exceptions-Control' 1
Complex Complex stx:libbasic 'Magnitude-Numbers' 0
ConfigurableFeatures ConfigurableFeatures stx:libbasic 'System-Support' 0
+FileDoesNotExistException FileDoesNotExistException stx:libbasic 'Kernel-Exceptions-Errors' 1
--- a/bc.mak Thu Sep 15 12:05:35 2011 +0100
+++ b/bc.mak Tue Sep 20 11:11:19 2011 +0100
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libbasic/bc.mak,v 1.178 2011/09/07 08:59:41 cg Exp $
+# $Header: /cvs/stx/stx/libbasic/bc.mak,v 1.179 2011/09/09 05:16:07 cg Exp $
#
# DO NOT EDIT
# automagically generated from the projectDefinition: stx_libbasic.
@@ -321,6 +321,7 @@
$(OUTDIR)BadLiteralsError.$(O) BadLiteralsError.$(H): BadLiteralsError.st $(INCLUDE_TOP)\stx\libbasic\InvalidCodeError.$(H) $(INCLUDE_TOP)\stx\libbasic\ExecutionError.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)DecodingError.$(O) DecodingError.$(H): DecodingError.st $(INCLUDE_TOP)\stx\libbasic\CharacterEncoderError.$(H) $(INCLUDE_TOP)\stx\libbasic\ConversionError.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)EncodingError.$(O) EncodingError.$(H): EncodingError.st $(INCLUDE_TOP)\stx\libbasic\CharacterEncoderError.$(H) $(INCLUDE_TOP)\stx\libbasic\ConversionError.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)FileDoesNotExistException.$(O) FileDoesNotExistException.$(H): FileDoesNotExistException.st $(INCLUDE_TOP)\stx\libbasic\OpenError.$(H) $(INCLUDE_TOP)\stx\libbasic\StreamError.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)FileStream.$(O) FileStream.$(H): FileStream.st $(INCLUDE_TOP)\stx\libbasic\ExternalStream.$(H) $(INCLUDE_TOP)\stx\libbasic\ReadWriteStream.$(H) $(INCLUDE_TOP)\stx\libbasic\WriteStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)InvalidByteCodeError.$(O) InvalidByteCodeError.$(H): InvalidByteCodeError.st $(INCLUDE_TOP)\stx\libbasic\InvalidCodeError.$(H) $(INCLUDE_TOP)\stx\libbasic\ExecutionError.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)InvalidInstructionError.$(O) InvalidInstructionError.$(H): InvalidInstructionError.st $(INCLUDE_TOP)\stx\libbasic\InvalidCodeError.$(H) $(INCLUDE_TOP)\stx\libbasic\ExecutionError.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
@@ -351,7 +352,7 @@
$(OUTDIR)Win32FILEHandle.$(O) Win32FILEHandle.$(H): Win32FILEHandle.st $(INCLUDE_TOP)\stx\libbasic\OSFileHandle.$(H) $(INCLUDE_TOP)\stx\libbasic\OSHandle.$(H) $(INCLUDE_TOP)\stx\libbasic\ExternalAddress.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)Win32Handle.$(O) Win32Handle.$(H): Win32Handle.st $(INCLUDE_TOP)\stx\libbasic\OSHandle.$(H) $(INCLUDE_TOP)\stx\libbasic\ExternalAddress.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)Win32Process.$(O) Win32Process.$(H): Win32Process.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)Win32OperatingSystem.$(O) Win32OperatingSystem.$(H): Win32OperatingSystem.st $(INCLUDE_TOP)\stx\libbasic\AbstractOperatingSystem.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\Win32Handle.$(H) $(INCLUDE_TOP)\stx\libbasic\OSHandle.$(H) $(INCLUDE_TOP)\stx\libbasic\ExternalAddress.$(H) $(INCLUDE_TOP)\stx\libbasic\ByteArray.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(STCHDR)
+$(OUTDIR)Win32OperatingSystem.$(O) Win32OperatingSystem.$(H): Win32OperatingSystem.st $(INCLUDE_TOP)\stx\libbasic\AbstractOperatingSystem.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ByteArray.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Win32Handle.$(H) $(INCLUDE_TOP)\stx\libbasic\OSHandle.$(H) $(INCLUDE_TOP)\stx\libbasic\ExternalAddress.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
@@ -361,3 +362,4 @@
+
--- a/libInit.cc Thu Sep 15 12:05:35 2011 +0100
+++ b/libInit.cc Tue Sep 20 11:11:19 2011 +0100
@@ -1,5 +1,5 @@
/*
- * $Header: /cvs/stx/stx/libbasic/libInit.cc,v 1.171 2011/09/07 09:01:08 cg Exp $
+ * $Header: /cvs/stx/stx/libbasic/libInit.cc,v 1.172 2011/09/09 05:16:52 cg Exp $
*
* DO NOT EDIT
* automagically generated from the projectDefinition: stx_libbasic.
@@ -295,6 +295,7 @@
_BadLiteralsError_Init(pass,__pRT__,snd);
_DecodingError_Init(pass,__pRT__,snd);
_EncodingError_Init(pass,__pRT__,snd);
+_FileDoesNotExistException_Init(pass,__pRT__,snd);
_FileStream_Init(pass,__pRT__,snd);
_InvalidByteCodeError_Init(pass,__pRT__,snd);
_InvalidInstructionError_Init(pass,__pRT__,snd);
@@ -343,3 +344,4 @@
+
--- a/libbasic.rc Thu Sep 15 12:05:35 2011 +0100
+++ b/libbasic.rc Tue Sep 20 11:11:19 2011 +0100
@@ -3,7 +3,7 @@
// automagically generated from the projectDefinition: stx_libbasic.
//
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 6,2,1,91
+ FILEVERSION 6,2,1,92
PRODUCTVERSION 6,2,1,1
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
@@ -18,12 +18,12 @@
BEGIN
VALUE "CompanyName", "eXept Software AG\0"
VALUE "FileDescription", "Smalltalk/X Basic Classes (LIB)\0"
- VALUE "FileVersion", "6.2.1.91\0"
+ VALUE "FileVersion", "6.2.1.92\0"
VALUE "InternalName", "stx:libbasic\0"
VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2011\nCopyright eXept Software AG 1998-2011\0"
VALUE "ProductName", "Smalltalk/X\0"
VALUE "ProductVersion", "6.2.1.1\0"
- VALUE "ProductDate", "Wed, 07 Sep 2011 08:58:28 GMT\0"
+ VALUE "ProductDate", "Fri, 09 Sep 2011 05:15:26 GMT\0"
END
END
@@ -38,3 +38,4 @@
+
--- a/stx_libbasic.st Thu Sep 15 12:05:35 2011 +0100
+++ b/stx_libbasic.st Tue Sep 20 11:11:19 2011 +0100
@@ -501,6 +501,7 @@
AbortAllOperationWantedQuery
Complex
ConfigurableFeatures
+ FileDoesNotExistException
)
!
@@ -540,17 +541,17 @@
"Return a SVN revision number of myself.
This number is updated after a commit"
- ^ "$SVN-Revision:"'10684M'"$"
+ ^ "$SVN-Revision:"'10688M'"$"
! !
!stx_libbasic class methodsFor:'documentation'!
version
- ^ '$Id: stx_libbasic.st 10686 2011-09-07 16:25:40Z vranyj1 $'
+ ^ '$Id: stx_libbasic.st 10690 2011-09-20 10:11:19Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/stx_libbasic.st,v 1.92 2011/09/07 09:01:21 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/stx_libbasic.st,v 1.93 2011/09/09 05:16:59 cg Exp §'
!
version_SVN
@@ -558,3 +559,4 @@
! !
+