--- a/Annotation.st Fri Jul 20 14:32:04 2012 +0100
+++ b/Annotation.st Wed Jul 25 09:45:15 2012 +0100
@@ -39,17 +39,6 @@
privateIn:Annotation
!
-Annotation comment:'I represent an occurrence of a pragma in a compiled method. A pragma is a literal message pattern that occurs between angle brackets at the start of a method after any temporaries. A common example is the primitive pragma:
- <primitive: 123 errorCode: ''errorCode''>
-but one can add one''s own and use them as metadata attached to a method. Because pragmas are messages one can browsse senders and implementors and perform them. One can query a method for its pragmas by sendng it the pragmas message, which answers an Array of instances of me, one for each pragma in the method.
-I can provide information about the defining class, method, its selector, as well as the information about the pragma keyword and its arguments. See the two ''accessing'' protocols for details. ''accessing-method'' provides information about the method the pragma is found in, while ''accessing-pragma'' is about the pragma itself.
-Instances are retrieved using one of the pragma search methods of the ''finding'' protocol on the class side.
-To browse all methods with pragmas in the system evaluate
- SystemNavigation default browseAllSelect: [:m| m pragmas notEmpty]
-and to browse all nonprimitive methods with pragmas evaluate
- SystemNavigation default browseAllSelect: [:m| m primitive isZero and: [m pragmas notEmpty]]'
-!
-
!Annotation class methodsFor:'documentation'!
copyright
@@ -383,6 +372,12 @@
"Modified: / 21-08-2011 / 12:46:31 / cg"
!
+isResource
+ ^ false
+
+ "Created: / 18-07-2012 / 19:28:39 / cg"
+!
+
isUnknown
^ false
! !
@@ -500,6 +495,14 @@
"Modified: / 16-07-2010 / 11:28:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!Annotation::Resource methodsFor:'testing'!
+
+isResource
+ ^ true
+
+ "Created: / 18-07-2012 / 19:28:46 / cg"
+! !
+
!Annotation::Unknown methodsFor:'accessing'!
arguments
@@ -570,21 +573,15 @@
!Annotation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.7 2011/11/29 10:19:47 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.8 2012/07/18 17:33:44 cg Exp $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.7 2011/11/29 10:19:47 cg Exp '
+ ^ '§Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.8 2012/07/18 17:33:44 cg Exp §'
!
version_SVN
- ^ '$Id: Annotation.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: Annotation.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
Annotation initialize!
-
-
-
-
-
-
--- a/ApplicationDefinition.st Fri Jul 20 14:32:04 2012 +0100
+++ b/ApplicationDefinition.st Wed Jul 25 09:45:15 2012 +0100
@@ -107,6 +107,24 @@
"
!
+startupClass
+ "the class, but onlz of loaded"
+
+ |cls|
+
+ Error
+ handle:[:ex | ]
+ do:[
+ |clsName|
+
+ clsName := self startupClassName.
+ cls := Smalltalk classNamed:clsName.
+ ].
+ ^ cls
+
+ "Created: / 20-07-2012 / 16:37:36 / cg"
+!
+
stxSourcesProjects
"Returns only the required STX projects (which are included in the STX module)"
@@ -2859,13 +2877,13 @@
!ApplicationDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.192 2012/03/15 17:02:44 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.193 2012/07/20 15:42:43 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.192 2012/03/15 17:02:44 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.193 2012/07/20 15:42:43 cg Exp §'
!
version_SVN
- ^ '$Id: ApplicationDefinition.st 10802 2012-04-12 23:04:07Z vranyj1 $'
+ ^ '$Id: ApplicationDefinition.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
--- a/Behavior.st Fri Jul 20 14:32:04 2012 +0100
+++ b/Behavior.st Wed Jul 25 09:45:15 2012 +0100
@@ -4666,14 +4666,21 @@
!
whichSelectorsRead: instVarName
- "Answer a set of selectors whose methods read the argument, instVarName,
- as a named instance variable."
-
- | instVarIndex methodDict|
- instVarIndex := self allInstVarNames indexOf: instVarName ifAbsent: [^Set new].
- methodDict := self methodDictionary.
- ^methodDict keys select: [:sel | (methodDict at: sel)
- readsField: instVarIndex]
+ "Answer a set of selectors whose methods read the argument, instVarName,
+ as a named instance variable."
+
+"/ | instVarIndex methodDict|
+"/ instVarIndex := self allInstVarNames indexOf: instVarName ifAbsent: [^Set new].
+"/ methodDict := self methodDictionary.
+"/ ^methodDict keys select: [:sel | (methodDict at: sel)
+"/ readsField: instVarIndex]
+
+ | methodDict |
+ methodDict := self methodDictionary.
+ ^ methodDict keys
+ select: [:sel | (methodDict at: sel) readsInstVar: instVarName]
+
+ "Modified: / 23-07-2012 / 11:22:04 / cg"
!
whichSelectorsReferTo:someLiteralConstant
@@ -4729,14 +4736,20 @@
!
whichSelectorsWrite: instVarName
- "Answer a set of selectors whose methods write the argument, instVarName,
- as a named instance variable."
-
- | instVarIndex methodDict |
- instVarIndex := self allInstVarNames indexOf: instVarName ifAbsent: [^Set new].
- methodDict := self methodDictionary.
- ^methodDict keys select: [:sel | (methodDict at: sel)
- writesField: instVarIndex]
+ "Answer a set of selectors whose methods write the argument, instVarName,
+ as a named instance variable."
+
+"/ | instVarIndex methodDict |
+"/ instVarIndex := self allInstVarNames indexOf: instVarName ifAbsent: [^Set new].
+"/ methodDict := self methodDictionary.
+"/ ^methodDict keys select: [:sel | (methodDict at: sel)
+"/ writesField: instVarIndex]
+ | methodDict |
+ methodDict := self methodDictionary.
+ ^ methodDict keys
+ select: [:sel | (methodDict at: sel) writesInstVar: instVarName]
+
+ "Modified: / 23-07-2012 / 11:21:17 / cg"
! !
!Behavior methodsFor:'snapshots'!
@@ -4777,13 +4790,13 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.320 2012/06/01 21:37:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.321 2012/07/23 09:38:41 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.320 2012/06/01 21:37:36 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.321 2012/07/23 09:38:41 cg Exp §'
!
version_SVN
- ^ '$Id: Behavior.st 10814 2012-06-05 13:35:12Z vranyj1 $'
+ ^ '$Id: Behavior.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
--- a/BlockContext.st Fri Jul 20 14:32:04 2012 +0100
+++ b/BlockContext.st Wed Jul 25 09:45:15 2012 +0100
@@ -114,17 +114,13 @@
"Created: / 5.3.1998 / 16:20:31 / stefan"
!
-isBlockContext
- "return true, iff the receiver is a BlockContext, false otherwise"
-
- ^ true
-!
-
method
"return the method in which the current contexts block was created."
home notNil ifTrue:[^ home method].
- ^ nil
+ ^ super method
+
+ "Modified: / 19-07-2012 / 10:58:55 / cg"
!
methodHome
@@ -189,10 +185,11 @@
in the args or temporaries, that must be the one.
This helps in some cases.
"
+ m := self method.
m isNil ifTrue:[
^ '[] (optimized) in ???'.
].
- ^ '[] (optimized) in ' , m mclass name , ' >> ' , m selector.
+ ^ '[] in ' , m mclass name , ' >> ' , m selector.
].
mHome := self methodHome.
@@ -235,17 +232,38 @@
].
^ '[] in ' , className , ' >> ' , sel
- "Modified: 10.1.1997 / 21:26:21 / cg"
+ "Modified: / 19-07-2012 / 11:02:41 / cg"
+! !
+
+!BlockContext methodsFor:'testing'!
+
+isBlockContext
+ "return true, iff the receiver is a BlockContext, false otherwise"
+
+ ^ true
+!
+
+isCheapBlockContext
+ "return true, iff the receiver is a BlockContext, for a cheap block, false otherwise.
+ Cheap blocks do not refer to their home"
+
+ ^ home isNil
+
+ "Created: / 19-07-2012 / 11:22:23 / cg"
! !
!BlockContext class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.33 2008/11/05 14:22:16 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.35 2012/07/19 09:24:00 cg Exp $'
+!
+
+version_CVS
+ ^ '§Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.35 2012/07/19 09:24:00 cg Exp §'
!
version_SVN
- ^ '$Id: BlockContext.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: BlockContext.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
--- a/Class.st Fri Jul 20 14:32:04 2012 +0100
+++ b/Class.st Wed Jul 25 09:45:15 2012 +0100
@@ -303,12 +303,14 @@
|idx|
+ name isNil ifTrue:[^ nil].
+
idx := name lastIndexOf:$:.
[idx > 1 and:[ (name at:(idx-1)) ~~ $: ]] whileTrue:[
- idx := name lastIndexOf:$: startingAt:idx-2.
+ idx := name lastIndexOf:$: startingAt:idx-2.
].
idx == 0 ifTrue:[
- ^ name
+ ^ name
].
^ name copyFrom:idx+1.
@@ -317,6 +319,8 @@
Class nameWithoutPrefix:'Array'
Class nameWithoutPrefix:'Tools::Array'
"
+
+ "Modified: / 13-06-2012 / 14:41:21 / cg"
!
revisionInfoFromString:aString
@@ -4330,7 +4334,7 @@
or the fallBack (for backward compatibility)"
|owner cls meta allVersionMethodNames nameOfVersionMethodForManager nameOfOldVersionMethod
- tryVersionFromVersionMethod|
+ tryVersionFromVersionMethod prefixOfVersionMethodSelector|
(owner := self owningClass) notNil ifTrue:[^ owner findVersionMethodOfManager:aSourceCodemanagerOrNil].
@@ -4352,7 +4356,12 @@
meta := self theMetaclass.
cls := self theNonMetaclass.
- allVersionMethodNames := meta methodDictionary keys select:[:sel | sel startsWith:AbstractSourceCodeManager prefixOfVersionMethodSelector].
+ prefixOfVersionMethodSelector :=
+ AbstractSourceCodeManager notNil
+ ifTrue: [AbstractSourceCodeManager prefixOfVersionMethodSelector ]
+ ifFalse:[ 'version_' ]. "/ sigh - for standalone apps without libbasic3
+
+ allVersionMethodNames := meta methodDictionary keys select:[:sel | sel startsWith:prefixOfVersionMethodSelector].
aSourceCodemanagerOrNil notNil ifTrue:[
nameOfVersionMethodForManager := aSourceCodemanagerOrNil nameOfVersionMethodInClasses.
@@ -5545,11 +5554,11 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.605 2012/06/01 10:45:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.607 2012/07/22 09:10:54 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Class.st,v 1.605 2012/06/01 10:45:53 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Class.st,v 1.607 2012/07/22 09:10:54 cg Exp §'
!
version_SVN
--- a/ClassDescription.st Fri Jul 20 14:32:04 2012 +0100
+++ b/ClassDescription.st Wed Jul 25 09:45:15 2012 +0100
@@ -820,6 +820,7 @@
"Created: / 28.3.1998 / 21:21:52 / cg"
! !
+
!ClassDescription methodsFor:'Compatibility-V''Age'!
categoriesFor:aSelector are:listOfCategories
@@ -3283,14 +3284,14 @@
set := IdentitySet new.
self selectorsAndMethodsDo:[:sel :mthd |
- (mthd accessedInstVars includes:instVarName) ifTrue:[
+ (mthd accessesInstVar:instVarName) ifTrue:[
set add:sel
]
].
^ set.
"Created: / 19-06-1997 / 17:51:50 / cg"
- "Modified: / 20-11-2006 / 12:55:55 / cg"
+ "Modified: / 23-07-2012 / 11:17:57 / cg"
! !
!ClassDescription methodsFor:'special accessing'!
@@ -4192,15 +4193,15 @@
!ClassDescription class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.223 2012/04/05 10:12:26 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.224 2012/07/23 10:17:39 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.223 2012/04/05 10:12:26 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.224 2012/07/23 10:17:39 cg Exp §'
!
version_SVN
- ^ '$Id: ClassDescription.st 10804 2012-04-13 13:18:13Z vranyj1 $'
+ ^ '$Id: ClassDescription.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
ClassDescription::MethodRedefinitionNotification initialize!
--- a/Collection.st Fri Jul 20 14:32:04 2012 +0100
+++ b/Collection.st Wed Jul 25 09:45:15 2012 +0100
@@ -2447,6 +2447,44 @@
"Modified: 23.4.1996 / 13:47:06 / cg"
!
+keysAndValuesCollect:aBlock
+ "for each key-value pair in the receiver, evaluate the argument, aBlock
+ and return a collection with the results.
+
+ See also:
+ #associationsCollect: (which passes keys->value pairs)
+ #collect: (which only passes values)
+
+ This is much like #associationsCollect:, but aBlock gets the
+ key and value as two separate arguments.
+ #associationsCollect: is a bit slower.
+
+ WARNING: do not add/remove elements while iterating over the receiver.
+ Iterate over a copy to do this."
+
+ |newCollection|
+
+ newCollection := OrderedCollection new.
+ self keysAndValuesDo:[:key :value |
+ newCollection add:(aBlock value:key value:value)
+ ].
+ ^ newCollection
+
+ "
+ |ages|
+
+ ages := Dictionary new.
+ ages at:'cg' put:37.
+ ages at:'ca' put:33.
+ ages at:'sv' put:36.
+ ages at:'tk' put:28.
+ ages keysAndValuesCollect:[:name :age |
+ name , '''s age is ' , age printString]
+ "
+
+ "Modified: 20.4.1996 / 11:33:50 / cg"
+!
+
keysAndValuesDo:aTwoArgBlock
"evaluate the argument, aBlock for every element in the collection,
passing both index and element as arguments."
@@ -4327,15 +4365,15 @@
!Collection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.275 2012/04/01 11:22:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.276 2012/07/20 13:05:23 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Collection.st,v 1.275 2012/04/01 11:22:59 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Collection.st,v 1.276 2012/07/20 13:05:23 cg Exp §'
!
version_SVN
- ^ '$Id: Collection.st 10804 2012-04-13 13:18:13Z vranyj1 $'
+ ^ '$Id: Collection.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
Collection initialize!
--- a/ConfigurableFeatures.st Fri Jul 20 14:32:04 2012 +0100
+++ b/ConfigurableFeatures.st Wed Jul 25 09:45:15 2012 +0100
@@ -168,6 +168,27 @@
"Created: / 21-12-2011 / 17:07:08 / cg"
!
+hasGitSupport
+ "/ use Smalltalk-at to trick the dependency/prerequisite generator
+ ^ (Smalltalk at: #'GitSourceCodeManager' ifAbsent:nil) notNil
+
+ "
+ ConfigurableFeatures hasGitSupport
+ "
+
+ "Created: / 23-07-2012 / 13:37:09 / cg"
+!
+
+hasGitSupportEnabled
+ ^ self hasSCMSupportEnabledFor:#'GitSourceCodeManager'
+
+ "
+ self hasGitSupportEnabled
+ "
+
+ "Created: / 23-07-2012 / 13:37:17 / cg"
+!
+
hasMercurialSupport
"/ use Smalltalk-at to trick the dependency/prerequisite generator
^ (Smalltalk at: #'MercurialSourceCodeManager' ifAbsent:nil) notNil
@@ -257,13 +278,13 @@
!ConfigurableFeatures class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ConfigurableFeatures.st,v 1.8 2012/04/16 18:03:49 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ConfigurableFeatures.st,v 1.9 2012/07/23 11:37:32 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ConfigurableFeatures.st,v 1.8 2012/04/16 18:03:49 vrany Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ConfigurableFeatures.st,v 1.9 2012/07/23 11:37:32 cg Exp §'
!
version_SVN
- ^ '$Id: ConfigurableFeatures.st 10807 2012-05-05 21:58:24Z vranyj1 $'
+ ^ '$Id: ConfigurableFeatures.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
--- a/Context.st Fri Jul 20 14:32:04 2012 +0100
+++ b/Context.st Wed Jul 25 09:45:15 2012 +0100
@@ -511,15 +511,29 @@
It is now stored in the context"
|c sender sendersSelector m|
- "/.
- method notNil ifTrue:[
- method isMethod ifTrue:[
- true "method wrapper isNil" ifTrue:[
- ^ method
+
+ (method notNil and:[method isMethod]) ifTrue:[
+ ^ method
+ ].
+
+ "mhmh - maybe I am a context for an unbound method (as generated by doIt);
+ look in the sender's context. Consider this a kludge.
+ Future versions of ST/X's message lookup may store the method in
+ the context.
+ "
+ sender := self sender.
+ sender notNil ifTrue:[
+ sendersSelector := sender selector.
+ sendersSelector notNil ifTrue:[
+ (sendersSelector startsWith:'valueWithReceiver:') ifTrue:[
+ m := sender receiver.
+ m isMethod ifTrue:[
+ method := m.
+ ^ m
+ ]
]
]
].
- "/
c := self searchClass.
"
@@ -539,31 +553,10 @@
^ method
].
- "mhmh - seems to be a context for an unbound method (as generated by doIt);
- look in the senders context. Consider this a kludge.
- (maybe it was not too good of an idea to NOT keep the current
- method in the context ...)
- Future versions of ST/X's message lookup may store the method in
- the context.
- "
- sender := self sender.
- sender notNil ifTrue:[
- sendersSelector := sender selector.
- sendersSelector notNil ifTrue:[
- (sendersSelector startsWith:'valueWithReceiver:') ifTrue:[
- m := sender receiver.
- m isMethod ifTrue:[
- method := m.
- ^ m
- ]
- ]
- ]
- ].
-
^ nil
"Modified: / 28-06-2011 / 20:23:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 31-05-2012 / 11:54:34 / cg"
+ "Modified: / 20-07-2012 / 14:46:37 / cg"
!
methodClass
@@ -1687,9 +1680,12 @@
"/ self selector storeOn:aStream. "show as symbol"
aStream normal.
aStream space.
+ (method notNil and:[method isWrapped]) ifTrue:[
+ aStream nextPutAll:'W '
+ ].
aStream nextPutAll:' ['; nextPutAll:self lineNumber printString; nextPutAll:']' .
- "Modified: / 21-05-2007 / 13:29:21 / cg"
+ "Modified: / 20-07-2012 / 14:33:13 / cg"
!
receiverPrintString
@@ -1714,6 +1710,8 @@
"/ ].
receiverClassName := receiverClass name.
].
+ receiverClassName := receiverClassName ? '???'.
+
(receiverClass == SmallInteger
or:[receiverClass == Float]) ifTrue:[
newString := '(' , receiver printString , ') ' , receiverClassName
@@ -1734,12 +1732,12 @@
implementorClass notNil ifTrue: [
(implementorClass ~~ receiverClass) ifTrue: [
"/ newString := newString , '>>>', implementorClass name printString
- newString := newString,'(',implementorClass name printString,')'
+ newString := newString,'(',(implementorClass name ? '???') printString,')'
]
] ifFalse:[
self searchClass ~~ receiverClass ifTrue:[
"/ newString := newString , '>>>' , self searchClass name
- newString := newString,'(',self searchClass name,')'
+ newString := newString,'(',(self searchClass name ? '???'),')'
].
"
kludge for doIt - these unbound methods are not
@@ -1754,7 +1752,7 @@
^ newString
- "Modified: / 24-07-2011 / 08:53:41 / cg"
+ "Modified: / 13-06-2012 / 14:49:33 / cg"
!
saveReceiverClassName
@@ -2382,6 +2380,15 @@
^ false
!
+isCheapBlockContext
+ "return true, iff the receiver is a BlockContext, for a cheap block, false otherwise.
+ Cheap blocks do not refer to their home"
+
+ ^ false
+
+ "Created: / 19-07-2012 / 11:22:38 / cg"
+!
+
isContext
"return true, iff the receiver is a Context, false otherwise"
@@ -2434,11 +2441,11 @@
!Context class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Context.st,v 1.169 2012/05/31 16:32:02 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Context.st,v 1.172 2012/07/20 12:47:39 cg Exp §'
!
version_SVN
- ^ '$Id: Context.st 10814 2012-06-05 13:35:12Z vranyj1 $'
+ ^ '$Id: Context.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
Context initialize!
--- a/Dictionary.st Fri Jul 20 14:32:04 2012 +0100
+++ b/Dictionary.st Wed Jul 25 09:45:15 2012 +0100
@@ -1472,44 +1472,6 @@
"Modified: 20.4.1996 / 11:32:11 / cg"
!
-keysAndValuesCollect:aBlock
- "for each key-value pair in the receiver, evaluate the argument, aBlock
- and return a collection with the results.
-
- See also:
- #associationsCollect: (which passes keys->value pairs)
- #collect: (which only passes values)
-
- This is much like #associationsCollect:, but aBlock gets the
- key and value as two separate arguments.
- #associationsCollect: is a bit slower.
-
- WARNING: do not add/remove elements while iterating over the receiver.
- Iterate over a copy to do this."
-
- |newCollection|
-
- newCollection := OrderedCollection new.
- self keysAndValuesDo:[:key :value |
- newCollection add:(aBlock value:key value:value)
- ].
- ^ newCollection
-
- "
- |ages|
-
- ages := Dictionary new.
- ages at:'cg' put:37.
- ages at:'ca' put:33.
- ages at:'sv' put:36.
- ages at:'tk' put:28.
- ages keysAndValuesCollect:[:name :age |
- name , '''s age is ' , age printString]
- "
-
- "Modified: 20.4.1996 / 11:33:50 / cg"
-!
-
keysAndValuesDo:aTwoArgBlock
"evaluate the argument, aBlock for every element in the collection,
passing both key and element as arguments.
@@ -2100,15 +2062,15 @@
!Dictionary class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.104 2011/09/23 12:07:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.105 2012/07/20 12:54:17 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.104 2011/09/23 12:07:54 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.105 2012/07/20 12:54:17 cg Exp §'
!
version_SVN
- ^ '$Id: Dictionary.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: Dictionary.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
Dictionary initialize!
--- a/Filename.st Fri Jul 20 14:32:04 2012 +0100
+++ b/Filename.st Wed Jul 25 09:45:15 2012 +0100
@@ -955,6 +955,74 @@
"Modified: / 18.7.1998 / 22:53:24 / cg"
!
+nameWithSpecialExpansions:aString
+ "return the nameString, expanding any OS specific macros.
+ Here, a ~/ or ~user/ prefix is expanded to the users home dir (as in csh)"
+
+ |dir user cutIdx idx userInfo|
+
+ (aString startsWith:'~') ifFalse:[
+ ^ aString.
+ ].
+
+ aString size > 1 ifTrue:[
+ idx := aString indexOf:self separator.
+ idx == 0 ifTrue:[
+ "aString is '~user'"
+ user := aString copyFrom:2.
+ cutIdx := aString size + 1.
+ ] ifFalse:[
+ "aString is '~user/something'"
+ user := aString copyFrom:2 to:(idx - 1).
+ cutIdx := idx.
+ ].
+ user notEmpty ifTrue:[
+ userInfo := OperatingSystem userInfoOf:user.
+ userInfo notNil ifTrue:[
+ dir := userInfo at:#dir ifAbsent:nil.
+ ].
+ dir isNil ifTrue:[
+"/ ('Filename [info]: unknown user: ' , user) infoPrintCR.
+ ^ aString
+ ].
+ ].
+ ].
+ dir isNil ifTrue:[
+ "aString is '~' or '~/'"
+ dir := OperatingSystem getHomeDirectory.
+ cutIdx := 2.
+ ].
+
+ ^ dir , (aString copyFrom:cutIdx)
+
+ "
+ Filename new nameWithSpecialExpansions:'~'
+ Filename new nameWithSpecialExpansions:'~\work'
+ Filename new nameWithSpecialExpansions:'~stefan'
+ Filename new nameWithSpecialExpansions:'~stefan\work'
+ Filename new nameWithSpecialExpansions:'~foo'
+ Filename new nameWithSpecialExpansions:'~foo\bar'
+ "
+
+ "
+ UnixFilename new nameWithSpecialExpansions:'~'
+ UnixFilename new nameWithSpecialExpansions:'~/work'
+ UnixFilename new nameWithSpecialExpansions:'~stefan'
+ UnixFilename new nameWithSpecialExpansions:'~stefan/work'
+ UnixFilename new nameWithSpecialExpansions:'~foo'
+ UnixFilename new nameWithSpecialExpansions:'~foo/bar'
+ "
+
+ "
+ PCFilename new nameWithSpecialExpansions:'~'
+ PCFilename new nameWithSpecialExpansions:'~\work'
+ PCFilename new nameWithSpecialExpansions:'~stefan'
+ PCFilename new nameWithSpecialExpansions:'~stefan\work'
+ PCFilename new nameWithSpecialExpansions:'~foo'
+ PCFilename new nameWithSpecialExpansions:'~foo\bar'
+ "
+!
+
suggest:aFilenameString
"return a fileNamestring based on the argument,
which is legal on the current platform."
@@ -3849,6 +3917,23 @@
"
! !
+!Filename methodsFor:'os shell'!
+
+openExplorer
+ "open a file-explorer on the directory represented by the receiver.
+ On non-windows systems, an error is raised"
+
+ OperatingSystem isMSWINDOWSlike ifFalse:[
+ self warn:'sorry - this operation is only available under windows'.
+ ].
+
+ OperatingSystem
+ openApplicationForDocument:self pathName
+ operation:#explore.
+
+ "Created: / 21-07-2012 / 12:28:18 / cg"
+! !
+
!Filename methodsFor:'printing & storing'!
printOn:aStream
@@ -3883,7 +3968,7 @@
setName:aString
"set the filename"
- nameString := self nameWithSpecialExpansions:aString.
+ nameString := aString.
"Modified: / 21.7.1998 / 10:44:18 / cg"
! !
@@ -4072,70 +4157,6 @@
"
!
-nameWithSpecialExpansions:aString
- "return the nameString, expanding any OS specific macros.
- Here, a ~\ prefix is expanded to the users home dir (as in csh)"
-
- |dir user cutIdx idx userInfo|
-
- (aString startsWith:'~') ifTrue:[
- dir := OperatingSystem getHomeDirectory.
- cutIdx := 2.
-
- (aString size > 1) ifTrue:[
- idx := aString indexOf:(self separator).
- idx == 0 ifTrue:[
- user := aString copyFrom:2.
- cutIdx := aString size + 1.
- ] ifFalse:[
- user := aString copyFrom:2 to:(idx - 1).
- cutIdx := idx.
- ].
- user size > 0 ifTrue:[
- userInfo := OperatingSystem userInfoOf:user.
- (userInfo notNil and:[userInfo includesKey:#dir]) ifTrue:[
- dir := userInfo at:#dir
- ] ifFalse:[
- dir := nil
- ]
- ].
- dir isNil ifTrue:[
-"/ ('Filename [info]: unknown user: ' , user) infoPrintCR.
- ^ aString
- ].
- ].
- ^ dir , (aString copyFrom:cutIdx)
- ].
- ^ aString
-
- "
- Filename new nameWithSpecialExpansions:'~'
- Filename new nameWithSpecialExpansions:'~\work'
- Filename new nameWithSpecialExpansions:'~sv'
- Filename new nameWithSpecialExpansions:'~sv\work'
- Filename new nameWithSpecialExpansions:'~foo'
- Filename new nameWithSpecialExpansions:'~foo\bar'
- "
-
- "
- UnixFilename new nameWithSpecialExpansions:'~'
- UnixFilename new nameWithSpecialExpansions:'~/work'
- UnixFilename new nameWithSpecialExpansions:'~sv'
- UnixFilename new nameWithSpecialExpansions:'~sv/work'
- UnixFilename new nameWithSpecialExpansions:'~foo'
- UnixFilename new nameWithSpecialExpansions:'~foo/bar'
- "
-
- "
- PCFilename new nameWithSpecialExpansions:'~'
- PCFilename new nameWithSpecialExpansions:'~\work'
- PCFilename new nameWithSpecialExpansions:'~sv'
- PCFilename new nameWithSpecialExpansions:'~sv\work'
- PCFilename new nameWithSpecialExpansions:'~foo'
- PCFilename new nameWithSpecialExpansions:'~foo\bar'
- "
-!
-
separator
"return the directory-separator character"
@@ -4154,7 +4175,7 @@
|newName|
- newName := self nameWithSpecialExpansions:nameString.
+ newName := self class nameWithSpecialExpansions:nameString.
newName ~= nameString ifTrue:[
^ newName asFilename.
].
@@ -4536,7 +4557,7 @@
caseless := self class isCaseSensitive not.
matching := OrderedCollection new.
- nm := self nameWithSpecialExpansions:nameString.
+ nm := self class nameWithSpecialExpansions:nameString.
nm := self class canonicalize:nm.
sepString := self class separatorString.
@@ -4714,11 +4735,12 @@
"return true, if the receiver represents an absolute pathname
(in contrast to one relative to the current directory)."
- (nameString startsWith:self class separator) ifTrue:[^ true].
+ ((nameString startsWith:self class separator) or:[nameString startsWith:'~']) ifTrue:[^ true].
^ self isVolumeAbsolute
"
- '/foo/bar' asFilename isAbsolute
+ '/foo/bar' asFilename isAbsolute
+ '~/bla' asFilename isAbsolute
'..' asFilename isAbsolute
'..' asAbsoluteFilename isAbsolute
'source/SBrowser.st' asFilename isAbsolute
@@ -4880,7 +4902,6 @@
no compression will be done (for now; this may change).
See also: name"
- |p|
"/ sep := self class separator.
"/ (nameString startsWith:sep) ifTrue:[
@@ -4889,8 +4910,7 @@
"/ ^ nameString
"/ ]
"/ ].
- p := OperatingSystem pathNameOf:nameString.
- ^ p
+ ^ OperatingSystem pathNameOf:(self class nameWithSpecialExpansions:nameString).
"
'/foo/bar' asFilename pathName
@@ -4899,6 +4919,7 @@
'../..' asFilename name
'/tmp/../usr' asFilename pathName
'/././usr' asFilename pathName
+ '~/..' asFilename pathName
"
"Modified: 27.4.1996 / 18:19:52 / cg"
@@ -5200,37 +5221,6 @@
"
!
-directoryContentsMatching: patternOrCollectionOfThose
- "Same as directoryContants, but returns only files
- that match the given pattern(s).
- This uses String>>matches: for glob pattern matching"
-
- | names patterns |
-
- patterns := patternOrCollectionOfThose isString
- ifTrue: [Array with: patternOrCollectionOfThose]
- ifFalse:[patternOrCollectionOfThose].
- names := self directoryContents.
- names isNil ifTrue:[^ nil].
- ^ names
- select: [:e | patterns anySatisfy:[:pattern|e matches: pattern]]
-
- "
- '/etc' asFilename
- directoryContentsMatching: 'pass*'
-
- '/etc' asFilename
- directoryContentsMatching: #('pass*' 'nsswitch.conf')
-
- '/etc' asFilename
- directoryContentsMatching: #('does-not-exists.txt')
-
- "
-
- "Created: / 03-06-2009 / 09:52:52 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified (format): / 18-11-2011 / 14:45:32 / cg"
-!
-
fullDirectoryContents
"return the full contents of the directory as a collection of strings.
This is much like #directoryContents, but includes an entry for the
@@ -5514,7 +5504,7 @@
"internal - return the OS's name for the receiver to
access it as a directory."
- ^ nameString
+ ^ self osNameForFile
"Modified: / 12.8.1998 / 14:44:32 / cg"
!
@@ -5533,7 +5523,11 @@
"internal - return the OS's name for the receiver to
access it as a file."
- ^ nameString
+ (nameString startsWith:'~') ifFalse:[
+ ^ nameString.
+ ].
+
+ ^ self class nameWithSpecialExpansions:nameString.
! !
!Filename methodsFor:'suffixes'!
@@ -5880,15 +5874,15 @@
!Filename class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.374 2012/04/01 11:25:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.377 2012/07/21 10:35:55 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Filename.st,v 1.374 2012/04/01 11:25:33 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Filename.st,v 1.377 2012/07/21 10:35:55 cg Exp §'
!
version_SVN
- ^ '$Id: Filename.st 10804 2012-04-13 13:18:13Z vranyj1 $'
+ ^ '$Id: Filename.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
Filename initialize!
--- a/GenericException.st Fri Jul 20 14:32:04 2012 +0100
+++ b/GenericException.st Wed Jul 25 09:45:15 2012 +0100
@@ -604,6 +604,19 @@
"Created: / 23.7.1999 / 14:07:59 / stefan"
!
+raiseIn:aContext
+ "raise a signal nonproceedable.
+ The signals notifierString is used as messageText."
+
+ <context: #return>
+ <resource: #skipInDebuggersWalkBack>
+
+ ^ self basicNew
+ raiseIn:aContext
+
+ "Created: / 27-01-2011 / 17:28:53 / cg"
+!
+
raiseRequest
"raise a signal proceedable.
The signals notifierString is used as messageText."
@@ -2302,15 +2315,15 @@
!GenericException class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.132 2012/04/03 18:34:13 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.133 2012/07/23 11:04:16 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.132 2012/04/03 18:34:13 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.133 2012/07/23 11:04:16 stefan Exp §'
!
version_SVN
- ^ '$Id: GenericException.st 10804 2012-04-13 13:18:13Z vranyj1 $'
+ ^ '$Id: GenericException.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
GenericException initialize!
--- a/ImmutableByteArray.st Fri Jul 20 14:32:04 2012 +0100
+++ b/ImmutableByteArray.st Wed Jul 25 09:45:15 2012 +0100
@@ -56,20 +56,20 @@
'ArraysAreImmutable' to true or use the new launchers settings menu.
ATTENTION:
- there may be still code around which checks for explicit class being ByteArray
- (both in Smalltalk and in primitive code). All code like foo 'class == ByteArray'
- or '__isByteArray' will not work with ImmutableByteArrays.
- A somewhat better approach would be to either add a flag to the object (mutability)
- and check this dynamically (expensive) or to place immutable objects into a readonly
- memory segment (the good solution). We will eventually implement the second in the future...
+ there may be still code around which checks for explicit class being ByteArray
+ (both in Smalltalk and in primitive code). All code like foo 'class == ByteArray'
+ or '__isByteArray()' will not work with ImmutableByteArrays - consider using '__isByteArrayLike()'.
+ A somewhat better approach would be to either add a flag to the object (mutability)
+ and check this dynamically (expensive) or to place immutable objects into a readonly
+ memory segment (the good solution). We will eventually implement the second in the future...
[see also:]
- ImmutableString
- ImmutableArray
- Parser Scanner
+ ImmutableString
+ ImmutableArray
+ Parser Scanner
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -189,9 +189,9 @@
!ImmutableByteArray class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ImmutableByteArray.st,v 1.9 2012/04/21 16:01:08 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ImmutableByteArray.st,v 1.10 2012/07/19 17:34:51 stefan Exp §'
!
version_SVN
- ^ '$Id: ImmutableByteArray.st 10807 2012-05-05 21:58:24Z vranyj1 $'
+ ^ '$Id: ImmutableByteArray.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
--- a/ImmutableString.st Fri Jul 20 14:32:04 2012 +0100
+++ b/ImmutableString.st Wed Jul 25 09:45:15 2012 +0100
@@ -58,19 +58,19 @@
ATTENTION:
- there may be still code around which checks for explicit class being String
- (both in Smalltalk and in primitive code). All code like foo 'class == String'
- or '__isString' will not work with ImmutableStrings.
- A somewhat better approach would be to either add a flag to the object (mutability)
- and check this dynamically (expensive) or to place immutable objects into a readonly
- memory segment (the good solution). We will eventually implement the second in the future...
+ there may be still code around which checks for explicit class being String
+ (both in Smalltalk and in primitive code). All code like foo 'class == String'
+ or '__isString()' will not work with ImmutableStrings. Use '__isStringLike()' instead.
+ A somewhat better approach would be to either add a flag to the object (mutability)
+ and check this dynamically (expensive) or to place immutable objects into a readonly
+ memory segment (the good solution). We will eventually implement the second in the future...
[see also:]
- ImmutableArray
- Parser Scanner
+ ImmutableArray
+ Parser Scanner
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -180,13 +180,13 @@
!ImmutableString class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ImmutableString.st,v 1.11 2012/04/21 16:01:10 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ImmutableString.st,v 1.12 2012/07/19 17:34:43 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ImmutableString.st,v 1.11 2012/04/21 16:01:10 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ImmutableString.st,v 1.12 2012/07/19 17:34:43 stefan Exp §'
!
version_SVN
- ^ '$Id: ImmutableString.st 10807 2012-05-05 21:58:24Z vranyj1 $'
+ ^ '$Id: ImmutableString.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
--- a/Method.st Fri Jul 20 14:32:04 2012 +0100
+++ b/Method.st Wed Jul 25 09:45:15 2012 +0100
@@ -193,19 +193,14 @@
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 := WeakArray new:1.
LastFileReference at:1 put:nil.
].
CompilationLock := RecursionLock new name:'MethodCompilation'.
- "Modified: 22.4.1996 / 16:34:38 / cg"
- "Modified: 3.1.1997 / 16:58:16 / stefan"
+ "Modified: / 03-01-1997 / 16:58:16 / stefan"
+ "Modified (comment): / 20-07-2012 / 18:41:11 / cg"
!
lastMethodSourcesLock
@@ -229,6 +224,7 @@
lowSpaceCleanup
LastParseTreeCache := nil.
LastSourceFileName := LastWhoClass := nil.
+ self flushSourceStreamCache.
"Created: / 08-08-2011 / 19:11:23 / cg"
! !
@@ -2357,6 +2353,31 @@
"Modified: 19.6.1997 / 17:54:09 / cg"
!
+accessesField:instVarIndex
+ "return true, if the instvar at instVarIndex is accessed by the receiver.
+ Uses parser (for now); could look at bytecode as well here..."
+
+ |instVarName|
+
+ instVarName := (self mclass allInstVarNames) at:instVarIndex.
+ ^ self accessesInstVar:instVarName
+
+ "Created: / 23-07-2012 / 11:13:54 / cg"
+!
+
+accessesInstVar:instVarName
+ "return true, if the named instvar is accessed by the receiver.
+ Uses parser (for now); could look at bytecode as well here..."
+
+ |usedInstVars|
+
+ (self source includesString:instVarName) ifFalse:[^ false]. "/ that's much faster than parsing...
+ usedInstVars := self parse:#'parseMethodSilent:in:' with:self mclass return:#usedInstVars or:#().
+ ^ usedInstVars includes:instVarName.
+
+ "Created: / 23-07-2012 / 11:15:02 / cg"
+!
+
containingClass
"return the class I am defined in.
See comment in who."
@@ -3118,11 +3139,25 @@
"return true, if the instvar at instVarIndex is read by the receiver.
Uses parser (for now); could look at bytecode as well here..."
- |varName readInstVars|
-
- varName := (self mclass allInstVarNames) at:instVarIndex.
+ |instVarName|
+
+ instVarName := (self mclass allInstVarNames) at:instVarIndex.
+ ^ self readsInstVar:instVarName
+
+ "Modified: / 23-07-2012 / 11:16:08 / cg"
+!
+
+readsInstVar:instVarName
+ "return true, if the named instvar is read by the receiver.
+ Uses parser (for now); could look at bytecode as well here..."
+
+ |readInstVars|
+
+ (self source includesString:instVarName) ifFalse:[^ false]. "/ that's much faster than parsing...
readInstVars := self parse:#'parseMethodSilent:in:' with:self mclass return:#readInstVars or:#().
- ^ readInstVars includes:varName.
+ ^ readInstVars includes:instVarName.
+
+ "Created: / 23-07-2012 / 11:15:56 / cg"
!
resourceType
@@ -3425,11 +3460,25 @@
"return true, if the instvar at instVarIndex is written (modified) by the receiver.
Uses parser (for now); could look at bytecode as well here..."
- |varName modifiedInstVars|
-
- varName := (self mclass allInstVarNames) at:instVarIndex.
+ |instVarName|
+
+ instVarName := (self mclass allInstVarNames) at:instVarIndex.
+ ^ self writesInstVar:instVarName
+
+ "Modified: / 23-07-2012 / 11:16:51 / cg"
+!
+
+writesInstVar:instVarName
+ "return true, if the named instvar is written (modified) by the receiver.
+ Uses parser (for now); could look at bytecode as well here..."
+
+ |modifiedInstVars|
+
+ (self source includesString:instVarName) ifFalse:[^ false]. "/ that's much faster than parsing...
modifiedInstVars := self parse:#'parseMethodSilent:in:' with:self mclass return:#modifiedInstVars or:#().
- ^ modifiedInstVars includes:varName.
+ ^ modifiedInstVars includes:instVarName.
+
+ "Created: / 23-07-2012 / 11:16:36 / cg"
! !
!Method methodsFor:'trap methods'!
@@ -3668,11 +3717,11 @@
!Method class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.385 2012/06/13 13:11:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.388 2012/07/23 09:17:47 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Method.st,v 1.385 2012/06/13 13:11:30 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Method.st,v 1.388 2012/07/23 09:17:47 cg Exp §'
!
version_SVN
--- a/ObjectMemory.st Fri Jul 20 14:32:04 2012 +0100
+++ b/ObjectMemory.st Wed Jul 25 09:45:15 2012 +0100
@@ -5100,57 +5100,6 @@
"Modified: 22.4.1997 / 23:42:59 / cg"
!
-fullBinaryModuleInfo
- "return a full collection of moduleInfo entries.
- This returns a dictionary (keys are component names)
- with one entry for each sub-component in all binary packages."
-
- |modules|
-
- modules := IdentityDictionary new.
- self allBinaryModulesDo:[:entry |
- |infoEntry
- id name type libName subModuleName module dynamic pathName t|
-
- id := entry at:1.
- subModuleName := (entry at:2) asSymbol.
- libName := (entry at:4).
- t := Timestamp fromOSTime:((entry at:5) * 1000).
-
- id > 0 ifTrue:[
- dynamic := true.
- ] ifFalse:[
- dynamic := false.
- ].
- libName isNil ifTrue:[
- type := #classObject
- ] ifFalse:[
- type := #classLibrary
- ].
-
- "/ ... new:
- infoEntry := BinaryModuleDescriptor
- name:nil
- type:type
- id:id
- dynamic:dynamic
- classNames:(Array with:subModuleName)
- pathName:nil
- libraryName:libName
- timeStamp:t.
-
- modules at:subModuleName put:infoEntry.
- ].
- ^ modules
-
- "
- ObjectMemory fullBinaryModuleInfo
- "
-
- "Modified: 30.8.1995 / 17:29:30 / claus"
- "Modified: 31.10.1996 / 13:58:44 / cg"
-!
-
getVMIdentificationStrings
"return a collection of release strings giving information
about the running VM. This is for configuration management only.
@@ -5589,11 +5538,11 @@
!ObjectMemory class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.260 2012/03/26 17:02:56 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.261 2012/07/24 13:26:44 stefan Exp §'
!
version_SVN
- ^ '$Id: ObjectMemory.st 10804 2012-04-13 13:18:13Z vranyj1 $'
+ ^ '$Id: ObjectMemory.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
ObjectMemory initialize!
--- a/PCFilename.st Fri Jul 20 14:32:04 2012 +0100
+++ b/PCFilename.st Wed Jul 25 09:45:15 2012 +0100
@@ -813,7 +813,7 @@
(nameString startsWith:'..\') ifTrue:[
^ self pathName
].
- ^ nameString
+ ^ self osNameForFile
!
osNameForDirectory
@@ -822,13 +822,11 @@
Care remove trailing backSlashes here and to use the shortName
if available"
- |n i shortName|
+ |n|
- (nameString includes:$~) ifTrue:[
- self makeNonDOSName
- ].
+ n := self osNameForFile.
- ((n := nameString) endsWith:'\') ifTrue:[
+ (n endsWith:'\') ifTrue:[
((n size == 3) and:[(n at:2) == $:]) ifFalse:[
n := n copyWithoutLast:1
]
@@ -848,10 +846,13 @@
access it as a directory for reading the contents.
Care to remove trailing backSlashes here"
- (nameString endsWith:'\') ifTrue:[
- ^ nameString copyWithoutLast:1
+ |name|
+
+ name := self osNameForFile.
+ (name endsWith:'\') ifTrue:[
+ ^ name copyWithoutLast:1
].
- ^ nameString
+ ^ name
"Modified: / 20.1.1998 / 15:39:06 / md"
"Created: / 3.8.1998 / 21:37:46 / cg"
@@ -859,20 +860,23 @@
!
osNameForFile
- "special - return the OS's name for the receiver to
- access it as a directory.
- Care remove trailing backSlashes here and to use the shortName
- if available"
+ "internal - return the OS's name for the receiver to
+ access it as a file."
(nameString includes:$~) ifTrue:[
- self makeNonDOSName
+ (nameString startsWith:'~') ifTrue:[
+ ^ self class nameWithSpecialExpansions:nameString.
+ ].
+ "/ self makeNonDOSName.
].
^ nameString
+
+ "Modified: / 21-07-2012 / 19:35:19 / cg"
!
setName:aString
- "set the filename"
+ "set the filename, convert unix directory separators to native separators"
nameString := aString copy replaceAll:$/ with:$\
@@ -882,18 +886,13 @@
!PCFilename class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/PCFilename.st,v 1.55 2011/11/08 14:59:44 mb Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/PCFilename.st,v 1.57 2012/07/22 08:06:13 cg Exp $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/PCFilename.st,v 1.55 2011/11/08 14:59:44 mb Exp '
+ ^ '§Header: /cvs/stx/stx/libbasic/PCFilename.st,v 1.57 2012/07/22 08:06:13 cg Exp §'
!
version_SVN
- ^ '$Id: PCFilename.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: PCFilename.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
-
-
-
-
-
--- a/ProcessorScheduler.st Fri Jul 20 14:32:04 2012 +0100
+++ b/ProcessorScheduler.st Wed Jul 25 09:45:15 2012 +0100
@@ -803,7 +803,10 @@
"avoid confusion if entered twice"
- dispatching == true ifTrue:[^ self].
+ dispatching == true ifTrue:[
+ 'Processor [info]: already in dispatch' infoPrintCR.
+ ^ self
+ ].
dispatching := true.
"/ create the relevant blocks & signalSet outside of the
@@ -838,7 +841,7 @@
'Processor [info]: finish dispatch (no more processes)' infoPrintCR.
"Modified: / 23-09-1996 / 14:19:56 / stefan"
- "Modified: / 05-08-2011 / 09:54:36 / cg"
+ "Modified: / 20-07-2012 / 18:34:48 / cg"
!
exitWhenNoMoreUserProcesses:aBoolean
@@ -3382,19 +3385,15 @@
!ProcessorScheduler class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.260 2011/11/03 20:32:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.261 2012/07/20 16:36:22 cg Exp $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.260 2011/11/03 20:32:58 cg Exp '
+ ^ '§Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.261 2012/07/20 16:36:22 cg Exp §'
!
version_SVN
- ^ '$Id: ProcessorScheduler.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: ProcessorScheduler.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
ProcessorScheduler initialize!
-
-
-
-
--- a/ProjectDefinition.st Fri Jul 20 14:32:04 2012 +0100
+++ b/ProjectDefinition.st Wed Jul 25 09:45:15 2012 +0100
@@ -318,34 +318,38 @@
"/ 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 |
+ Verbose == true ifTrue:[
+ 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 |
+ Verbose == true ifTrue:[
+ Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' hasSub ', eachSubSubRequisite).
+ ].
+ aBlock value:def value:eachSubSubRequisite.
+ toAdd add:eachSubSubRequisite
+ ].
+ ].
+ ]
].
^ setOfAllPreRequisites.
@@ -361,7 +365,7 @@
"
"Created: / 13-04-2011 / 15:23:21 / sr"
- "Modified (comment): / 06-09-2011 / 08:25:53 / cg"
+ "Modified: / 20-07-2012 / 18:29:31 / cg"
!
directory
@@ -614,6 +618,8 @@
"Modified: / 14-09-2006 / 14:49:17 / cg"
!
+
+
packageName
"the last component"
@@ -2388,7 +2394,6 @@
"Created: / 18-08-2006 / 12:51:38 / cg"
! !
-
!ProjectDefinition class methodsFor:'description - project information'!
applicationAdditionalIconFileNames
@@ -6830,15 +6835,15 @@
!ProjectDefinition class methodsFor:'documentation'!
version
- ^ '$Id: ProjectDefinition.st 10802 2012-04-12 23:04:07Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.385 2012/07/21 16:56:36 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.384 2012/03/15 17:02:26 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.385 2012/07/21 16:56:36 cg Exp §'
!
version_SVN
- ^ '$Id: ProjectDefinition.st 10802 2012-04-12 23:04:07Z vranyj1 $'
+ ^ '$ Id: ProjectDefinition.st 10645 2011-06-09 15:28:45Z vranyj1 $'
! !
ProjectDefinition initialize!
--- a/SequenceableCollection.st Fri Jul 20 14:32:04 2012 +0100
+++ b/SequenceableCollection.st Wed Jul 25 09:45:15 2012 +0100
@@ -4435,7 +4435,7 @@
species growIsCheap ifTrue:[
newColl := self copyEmpty:n.
needCopy := false
- ] ifTrue:[
+ ] ifFalse:[
newColl := OrderedCollection new:n.
needCopy := true
].
@@ -8699,15 +8699,15 @@
!SequenceableCollection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.322 2012/05/25 12:10:28 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.323 2012/07/23 09:19:11 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.322 2012/05/25 12:10:28 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.323 2012/07/23 09:19:11 stefan Exp §'
!
version_SVN
- ^ '$Id: SequenceableCollection.st 10814 2012-06-05 13:35:12Z vranyj1 $'
+ ^ '$Id: SequenceableCollection.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
SequenceableCollection initialize!
--- a/Smalltalk.st Fri Jul 20 14:32:04 2012 +0100
+++ b/Smalltalk.st Wed Jul 25 09:45:15 2012 +0100
@@ -7692,16 +7692,16 @@
to the outside world.
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
-
- ^ 1
+ <major>.<minor>.<revision>.<release>"
+
+ ^ 2
"
Smalltalk revisionNr
Smalltalk hello string
"
- "Modified: / 12-08-2010 / 01:20:56 / cg"
+ "Modified: / 18-07-2012 / 19:09:42 / cg"
!
timeStamp
@@ -7786,13 +7786,13 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.990 2012/02/22 13:28:10 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.991 2012/07/18 17:09:50 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.990 2012/02/22 13:28:10 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.991 2012/07/18 17:09:50 cg Exp §'
!
version_SVN
- ^ '$Id: Smalltalk.st 10796 2012-03-29 14:24:59Z vranyj1 $'
+ ^ '$Id: Smalltalk.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
--- a/String.st Fri Jul 20 14:32:04 2012 +0100
+++ b/String.st Wed Jul 25 09:45:15 2012 +0100
@@ -3720,84 +3720,82 @@
unsigned char c;
REGISTER OBJ slf = self;
- if (((__qClass(slf)==String) || (__qClass(slf)==Symbol))
- && __isNonNilObject(aStringOrChar)
- && ((__qClass(aStringOrChar)==String) || (__qClass(aStringOrChar)==Symbol))) {
- src1 = __stringVal(slf);
- src2 = __stringVal(aStringOrChar);
-
- if (src1[0] != src2[0]) {
- if (__qSize(aStringOrChar) == (OHDR_SIZE+1) /* 1 for the 0-byte */) {
- RETURN (true);
- }
- RETURN ( false );
- }
-
- len1 = __qSize(slf);
- len2 = __qSize(aStringOrChar);
- if (len1 < len2) {
- RETURN ( false );
- }
+ if (__qIsStringLike(slf) &&__isStringLike(aStringOrChar)) {
+ src1 = __stringVal(slf);
+ src2 = __stringVal(aStringOrChar);
+
+ if (src1[0] != src2[0]) {
+ if (__qSize(aStringOrChar) == (OHDR_SIZE+1) /* 1 for the 0-byte */) {
+ RETURN (true);
+ }
+ RETURN ( false );
+ }
+
+ len1 = __qSize(slf);
+ len2 = __qSize(aStringOrChar);
+ if (len1 < len2) {
+ RETURN ( false );
+ }
#ifdef UINT64
- while (len2 > (OHDR_SIZE+sizeof(UINT64))) {
- if ( ((UINT64 *)src1)[0] != ((UINT64 *)src2)[0] ) {
- RETURN (false);
- }
- len2 -= sizeof(UINT64);
- src1 += sizeof(UINT64);
- src2 += sizeof(UINT64);
- }
+ while (len2 > (OHDR_SIZE+sizeof(UINT64))) {
+ if ( ((UINT64 *)src1)[0] != ((UINT64 *)src2)[0] ) {
+ RETURN (false);
+ }
+ len2 -= sizeof(UINT64);
+ src1 += sizeof(UINT64);
+ src2 += sizeof(UINT64);
+ }
#else
# ifdef __UNROLL_LOOPS__
- while (len2 > (OHDR_SIZE+sizeof(INT)*4)) {
- if ( ((unsigned INT *)src1)[0] != ((unsigned INT *)src2)[0]) {
- RETURN (false);
- }
- if ( ((unsigned INT *)src1)[1] != ((unsigned INT *)src2)[1]) {
- RETURN (false);
- }
- if ( ((unsigned INT *)src1)[2] != ((unsigned INT *)src2)[2]) {
- RETURN (false);
- }
- if ( ((unsigned INT *)src1)[3] != ((unsigned INT *)src2)[3]) {
- RETURN (false);
- }
- len2 -= sizeof(INT)*4;
- src1 += sizeof(INT)*4;
- src2 += sizeof(INT)*4;
- }
+ while (len2 > (OHDR_SIZE+sizeof(INT)*4)) {
+ if ( ((unsigned INT *)src1)[0] != ((unsigned INT *)src2)[0]) {
+ RETURN (false);
+ }
+ if ( ((unsigned INT *)src1)[1] != ((unsigned INT *)src2)[1]) {
+ RETURN (false);
+ }
+ if ( ((unsigned INT *)src1)[2] != ((unsigned INT *)src2)[2]) {
+ RETURN (false);
+ }
+ if ( ((unsigned INT *)src1)[3] != ((unsigned INT *)src2)[3]) {
+ RETURN (false);
+ }
+ len2 -= sizeof(INT)*4;
+ src1 += sizeof(INT)*4;
+ src2 += sizeof(INT)*4;
+ }
# endif /* __UNROLL_LOOPS__ */
#endif /* UINT64 */
- while (len2 > (OHDR_SIZE+sizeof(INT))) {
- if ( ((unsigned INT *)src1)[0] != ((unsigned INT *)src2)[0]) {
- RETURN (false);
- }
- len2 -= sizeof(INT);
- src1 += sizeof(INT);
- src2 += sizeof(INT);
- }
-
- while (c = *src2++) {
- if (c != *src1) {
- RETURN ( false );
- }
- src1++;
- }
- RETURN (true);
+ while (len2 > (OHDR_SIZE+sizeof(INT))) {
+ if ( ((unsigned INT *)src1)[0] != ((unsigned INT *)src2)[0]) {
+ RETURN (false);
+ }
+ len2 -= sizeof(INT);
+ src1 += sizeof(INT);
+ src2 += sizeof(INT);
+ }
+
+ while (c = *src2++) {
+ if (c != *src1) {
+ RETURN ( false );
+ }
+ src1++;
+ }
+ RETURN (true);
}
if (__isCharacter(aStringOrChar)) {
- int val;
-
- val = __intVal(_characterVal(aStringOrChar));
- if ((unsigned)val <= 0xFF) {
- len1 = __stringSize(slf);
- if (len1 > 0) {
- RETURN ( (__stringVal(slf)[0] == val) ? true : false);
- }
- }
- RETURN ( false );
+ int val;
+
+ val = __intVal(_characterVal(aStringOrChar));
+ if ((unsigned)val <= 0xFF) {
+ len1 = __stringSize(slf);
+ if (len1 > 0) {
+ RETURN ( (__stringVal(slf)[0] == val) ? true : false);
+ }
+ }
+ RETURN ( false );
}
%}.
^ super startsWith:aStringOrChar
@@ -3828,9 +3826,9 @@
!String class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.285 2012/07/11 17:07:34 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.286 2012/07/19 13:23:22 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/String.st,v 1.285 2012/07/11 17:07:34 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/String.st,v 1.286 2012/07/19 13:23:22 stefan Exp §'
! !
--- a/UninterpretedBytes.st Fri Jul 20 14:32:04 2012 +0100
+++ b/UninterpretedBytes.st Wed Jul 25 09:45:15 2012 +0100
@@ -397,8 +397,8 @@
^ (self byteAt:index) decodeFromBCD
"
- #[ 16r55 ] bcdByteAt:1
- #[ 16r99] bcdByteAt:1
+ #[ 16r55 ] bcdByteAt:1
+ #[ 16r99] bcdByteAt:1
#[ 16rAA] bcdByteAt:1
"
@@ -411,7 +411,7 @@
(i.e. the value n is encoded as: ((n // 10) * 16) + (n \\ 10)"
(aNumber between:0 and:99) ifFalse:[
- self error:'invalid value for BCD encoding'
+ self error:'invalid value for BCD encoding'
].
^ self byteAt:index put:aNumber encodeAsBCD
@@ -453,9 +453,9 @@
|b "{ Class: SmallInteger }"|
aSignedByteValue >= 0 ifTrue:[
- b := aSignedByteValue
+ b := aSignedByteValue
] ifFalse:[
- b := 16r100 + aSignedByteValue
+ b := 16r100 + aSignedByteValue
].
self at:index put:b.
^ aSignedByteValue
@@ -2482,6 +2482,10 @@
"
"Created: / 05-06-2012 / 14:11:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+asUUID
+ ^ UUID fromBytes:self
! !
!UninterpretedBytes methodsFor:'filling & replacing'!
@@ -2505,145 +2509,145 @@
#ifndef NO_PRIM_BYTEARR
if ((__isBytes(aCollection) || __isExternalBytesLike(aCollection))
- && (__isBytes(self) /*|| __isWords(self) */)
+ && (__isBytes(self) || __isWords(self))
&& __bothSmallInteger(start, stop)
&& __isSmallInteger(repStart)) {
- startIndex = __intVal(start) - 1;
- if (startIndex >= 0) {
- dst = (__ByteArrayInstPtr(self)->ba_element) + startIndex;
- nIndex = __byteArraySize(self);
-
- if ((cls = __qClass(self)) != @global(ByteArray)) {
- int nInst;
-
- nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
- dst += nInst;
- nIndex -= nInst;
- }
-
- stopIndex = __intVal(stop) - 1;
- count = stopIndex - startIndex + 1;
- if (count == 0) {
- RETURN ( self );
- }
-
- if ((count > 0) && (stopIndex < nIndex)) {
- repStartIndex = __intVal(repStart) - 1;
- if (repStartIndex >= 0) {
- if (__isExternalBytesLike(aCollection)) {
- OBJ sz;
-
- src = __externalAddressVal(aCollection);
- if (src == 0) goto fallBack;
-
- sz = __externalBytesSize(aCollection);
- if (__isSmallInteger(sz)) {
- repNIndex = __smallIntegerVal(sz);
- } else {
- repNIndex = repStopIndex+1; /* always enough */
- }
- src = src + repStartIndex;
- } else {
- if (__isString(aCollection)) {
- repNIndex = __stringSize(aCollection);
- } else {
- repNIndex = __qSize(aCollection) - OHDR_SIZE;
- }
- src = (__ByteArrayInstPtr(aCollection)->ba_element) + repStartIndex;
- if ((cls = __qClass(aCollection)) != @global(ByteArray)) {
- int nInst;
-
- nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
- src += nInst;
- repNIndex -= nInst;
- }
- }
- repStopIndex = repStartIndex + (stopIndex - startIndex);
- if (repStopIndex < repNIndex) {
- if (aCollection == self) {
- /* take care of overlapping copy */
- if (src < dst) {
- /* must do a reverse copy */
- src += count;
- dst += count;
- while (count-- > 0) {
- *--dst = *--src;
- }
- RETURN ( self );
- }
- }
+ startIndex = __intVal(start) - 1;
+ if (startIndex >= 0) {
+ dst = (__ByteArrayInstPtr(self)->ba_element) + startIndex;
+ nIndex = __byteArraySize(self);
+
+ if ((cls = __qClass(self)) != @global(ByteArray)) {
+ int nInst;
+
+ nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ dst += nInst;
+ nIndex -= nInst;
+ }
+
+ stopIndex = __intVal(stop) - 1;
+ count = stopIndex - startIndex + 1;
+ if (count == 0) {
+ RETURN ( self );
+ }
+
+ if ((count > 0) && (stopIndex < nIndex)) {
+ repStartIndex = __intVal(repStart) - 1;
+ if (repStartIndex >= 0) {
+ if (__isExternalBytesLike(aCollection)) {
+ OBJ sz;
+
+ src = __externalAddressVal(aCollection);
+ if (src == 0) goto fallBack;
+
+ sz = __externalBytesSize(aCollection);
+ if (__isSmallInteger(sz)) {
+ repNIndex = __smallIntegerVal(sz);
+ } else {
+ repNIndex = repStopIndex+1; /* always enough */
+ }
+ src = src + repStartIndex;
+ } else {
+ if (__isStringLike(aCollection)) {
+ repNIndex = __stringSize(aCollection);
+ } else {
+ repNIndex = __qSize(aCollection) - OHDR_SIZE;
+ }
+ src = (__ByteArrayInstPtr(aCollection)->ba_element) + repStartIndex;
+ if ((cls = __qClass(aCollection)) != @global(ByteArray)) {
+ int nInst;
+
+ nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ src += nInst;
+ repNIndex -= nInst;
+ }
+ }
+ repStopIndex = repStartIndex + (stopIndex - startIndex);
+ if (repStopIndex < repNIndex) {
+ if (aCollection == self) {
+ /* take care of overlapping copy */
+ if (src < dst) {
+ /* must do a reverse copy */
+ src += count;
+ dst += count;
+ while (count-- > 0) {
+ *--dst = *--src;
+ }
+ RETURN ( self );
+ }
+ }
# ifdef bcopy4
- if (((unsigned INT)src & 3) == ((unsigned INT)dst & 3)) {
- int nW;
-
- /* copy unaligned part */
- while (count && ((unsigned INT)src & 3)) {
- *dst++ = *src++;
- count--;
- }
-
- if (count > 0) {
- /* copy aligned part */
- nW = count >> 2;
- bcopy4(src, dst, nW);
- if ((count = count & 3) != 0) {
- /* copy any remaining part */
- src += (nW<<2);
- dst += (nW<<2);
- while (count--) {
- *dst++ = *src++;
- }
- }
- }
- RETURN ( self );
- }
+ if (((unsigned INT)src & 3) == ((unsigned INT)dst & 3)) {
+ int nW;
+
+ /* copy unaligned part */
+ while (count && ((unsigned INT)src & 3)) {
+ *dst++ = *src++;
+ count--;
+ }
+
+ if (count > 0) {
+ /* copy aligned part */
+ nW = count >> 2;
+ bcopy4(src, dst, nW);
+ if ((count = count & 3) != 0) {
+ /* copy any remaining part */
+ src += (nW<<2);
+ dst += (nW<<2);
+ while (count--) {
+ *dst++ = *src++;
+ }
+ }
+ }
+ RETURN ( self );
+ }
# else
# if __POINTER_SIZE__ == 8
- if (((unsigned INT)src & 7) == ((unsigned INT)dst & 7)) {
- /* copy unaligned part */
- while (count && ((unsigned INT)src & 7)) {
- *dst++ = *src++;
- count--;
- }
-
- /* copy aligned part */
- while (count >= 8) {
- ((unsigned INT *)dst)[0] = ((unsigned INT *)src)[0];
- dst += 8;
- src += 8;
- count -= 8;
- }
- while (count--) {
- *dst++ = *src++;
- }
- RETURN ( self );
- }
+ if (((unsigned INT)src & 7) == ((unsigned INT)dst & 7)) {
+ /* copy unaligned part */
+ while (count && ((unsigned INT)src & 7)) {
+ *dst++ = *src++;
+ count--;
+ }
+
+ /* copy aligned part */
+ while (count >= 8) {
+ ((unsigned INT *)dst)[0] = ((unsigned INT *)src)[0];
+ dst += 8;
+ src += 8;
+ count -= 8;
+ }
+ while (count--) {
+ *dst++ = *src++;
+ }
+ RETURN ( self );
+ }
# endif /* 64bit */
# endif /* bcopy4 */
# ifdef FAST_MEMCPY
- bcopy(src, dst, count);
+ bcopy(src, dst, count);
# else
# ifdef __UNROLL_LOOPS__
- while (count >= 8) {
- dst[0] = src[0]; dst[1] = src[1];
- dst[2] = src[2]; dst[3] = src[3];
- dst[4] = src[4]; dst[5] = src[5];
- dst[6] = src[6]; dst[7] = src[7];
- dst += 8; src += 8;
- count -= 8;
- }
+ while (count >= 8) {
+ dst[0] = src[0]; dst[1] = src[1];
+ dst[2] = src[2]; dst[3] = src[3];
+ dst[4] = src[4]; dst[5] = src[5];
+ dst[6] = src[6]; dst[7] = src[7];
+ dst += 8; src += 8;
+ count -= 8;
+ }
# endif /* __UNROLL_LOOPS__ */
- while (count-- > 0) {
- *dst++ = *src++;
- }
+ while (count-- > 0) {
+ *dst++ = *src++;
+ }
# endif
- RETURN ( self );
- }
- }
- }
- }
+ RETURN ( self );
+ }
+ }
+ }
+ }
}
fallBack: ;
#endif
@@ -2656,34 +2660,34 @@
"
#[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
- copy
- replaceFrom:1 to:8
- with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
- startingAt:1
+ copy
+ replaceFrom:1 to:8
+ with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
+ startingAt:1
#[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
- copy
- replaceFrom:3 to:10
- with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
- startingAt:1
+ copy
+ replaceFrom:3 to:10
+ with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
+ startingAt:1
#[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
- copy
- replaceFrom:3 to:4
- with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
- startingAt:1
+ copy
+ replaceFrom:3 to:4
+ with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
+ startingAt:1
#[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
- copy
- replaceFrom:0 to:9
- with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
- startingAt:1
+ copy
+ replaceFrom:0 to:9
+ with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
+ startingAt:1
#[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
- copy
- replaceFrom:1 to:10
- with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
- startingAt:0
+ copy
+ replaceFrom:1 to:10
+ with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160]
+ startingAt:0
"
!
@@ -2720,14 +2724,14 @@
therefore the change may affect all others referencing the receiver."
^ self
- replaceBytesFrom:1
- to:(replacementCollection size min:self size)
- with:replacementCollection
- startingAt:1
+ replaceBytesFrom:1
+ to:(replacementCollection size min:self size)
+ with:replacementCollection
+ startingAt:1
"
- (ByteArray new:10) replaceBytesWith:'hello'
- (ByteArray new:10) replaceBytesWith:'hello world bla bla bla'
+ (ByteArray new:10) replaceBytesWith:'hello'
+ (ByteArray new:10) replaceBytesWith:'hello world bla bla bla'
"
"Created: / 09-01-2012 / 16:18:10 / cg"
@@ -2741,22 +2745,24 @@
Notice: This operation modifies the receiver, NOT a copy;
therefore the change may affect all others referencing the receiver."
- ((aCollection class == self class)
- or:[aCollection isByteCollection]) ifTrue:[
- ^ self replaceBytesFrom:startIndex to:stopIndex with:aCollection startingAt:repStartIndex
+ self class isBytes ifTrue:[
+ ((aCollection class == self class)
+ or:[aCollection isByteCollection]) ifTrue:[
+ ^ self replaceBytesFrom:startIndex to:stopIndex with:aCollection startingAt:repStartIndex
+ ].
].
^ super replaceFrom:startIndex to:stopIndex with:aCollection startingAt:repStartIndex
"
args: startIndex : <integer>
- stopIndex : <integer>
- replacementCollection : <collection of <bytes> >
- repStartIndex : <integer>
+ stopIndex : <integer>
+ replacementCollection : <collection of <bytes> >
+ repStartIndex : <integer>
returns: self
"
- "Modified: / 27.7.1998 / 16:58:33 / cg"
+ "Modified: / 08-05-2012 / 13:23:27 / cg"
! !
!UninterpretedBytes methodsFor:'hashing'!
@@ -2958,13 +2964,9 @@
!UninterpretedBytes class methodsFor:'documentation'!
version
- ^ '$Id: UninterpretedBytes.st 10815 2012-06-05 21:12:57Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.90 2012/07/19 17:36:24 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.89 2012/06/05 12:29:47 vrany Exp §'
-!
-
-version_SVN
- ^ '$Id: UninterpretedBytes.st 10815 2012-06-05 21:12:57Z vranyj1 $'
-! !
+ ^ '§Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.90 2012/07/19 17:36:24 stefan Exp §'
+! !
\ No newline at end of file
--- a/UnixFilename.st Fri Jul 20 14:32:04 2012 +0100
+++ b/UnixFilename.st Wed Jul 25 09:45:15 2012 +0100
@@ -187,9 +187,8 @@
!UnixFilename methodsFor:'special accessing'!
-osNameForDirectory
- "internal - return the OS's name for the receiver to
- access it as a directory."
+osName
+ "redefined from superclass, because we do not distinguish file and directory names"
^ self osNameForFile
!
@@ -198,24 +197,32 @@
"internal - return the OS's name for the receiver to
access it as a file."
- nameString bitsPerCharacter < 8 ifTrue:[
- ^ nameString.
+ |name|
+
+ (nameString startsWith:'~') ifTrue:[
+ name := self class nameWithSpecialExpansions:nameString.
+ ] ifFalse:[
+ name := nameString.
].
- ^ nameString utf8Encoded.
+
+ name bitsPerCharacter < 8 ifTrue:[
+ ^ name.
+ ].
+ ^ name utf8Encoded.
! !
!UnixFilename class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UnixFilename.st,v 1.16 2009/10/28 14:02:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UnixFilename.st,v 1.17 2012/07/19 14:42:30 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/UnixFilename.st,v 1.16 2009/10/28 14:02:12 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/UnixFilename.st,v 1.17 2012/07/19 14:42:30 stefan Exp §'
!
version_SVN
- ^ '$Id: UnixFilename.st 10761 2012-01-19 11:46:00Z vranyj1 $'
+ ^ '$Id: UnixFilename.st 10829 2012-07-25 08:45:15Z vranyj1 $'
! !
--- a/stx_libbasic.st Fri Jul 20 14:32:04 2012 +0100
+++ b/stx_libbasic.st Wed Jul 25 09:45:15 2012 +0100
@@ -11,7 +11,7 @@
"
"{ Package: 'stx:libbasic' }"
-LibraryDefinition subclass:#stx_libbasic
+LibraryDefinition subclass:#'stx_libbasic'
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
@@ -534,9 +534,9 @@
legalCopyright
"Return a copyright string which will appear in <lib>.rc"
- ^ 'Copyright Claus Gittinger 1988-2011\nCopyright eXept Software AG 1998-2011'
+ ^ 'Copyright Claus Gittinger 1988-2012\nCopyright eXept Software AG 1998-2012'
- "Modified: / 01-02-2011 / 11:55:33 / cg"
+ "Modified: / 18-07-2012 / 19:10:19 / cg"
! !
!stx_libbasic class methodsFor:'description - svn'!
@@ -572,13 +572,13 @@
!stx_libbasic class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/stx_libbasic.st,v 1.100 2012/07/11 16:41:49 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/stx_libbasic.st,v 1.101 2012/07/18 17:13:14 cg Exp $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/stx_libbasic.st,v 1.100 2012/07/11 16:41:49 stefan Exp '
+ ^ '§Header: /cvs/stx/stx/libbasic/stx_libbasic.st,v 1.101 2012/07/18 17:13:14 cg Exp §'
!
version_SVN
- ^ '$Id: stx_libbasic.st 10824 2012-07-18 16:55:48Z vranyj1 $'
+ ^ '$ Id: stx_libbasic.st 10648 2011-06-23 15:55:10Z vranyj1 $'
! !