--- a/AbstractOperatingSystem.st Sun Aug 01 12:11:07 2010 +0100
+++ b/AbstractOperatingSystem.st Tue Aug 10 09:55:15 2010 +0100
@@ -3282,8 +3282,9 @@
!
getHostName
- "return the hostname we are running on - if there is
- a HOST environment variable, we are much faster here ...
+ "return the hostname we are running on -
+ a fully qalified hostname at best.
+
Notice:
not all systems support this; on some, 'unknown' is returned."
@@ -5523,6 +5524,24 @@
!AbstractOperatingSystem class methodsFor:'users & groups'!
+getApplicationDataDirectoryFor:appName
+ "return the directory, where user-and-application-specific private files are to be
+ located (ini-files, preferences etc.).
+ Under windows, something like 'C:\Users\Administrator\AppData\Roaming\<appName>'
+ is returned, here, the fallback ~/.<appName> is returned.
+ Notice that only the name is returned; the directory is not guaranteed to exist."
+
+ "{ Pragma: +optSpace }"
+
+ ^ self getHomeDirectory asFilename constructString:('.',appName)
+
+ "
+ OperatingSystem getApplicationDataDirectoryFor:'expecco'
+ "
+
+ "Created: / 29-07-2010 / 12:07:25 / sr"
+!
+
getDesktopDirectory
"{ Pragma: +optSpace }"
@@ -6934,18 +6953,19 @@
!AbstractOperatingSystem class methodsFor:'documentation'!
version
- ^ '$Id: AbstractOperatingSystem.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: AbstractOperatingSystem.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.197 2010/03/30 13:50:30 stefan Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.199 2010/07/29 10:14:05 sr Exp '
!
version_SVN
- ^ '$Id: AbstractOperatingSystem.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: AbstractOperatingSystem.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
AbstractOperatingSystem initialize!
+
--- a/AbstractSourceFileReader.st Sun Aug 01 12:11:07 2010 +0100
+++ b/AbstractSourceFileReader.st Tue Aug 10 09:55:15 2010 +0100
@@ -58,9 +58,10 @@
[stream := aFilename asFilename readStream.
self fileInStream: stream]
ensure:
- [stream ifNotNil:[stream close]]
+ [stream notNil ifTrue:[stream close]]
"Modified: / 15-08-2009 / 14:47:29 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 08-08-2010 / 14:38:35 / cg"
!
fileInStream:arg
@@ -72,16 +73,17 @@
!AbstractSourceFileReader class methodsFor:'documentation'!
version
- ^ '$Id: AbstractSourceFileReader.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: AbstractSourceFileReader.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/AbstractSourceFileReader.st,v 1.4 2009/10/08 11:50:15 fm Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/AbstractSourceFileReader.st,v 1.5 2010/08/08 12:38:42 cg Exp §'
!
version_SVN
- ^ '$Id: AbstractSourceFileReader.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: AbstractSourceFileReader.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
+
--- a/ApplicationDefinition.st Sun Aug 01 12:11:07 2010 +0100
+++ b/ApplicationDefinition.st Tue Aug 10 09:55:15 2010 +0100
@@ -479,6 +479,21 @@
"Created: / 15-10-2006 / 12:44:14 / cg"
!
+initiallyLoadedPreRequisites
+ "Prereqisites packages that are not to be loaded at application startup, but
+ that maybe loaded later by the application.
+ This is used for a fast startup in case that the application wants to only inform
+ an already running application to e.g. open an additional window."
+
+ ^ nil "the default, nil means: all prerequisites should be loaded initially"
+
+"/ ^ #(
+"/ #'stx:libbasic'
+"/ #'stx:libbasic2'
+"/ #'stx:libcomp'
+"/ )
+!
+
isConsoleApplication
"Used with WIN32 only (i.e. affects bc.mak).
Return true, if this is a console application.
@@ -1139,7 +1154,10 @@
generateAllPreRequisiteLibs_modules_dot_stx
^ String streamContents:[:s |
self allPreRequisitesSorted do:[:projectID |
- s nextPutLine:(self libraryNameFor:projectID)
+ (self shouldBeLoadedInitially:projectID) ifFalse:[
+ s nextPut:$*.
+ ].
+ s nextPutLine:(self libraryNameFor:projectID).
].
self isGUIApplication ifTrue:[
self guiClassFileNames_win32 do:[:eachFilename |
@@ -1149,7 +1167,7 @@
].
"
- bosch_dapasx_application generatePreRequisiteLibs_modules_dot_stx
+ exept_expecco_application generateAllPreRequisiteLibs_modules_dot_stx
"
"Modified: / 07-09-2006 / 17:22:58 / cg"
@@ -1158,7 +1176,10 @@
generatePreRequisiteLibs_modules_dot_stx
^ String streamContents:[:s |
self effectivePreRequisites do:[:projectID |
- s nextPutLine:(self libraryNameFor:projectID)
+ (self shouldBeLoadedInitially:projectID) ifFalse:[
+ s nextPut:$*.
+ ].
+ s nextPutLine:(self libraryNameFor:projectID).
].
self isGUIApplication ifTrue:[
self guiClassFileNames_win32 do:[:eachFilename |
@@ -1168,7 +1189,7 @@
].
"
- bosch_dapasx_application generatePreRequisiteLibs_modules_dot_stx
+ exept_expecco_application generatePreRequisiteLibs_modules_dot_stx
"
"Modified: / 07-09-2006 / 17:22:58 / cg"
@@ -1378,14 +1399,17 @@
string := String streamContents:[:s |
self subProjects do:[:projectID |
- s nextPutLine:(self libraryNameFor:projectID)
+ (self shouldBeLoadedInitially:projectID) ifFalse:[
+ s nextPut:$*.
+ ].
+ s nextPutLine:(self libraryNameFor:projectID).
].
].
^ string
"
- bosch_dapasx_application generateSubProjectLines_modules_dot_stx
+ exept_expecco_application generateSubProjectLines_modules_dot_stx
cg_newCompiler_driver_stc generateSubProjectLines_modules_dot_stx
"
@@ -1491,6 +1515,7 @@
consoleApp:
-del main.obj
$(MAKE) -N -f bc.mak \
+ MAKE_BAT=$(MAKE_BAT) \
PROJECT=$(PROJECT_CONSOLE) \
CFLAGS_APPTYPE="$(CFLAGS_CONSOLE)" \
LFLAGS_APPTYPE="$(LFLAGS_CONSOLE)" \
@@ -1500,6 +1525,7 @@
noConsoleApp:
-del main.obj
$(MAKE) -N -f bc.mak \
+ MAKE_BAT=$(MAKE_BAT) \
PROJECT=$(PROJECT_NOCONSOLE) \
CFLAGS_APPTYPE="$(CFLAGS_NOCONSOLE) -DWIN_LOGFILE="\\"\"%(NOCONSOLE_LOGFILE)\\"\""" \
LFLAGS_APPTYPE="$(LFLAGS_NOCONSOLE)" \
@@ -1624,7 +1650,7 @@
# ENDMAKEDEPEND --- do not remove this line
'.
- "Modified: / 05-07-2007 / 20:50:27 / cg"
+ "Modified: / 26-07-2010 / 12:26:36 / cg"
!
bc_dot_mak_app_source_rules
@@ -2248,7 +2274,7 @@
!!define STX_ROOT "%(TOP)\.."
-SetCompressor lzma
+SetCompressor /solid lzma
!!include "MUI2.nsh"
@@ -2512,14 +2538,14 @@
is required!!"
^
-'%(FILE_NAME).dll: %(MODULE_DIRECTORY)\objbc\%(FILE_NAME).dll
- copy %(MODULE_DIRECTORY)\objbc\%(FILE_NAME).dll *.*
-
-%(MODULE_DIRECTORY)\objbc\%(FILE_NAME).dll:
- pushd %(MODULE_DIRECTORY) & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+'%(FILE_NAME).dll: %(MODULE_DIRECTORY)\$(OBJDIR)\%(FILE_NAME).dll
+ copy %(MODULE_DIRECTORY)\$(OBJDIR)\%(FILE_NAME).dll *.*
+
+%(MODULE_DIRECTORY)\$(OBJDIR)\%(FILE_NAME).dll:
+ pushd %(MODULE_DIRECTORY) & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
'
- "Modified: / 09-02-2007 / 16:22:47 / cg"
+ "Modified: / 26-07-2010 / 12:26:10 / cg"
!
preRequisiteLine_make_dot_proto
@@ -2540,14 +2566,16 @@
subProjectLine_bc_dot_mak
-^'%(LIBRARY_NAME).dll: $(TOP)\..\%(PATH_TO_SUB_PROJECT)\objbc\%(LIBRARY_NAME).dll
- copy $(TOP)\..\%(PATH_TO_SUB_PROJECT)\objbc\%(LIBRARY_NAME).dll *.*
-
-$(TOP)\..\%(PATH_TO_SUB_PROJECT)\objbc\%(LIBRARY_NAME).dll:
+^'%(LIBRARY_NAME).dll: $(TOP)\..\%(PATH_TO_SUB_PROJECT)\$(OBJDIR)\%(LIBRARY_NAME).dll
+ copy $(TOP)\..\%(PATH_TO_SUB_PROJECT)\$(OBJDIR)\%(LIBRARY_NAME).dll *.*
+
+$(TOP)\..\%(PATH_TO_SUB_PROJECT)\$(OBJDIR)\%(LIBRARY_NAME).dll:
cd $(TOP)\..\%(PATH_TO_SUB_PROJECT)
$(MAKE_BAT)
-cd $(TOP)\..\%(PATH_TO_MYPROJECT)
'
+
+ "Modified: / 26-07-2010 / 12:26:01 / cg"
!
undefineExtenionLine_nsi_for:extension
@@ -2578,6 +2606,20 @@
^ self isGUIApplication
ifTrue:[ GUIApplicationType ]
ifFalse:[ NonGUIApplicationType ]
+!
+
+shouldBeLoadedInitially:aProjectID
+ "answer true, if a class should not be loaded initially,
+ but explicitly later by the application"
+
+ |initiallyLoaded|
+
+ initiallyLoaded := self initiallyLoadedPreRequisites.
+ initiallyLoaded isNil ifTrue:[
+ ^ true.
+ ].
+
+ ^ initiallyLoaded includes:aProjectID
! !
!ApplicationDefinition class methodsFor:'sanity checks'!
@@ -2629,16 +2671,17 @@
!ApplicationDefinition class methodsFor:'documentation'!
version
- ^ '$Id: ApplicationDefinition.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: ApplicationDefinition.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.158 2009/12/10 17:59:27 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.162 2010/08/05 12:05:04 stefan Exp '
!
version_SVN
- ^ '$Id: ApplicationDefinition.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: ApplicationDefinition.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
+
--- a/ArithmeticValue.st Sun Aug 01 12:11:07 2010 +0100
+++ b/ArithmeticValue.st Tue Aug 10 09:55:15 2010 +0100
@@ -518,6 +518,37 @@
"
!
+asFixedPointRoundedToScale
+ "return the receiver as fixedPoint number, rounded to its scale."
+
+ ^ self asFixedPoint roundedToScale
+
+ "
+ 0.3 asFixedPoint
+ 0.5 asFixedPoint
+ (2/3) asFloat asFixedPoint
+ (1/8) asFloat asFixedPoint
+ 3.14159 asFixedPoint
+
+ 0.3 asFixedPointRoundedToScale
+ 0.5 asFixedPointRoundedToScale
+ (2/3) asFloat asFixedPointRoundedToScale
+ (1/8) asFloat asFixedPointRoundedToScale
+ 3.14159 asFixedPointRoundedToScale
+ "
+
+ "Created: / 02-08-2010 / 13:32:16 / cg"
+!
+
+asFixedPointRoundedToScale:scale
+ "return the receiver as fixedPoint number with the given
+ number of post-decimal-digits, rounded to its scale"
+
+ ^ (self asFixedPoint:scale) roundedToScale
+
+ "Created: / 02-08-2010 / 13:33:11 / cg"
+!
+
asFloat
"return a float with same value"
@@ -1283,18 +1314,19 @@
!ArithmeticValue class methodsFor:'documentation'!
version
- ^ '$Id: ArithmeticValue.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: ArithmeticValue.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/ArithmeticValue.st,v 1.85 2010/03/06 10:06:53 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/ArithmeticValue.st,v 1.86 2010/08/02 11:33:27 cg Exp '
!
version_SVN
- ^ '$Id: ArithmeticValue.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: ArithmeticValue.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
ArithmeticValue initialize!
+
--- a/ClassBuilder.st Sun Aug 01 12:11:07 2010 +0100
+++ b/ClassBuilder.st Tue Aug 10 09:55:15 2010 +0100
@@ -155,10 +155,13 @@
a trap when its executed. This is used when a class has changed its
layout for all methods which are affected by the change."
- self copyInvalidatedMethodsFrom:oldClass
- for:newClass
- accessingAny:setOfNames
- orSuper:false
+ self
+ copyInvalidatedMethodsFrom:oldClass
+ for:newClass
+ accessingAny:setOfNames
+ orSuper:false
+
+ "Modified: / 02-08-2010 / 16:40:30 / cg"
!
copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:setOfNames orSuper:superBoolean
@@ -2222,17 +2225,18 @@
!ClassBuilder class methodsFor:'documentation'!
version
- ^ '$Id: ClassBuilder.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: ClassBuilder.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.94 2010/07/11 14:37:58 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.95 2010/08/02 16:23:53 cg Exp '
!
version_SVN
- ^ '$Id: ClassBuilder.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: ClassBuilder.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
+
--- a/Collection.st Sun Aug 01 12:11:07 2010 +0100
+++ b/Collection.st Tue Aug 10 09:55:15 2010 +0100
@@ -901,7 +901,7 @@
!
removeAll:aCollection
- "remove all elements of the argument, aCollection from the receiver.
+ "remove all elements from the receiver which are equal to any in aCollection.
Return the argument, aCollection.
Raises an error, if some element-to-remove is not in the receiver.
(see also: #removeAllFoundIn:, which does not raise an error).
@@ -939,12 +939,11 @@
coll
"
-
+ "Modified: / 05-08-2010 / 13:50:33 / cg"
!
removeAllFoundIn:aCollection
- "Remove each element of aCollection, which is present in the receiver
- from the receiver.
+ "remove all elements from the receiver which are equal to any in aCollection.
No error is raised, if some element-to-remove is not in the receiver.
(see also: #removeAll:, which does raise an error)."
@@ -967,6 +966,76 @@
coll
"
+ "Modified: / 05-08-2010 / 13:51:05 / cg"
+!
+
+removeAllIdentical:aCollection
+ "remove all elements from the receiver which are in aCollection.
+ Return the argument, aCollection.
+ Raises an error, if some element-to-remove is not in the receiver.
+ (see also: #removeAllFoundIn:, which does not raise an error).
+
+ Notice: for some collections (those not tuned for
+ resizing themself) this may be very slow.
+ If the number of removed elements is big compared to to
+ the receivers size, it may be better to copy the
+ ones which are not to be removed into a new collection."
+
+ aCollection do:[:element | self removeIdentical:element].
+ ^ aCollection
+
+ "
+ |coll|
+
+ coll := #(1 2 3 4 5 6) asSet.
+ coll removeAll:#(4 5 6).
+ coll
+ "
+
+ "raises an error:
+ |coll|
+
+ coll := #(1 2 3 4 5 6) asSet.
+ coll removeAll:#(4 5 6 7 8).
+ coll
+ "
+
+ "no error raised:
+ |coll|
+
+ coll := #(1 2 3 4 5 6) asSet.
+ coll removeAllFoundIn:#(4 5 6 7 8).
+ coll
+ "
+
+ "Created: / 05-08-2010 / 13:51:51 / cg"
+!
+
+removeAllIdenticalFoundIn:aCollection
+ "remove all elements from the receiver which are in aCollection.
+ No error is raised, if some element-to-remove is not in the receiver.
+ (see also: #removeAll:, which does raise an error)."
+
+ aCollection do:[:each | self removeIdentical:each ifAbsent:[]].
+ ^ aCollection
+
+ "
+ |coll|
+
+ coll := #(1 2 3 4 5 6) asSet.
+ coll removeAllFoundIn:#(4 5 6 7 8).
+ coll
+ "
+
+ "raises an error:
+ |coll|
+
+ coll := #(1 2 3 4 5 6) asSet.
+ coll removeAll:#(4 5 6 7 8).
+ coll
+ "
+
+ "Created: / 05-08-2010 / 13:52:21 / cg"
!
removeAllKeys:aCollection
@@ -2300,18 +2369,35 @@
the argument aBlock evaluates to true.
See also: #removeAllFoundIn: and #removeAllSuchThat:"
+ ^ self select:aBlock as:(self species)
+
+ "
+ #(1 2 3 4) select:[:e | e odd]
+ (1 to:10) select:[:e | e even]
+ "
+
+ "Modified: / 07-08-2010 / 16:26:40 / cg"
+!
+
+select:aBlock as:aCollectionClass
+ "return a new collection with all elements from the receiver, for which
+ the argument aBlock evaluates to true.
+ See also: #removeAllFoundIn: and #removeAllSuchThat:"
+
|newCollection|
- newCollection := self species new.
+ newCollection := aCollectionClass new.
self do:[:each |
(aBlock value:each) ifTrue:[newCollection add:each].
].
^ newCollection
"
- #(1 2 3 4) select:[:e | e odd]
- (1 to:10) select:[:e | e even]
+ #(1 2 3 4) select:[:e | e odd] as:OrderedCollection
+ (1 to:10) select:[:e | e even] as:OrderedCollection
"
+
+ "Created: / 07-08-2010 / 16:26:15 / cg"
!
select:aBlock ifNone:exceptionBlock
@@ -3650,18 +3736,19 @@
!Collection class methodsFor:'documentation'!
version
- ^ '$Id: Collection.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Collection.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/Collection.st,v 1.244 2010/07/11 15:06:50 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/Collection.st,v 1.246 2010/08/07 17:18:25 cg Exp '
!
version_SVN
- ^ '$Id: Collection.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Collection.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
Collection initialize!
+
--- a/Delay.st Sun Aug 01 12:11:07 2010 +0100
+++ b/Delay.st Tue Aug 10 09:55:15 2010 +0100
@@ -228,6 +228,15 @@
This is a combined instance creation & wait."
^ (self forSeconds:aNumber) wait
+!
+
+waitUntil:aTimestamp
+ "wait until a given time is reached.
+ This is a combined instance creation & wait."
+
+ ^ (self until:aTimestamp) wait
+
+ "Created: / 29-07-2010 / 13:51:41 / cg"
! !
!Delay methodsFor:'accessing'!
@@ -334,9 +343,14 @@
!Delay class methodsFor:'documentation'!
version
- ^ '$Id: Delay.st 10517 2010-04-26 18:26:38Z vranyj1 $'
+ ^ '$Id: Delay.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_SVN
- ^ '$Id: Delay.st 10517 2010-04-26 18:26:38Z vranyj1 $'
+ ^ '$Id: Delay.st 10564 2010-08-10 08:55:15Z vranyj1 $'
+!
+
+version_CVS
+ ^ '§Header: /cvs/stx/stx/libbasic/Delay.st,v 1.43 2010/08/02 14:02:50 cg Exp§'
! !
+
--- a/Filename.st Sun Aug 01 12:11:07 2010 +0100
+++ b/Filename.st Tue Aug 10 09:55:15 2010 +0100
@@ -274,6 +274,32 @@
!Filename class methodsFor:'instance creation'!
+applicationDataDirectoryFor:appName
+ "return the directory, where user-and-application-specific private files are to be
+ located (ini-files, preferences etc.).
+ Under windows, something like 'C:\Users\Administrator\AppData\Roaming\<appName>'
+ is returned, under unix, we use ~/.<appName> (but see details in UnixOS).
+ If the directory does not exist, it is created"
+
+ |s dir|
+
+ s := OperatingSystem getApplicationDataDirectoryFor:appName.
+ s isNil ifTrue:[
+ ^ self homeDirectory
+ ].
+ dir := self named:s.
+ dir exists ifFalse:[
+ dir makeDirectory
+ ].
+ ^ dir
+
+ "
+ Filename applicationDataDirectoryFor:'expecco'
+ "
+
+ "Created: / 29-07-2010 / 12:05:35 / sr"
+!
+
currentDirectory
"return a filename for the current directory"
@@ -2773,19 +2799,14 @@
(Notice, that a rename is tried first, in case of non-cross device move)"
[self renameTo:newName]
- on:(OperatingSystem errorSignal)
+ on:(OSErrorHolder inappropriateReferentSignal)
do:[:ex |
- ex signal == OperatingSystem fileNotFoundErrorSignal ifTrue:[
- ex reject
- ].
- ex signal == OperatingSystem accessDeniedErrorSignal ifTrue:[
- ex reject
- ].
-
+ "handle renames accross device boundaries (Unix. cross device link)"
self isDirectory ifTrue:[
self recursiveMoveDirectoryTo:newName.
] ifFalse:[
- self moveFileTo:newName.
+ self copyTo:newName.
+ self remove.
].
].
@@ -2813,7 +2834,7 @@
recursiveCopyTo:destination
"if I represent a regular file, copy it.
Otherwise, copy the directory and recursively
- and recursively all of its subfiles/subdirectories.
+ all of its subfiles/subdirectories.
Raises an exception if not successful."
|ok d|
@@ -2839,8 +2860,9 @@
self recursiveCopyWithoutOSCommandTo:destination
].
- "Created: / 5.5.1999 / 13:35:01 / cg"
- "Modified: / 31.5.1999 / 13:11:34 / cg"
+ "Created: / 05-05-1999 / 13:35:01 / cg"
+ "Modified: / 31-05-1999 / 13:11:34 / cg"
+ "Modified: / 29-07-2010 / 12:41:06 / sr"
!
recursiveCopyWithoutOSCommandTo:destination
@@ -3142,7 +3164,9 @@
self exists ifFalse:[
^ self fileNotFoundError:self
].
- ^ self accessDeniedError:newName asFilename.
+ (OperatingSystem errorHolderForNumber:errno)
+ parameter:newName asFilename;
+ reportError.
].
"
@@ -5775,15 +5799,15 @@
!Filename class methodsFor:'documentation'!
version
- ^ '$Id: Filename.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Filename.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/Filename.st,v 1.351 2010/05/07 12:06:04 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/Filename.st,v 1.358 2010/07/29 10:39:38 sr Exp '
!
version_SVN
- ^ '$Id: Filename.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Filename.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
Filename initialize!
@@ -5792,3 +5816,4 @@
+
--- a/Integer.st Sun Aug 01 12:11:07 2010 +0100
+++ b/Integer.st Tue Aug 10 09:55:15 2010 +0100
@@ -2402,6 +2402,15 @@
"Modified: / 24.2.1998 / 10:07:29 / stefan"
! !
+!Integer methodsFor:'dependents access'!
+
+addDependent:anObject
+ Transcript show:'*** trying to make dependent on an integer: '.
+ thisContext sender printOn:Transcript. Transcript cr.
+
+ "Created: / 28-07-2010 / 20:29:00 / cg"
+! !
+
!Integer methodsFor:'double dispatching'!
differenceFromFraction:aFraction
@@ -3487,22 +3496,22 @@
|base num s divMod mod r r2 r4 nD numN|
base := b.
- (base between:2 and:36) ifFalse:[
- ConversionError raiseRequestErrorString:' - invalid base'.
- base := 10.
+ (base isInteger and:[ base between:2 and:36 ]) ifFalse:[
+ ConversionError raiseRequestErrorString:' - invalid base'.
+ base := 10.
].
showRadix ifTrue:[
- base printOn:aStream.
- aStream nextPut:$r.
+ base printOn:aStream.
+ aStream nextPut:$r.
].
(self = 0) ifTrue:[aStream nextPut:$0. ^ self].
(self negative) ifTrue:[
- aStream nextPut:$- .
- num := self negated.
+ aStream nextPut:$- .
+ num := self negated.
] ifFalse:[
- num := self.
+ num := self.
].
"
@@ -3527,11 +3536,11 @@
r2 := base*base. "/ radix^2
r4 := r2*r2. "/ radix^4
base <= 10 ifTrue:[
- r := r4*r2. "/ radix^6
- nD := 6.
+ r := r4*r2. "/ radix^6
+ nD := 6.
] ifFalse:[
- r := r4*base. "/ radix^5
- nD := 5.
+ r := r4*base. "/ radix^5
+ nD := 5.
].
"get a Stream with space for the digits we are going to print.
@@ -3541,43 +3550,43 @@
s := WriteStream on:(String new:((num highBit // base highBit - 1) + 1)).
[num >= r] whileTrue:[
- "/
- "/ chop off nD digits.
- "/
- divMod := num divMod:r.
- num := divMod at:1.
- numN := divMod at:2.
-
- "/ process them
- nD timesRepeat:[
- divMod := numN divMod:base.
- numN := divMod at:1.
- mod := divMod at:2.
- s nextPut:(Character digitValue:mod).
- ].
+ "/
+ "/ chop off nD digits.
+ "/
+ divMod := num divMod:r.
+ num := divMod at:1.
+ numN := divMod at:2.
+
+ "/ process them
+ nD timesRepeat:[
+ divMod := numN divMod:base.
+ numN := divMod at:1.
+ mod := divMod at:2.
+ s nextPut:(Character digitValue:mod).
+ ].
].
[num ~= 0] whileTrue:[
- divMod := num divMod:base.
- num := divMod at:1.
- mod := divMod at:2.
- s nextPut:(Character digitValue:mod).
+ divMod := num divMod:base.
+ num := divMod at:1.
+ mod := divMod at:2.
+ s nextPut:(Character digitValue:mod).
].
aStream nextPutAll:(s contents reverse).
"
- 3000 factorial printOn:Transcript base:10
- 10 printOn:Transcript base:3
- 31 printOn:Transcript base:3
- -20 printOn:Transcript base:16
- -20 printOn:Transcript base:10
- Time millisecondsToRun:[10000 factorial printString] 7650
- "
-
- "Modified: / 20.1.1998 / 18:05:02 / stefan"
- "Created: / 7.9.2001 / 13:51:33 / cg"
- "Modified: / 7.9.2001 / 13:54:50 / cg"
+ 3000 factorial printOn:Transcript base:10
+ 10 printOn:Transcript base:3
+ 31 printOn:Transcript base:3
+ -20 printOn:Transcript base:16
+ -20 printOn:Transcript base:10
+ Time millisecondsToRun:[10000 factorial printString] 7650
+ "
+
+ "Modified: / 20-01-1998 / 18:05:02 / stefan"
+ "Created: / 07-09-2001 / 13:51:33 / cg"
+ "Modified: / 02-08-2010 / 12:24:14 / cg"
!
printOn:aStream base:baseInteger size:sz fill:fillCharacter
@@ -3920,7 +3929,6 @@
"Modified: 15.10.1997 / 18:43:49 / cg"
! !
-
!Integer methodsFor:'special access'!
exponent
@@ -4699,15 +4707,15 @@
!Integer class methodsFor:'documentation'!
version
- ^ '$Id: Integer.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Integer.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/Integer.st,v 1.246 2010/04/13 16:11:42 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/Integer.st,v 1.248 2010/08/02 10:34:20 cg Exp '
!
version_SVN
- ^ '$Id: Integer.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Integer.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
Integer initialize!
@@ -4715,3 +4723,4 @@
+
--- a/MD5Stream.st Sun Aug 01 12:11:07 2010 +0100
+++ b/MD5Stream.st Tue Aug 10 09:55:15 2010 +0100
@@ -84,7 +84,7 @@
examples
"
- [exBegin]
+ [exBegin]
Test Vectors (from FIPS PUB 180-1); results are:
'abc'
@@ -95,22 +95,25 @@
A million repetitions of 'a'
-> #[77 7 D6 AE 4E 2 7C 70 EE A2 A9 35 C2 29 6F 21]
- [exEnd]
-
+ [exEnd]
- [exBegin]
+ [exBegin]
+ Transcript showCR:(MD5Stream hashValueOf:'abc') hexPrintString
+ [exEnd]
+
+ [exBegin]
(MD5Stream hashValueOf:'abc')
- printOn:Transcript base:16.
+ printOn:Transcript base:16.
Transcript cr.
- [exEnd]
+ [exEnd]
- [exBegin]
+ [exBegin]
(MD5Stream hashValueOfStream:('abc' readStream))
- printOn:Transcript base:16.
+ printOn:Transcript base:16.
Transcript cr.
- [exEnd]
+ [exEnd]
- [exBegin]
+ [exBegin]
|hashStream|
hashStream := MD5Stream new.
@@ -118,9 +121,9 @@
hashStream hashValue printOn:Transcript base:16. Transcript cr.
hashStream nextPut:'dbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'.
hashStream hashValue printOn:Transcript base:16. Transcript cr.
- [exEnd]
+ [exEnd]
- [exBegin]
+ [exBegin]
|hashStream|
hashStream := MD5Stream new.
@@ -129,33 +132,33 @@
hashStream hashValue printOn:Transcript base:16. Transcript cr.
hashStream nextPut:'dbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq' asByteArray.
hashStream hashValue printOn:Transcript base:16. Transcript cr.
- [exEnd]
+ [exEnd]
- [exBegin]
+ [exBegin]
|hashStream|
hashStream := MD5Stream new.
1000000 timesRepeat:[ hashStream nextPut:$a ].
hashStream hashValue printOn:Transcript base:16. Transcript cr.
- [exEnd]
+ [exEnd]
- [exBegin]
+ [exBegin]
|hashStream|
hashStream := MD5Stream new.
hashStream nextPut:'a'.
hashStream hashValue printOn:Transcript base:16. Transcript cr.
- [exEnd]
+ [exEnd]
- [exBegin]
+ [exBegin]
|hashStream|
hashStream := MD5Stream new.
hashStream nextPut:$a.
hashStream hashValue printOn:Transcript base:16. Transcript cr.
- [exEnd]
+ [exEnd]
- [exBegin]
+ [exBegin]
|hashStream|
hashStream := MD5Stream new.
@@ -164,23 +167,23 @@
hashStream reset.
hashStream nextPut:'abc'.
hashStream hashValue printOn:Transcript base:16. Transcript cr.
- [exEnd]
+ [exEnd]
timing throughput:
- [exBegin]
+ [exBegin]
|hashStream n t|
hashStream := MD5Stream new.
n := 1000000.
t := Time millisecondsToRun:[
- n timesRepeat:[
- hashStream nextPutAll:'12345678901234567890123456789012345678901234567890'.
- ].
- ].
+ n timesRepeat:[
+ hashStream nextPutAll:'12345678901234567890123456789012345678901234567890'.
+ ].
+ ].
t := (t / 1000) asFloat.
Transcript show:t; show:' seconds for '; show:(50*n/1024) asFloat; showCR:' Kb'.
Transcript show:(n*50/1024 / t); showCR:' Kb/s'
- [exEnd]
+ [exEnd]
"
! !
@@ -452,18 +455,19 @@
!MD5Stream class methodsFor:'documentation'!
version
- ^ '$Id: MD5Stream.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: MD5Stream.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/MD5Stream.st,v 1.13 2010/03/04 20:55:03 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/MD5Stream.st,v 1.14 2010/08/07 17:11:19 cg Exp '
!
version_SVN
- ^ '$Id: MD5Stream.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: MD5Stream.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
MD5Stream initialize!
+
--- a/NamespaceAwareLookup.st Sun Aug 01 12:11:07 2010 +0100
+++ b/NamespaceAwareLookup.st Tue Aug 10 09:55:15 2010 +0100
@@ -85,7 +85,7 @@
"Invoked by the VM to ask me for a method to fire.
For details, see comment inLookup>>lookupMethodForSelector:directedTo:for:withArguments:from:"
- | sendingNs sendingMthd queue seen methods |
+ | sendingNs sendingMthd queue seen namespaces methods |
"JV @ 2010-07-24
Following C code is just a performance optimization.
@@ -117,19 +117,18 @@
}
%}.
- "
+
Transcript
show: 'sel='; show: selector; show: ' ns='; show: sendingNs printString;
show: ' method=', sendingContext method printString; cr.
- "
+
- queue := Queue with: (Array with: sendingNs).
+ namespaces := Array with: sendingNs.
seen := Set new.
sendingNs ifNotNil:[
- [queue notEmpty] whileTrue:
- [|namespaces imports |
- namespaces := queue removeFirst.
+ [namespaces notEmpty] whileTrue:
+ [| imports |
imports := Set new.
methods := self
lookupMethodsForSelector: selector
@@ -153,8 +152,8 @@
[:import|
(seen includes: import) ifFalse:
[imports add: import]]]].
- imports isEmpty ifFalse:[queue add: imports]].
- ].
+ namespaces := imports..
+ ]].
methods := self lookupMethodsForSelector: selector
directedTo: initialSearchClass.
@@ -217,7 +216,7 @@
!NamespaceAwareLookup class methodsFor:'documentation'!
version_SVN
- ^ '$Id: NamespaceAwareLookup.st 10562 2010-08-01 11:11:07Z vranyj1 $'
+ ^ '$Id: NamespaceAwareLookup.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
NamespaceAwareLookup initialize!
--- a/Number.st Sun Aug 01 12:11:07 2010 +0100
+++ b/Number.st Tue Aug 10 09:55:15 2010 +0100
@@ -704,7 +704,6 @@
^ self == Number
! !
-
!Number methodsFor:'Compatibility-Squeak'!
asSmallAngleDegrees
@@ -797,9 +796,13 @@
"
1 closeTo:1.0000000001
1 closeTo:1.001
+
+ 3.14 closeTo:(3.14 asFixedPoint:2)
+ (3.14 asFixedPoint:2) closeTo:3.14
"
- "Created: / 5.11.2001 / 18:07:26 / cg"
+ "Created: / 05-11-2001 / 18:07:26 / cg"
+ "Modified: / 02-08-2010 / 13:27:22 / cg"
!
degreeCos
@@ -2248,16 +2251,17 @@
!Number class methodsFor:'documentation'!
version
- ^ '$Id: Number.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Number.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/Number.st,v 1.132 2010/03/06 11:29:09 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/Number.st,v 1.133 2010/08/02 11:27:38 cg Exp '
!
version_SVN
- ^ '$Id: Number.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Number.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
+
--- a/OSErrorHolder.st Sun Aug 01 12:11:07 2010 +0100
+++ b/OSErrorHolder.st Tue Aug 10 09:55:15 2010 +0100
@@ -119,13 +119,19 @@
!
noAccociationSignal
- ^ Signals at:#noAccociationSignal
+ <resource: #obsolete>
+ self obsoleteMethodWarning.
+ ^ self noAssociationSignal
!
noAggregationSignal
^ Signals at:#noAggregationSignal
!
+noAssociationSignal
+ ^ Signals at:#noAssociationSignal
+!
+
noDataSignal
^ Signals at:#noDataSignal
!
@@ -221,7 +227,7 @@
initialize
"init signals etc."
- |s|
+ |unavailableReferentSignal|
OSErrorSignal isNil ifTrue:[
OSErrorSignal := OsError.
@@ -249,14 +255,13 @@
Signals at:#defaultOsErrorSignal put:OSErrorSignal.
-false ifTrue:[
"/ Information signals
- s := self setupSignal:#informationSignal parent:OSErrorSignal
- notifier:'Information'.
- self setupSignal:#operationStartedSignal parent:s
- notifier:'Operation started'.
-].
+"/ s := self setupSignal:#informationSignal parent:OSErrorSignal
+"/ notifier:'Information'.
+"/ self setupSignal:#operationStartedSignal parent:s
+"/ notifier:'Operation started'.
+
"/ Retry signals
self setupSignal:#notReadySignal parent:OsNeedRetryError
@@ -284,7 +289,8 @@
self setupSignal:#nonexistentSignal parent:OsInaccessibleError
notifier:'File does not exist'.
- self setupSignal:#unavailableReferentSignal parent:OsInaccessibleError
+ unavailableReferentSignal :=
+ self setupSignal:#unavailableReferentSignal parent:OsInaccessibleError
notifier:' currently'.
self setupSignal:#noPermissionsSignal parent:OsInaccessibleError
notifier:'Permission denied'.
@@ -318,19 +324,19 @@
"/ COM errors
self setupSignal:#coNotInitializedSignal parent:OsIllegalOperation
notifier:'COM not initialized'.
- self setupSignal:#noInterfaceSignal parent:OsIllegalOperation
+ self setupSignal:#noInterfaceSignal parent:unavailableReferentSignal
notifier:'No such interface'.
- self setupSignal:#classNotRegisteredSignal parent:OsIllegalOperation
+ self setupSignal:#classNotRegisteredSignal parent:unavailableReferentSignal
notifier:'Class not registered'.
self setupSignal:#noAggregationSignal parent:OsIllegalOperation
notifier:'No Aggregation'.
- self setupSignal:#unknownNameSignal parent:OsIllegalOperation
+ self setupSignal:#unknownNameSignal parent:unavailableReferentSignal
notifier:'Unknown member name'.
self setupSignal:#noVerbsSignal parent:OsIllegalOperation
notifier:'No verbs for OLE object'.
"/ Shell errors
- self setupSignal:#noAccociationSignal parent:OsIllegalOperation
+ self setupSignal:#noAssociationSignal parent:unavailableReferentSignal
notifier:'No association for file extension'.
].
@@ -379,7 +385,7 @@
signal := self class signalNamed:errorCategory.
signal
raiseWith:self
- errorString:(parameter isNil ifTrue:[''] ifFalse:[' - ', parameter printString])
+ errorString:(parameter isNil ifTrue:[nil] ifFalse:[' - ', parameter printString])
in:(thisContext sender).
"/ ^ self errorReporter reportOn:self
@@ -406,18 +412,19 @@
!OSErrorHolder class methodsFor:'documentation'!
version
- ^ '$Id: OSErrorHolder.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: OSErrorHolder.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/OSErrorHolder.st,v 1.17 2009/10/06 08:31:33 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/OSErrorHolder.st,v 1.19 2010/07/22 18:11:49 stefan Exp '
!
version_SVN
- ^ '$Id: OSErrorHolder.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: OSErrorHolder.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
OSErrorHolder initialize!
+
--- a/Object.st Sun Aug 01 12:11:07 2010 +0100
+++ b/Object.st Tue Aug 10 09:55:15 2010 +0100
@@ -526,6 +526,7 @@
! !
+
!Object methodsFor:'Compatibility-Dolphin'!
stbFixup: anSTBInFiler at: newObjectIndex
@@ -575,18 +576,6 @@
self becomeSameAs:anotherObject
!
-caseOf:collectionOfKeyValuePairs otherwise:exceptionValue
- "as this is not compiled inline (for now), this is slow and only present for
- squeak compatibility"
-
- collectionOfKeyValuePairs do:[:eachPair |
- self = eachPair key value ifTrue:[
- ^ eachPair value value
- ].
- ].
- ^ exceptionValue value
-!
-
clone
^ self shallowCopy
!
@@ -699,6 +688,8 @@
"
! !
+
+
!Object methodsFor:'accessing'!
at:index
@@ -1866,6 +1857,7 @@
^ self
! !
+
!Object methodsFor:'comparing'!
= anObject
@@ -2075,7 +2067,7 @@
"compare the instance variables"
sz := myClass instSize.
- anObject instSize >= sz ifFalse:[^ false].
+ anObject class instSize >= sz ifFalse:[^ false].
1 to:sz do:[:i |
(self instVarAt:i) == (anObject instVarAt:i) ifFalse:[^ false].
@@ -2088,8 +2080,8 @@
(1@2) sameContentsAs:(1->2)
"
- "Created: / 21.4.1998 / 15:56:40 / cg"
- "Modified: / 21.4.1998 / 15:58:15 / cg"
+ "Created: / 21-04-1998 / 15:56:40 / cg"
+ "Modified: / 05-08-2010 / 16:44:09 / sr"
!
~= anObject
@@ -7199,6 +7191,7 @@
^ self
! !
+
!Object methodsFor:'secure message sending'!
askFor:aSelector
@@ -9335,15 +9328,16 @@
!Object class methodsFor:'documentation'!
version
- ^ '$Id: Object.st 10554 2010-07-22 14:39:35Z vranyj1 $'
+ ^ '$Id: Object.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/Object.st,v 1.650 2010/04/07 14:33:48 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/Object.st,v 1.651 2010/08/05 15:40:40 sr Exp '
!
version_SVN
- ^ '$Id: Object.st 10554 2010-07-22 14:39:35Z vranyj1 $'
+ ^ '$Id: Object.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
Object initialize!
+
--- a/ProcessorScheduler.st Sun Aug 01 12:11:07 2010 +0100
+++ b/ProcessorScheduler.st Tue Aug 10 09:55:15 2010 +0100
@@ -1273,7 +1273,21 @@
currentPriority := pri.
activeProcess := aProcess.
activeProcessId := id.
- ok := self threadSwitchFrom:oldProcess to:aProcess id:id singleStep:singleStep.
+
+ "
+ no interrupts now - activeProcess has already been changed
+ (dont add any message sends here)
+ "
+"/ ok := self threadSwitchFrom:oldProcess to:aProcess id:id singleStep:singleStep.
+%{
+ extern OBJ ___threadSwitch();
+
+ if (__isSmallInteger(id)) {
+ ok = ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0, 0);
+ } else {
+ ok = false;
+ }
+%}.
"time passes spent in some other process ...
... here again"
@@ -1284,62 +1298,44 @@
currentPriority := oldProcess priority.
ok == true ifFalse:[
- "
- switch failed for some reason -
- destroy (hard-terminate) the bad process.
- This happens when:
- - the stack went above the absolute limit
- (VM switches back to scheduler)
- - a halted process cannot execute its interrupt
- actions (win32 only)
- "
- (id := p id) ~~ 0 ifTrue:[
- id notNil ifTrue:[
- 'Processor [warning]: problem with process ' errorPrint.
- id errorPrint.
- (nm := p name) notNil ifTrue:[
- ' (' errorPrint. nm errorPrint. ')' errorPrint.
- ].
-
- ok == #halted ifTrue:[
- "/ that process was halted (win32 only)
- p state:#halted.
- '; stopped it.' errorPrintCR.
- self suspend:p.
- ] ifFalse:[
- '; hard-terminate it.' errorPrintCR.
- 'Processor [info]: cleanup may take a while if stack is huge' infoPrintCR.
- p state:#cleanup.
- self terminateNoSignal:p.
- ]
- ]
- ]
+ "
+ switch failed for some reason -
+ destroy (hard-terminate) the bad process.
+ This happens when:
+ - the stack went above the absolute limit
+ (VM switches back to scheduler)
+ - a halted process cannot execute its interrupt
+ actions (win32 only)
+ "
+ (id := p id) ~~ 0 ifTrue:[
+ id notNil ifTrue:[
+ 'Processor [warning]: problem with process ' errorPrint.
+ id errorPrint.
+ (nm := p name) notNil ifTrue:[
+ ' (' errorPrint. nm errorPrint. ')' errorPrint.
+ ].
+
+ ok == #halted ifTrue:[
+ "/ that process was halted (win32 only)
+ p state:#halted.
+ '; stopped it.' errorPrintCR.
+ self suspend:p.
+ ] ifFalse:[
+ '; hard-terminate it.' errorPrintCR.
+ 'Processor [info]: cleanup may take a while if stack is huge' infoPrintCR.
+ p state:#cleanup.
+ self terminateNoSignal:p.
+ ]
+ ]
+ ]
].
zombie notNil ifTrue:[
- self class threadDestroy:zombie.
- zombie := nil
+ self class threadDestroy:zombie.
+ zombie := nil
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-!
-
-threadSwitchFrom:oldProcess to:aProcess id:id singleStep:singleStep
- "continue execution in aProcess.
- WARNING: this is very a low level entry, no process administration is done here"
-
- "
- no interrupts now - activeProcess has already been changed
- (dont add any message sends here)
- "
- activeProcess := aProcess.
- activeProcessId := id.
-%{
- extern OBJ ___threadSwitch();
-
- if (__isSmallInteger(id)) {
- RETURN ( ___threadSwitch(__context, __intVal(id), (singleStep == true) ? 1 : 0, 0) );
- }
- RETURN (false);
-%}
+
+ "Modified: / 23-07-2010 / 10:32:11 / cg"
! !
!ProcessorScheduler methodsFor:'priority constants'!
@@ -2060,12 +2056,17 @@
wasBlocked := OperatingSystem blockInterrupts.
+ activeProcess == scheduler ifTrue:[
+ 'Processor [warning]: scheduler tries to yield' errorPrintCR.
+ ^ self
+ ].
+
"
debugging consistency check - will be removed later
"
activeProcess priority ~~ currentPriority ifTrue:[
- 'Processor [warning]: process changed its priority' errorPrintCR.
- currentPriority := activeProcess priority.
+ 'Processor [warning]: process changed its priority' errorPrintCR.
+ currentPriority := activeProcess priority.
].
l := quiescentProcessLists at:currentPriority.
@@ -2075,29 +2076,29 @@
debugging consistency checks - will be removed later
"
sz == 0 ifTrue:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- 'Processor [warning]: empty runnable list' errorPrintCR.
- ^ self
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ 'Processor [warning]: empty runnable list' errorPrintCR.
+ ^ self
].
"
check if the running process is not the only one
"
sz ~~ 1 ifTrue:[
- "
- bring running process to the end
- "
- l removeFirst.
- l addLast:activeProcess.
-
- "
- and switch to first in the list
- "
- self threadSwitch:(l first).
+ "
+ bring running process to the end
+ "
+ l removeFirst.
+ l addLast:activeProcess.
+
+ "
+ and switch to first in the list
+ "
+ self threadSwitch:(l first).
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- "Modified: 10.1.1997 / 18:04:35 / cg"
+ "Modified: / 02-08-2010 / 13:36:25 / cg"
! !
!ProcessorScheduler methodsFor:'scheduling-preemptive'!
@@ -3377,18 +3378,19 @@
!ProcessorScheduler class methodsFor:'documentation'!
version
- ^ '$Id: ProcessorScheduler.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: ProcessorScheduler.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.253 2010/02/09 19:05:37 stefan Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.255 2010/08/02 11:36:55 cg Exp '
!
version_SVN
- ^ '$Id: ProcessorScheduler.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: ProcessorScheduler.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
ProcessorScheduler initialize!
+
--- a/ProgrammingLanguage.st Sun Aug 01 12:11:07 2010 +0100
+++ b/ProgrammingLanguage.st Tue Aug 10 09:55:15 2010 +0100
@@ -92,17 +92,17 @@
!
named: aString
- ^ self
- instancesDetect:[:each | each name = aString ]
- ifNone: [ self error: 'No language named ' , aString ].
+ ^ self named:aString ifNone:[ self error: 'No language named ' , aString ].
"
- ProgrammingLanguage named: 'Smalltalk'
-
- ProgrammingLanguage named: 'Ruby'"
+ ProgrammingLanguage named: 'Smalltalk'
+ ProgrammingLanguage named: 'JavaScript'
+ ProgrammingLanguage named: 'Ruby'
+ "
"Created: / 15-08-2009 / 22:40:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 16-08-2009 / 10:58:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 04-08-2010 / 12:06:38 / cg"
!
named: aString ifNone: aBlock
@@ -413,15 +413,16 @@
!ProgrammingLanguage class methodsFor:'documentation'!
version
- ^ '$Id: ProgrammingLanguage.st 10551 2010-07-21 15:52:22Z vranyj1 $'
+ ^ '$Id: ProgrammingLanguage.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ProgrammingLanguage.st,v 1.10 2009/12/04 11:21:32 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ProgrammingLanguage.st,v 1.12 2010/08/04 10:06:44 cg Exp §'
!
version_SVN
- ^ '$Id: ProgrammingLanguage.st 10551 2010-07-21 15:52:22Z vranyj1 $'
+ ^ '$Id: ProgrammingLanguage.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
ProgrammingLanguage initialize!
+
--- a/ProjectDefinition.st Sun Aug 01 12:11:07 2010 +0100
+++ b/ProjectDefinition.st Tue Aug 10 09:55:15 2010 +0100
@@ -264,6 +264,7 @@
stx_libview2 allPreRequisites
ubs_application allPreRequisites
ubs_application allPreRequisitesSorted
+ exept_expecco_application allPreRequisites
exept_expeccoNET_application allPreRequisites
alspa_batch_application allPreRequisites
"
@@ -3821,10 +3822,12 @@
@REM type vcmake, and wait...
@REM do not edit - automatically generated from ProjectDefinition
@REM -------
-make.exe -N -f bc.mak USEVC=1 %%1 %%2
+make.exe -N -f bc.mak -DUSEVC %%1 %%2
%(SUBPROJECT_VCMAKE_CALLS)
'
+
+ "Modified: / 26-07-2010 / 12:25:44 / cg"
! !
!ProjectDefinition class methodsFor:'loading'!
@@ -4159,7 +4162,9 @@
cls := (Smalltalk at:eachName asSymbol).
cls isBehavior ifFalse:[
- self warn:'Missing/invalid class: ',eachName.
+ self warn:('Missing/invalid class: %1\\%2'
+ bindWith:eachName
+ with:('Warning: The class is skipped in the list of compiled classes.' allBold)).
cls := nil.
].
cls
@@ -4168,7 +4173,7 @@
"Created: / 09-08-2006 / 16:28:15 / fm"
"Modified: / 09-08-2006 / 18:02:28 / fm"
- "Modified: / 09-11-2007 / 17:37:39 / cg"
+ "Modified: / 26-07-2010 / 12:00:10 / cg"
!
cvsRevision
@@ -5590,17 +5595,18 @@
!ProjectDefinition class methodsFor:'documentation'!
version
- ^ '$Id: ProjectDefinition.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: ProjectDefinition.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.313 2010/05/12 08:55:22 stefan Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.316 2010/08/05 12:04:44 stefan Exp '
!
version_SVN
- ^ '$Id: ProjectDefinition.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: ProjectDefinition.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
ProjectDefinition initialize!
+
--- a/SequenceableCollection.st Sun Aug 01 12:11:07 2010 +0100
+++ b/SequenceableCollection.st Tue Aug 10 09:55:15 2010 +0100
@@ -718,6 +718,37 @@
"
!
+atAllIndices:indexCollection
+ "return the elements at each index from indexCollection."
+
+ ^ indexCollection collect:[:eachIdx | self at:eachIdx].
+
+ "
+ 'abcdefghijklmnopqrstuvwxyz' atAllIndices:#( 8 5 12 12 15)
+ 'abcdefghijklmnopqrstuvwxyz' atAllIndices:( 5 to: 10)
+ "
+
+ "Created: / 08-08-2010 / 01:15:06 / cg"
+!
+
+atIndex:index
+ "return an element at a given index. This allows for seqentialCollections
+ and orderedDictionaries to be both accessed via a numeric index."
+
+ ^ self at:index
+
+ "Created: / 08-08-2010 / 00:50:10 / cg"
+!
+
+atIndex:index put:newValue
+ "return an element at a given index. This allows for seqentialCollections
+ and orderedDictionaries to be both accessed via a numeric index."
+
+ ^ self at:index put:newValue
+
+ "Created: / 08-08-2010 / 00:50:27 / cg"
+!
+
before:anObject
"return the element before the argument, anObject.
If anObject is not in the receiver, report an error;
@@ -7801,15 +7832,15 @@
!SequenceableCollection class methodsFor:'documentation'!
version
- ^ '$Id: SequenceableCollection.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: SequenceableCollection.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.297 2010/07/10 22:01:19 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.298 2010/08/07 23:16:59 cg Exp '
!
version_SVN
- ^ '$Id: SequenceableCollection.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: SequenceableCollection.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
SequenceableCollection initialize!
@@ -7817,3 +7848,4 @@
+
--- a/Set.st Sun Aug 01 12:11:07 2010 +0100
+++ b/Set.st Tue Aug 10 09:55:15 2010 +0100
@@ -340,6 +340,23 @@
"Modified: 30.1.1997 / 14:58:08 / cg"
!
+addAllNonNilElements:aCollection
+ "add all non-nil elements of the argument, aCollection to the receiver.
+ Use this, when operating on a Set, that cannot hold nil.
+ Answer the argument, aCollection (sigh)."
+
+ aCollection do:[:eachElement |
+ eachElement notNil ifTrue:[
+ self add:eachElement
+ ].
+ ].
+ ^ aCollection
+
+ "
+ #(1 2 3 4) asSet addAllNonNilElements:#(5 nil 6 7 8)
+ "
+!
+
remove:oldObject ifAbsent:exceptionBlock
"remove oldObject from the collection and return it.
If it was not in the collection return the value of exceptionBlock.
@@ -393,13 +410,13 @@
In contrast to #remove:, this does not resize the underlying collection
and therefore does NOT rehash & change the elements order.
- Therefor this can be used while enumerating the receiver,
+ Therefore this can be used while enumerating the receiver,
which is not possible if #remove: is used.
WARNING: since no resizing is done, the physical amount of memory used
- by the container remains the same, although the logical size shrinks.
- You may want to manually resize the receiver using #emptyCheck.
- (after the loop)"
+ by the container remains the same, although the logical size shrinks.
+ You may want to manually resize the receiver using #emptyCheck.
+ (after the loop)"
|index "{ Class:SmallInteger }"
next "{ Class:SmallInteger }"
@@ -415,59 +432,59 @@
tally := tally - 1.
tally ~~ 0 ifTrue:[
- index == keyArray basicSize ifTrue:[
- next := 1
- ] ifFalse:[
- next := index + 1.
- ].
- (keyArray basicAt:next) notNil ifTrue:[
- keyArray basicAt:index put:DeletedEntry
- ].
+ index == keyArray basicSize ifTrue:[
+ next := 1
+ ] ifFalse:[
+ next := index + 1.
+ ].
+ (keyArray basicAt:next) notNil ifTrue:[
+ keyArray basicAt:index put:DeletedEntry
+ ].
].
^ removedObject
"does NOT work:
- |s|
+ |s|
- s := Set new.
- s add:1.
- s add:2.
- s add:3.
- s add:4.
- s add:5.
- s add:6.
- s add:7.
- s add:8.
- s add:9.
- s do:[:v |
- v odd ifTrue:[
- s remove:v
- ]
- ].
- s inspect
+ s := Set new.
+ s add:1.
+ s add:2.
+ s add:3.
+ s add:4.
+ s add:5.
+ s add:6.
+ s add:7.
+ s add:8.
+ s add:9.
+ s do:[:v |
+ v odd ifTrue:[
+ s remove:v
+ ]
+ ].
+ s inspect
"
"DOES work:
- |s|
+ |s|
- s := Set new.
- s add:1.
- s add:2.
- s add:3.
- s add:4.
- s add:5.
- s add:6.
- s add:7.
- s add:8.
- s add:9.
- s do:[:v |
- v odd ifTrue:[
- s saveRemove:v
- ]
- ].
- s inspect
+ s := Set new.
+ s add:1.
+ s add:2.
+ s add:3.
+ s add:4.
+ s add:5.
+ s add:6.
+ s add:7.
+ s add:8.
+ s add:9.
+ s do:[:v |
+ v odd ifTrue:[
+ s saveRemove:v
+ ]
+ ].
+ s inspect
"
"Created: / 1.3.1996 / 21:14:26 / cg"
@@ -1055,6 +1072,7 @@
^ tally
! !
+
!Set methodsFor:'testing'!
capacity
@@ -1156,18 +1174,19 @@
!Set class methodsFor:'documentation'!
version
- ^ '$Id: Set.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Set.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/Set.st,v 1.105 2010/02/26 10:53:48 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/Set.st,v 1.106 2010/07/23 19:40:09 stefan Exp '
!
version_SVN
- ^ '$Id: Set.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Set.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
Set initialize!
+
--- a/SharedPool.st Sun Aug 01 12:11:07 2010 +0100
+++ b/SharedPool.st Tue Aug 10 09:55:15 2010 +0100
@@ -82,16 +82,18 @@
"First look in classVar dictionary."
binding := self classPool bindingOf: aSymbol.
- binding ifNotNil:[^binding].
+ binding notNil ifTrue:[^binding].
"Next look in shared pools."
self sharedPools do:[:pool |
- binding := pool bindingOf: aSymbol.
- binding ifNotNil:[^binding].
+ binding := pool bindingOf: aSymbol.
+ binding notNil ifTrue:[^binding].
].
"subclassing and environment are not preserved"
^nil
+
+ "Modified: / 08-08-2010 / 14:46:09 / cg"
!
bindingsDo: aBlock
@@ -147,16 +149,17 @@
!SharedPool class methodsFor:'documentation'!
version
- ^ '$Id: SharedPool.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: SharedPool.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/SharedPool.st,v 1.8 2009/10/12 19:09:14 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/SharedPool.st,v 1.9 2010/08/08 12:46:20 cg Exp '
!
version_SVN
- ^ '$Id: SharedPool.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: SharedPool.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
+
--- a/SmallInteger.st Sun Aug 01 12:11:07 2010 +0100
+++ b/SmallInteger.st Tue Aug 10 09:55:15 2010 +0100
@@ -3526,13 +3526,14 @@
aStream nextPut:$r.
].
- (base between:2 and:36) ifTrue:[
+ (base isInteger and:[ base between:2 and:36 ]) ifTrue:[
aStream nextPutAll:(self printStringRadix:base)
] ifFalse:[
super printOn:aStream base:base showRadix:false.
].
- "Created: / 7.9.2001 / 13:54:40 / cg"
+ "Created: / 07-09-2001 / 13:54:40 / cg"
+ "Modified: / 02-08-2010 / 12:25:20 / cg"
!
printString
@@ -3917,17 +3918,18 @@
!SmallInteger class methodsFor:'documentation'!
version
- ^ '$Id: SmallInteger.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: SmallInteger.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.185 2010/04/13 18:58:23 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.186 2010/08/02 10:33:35 cg Exp '
!
version_SVN
- ^ '$Id: SmallInteger.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: SmallInteger.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
+
--- a/Smalltalk.st Sun Aug 01 12:11:07 2010 +0100
+++ b/Smalltalk.st Tue Aug 10 09:55:15 2010 +0100
@@ -1031,7 +1031,6 @@
"Created: 20.6.1997 / 16:58:28 / cg"
! !
-
!Smalltalk class methodsFor:'browsing'!
browseAllCallsOn:aSelectorSymbol
@@ -5784,16 +5783,20 @@
"Modified: 31.10.1996 / 16:57:24 / cg"
!
-secureFileIn:aFileName
+secureFileIn:aFileName
"read in the named file, looking for it at standard places.
- Catch any error during fileIn. Return true if ok, false if failed"
-
+ Catch various errors during fileIn.
+ Return true if ok, false if failed"
+
|retVal|
retVal := false.
- (SignalSet with:AbortOperationRequest with:TerminateProcessRequest)
- handle:[:ex | ex return ]
- do:[ retVal := self fileIn:aFileName ].
+ (SignalSet
+ with:AbortOperationRequest
+ with:TerminateProcessRequest
+ with:Parser parseErrorSignal)
+ handle:[:ex | ex return ]
+ do:[ retVal := self fileIn:aFileName ].
^ retVal
!
@@ -7462,15 +7465,15 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Id: Smalltalk.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Smalltalk.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.936 2010/05/07 12:37:03 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.937 2010/08/06 13:05:23 stefan Exp '
!
version_SVN
- ^ '$Id: Smalltalk.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Smalltalk.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
@@ -7483,3 +7486,4 @@
+
--- a/StandaloneStartup.st Sun Aug 01 12:11:07 2010 +0100
+++ b/StandaloneStartup.st Tue Aug 10 09:55:15 2010 +0100
@@ -163,22 +163,10 @@
self subclassResponsibility
!
-checkForAndExitIfAnotherApplicationInstanceIsRunning
- "if another instance of this application is running,
- send it an openFile command for my file-argument, and exit.
- (i.e. to let the already running application open up another window)."
-
- |shouldExit|
+shouldReuseRunningApplication
+ "answer true, if an already running application instance should be re-used"
- self isAnotherApplicationInstanceRunning ifTrue:[
- shouldExit := self processStartupOfASecondInstance.
- shouldExit ifTrue:[
- self releaseApplicationMutex.
- Smalltalk isStandAloneApp ifTrue:[
- Smalltalk exit.
- ]
- ].
- ].
+ ^ false
! !
!StandaloneStartup class methodsFor:'multiple applications support-helpers'!
@@ -214,6 +202,26 @@
^ applicationEntry
!
+checkForAndExitIfAnotherApplicationInstanceIsRunning
+ "if another instance of this application is running,
+ send it an openFile command for my file-argument, and exit.
+ (i.e. to let the already running application open up another window)."
+
+ |shouldExit|
+
+ self isAnotherApplicationInstanceRunning ifTrue:[
+ shouldExit := self processStartupOfASecondInstance.
+ shouldExit ifTrue:[
+ self releaseApplicationMutex.
+ Smalltalk isStandAloneApp ifTrue:[
+ Smalltalk exit.
+ ]
+ ].
+ ].
+
+ "Modified: / 03-08-2010 / 17:27:25 / cg"
+!
+
confirmOpenNewApplicationInstance
^ Dialog confirm: ('Continue opening a new instance of %1 or exit?' bindWith:self applicationName)
@@ -285,7 +293,7 @@
|currentIDStringFromRegistry currentIDFromRegistry fileArg commands aWindowId setForegroundWindowSucceeded|
- commands := Smalltalk commandLineArguments.
+ commands := CommandLineArguments.
currentIDStringFromRegistry := self getCurrentIDFromRegistry.
@@ -453,6 +461,49 @@
"Modified: / 19-09-2006 / 16:30:58 / cg"
!
+loadRemainingClassLibraries
+ "To speedup startup, we did not load all dll's (only a subset of non-GUI dll's is present).
+ Now, load all skipped libs (the ones marked with '*') from modules.stx."
+
+ |modulesFile dllDirectory dlls|
+
+ OperatingSystem isMSWINDOWSlike ifFalse:[^ self ].
+
+ self verboseInfo:'loadRemainingClassLibraries'.
+ modulesFile := self stxModulesFilename.
+ dllDirectory := modulesFile directory.
+
+ dlls := OrderedCollection new.
+
+ modulesFile readingLinesDo:[:eachModulesLine|
+ |basename dllFile|
+
+ basename := eachModulesLine withoutSeparators.
+
+ (basename notEmpty and:[basename first == $*]) ifTrue:[
+ basename := (basename copyFrom:2) withoutSeparators, '.dll'.
+ dllFile := dllDirectory construct:basename.
+
+ dllFile exists ifTrue:[
+"/ self verboseInfo:('loading: ', basename).
+ Smalltalk showSplashMessage:('loading ', basename).
+ dlls add:dllFile.
+ ] ifFalse:[
+ self verboseInfo:( '**** cannot resolve: ', basename).
+ ].
+ ].
+ ].
+
+ dlls notEmpty ifTrue:[
+ ObjectFileLoader loadObjectFiles:dlls.
+ Display notNil ifTrue:[
+ "New view classes may have been loaded - have to update their styles"
+ self verboseInfo:'update style caches of loaded dlls'.
+ SimpleView readStyleSheetAndUpdateAllStyleCaches.
+ ].
+ ].
+!
+
setupSmalltalkFromArguments:argv
"handle common command line arguments:
--help ............... print usage and exit
@@ -593,25 +644,68 @@
!
start
- CommandLineArguments := Smalltalk commandLineArguments.
+ GenericException handle:[:ex |
+ self verboseInfo:('Error during startup:').
+ self verboseInfo:(ex description).
+ Verbose == true ifTrue:[ex suspendedContext fullPrintAllLevels:10].
+ ex reject.
+ ] do:[
+ |idx|
+ self verboseInfo:('starting...').
+ CommandLineArguments := (self additionalArgumentsFromRegistry)
+ , Smalltalk commandLineArguments.
- self verboseInfo:('starting...').
- self verboseInfo:('args: ', CommandLineArguments asStringCollection asString).
+ self verboseInfo:('args: ', CommandLineArguments asStringCollection asString).
- Smalltalk isStandAloneApp ifTrue:[
- self loadPatches.
- self verboseInfo:('setup Smalltalk').
+ "--noRemote - do not reuse an existing application instance,
+ but run in a separate process"
+ idx := CommandLineArguments indexOfAny:#('--noRemote').
+ idx == 0 ifTrue:[
+ self shouldReuseRunningApplication ifTrue:[
+ "Multiple Application support:
+ if another expecco is running, ask it to open another window for me.
+ If that is the case, the following function will not return, but instead exit."
+ self checkForAndExitIfAnotherApplicationInstanceIsRunning.
+ ].
+ ] ifFalse:[
+ CommandLineArguments removeAtIndex:idx.
+ Verbose := true.
+ ].
+
+ "/ Arrive here, if no other application is running.
+ "/ to speedup startup, we did not load all dll's (only a subset of non-GUI dll's is present).
+ "/ now, load all skipped libs from modules.stx.
+ self loadRemainingClassLibraries.
+
+ Smalltalk isStandAloneApp ifTrue:[
+ self loadPatches.
+ self verboseInfo:('setup Smalltalk').
+ ].
+ self setupSmalltalkFromArguments:CommandLineArguments.
+ self main
].
- self setupSmalltalkFromArguments:CommandLineArguments.
- self main
- "Modified: / 31-10-2007 / 16:03:44 / cg"
+ "Modified: / 04-08-2010 / 12:30:05 / cg"
!
startStartBlockProcess
Smalltalk startStartBlockProcess
!
+stxModulesFilename
+ "answer the Filename of modules.stx"
+
+ |file|
+
+ file := 'modules.stx' asFilename.
+ file exists ifTrue:[^ file].
+
+ file := OperatingSystem pathOfSTXExecutable asFilename directory construct:'modules.stx'.
+ file exists ifTrue:[^ file].
+
+ self error:'cannot find: modules.stx'.
+!
+
usage
Stderr nextPutLine:'usage:'.
Stderr nextPutLine:' ',self applicationName,' [options...]'.
@@ -619,6 +713,9 @@
Stderr nextPutLine:' --help .................. output this message'.
Stderr nextPutLine:' --verbose ............... verbose startup'.
Stderr nextPutLine:' --noBanner .............. no splash screen'.
+ self shouldReuseRunningApplication ifTrue:[
+ Stderr nextPutLine:' --noRemote .............. start as an own application process and do not reuse a running instance'.
+ ].
self allowScriptingOption ifTrue:[
Stderr nextPutLine:' --scripting portNr ...... enable scripting via port (or stdin/stdOut, if 0)'.
].
@@ -634,6 +731,15 @@
!StandaloneStartup class methodsFor:'startup-to be redefined'!
+additionalArgumentsFromRegistry
+ "can be redefined to fetch and return additional arguments from the registry
+ (or other .ini file). These are added to the beginning of the command line arguments."
+
+ ^ #()
+
+ "Created: / 04-08-2010 / 12:20:27 / cg"
+!
+
isHeadless
"this is invoked early by Smalltalk>>mainStartup, to ask if I like to
have a Display or if I am a non-GUI headless application.
@@ -692,18 +798,19 @@
!StandaloneStartup class methodsFor:'documentation'!
version
- ^ '$Id: StandaloneStartup.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: StandaloneStartup.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.43 2010/07/07 23:05:21 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.50 2010/08/06 10:51:41 stefan Exp '
!
version_SVN
- ^ '$Id: StandaloneStartup.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: StandaloneStartup.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
StandaloneStartup initialize!
+
--- a/UndefinedObject.st Sun Aug 01 12:11:07 2010 +0100
+++ b/UndefinedObject.st Tue Aug 10 09:55:15 2010 +0100
@@ -208,10 +208,11 @@
!UndefinedObject methodsFor:'dependents access'!
addDependent:someObject
- "raise an error here - nil may not have dependents"
+ "raise an error here - nil may not have dependents (it never changes anyway)"
self error:'nil may not have dependents' mayProceed:true
+ "Modified: / 28-07-2010 / 19:20:36 / cg"
!
dependents
@@ -228,6 +229,7 @@
"ignored here - nil has no dependents"
! !
+
!UndefinedObject methodsFor:'error catching'!
basicAt:index
@@ -289,6 +291,7 @@
^ 0
! !
+
!UndefinedObject methodsFor:'subclass creation'!
nilSubclass:action
@@ -688,11 +691,16 @@
!UndefinedObject class methodsFor:'documentation'!
version
- ^ '$Id: UndefinedObject.st 10517 2010-04-26 18:26:38Z vranyj1 $'
+ ^ '$Id: UndefinedObject.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_SVN
- ^ '$Id: UndefinedObject.st 10517 2010-04-26 18:26:38Z vranyj1 $'
+ ^ '$Id: UndefinedObject.st 10564 2010-08-10 08:55:15Z vranyj1 $'
+!
+
+version_CVS
+ ^ 'Header: /cvs/stx/stx/libbasic/UndefinedObject.st,v 1.71 2010/07/28 17:20:51 cg Exp '
! !
UndefinedObject initialize!
+
--- a/UnixOperatingSystem.st Sun Aug 01 12:11:07 2010 +0100
+++ b/UnixOperatingSystem.st Tue Aug 10 09:55:15 2010 +0100
@@ -6481,43 +6481,32 @@
!
getHostName
- "return the hostname we are running on - if there is
- a HOST environment variable, we are much faster here ...
- Notice:
- not all systems support this; on some, 'unknown' is returned."
-
- |hostName idx shouldCacheHostName|
+ "return the hostname we are running on.
+ The host name returned is fully qualified - if returned so by the system."
+
+ |hostName|
HostName notNil ifTrue:[
- ^ HostName
- ].
-
- shouldCacheHostName := false.
+ ^ HostName
+ ].
+
hostName := self primGetHostName.
hostName isNil ifTrue:[
- "fallBack - in non-antique systes we never come here"
- hostName := self getEnvironment:'HOST'.
- hostName isNil ifTrue:[
- hostName := self getCommandOutputFrom:'/bin/hostname'
- ].
- hostName isNil ifTrue:[
- 'UnixOperatingSystem [warning]: cannot find out hostname' errorPrintCR.
- hostName := 'unknown'.
- ].
- shouldCacheHostName := true.
- ].
-
- "on some systems, the host already contains the domain.
- decompose it here."
- idx := hostName indexOf:$..
- idx ~~ 0 ifTrue:[
- hostName := hostName copyTo:(idx-1).
- ].
- shouldCacheHostName ifTrue:[
- "only cache, if hostname fetching is expensive, otherwise we want to see a changed hostname"
- HostName := hostName.
- ].
+ "fallBack - in non-antique systes we never come here"
+ hostName := self getEnvironment:'HOST'.
+ hostName isNil ifTrue:[
+ hostName := self getCommandOutputFrom:'/bin/hostname'
+ ].
+ hostName isNil ifTrue:[
+ 'UnixOperatingSystem [warning]: cannot find out hostname' errorPrintCR.
+ hostName := 'unknown'.
+ ].
+ "cache, only because hostname fetching was expensive,
+ otherwise we want to see a changed hostname"
+ HostName := hostName.
+ ].
+
^ hostName
"
@@ -7188,7 +7177,7 @@
rel = __MKSTRING(ubuff.release);
ver = __MKSTRING(ubuff.version);
mach = __MKSTRING(ubuff.machine);
-# ifdef HAS_UTS_DOMAINNAME
+# if defined(HAS_UTS_DOMAINNAME) || defined(_GNU_SOURCE)
dom = __MKSTRING(ubuff.domainname);
# endif /* no HAS_UTS_DOMAINNAME */
}
@@ -7243,16 +7232,6 @@
# endif /* SI_RELEASE */
#endif /* HAS_SYSINFO */
-#if defined(HAS_GETDOMAINNAME)
- if (dom == nil) {
- char buffer[128];
-
- if (getdomainname(buffer, sizeof(buffer)) == 0) {
- dom = __MKSTRING(buffer);
- }
- }
-#endif /* HAS_GETDOMAINNAME */
-
#if defined(HAS_SYSCONF)
# ifdef _SC_NPROCESSORS_ONLN
{
@@ -7759,21 +7738,21 @@
%{
# ifdef NEXT
-# define SYS_STRING "next"
+# define SYS_SYMBOL @symbol(next)
# endif
# ifdef IRIS
-# define SYS_STRING "iris"
+# define SYS_SYMBOL @symbol(iris)
# endif
-# ifdef SYS_STRING
- sys = __MKSTRING(SYS_STRING);
-# undef SYS_STRING
+# ifdef SYS_SYMBOL
+ sys = SYS_SYMBOL;
+# undef SYS_SYMBOL
# endif
%}.
sys isNil ifTrue:[
- ^ self getOSType
+ ^ self getOSType
].
^ sys
@@ -11287,7 +11266,7 @@
serviceName := serviceNameArg printString. "convert integer port numbers"
].
-%{ /* STACK: 100000 */ /* Don't know whether DNS, NIS, LDAP or whatever is consulted */
+%{ /* STACK: 200000 */ /* Don't know whether DNS, NIS, LDAP or whatever is consulted */
#undef xxAI_NUMERICHOST /* remove xx to test gethost...() path */
@@ -12721,15 +12700,15 @@
!UnixOperatingSystem class methodsFor:'documentation'!
version
- ^ '$Id: UnixOperatingSystem.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: UnixOperatingSystem.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.274 2010/04/12 18:37:20 stefan Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.276 2010/07/27 09:08:07 stefan Exp '
!
version_SVN
- ^ '$Id: UnixOperatingSystem.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: UnixOperatingSystem.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
UnixOperatingSystem initialize!
@@ -12738,3 +12717,4 @@
+
--- a/WeakArray.st Sun Aug 01 12:11:07 2010 +0100
+++ b/WeakArray.st Tue Aug 10 09:55:15 2010 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1991 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
@@ -23,7 +23,7 @@
copyright
"
COPYRIGHT (c) 1991 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
@@ -72,18 +72,18 @@
A weakArray notifies its dependents via normal dependency notfications.
[hint:]
- WeakArray handling adds small some overhead to the VM
- (each weakarray is scanned after each GC).
- It is uncertain, if the current mechanism works well
- with (say) ten-thousands of weakArrays.
- We had the system running with >2000 weakArrays, some being quite
- big for a while and had a few percent of added gc time.
- The system as delivered creates between 50 and 100 weakArrays,
- but with many dependents, this number may grow.
- If you need the dependency mechanism on a huge number of objects,
- consider adding a (non-weak) dependents field to your class
- - take the implementation of Model as a guide (or subclass them
- from Model).
+ WeakArray handling adds small some overhead to the VM
+ (each weakarray is scanned after each GC).
+ It is uncertain, if the current mechanism works well
+ with (say) ten-thousands of weakArrays.
+ We had the system running with >2000 weakArrays, some being quite
+ big for a while and had a few percent of added gc time.
+ The system as delivered creates between 50 and 100 weakArrays,
+ but with many dependents, this number may grow.
+ If you need the dependency mechanism on a huge number of objects,
+ consider adding a (non-weak) dependents field to your class
+ - take the implementation of Model as a guide (or subclass them
+ from Model).
As a possible option, we could perform the weakArray scanning only in
the oldSpace reclamation code - this would remove most of the overhead,
@@ -92,27 +92,27 @@
[instance variables:]
- dependents get informed via #change notifiction
- that the weakArray has lost pointers.
- Having the dependents here is an optimization.
+ dependents get informed via #change notifiction
+ that the weakArray has lost pointers.
+ Having the dependents here is an optimization.
[class variables:]
- RegistrationFailedSignal raised if a weakArray cannot be
- registered by the VM. This only happens,
- if the VM has to resize its internal tables
- and is running out of malloc-memory.
+ RegistrationFailedSignal raised if a weakArray cannot be
+ registered by the VM. This only happens,
+ if the VM has to resize its internal tables
+ and is running out of malloc-memory.
[memory requirements:]
- OBJ-HEADER + (size * ptr-size) + ptr-size
- + sizeof(dependents-collection)
+ OBJ-HEADER + (size * ptr-size) + ptr-size
+ + sizeof(dependents-collection)
[author:]
- Claus Gittinger
+ Claus Gittinger
[See also:]
- Array WeakIdentitySet WeakIdentityDictionary Registry
- Model
+ Array WeakIdentitySet WeakIdentityDictionary Registry
+ Model
"
! !
@@ -122,9 +122,9 @@
"setup the private signal"
RegistrationFailedSignal isNil ifTrue:[
- RegistrationFailedSignal := Error newSignalMayProceed:true.
- RegistrationFailedSignal nameClass:self message:#registrationFailedSignal.
- RegistrationFailedSignal notifierString:'weakArray registration failed'.
+ RegistrationFailedSignal := Error newSignalMayProceed:true.
+ RegistrationFailedSignal nameClass:self message:#registrationFailedSignal.
+ RegistrationFailedSignal notifierString:'weakArray registration failed'.
]
! !
@@ -145,8 +145,8 @@
from the start.]"
AlreadyInitialized isNil ifTrue:[
- self flags:(Behavior flagWeakPointers).
- AlreadyInitialized := true
+ self flags:(Behavior flagWeakPointers).
+ AlreadyInitialized := true
].
^ (super basicNew:size) registerAsWeakArray
@@ -177,71 +177,71 @@
ok = __addShadowObject(self, 0);
if (ok == false) {
- /*
- * the behavior of __addShadowObject() in case of overflowing
- * VM-table space can be controlled by the second argument:
- * if its 0, the weakObject is not registered, and false
- * is returned.
- * if its 1, the tables are reallocated, registration proceeds,
- * and true is returned.
- * This allows for the caller to have an influence on the VM's
- * shadow table allocation.
- *
- * If addShadowObject() returned false, too many shadow objects are
- * already there. Then collect garbage to get rid of
- * obsolete ones, and try again.
- * Since a full collect is expensive, we try
- * a scavenge first, doing a full collect only if
- * that does not help.
- *
- * THIS MAY OR MAY NOT BE A GOOD IDEA: although it reduces
- * the number of shadow objects that have to be
- * processed at GC time, it may create a long delay here,
- * at shadow object creation time.
- * Dont know which is better ...
- */
- __nonTenuringScavenge(__context);
- ok = __addShadowObject(self, 0);
+ /*
+ * the behavior of __addShadowObject() in case of overflowing
+ * VM-table space can be controlled by the second argument:
+ * if its 0, the weakObject is not registered, and false
+ * is returned.
+ * if its 1, the tables are reallocated, registration proceeds,
+ * and true is returned.
+ * This allows for the caller to have an influence on the VM's
+ * shadow table allocation.
+ *
+ * If addShadowObject() returned false, too many shadow objects are
+ * already there. Then collect garbage to get rid of
+ * obsolete ones, and try again.
+ * Since a full collect is expensive, we try
+ * a scavenge first, doing a full collect only if
+ * that does not help.
+ *
+ * THIS MAY OR MAY NOT BE A GOOD IDEA: although it reduces
+ * the number of shadow objects that have to be
+ * processed at GC time, it may create a long delay here,
+ * at shadow object creation time.
+ * Dont know which is better ...
+ */
+ __nonTenuringScavenge(__context);
+ ok = __addShadowObject(self, 0);
- if (ok == false) {
- /*
- * hard stuff - need full collect
- * if this is the very first GC, assume that we are in
- * the startup phase (where all weak stuff is allocated).
- * Then do no GC.
- * Heuristics showed, that this GC does not find much ...
- */
- if ((__garbageCollectCount() != 0)
- || (__incrementalGCCount() != 0)) {
- __markAndSweepIfUseful(__context);
- ok = __addShadowObject(self, 0);
- }
- if (ok == false) {
- /*
- * mhmh - it seems that there are really many shadow
- * objects around - force creation
- */
- ok = __addShadowObject(self, 1);
- if (ok == false) {
- /*
- * no chance - something must be wrong
- * lets fall into the exception and see.
- */
- }
- }
- }
+ if (ok == false) {
+ /*
+ * hard stuff - need full collect
+ * if this is the very first GC, assume that we are in
+ * the startup phase (where all weak stuff is allocated).
+ * Then do no GC.
+ * Heuristics showed, that this GC does not find much ...
+ */
+ if ((__garbageCollectCount() != 0)
+ || (__incrementalGCCount() != 0)) {
+ __markAndSweepIfUseful(__context);
+ ok = __addShadowObject(self, 0);
+ }
+ if (ok == false) {
+ /*
+ * mhmh - it seems that there are really many shadow
+ * objects around - force creation
+ */
+ ok = __addShadowObject(self, 1);
+ if (ok == false) {
+ /*
+ * no chance - something must be wrong
+ * lets fall into the exception and see.
+ */
+ }
+ }
+ }
}
%}.
ok ifFalse:[
- "
- the VM was not able to register the new weakArray
- This can only happen, if the VM has to resize its tables,
- and a malloc request failed. Usually, this smells like big
- trouble being on the way (soon running out of memory in
- other places as well).
- Configure your OS for more swap space.
- "
- ^ RegistrationFailedSignal raiseRequestWith:self
+ "
+ the VM was not able to register the new weakArray
+ This can only happen, if the VM has to resize its tables,
+ and a malloc request failed. Usually, this smells like big
+ trouble being on the way (soon running out of memory in
+ other places as well).
+ Configure your OS for more swap space.
+ "
+ ^ RegistrationFailedSignal raiseRequestWith:self
]
! !
@@ -275,18 +275,25 @@
OBJ el;
if (__isSmallInteger(index)) {
- indx = __intVal(index) - 1;
- if (indx >= 0) {
- nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
- indx += __intVal(__ClassInstPtr(__qClass(self))->c_ninstvars);
- if (indx < nIndex) {
- el = __InstPtr(self)->i_instvars[indx];
- if (__isNonNilObject(el)) {
- el = __WEAK_READ__(self, el);
- }
- RETURN (el);
- }
- }
+ indx = __intVal(index) - 1;
+ if (indx >= 0) {
+ nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
+ indx += __intVal(__ClassInstPtr(__qClass(self))->c_ninstvars);
+ if (indx < nIndex) {
+ el = __InstPtr(self)->i_instvars[indx];
+ if (__isNonNilObject(el)) {
+ el = __WEAK_READ__(self, el);
+#ifdef WEAK_DEBUG
+ if (! __ISVALIDOBJECT(el)) {
+ fprintf(stderr, "****** OOPS - invalid Weak-Read\n");
+ __dumpObject__(el);
+ el = nil;
+ }
+#endif
+ }
+ RETURN (el);
+ }
+ }
}
%}.
^ super basicAt:index
@@ -300,21 +307,21 @@
REGISTER unsigned int nIndex;
if (__isSmallInteger(index)) {
- indx = __intVal(index) - 1;
- if (indx >= 0) {
- nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
- indx += __intVal(__ClassInstPtr(__qClass(self))->c_ninstvars);
- if (indx < nIndex) {
- REGISTER OBJ el = someObject;
+ indx = __intVal(index) - 1;
+ if (indx >= 0) {
+ nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
+ indx += __intVal(__ClassInstPtr(__qClass(self))->c_ninstvars);
+ if (indx < nIndex) {
+ REGISTER OBJ el = someObject;
- __InstPtr(self)->i_instvars[indx] = el;
- if (__isNonNilObject(el)) {
- __STORE(self, el);
- __WEAK_WRITE__(self, el);
- }
- RETURN (el);
- }
- }
+ __InstPtr(self)->i_instvars[indx] = el;
+ if (__isNonNilObject(el)) {
+ __STORE(self, el);
+ __WEAK_WRITE__(self, el);
+ }
+ RETURN (el);
+ }
+ }
}
%}.
"/ for the error-message ...
@@ -342,7 +349,7 @@
false are copied in a deep copy."
index == 1 ifTrue:[
- ^ true "/ skip dependents
+ ^ true "/ skip dependents
].
^ false
@@ -357,35 +364,35 @@
wasBlocked := OperatingSystem blockInterrupts.
[
- |deps|
+ |deps|
- deps := dependents.
- "/
- "/ store the very first dependent directly in
- "/ the dependents instVar
- "/
- (deps isNil and:[anObject isCollection not]) ifTrue:[
- dependents := anObject
- ] ifFalse:[
- "/
- "/ store more dependents in the dependents collection
- "/
- deps isCollection ifTrue:[
- deps add:anObject
- ] ifFalse:[
- deps == anObject ifFalse:[
- deps isNil ifTrue:[
- dependents := (IdentitySet with:anObject)
- ] ifFalse:[
- dependents := (IdentitySet with:deps with:anObject)
- ]
- ]
- ]
- ]
+ deps := dependents.
+ "/
+ "/ store the very first dependent directly in
+ "/ the dependents instVar
+ "/
+ (deps isNil and:[anObject isCollection not]) ifTrue:[
+ dependents := anObject
+ ] ifFalse:[
+ "/
+ "/ store more dependents in the dependents collection
+ "/
+ deps isCollection ifTrue:[
+ deps add:anObject
+ ] ifFalse:[
+ deps == anObject ifFalse:[
+ deps isNil ifTrue:[
+ dependents := (IdentitySet with:anObject)
+ ] ifFalse:[
+ dependents := (IdentitySet with:deps with:anObject)
+ ]
+ ]
+ ]
+ ]
] ensure:[
- wasBlocked ifFalse:[
- OperatingSystem unblockInterrupts
- ]
+ wasBlocked ifFalse:[
+ OperatingSystem unblockInterrupts
+ ]
]
"Modified: 8.1.1997 / 23:40:30 / cg"
@@ -396,7 +403,7 @@
dependents isNil ifTrue:[^ #()].
dependents isCollection ifTrue:[
- ^ dependents
+ ^ dependents
].
^ IdentitySet with:dependents
@@ -409,11 +416,11 @@
|dep|
aCollection size == 1 ifTrue:[
- dep := aCollection first.
- dep isCollection ifFalse:[
- dependents := aCollection first.
- ^ self
- ]
+ dep := aCollection first.
+ dep isCollection ifFalse:[
+ dependents := aCollection first.
+ ^ self
+ ]
].
dependents := aCollection
!
@@ -425,11 +432,11 @@
deps := dependents.
deps notNil ifTrue:[
- deps isCollection ifTrue:[
- deps do:aBlock
- ] ifFalse:[
- aBlock value:deps
- ]
+ deps isCollection ifTrue:[
+ deps do:aBlock
+ ] ifFalse:[
+ aBlock value:deps
+ ]
]
!
@@ -445,31 +452,31 @@
wasBlocked := OperatingSystem blockInterrupts.
[
- |deps sz dep|
+ |deps sz dep|
- deps := dependents.
- deps notNil ifTrue:[
- deps isCollection ifTrue:[
- deps remove:anObject ifAbsent:[].
- (sz := deps size) == 0 ifTrue:[
- dependents := nil
- ] ifFalse:[
- sz == 1 ifTrue:[
- (dep := deps first) isCollection ifFalse:[
- dependents := dep
- ]
- ]
- ]
- ] ifFalse:[
- deps == anObject ifTrue:[
- dependents := nil
- ]
- ]
- ]
+ deps := dependents.
+ deps notNil ifTrue:[
+ deps isCollection ifTrue:[
+ deps remove:anObject ifAbsent:[].
+ (sz := deps size) == 0 ifTrue:[
+ dependents := nil
+ ] ifFalse:[
+ sz == 1 ifTrue:[
+ (dep := deps first) isCollection ifFalse:[
+ dependents := dep
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ deps == anObject ifTrue:[
+ dependents := nil
+ ]
+ ]
+ ]
] ensure:[
- wasBlocked ifFalse:[
- OperatingSystem unblockInterrupts
- ]
+ wasBlocked ifFalse:[
+ OperatingSystem unblockInterrupts
+ ]
]
! !
@@ -480,6 +487,8 @@
- reimplemented for IGC readBarrier.
You dont have to understand this."
+ |element|
+
%{
REGISTER int index;
unsigned int nIndex;
@@ -490,45 +499,50 @@
if (__isBlockLike(aBlock)
&& (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(1))) {
- {
- /*
- * the most common case: a static compiled block, with home on the stack ...
- */
- REGISTER OBJFUNC codeVal;
+ {
+ /*
+ * the most common case: a static compiled block, with home on the stack ...
+ */
+ REGISTER OBJFUNC codeVal;
- if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
- && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))) {
+ if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
+ && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))) {
#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
#else
# define BLOCK_ARG rHome
- REGISTER OBJ rHome;
+ REGISTER OBJ rHome;
- rHome = __BlockInstPtr(aBlock)->b_home;
- if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
+ rHome = __BlockInstPtr(aBlock)->b_home;
+ if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
#endif
- {
- for (; index < nIndex; index++) {
- OBJ element;
-
- if (InterruptPending != nil) __interruptL(@line);
+ {
+ for (; index < nIndex; index++) {
+ if (InterruptPending != nil) __interruptL(@line);
- element = __InstPtr(self)->i_instvars[index];
- if (__isNonNilObject(element)) {
- element = __WEAK_READ__(self, element);
- }
- (*codeVal)(BLOCK_ARG, element);
- }
- RETURN (self);
- }
- }
- }
+ element = __InstPtr(self)->i_instvars[index];
+ if (__isNonNilObject(element)) {
+ element = __WEAK_READ__(self, element);
+#ifdef WEAK_DEBUG
+ if (! __ISVALIDOBJECT(element)) {
+ fprintf(stderr, "****** OOPS - invalid Weak-Read\n");
+ __dumpObject__(element);
+ element = nil;
+ }
+#endif
+ }
+ (*codeVal)(BLOCK_ARG, element);
+ }
+ RETURN (self);
+ }
+ }
+ }
- /*
- * sorry, must check code-pointer in the loop
- * it could be recompiled or flushed
- */
+ /*
+ * sorry, must check code-pointer in the loop
+ * it could be recompiled or flushed
+ */
# undef BLOCK_ARG
#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
@@ -538,38 +552,44 @@
# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
#endif
- for (; index < nIndex; index++) {
- REGISTER OBJFUNC codeVal;
- OBJ element;
+ for (; index < nIndex; index++) {
+ REGISTER OBJFUNC codeVal;
- if (InterruptPending != nil) __interruptL(@line);
+ if (InterruptPending != nil) __interruptL(@line);
- element = __InstPtr(self)->i_instvars[index];
- if (__isNonNilObject(element)) {
- element = __WEAK_READ__(self, element);
- }
- if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
- (*codeVal)(BLOCK_ARG, element);
- } else {
- if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
- /*
- * arg is a compiled block with bytecode -
- * directly call interpreter without going through Block>>value
- */
+ element = __InstPtr(self)->i_instvars[index];
+ if (__isNonNilObject(element)) {
+ element = __WEAK_READ__(self, element);
+#ifdef WEAK_DEBUG
+ if (! __ISVALIDOBJECT(element)) {
+ fprintf(stderr, "****** OOPS - invalid Weak-Read\n");
+ __dumpObject__(element);
+ element = nil;
+ }
+#endif
+ }
+ if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
+ (*codeVal)(BLOCK_ARG, element);
+ } else {
+ if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
+ /*
+ * arg is a compiled block with bytecode -
+ * directly call interpreter without going through Block>>value
+ */
#ifdef PASS_ARG_POINTER
- __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &element);
+ __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &element);
#else
- __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, element);
+ __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, element);
#endif
- } else {
- /*
- * arg is something else - call it with #value
- */
- (*val.ilc_func)(aBlock, @symbol(value:), nil, &val, element);
- }
- }
- }
- RETURN (self);
+ } else {
+ /*
+ * arg is something else - call it with #value
+ */
+ (*val.ilc_func)(aBlock, @symbol(value:), nil, &val, element);
+ }
+ }
+ }
+ RETURN (self);
# undef BLOCK_ARG
# undef IBLOCK_ARG
@@ -580,23 +600,28 @@
* not a block - send it #value:
*/
for (; index < nIndex; index++) {
- OBJ element;
-
- if (InterruptPending != nil) __interruptL(@line);
+ if (InterruptPending != nil) __interruptL(@line);
- element = __InstPtr(self)->i_instvars[index];
- if (__isNonNilObject(element)) {
- element = __WEAK_READ__(self, element);
- }
- (*val.ilc_func)(aBlock,
- @symbol(value:),
- nil, &val,
- element);
+ element = __InstPtr(self)->i_instvars[index];
+ if (__isNonNilObject(element)) {
+ element = __WEAK_READ__(self, element);
+#ifdef WEAK_DEBUG
+ if (! __ISVALIDOBJECT(element)) {
+ fprintf(stderr, "****** OOPS - invalid Weak-Read\n");
+ __dumpObject__(element);
+ element = nil;
+ }
+#endif
+ }
+ (*val.ilc_func)(aBlock,
+ @symbol(value:),
+ nil, &val,
+ element);
}
RETURN (self);
%}.
^ super do:[:each |
- each ~~ nil ifTrue:[aBlock value:each]
+ each ~~ nil ifTrue:[aBlock value:each]
]
!
@@ -607,9 +632,9 @@
slots may change iff the garbage collector finds new garbage."
self keysAndValuesDo:[:index :element |
- element == 0 ifTrue:[
- aBlock value:index
- ]
+ element == 0 ifTrue:[
+ aBlock value:index
+ ]
]
"Modified: 25.1.1997 / 14:50:59 / cg"
@@ -626,10 +651,10 @@
slots may change iff the garbage collector finds new garbage."
self keysAndValuesDo:[:index :element |
- element == 0 ifTrue:[
- self at:index put:newValue.
- aBlock value:index.
- ]
+ element == 0 ifTrue:[
+ self at:index put:newValue.
+ aBlock value:index.
+ ]
]
"Modified: 25.1.1997 / 14:51:28 / cg"
@@ -645,6 +670,7 @@
nonNilElementsDo:aBlock
"evaluate the argument, aBlock for each non-nil element"
+ |element|
%{
REGISTER int index;
int nIndex;
@@ -654,52 +680,57 @@
nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
if (__isBlockLike(aBlock)
&& (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(1))) {
- {
- /*
- * the most common case: a static compiled block, with home on the stack ...
- */
- REGISTER OBJFUNC codeVal;
+ {
+ /*
+ * the most common case: a static compiled block, with home on the stack ...
+ */
+ REGISTER OBJFUNC codeVal;
- if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
- && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))) {
+ if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
+ && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))) {
#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
#else
# define BLOCK_ARG rHome
- REGISTER OBJ rHome;
+ REGISTER OBJ rHome;
- rHome = __BlockInstPtr(aBlock)->b_home;
- if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
+ rHome = __BlockInstPtr(aBlock)->b_home;
+ if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
#endif
- {
- for (; index < nIndex; index++) {
- REGISTER OBJ element;
-
- element = __InstPtr(self)->i_instvars[index];
- if (element) {
- if (InterruptPending != nil) {
- __interruptL(@line);
- element = __InstPtr(self)->i_instvars[index];
- }
+ {
+ for (; index < nIndex; index++) {
+ element = __InstPtr(self)->i_instvars[index];
+ if (element) {
+ if (InterruptPending != nil) {
+ __interruptL(@line);
+ element = __InstPtr(self)->i_instvars[index];
+ }
- if (__isNonNilObject(element)) {
- element = __WEAK_READ__(self, element);
- }
- if (element) {
- (*codeVal)(BLOCK_ARG, element);
- }
- }
- }
- RETURN (self);
- }
- }
- }
+ if (__isNonNilObject(element)) {
+ element = __WEAK_READ__(self, element);
+#ifdef WEAK_DEBUG
+ if (! __ISVALIDOBJECT(element)) {
+ fprintf(stderr, "****** OOPS - invalid Weak-Read\n");
+ __dumpObject__(element);
+ element = nil;
+ }
+#endif
+ }
+ if (element) {
+ (*codeVal)(BLOCK_ARG, element);
+ }
+ }
+ }
+ RETURN (self);
+ }
+ }
+ }
- /*
- * sorry, must check code-pointer in the loop
- * it could be recompiled or flushed
- */
+ /*
+ * sorry, must check code-pointer in the loop
+ * it could be recompiled or flushed
+ */
# undef BLOCK_ARG
#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
@@ -709,44 +740,50 @@
# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
#endif
- for (; index < nIndex; index++) {
- REGISTER OBJFUNC codeVal;
- OBJ element;
+ for (; index < nIndex; index++) {
+ REGISTER OBJFUNC codeVal;
- element = __InstPtr(self)->i_instvars[index];
- if (element) {
- if (InterruptPending != nil) {
- __interruptL(@line);
- element = __InstPtr(self)->i_instvars[index];
- }
- if (__isNonNilObject(element)) {
- element = __WEAK_READ__(self, element);
- }
- if (element) {
- if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
- (*codeVal)(BLOCK_ARG, element);
- } else {
- if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
- /*
- * arg is a compiled block with bytecode -
- * directly call interpreter without going through Block>>value
- */
+ element = __InstPtr(self)->i_instvars[index];
+ if (element) {
+ if (InterruptPending != nil) {
+ __interruptL(@line);
+ element = __InstPtr(self)->i_instvars[index];
+ }
+ if (__isNonNilObject(element)) {
+ element = __WEAK_READ__(self, element);
+#ifdef WEAK_DEBUG
+ if (! __ISVALIDOBJECT(element)) {
+ fprintf(stderr, "****** OOPS - invalid Weak-Read\n");
+ __dumpObject__(element);
+ element = nil;
+ }
+#endif
+ }
+ if (element) {
+ if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
+ (*codeVal)(BLOCK_ARG, element);
+ } else {
+ if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
+ /*
+ * arg is a compiled block with bytecode -
+ * directly call interpreter without going through Block>>value
+ */
#ifdef PASS_ARG_POINTER
- __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &element);
+ __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &element);
#else
- __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, element);
+ __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, element);
#endif
- } else {
- /*
- * arg is something else - call it with #value
- */
- (*val.ilc_func)(aBlock, @symbol(value:), nil, &val, element);
- }
- }
- }
- }
- }
- RETURN (self);
+ } else {
+ /*
+ * arg is something else - call it with #value
+ */
+ (*val.ilc_func)(aBlock, @symbol(value:), nil, &val, element);
+ }
+ }
+ }
+ }
+ }
+ RETURN (self);
# undef BLOCK_ARG
# undef IBLOCK_ARG
@@ -756,35 +793,41 @@
* not a block - send it #value:
*/
for (; index < nIndex; index++) {
- REGISTER OBJ element;
-
- element = __InstPtr(self)->i_instvars[index];
- if (element) {
- if (InterruptPending != nil) {
- __interruptL(@line);
- element = __InstPtr(self)->i_instvars[index];
- }
- if (__isNonNilObject(element)) {
- element = __WEAK_READ__(self, element);
- }
- if (element) {
- (*val.ilc_func)(aBlock,
- @symbol(value:),
- nil, &val,
- element);
- }
- }
+ element = __InstPtr(self)->i_instvars[index];
+ if (element) {
+ if (InterruptPending != nil) {
+ __interruptL(@line);
+ element = __InstPtr(self)->i_instvars[index];
+ }
+ if (__isNonNilObject(element)) {
+ element = __WEAK_READ__(self, element);
+#ifdef WEAK_DEBUG
+ if (! __ISVALIDOBJECT(element)) {
+ fprintf(stderr, "****** OOPS - invalid Weak-Read\n");
+ __dumpObject__(element);
+ element = nil;
+ }
+#endif
+ }
+ if (element) {
+ (*val.ilc_func)(aBlock,
+ @symbol(value:),
+ nil, &val,
+ element);
+ }
+ }
}
RETURN (self);
%}.
^ super do:[:each |
- each ~~ nil ifTrue:[aBlock value:each]
+ each ~~ nil ifTrue:[aBlock value:each]
]
!
validElementsDo:aBlock
"evaluate the argument, aBlock for each non-nil/non-zero element"
+ |element|
%{
REGISTER int index;
int nIndex;
@@ -794,52 +837,57 @@
nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
if (__isBlockLike(aBlock)
&& (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(1))) {
- {
- /*
- * the most common case: a static compiled block, with home on the stack ...
- */
- REGISTER OBJFUNC codeVal;
+ {
+ /*
+ * the most common case: a static compiled block, with home on the stack ...
+ */
+ REGISTER OBJFUNC codeVal;
- if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
- && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))) {
+ if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
+ && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))) {
#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
#else
# define BLOCK_ARG rHome
- REGISTER OBJ rHome;
+ REGISTER OBJ rHome;
- rHome = __BlockInstPtr(aBlock)->b_home;
- if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
+ rHome = __BlockInstPtr(aBlock)->b_home;
+ if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
#endif
- {
- for (; index < nIndex; index++) {
- REGISTER OBJ element;
-
- element = __InstPtr(self)->i_instvars[index];
- if (element && (element != __mkSmallInteger(0))) {
- if (InterruptPending != nil) {
- __interruptL(@line);
- element = __InstPtr(self)->i_instvars[index];
- }
+ {
+ for (; index < nIndex; index++) {
+ element = __InstPtr(self)->i_instvars[index];
+ if (element && (element != __mkSmallInteger(0))) {
+ if (InterruptPending != nil) {
+ __interruptL(@line);
+ element = __InstPtr(self)->i_instvars[index];
+ }
- if (__isNonNilObject(element)) {
- element = __WEAK_READ__(self, element);
- }
- if (element && (element != __mkSmallInteger(0))) {
- (*codeVal)(BLOCK_ARG, element);
- }
- }
- }
- RETURN (self);
- }
- }
- }
+ if (__isNonNilObject(element)) {
+ element = __WEAK_READ__(self, element);
+#ifdef WEAK_DEBUG
+ if (! __ISVALIDOBJECT(element)) {
+ fprintf(stderr, "****** OOPS - invalid Weak-Read\n");
+ __dumpObject__(element);
+ element = nil;
+ }
+#endif
+ }
+ if (element && (element != __mkSmallInteger(0))) {
+ (*codeVal)(BLOCK_ARG, element);
+ }
+ }
+ }
+ RETURN (self);
+ }
+ }
+ }
- /*
- * sorry, must check code-pointer in the loop
- * it could be recompiled or flushed
- */
+ /*
+ * sorry, must check code-pointer in the loop
+ * it could be recompiled or flushed
+ */
# undef BLOCK_ARG
#ifdef NEW_BLOCK_CALL
# define BLOCK_ARG aBlock
@@ -849,44 +897,50 @@
# define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
#endif
- for (; index < nIndex; index++) {
- REGISTER OBJFUNC codeVal;
- OBJ element;
+ for (; index < nIndex; index++) {
+ REGISTER OBJFUNC codeVal;
- element = __InstPtr(self)->i_instvars[index];
- if (element && (element != __mkSmallInteger(0))) {
- if (InterruptPending != nil) {
- __interruptL(@line);
- element = __InstPtr(self)->i_instvars[index];
- }
- if (__isNonNilObject(element)) {
- element = __WEAK_READ__(self, element);
- }
- if (element && (element != __mkSmallInteger(0))) {
- if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
- (*codeVal)(BLOCK_ARG, element);
- } else {
- if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
- /*
- * arg is a compiled block with bytecode -
- * directly call interpreter without going through Block>>value
- */
+ element = __InstPtr(self)->i_instvars[index];
+ if (element && (element != __mkSmallInteger(0))) {
+ if (InterruptPending != nil) {
+ __interruptL(@line);
+ element = __InstPtr(self)->i_instvars[index];
+ }
+ if (__isNonNilObject(element)) {
+ element = __WEAK_READ__(self, element);
+#ifdef WEAK_DEBUG
+ if (! __ISVALIDOBJECT(element)) {
+ fprintf(stderr, "****** OOPS - invalid Weak-Read\n");
+ __dumpObject__(element);
+ element = nil;
+ }
+#endif
+ }
+ if (element && (element != __mkSmallInteger(0))) {
+ if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
+ (*codeVal)(BLOCK_ARG, element);
+ } else {
+ if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
+ /*
+ * arg is a compiled block with bytecode -
+ * directly call interpreter without going through Block>>value
+ */
#ifdef PASS_ARG_POINTER
- __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &element);
+ __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &element);
#else
- __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, element);
+ __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, element);
#endif
- } else {
- /*
- * arg is something else - call it with #value
- */
- (*val.ilc_func)(aBlock, @symbol(value:), nil, &val, element);
- }
- }
- }
- }
- }
- RETURN (self);
+ } else {
+ /*
+ * arg is something else - call it with #value
+ */
+ (*val.ilc_func)(aBlock, @symbol(value:), nil, &val, element);
+ }
+ }
+ }
+ }
+ }
+ RETURN (self);
# undef BLOCK_ARG
# undef IBLOCK_ARG
@@ -896,29 +950,34 @@
* not a block - send it #value:
*/
for (; index < nIndex; index++) {
- REGISTER OBJ element;
-
- element = __InstPtr(self)->i_instvars[index];
- if (element && (element != __mkSmallInteger(0))) {
- if (InterruptPending != nil) {
- __interruptL(@line);
- element = __InstPtr(self)->i_instvars[index];
- }
- if (__isNonNilObject(element)) {
- element = __WEAK_READ__(self, element);
- }
- if (element && (element != __mkSmallInteger(0))) {
- (*val.ilc_func)(aBlock,
- @symbol(value:),
- nil, &val,
- element);
- }
- }
+ element = __InstPtr(self)->i_instvars[index];
+ if (element && (element != __mkSmallInteger(0))) {
+ if (InterruptPending != nil) {
+ __interruptL(@line);
+ element = __InstPtr(self)->i_instvars[index];
+ }
+ if (__isNonNilObject(element)) {
+ element = __WEAK_READ__(self, element);
+#ifdef WEAK_DEBUG
+ if (! __ISVALIDOBJECT(element)) {
+ fprintf(stderr, "****** OOPS - invalid Weak-Read\n");
+ __dumpObject__(element);
+ element = nil;
+ }
+#endif
+ }
+ if (element && (element != __mkSmallInteger(0))) {
+ (*val.ilc_func)(aBlock,
+ @symbol(value:),
+ nil, &val,
+ element);
+ }
+ }
}
RETURN (self);
%}.
^ super do:[:each |
- (each ~~ nil and:[each ~~ 0]) ifTrue:[aBlock value:each]
+ (each ~~ nil and:[each ~~ 0]) ifTrue:[aBlock value:each]
]
! !
@@ -930,7 +989,7 @@
This is sent from the finalization code in ObjectMemory."
dependents notNil ifTrue:[
- self changed:#ElementExpired with:nil.
+ self changed:#ElementExpired with:nil.
].
"Modified: 18.10.1996 / 21:28:10 / cg"
@@ -948,11 +1007,12 @@
!WeakArray class methodsFor:'documentation'!
version
- ^ '$Id: WeakArray.st 10517 2010-04-26 18:26:38Z vranyj1 $'
+ ^ '$Id: WeakArray.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_SVN
- ^ '$Id: WeakArray.st 10517 2010-04-26 18:26:38Z vranyj1 $'
+ ^ '$Id: WeakArray.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
WeakArray initialize!
+
--- a/Win32OperatingSystem.st Sun Aug 01 12:11:07 2010 +0100
+++ b/Win32OperatingSystem.st Tue Aug 10 09:55:15 2010 +0100
@@ -4569,6 +4569,20 @@
^ false
!
+clearHidden:aPathName
+ "set the hidden attribute; Return true if the operation succeeded"
+
+ |attr|
+
+ attr := self primGetFileAttributes:aPathName.
+ (attr bitTest:FILE_ATTRIBUTE_HIDDEN ) ifTrue:[
+ ^ self primSetFileAttributes:aPathName to:(attr bitClear:2).
+ ].
+ ^ true
+
+ "Created: / 29-07-2010 / 11:31:55 / sr"
+!
+
compressPath:pathName
"return the pathName compressed - that is, remove all ..-entries
and . entries. This does not always (in case of symbolic links)
@@ -5866,15 +5880,17 @@
!
setHidden:aPathName
- "set the hidden attribute. Return true if it is set"
+ "set the hidden attribute. Return true if the operation succeeded"
|attr|
attr := self primGetFileAttributes:aPathName.
(attr bitTest:FILE_ATTRIBUTE_HIDDEN ) ifFalse:[
- ^ self primSetFileAttributes:aPathName to:(attr bitOr:2).
+ ^ self primSetFileAttributes:aPathName to:(attr bitOr:2).
].
^ true "/ aready set
+
+ "Modified: / 29-07-2010 / 11:32:26 / sr"
!
setNormal:aPathName
@@ -7029,35 +7045,36 @@
!Win32OperatingSystem class methodsFor:'mutex'!
createMutexNamed: name
-
"Returns an array with the handle and the lastErrorCode"
|handle lastErrorCode|
- "Without clear reasons, before creating the mutex we must call #printCR"
- 'Creating mutex' printCR.
+ "/ "Without clear reasons, before creating the mutex we must call #printCR"
+ "/ 'Creating mutex' printCR.
self primSetLastError: 0.
self primGetLastError.
handle := self primCreateMutex:nil initialOwner: true name: name.
lastErrorCode := self primGetLastError.
- lastErrorCode printCR.
+ "/ lastErrorCode printCR.
+
"/ self assert: lastErrorCode == 0.
"/ lastErrorCode == 5 "ERROR_ACCESS_DENIED" ifTrue:[Transcript showCR: 'Mutex not accesible (GetLastError = ERROR_ACCESS_DENIED)'.].
"/ lastErrorCode == 183 "ERROR_ALREADY_EXISTS" ifTrue:[Transcript showCR: 'Mutex already exists (GetLastError = ERROR_ALREADY_EXISTS)'.].
(handle isNil or:[handle address ~~ 0]) ifFalse:[
- Transcript showCR: 'CreateMutexNamed: "', name printString, '" failed'.
- handle := nil.
+ Transcript showCR: 'CreateMutexNamed: "', name printString, '" failed'.
+ handle := nil.
].
^ Array with: handle with: lastErrorCode
"
- self createMutexNamed: '8906f5e0-54ed-11dd-9da4-001558137da0'
- self releaseMutexNamed: '8906f5e0-54ed-11dd-9da4-001558137da0'
- "
+ self createMutexNamed: '8906f5e0-54ed-11dd-9da4-001558137da0'
+ self releaseMutexNamed: '8906f5e0-54ed-11dd-9da4-001558137da0'
+ "
+
+ "Modified: / 03-08-2010 / 16:57:36 / cg"
!
existsMutexNamed: name
-
|handle lastErrorCode handleAndLastErrorCode|
handleAndLastErrorCode := self createMutexNamed: name.
@@ -7065,17 +7082,16 @@
lastErrorCode := handleAndLastErrorCode second.
"/ self assert: lastErrorCode == 0.
^ handle isNil
- or:[lastErrorCode == 183 "ERROR_ALREADY_EXISTS"
- or:[ lastErrorCode == 5 "ERROR_ACCESS_DENIED"]]
+ or:[lastErrorCode == 183 "ERROR_ALREADY_EXISTS"
+ or:[ lastErrorCode == 5 "ERROR_ACCESS_DENIED"]]
+
+ "Modified: / 03-08-2010 / 16:59:41 / cg"
!
openMutexNamed: name
-
- "
- If the function succeeds, the return value is a handle to the mutex object.
- If the function fails, the return value is NULL. To get extended error information, call GetLastError.
- If a named mutex does not exist, the function fails and GetLastError returns ERROR_FILE_NOT_FOUND.
- "
+ "If the function succeeds, the return value is a handle to the mutex object.
+ If the function fails, the return value is NULL. To get extended error information, call GetLastError.
+ If a named mutex does not exist, the function fails and GetLastError returns ERROR_FILE_NOT_FOUND."
|handle |
@@ -7084,8 +7100,8 @@
"/ lastErrorCode = 2 ifTrue:[Transcript showCR: 'Mutex does not exist (GetLastError = ERROR_FILE_NOT_FOUND)'.].
"/ lastErrorCode = 5 ifTrue:[Transcript showCR: 'Mutex not accesible (GetLastError = ERROR_ACCESS_DENIED)'.].
(handle isNil or:[handle address ~~ 0]) ifFalse:[
- Transcript showCR: 'OpenMutexNamed: "', name printString, '" failed'.
- ^ nil.
+ Transcript showCR: 'OpenMutexNamed: "', name printString, '" failed'.
+ ^ nil.
].
^ handle
@@ -7094,84 +7110,86 @@
"
self openMutexNamed: '8906f5e0-54ed-11dd-9da4-001558137da0'
"
+
+ "Modified: / 03-08-2010 / 16:59:37 / cg"
!
primCreateMutex:lpSecurityDescriptor initialOwner: bInitialOwner name: lpName
-
- "
- If the function succeeds, the return value is a handle to the newly created mutex object.
+ "If the function succeeds, the return value is a handle to the newly created mutex object.
If the function fails, the return value is NULL.
- If the mutex is a named mutex and the object existed before this function call, the return value is a handle to the existing object.
- "
+ If the mutex is a named mutex and the object existed before this function call, the return value is a handle to the existing object."
<apicall: handle "CreateMutexA" (lpstr bool lpstr) module: "kernel32.dll" >
+
+ "Modified: / 03-08-2010 / 16:59:26 / cg"
!
primOpenMutex:lpSecurityDescriptor initialOwner: bInitialOwner name: lpName
-
- "
- If the function succeeds, the return value is a handle to the mutex object.
- If the function fails, the return value is NULL. To get extended error information, call GetLastError.
- If a named mutex does not exist, the function fails and GetLastError returns ERROR_FILE_NOT_FOUND.
- "
+ "If the function succeeds, the return value is a handle to the mutex object.
+ If the function fails, the return value is NULL. To get extended error information, call GetLastError.
+ If a named mutex does not exist, the function fails and GetLastError returns ERROR_FILE_NOT_FOUND."
<apicall: handle "OpenMutexA" (lpstr bool lpstr) module: "kernel32.dll" >
+
+ "Modified: / 03-08-2010 / 16:59:11 / cg"
!
primReleaseMutex: hMutex
-
- "
- If the function succeeds, the return value is nonzero.
- If the function fails, the return value is zero.
- "
+ "If the function succeeds, the return value is nonzero.
+ If the function fails, the return value is zero."
<apicall: bool "ReleaseMutex" (handle) module: "kernel32.dll" >
+
+ "Modified: / 03-08-2010 / 16:59:55 / cg"
!
primWaitForSingleObject: handle milliseconds: dwMilliseconds
-
- "
- If the function succeeds, the return value indicates the event that caused the function to return.
- If the function fails, the return value is WAIT_FAILED ((DWORD)0xFFFFFFFF).
- "
+ "If the function succeeds, the return value indicates the event that caused the function to return.
+ If the function fails, the return value is WAIT_FAILED ((DWORD)0xFFFFFFFF)."
<apicall: dword "WaitForSingleObject" (handle dword) module: "kernel32.dll" >
+
+ "Modified: / 03-08-2010 / 17:00:02 / cg"
!
releaseMutex: hMutex
-
"Returns true if the Mutex was released. Otherwise, returns false."
| released|
hMutex isNil ifTrue:[
- Transcript showCR: 'hMutex is nil - cannot release'.
- ^ false
+ Transcript showCR: 'hMutex is nil - cannot release'.
+ ^ false
].
released := self primReleaseMutex: hMutex.
released ifFalse:[Transcript showCR: 'Release Mutex failed'.].
^ released
+
+ "Modified: / 03-08-2010 / 17:00:05 / cg"
!
releaseMutexNamed: name
-
"Returns true if the Mutex was released. Otherwise, returns false."
| hMutex |
+
hMutex := self openMutexNamed: name.
hMutex isNil ifTrue:[
- Transcript showCR: 'Cannot release Mutex named: "', name printString,'"'.
- ^ false
+ Transcript showCR: 'Cannot release Mutex named: "', name printString,'"'.
+ ^ false
].
^ self releaseMutex: hMutex.
+
+ "Modified: / 03-08-2010 / 16:58:25 / cg"
!
waitForSingleObject: handle
-
|result|
result := self primWaitForSingleObject: handle milliseconds: 500.
^ result
+
+ "Modified: / 03-08-2010 / 17:00:10 / cg"
! !
!Win32OperatingSystem class methodsFor:'os queries'!
@@ -7186,57 +7204,57 @@
!
getDomainName
- "return the domain this host is in.
+ "return the DNS domain this host is in.
Notice:
- not all systems support this; on some, 'unknown' is returned."
-
- |name idx hostName k|
+ not all systems support this; on some, 'unknown' is returned."
+
+ |domainName idx hostName k|
DomainName notNil ifTrue:[
- ^ DomainName
- ].
-
- name := self getEnvironment:'DOMAIN'.
- name isNil ifTrue:[
- name := self getEnvironment:'DOMAINNAME'.
- ].
-
- name isNil ifTrue:[
- "/ sometimes, we can extract the domainName from the hostName ...
- hostName := self primGetHostName.
- hostName notNil ifTrue:[
- idx := hostName indexOf:$..
- idx ~~ 0 ifTrue:[
- name := hostName copyFrom:idx+1.
- ]
- ].
-
- name isNil ifTrue:[
- "/ ok, search the registry ...
- "/ under NT and later, it is found there ...
- k := RegistryEntry key:'HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters'.
- k notNil ifTrue:[
- name := k valueNamed:'Domain'.
- k close.
- ].
- ].
-
- name isNil ifTrue:[
- "/ under Win95/Win98, it is found there ...
- k := RegistryEntry key:'HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\VxD\MSTCP'.
- k notNil ifTrue:[
- name := k valueNamed:'Domain'.
- k close.
- ]
- ].
-
- name isNil ifTrue:[
- 'Win32OperatingSystem [warning]: cannot find out domainname' errorPrintCR.
- name := 'unknown'.
- ]
- ].
- DomainName := name.
- ^ name
+ ^ DomainName
+ ].
+
+ "/ sometimes, we can extract the domainName from the hostName ...
+ hostName := self getHostName.
+ hostName notEmptyOrNil ifTrue:[
+ idx := hostName indexOf:$..
+ idx ~~ 0 ifTrue:[
+ domainName := hostName copyFrom:idx+1.
+ ]
+ ].
+
+ domainName isNil ifTrue:[
+ domainName := self getEnvironment:'DOMAIN'.
+ domainName isNil ifTrue:[
+ domainName := self getEnvironment:'DOMAINNAME'.
+ ].
+
+ domainName isNil ifTrue:[
+ "/ ok, search the registry ...
+ "/ under NT and later, it is found there ...
+ k := RegistryEntry key:'HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters'.
+ k notNil ifTrue:[
+ domainName := k valueNamed:'Domain'.
+ k close.
+ ].
+ ].
+
+ domainName isNil ifTrue:[
+ "/ under Win95/Win98, it is found there ...
+ k := RegistryEntry key:'HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\VxD\MSTCP'.
+ k notNil ifTrue:[
+ domainName := k valueNamed:'Domain'.
+ k close.
+ ]
+ ].
+
+ domainName isNil ifTrue:[
+ 'Win32OperatingSystem [warning]: cannot find out domainName' errorPrintCR.
+ domainName := 'unknown'.
+ ].
+ DomainName := domainName. "cache only, if it is fixed"
+ ].
+ ^ domainName
"
DomainName := nil.
@@ -7294,28 +7312,20 @@
!
getHostName
- "return the hostname we are running on - if there is
- a HOST environment variable, we are much faster here ...
- Notice:
- not all systems support this; on some, 'unknown' is returned."
-
- |name idx|
-
- HostName notNil ifTrue:[
- ^ HostName
- ].
-
- name := self primGetHostName.
-
- "/ on some systems, the hostname already contains the domain.
- "/ decompose it here.
- idx := name indexOf:$..
- idx ~~ 0 ifTrue:[
- DomainName := name copyFrom:(idx+1).
- name := name copyTo:(idx-1).
- ].
- HostName := name.
- ^ name
+ "return the hostname we are running on
+ - if possible, the fully qualified host name."
+
+ |hostName|
+
+%{ /* STACK: 2048 */
+ char buffer[512];
+ DWORD buffSize = sizeof(buffer);
+
+ if (GetComputerNameEx(ComputerNameDnsFullyQualified, buffer, &buffSize) == TRUE) {
+ hostName = __MKSTRING(buffer);
+ }
+%}.
+ ^ hostName
"
OperatingSystem getHostName
@@ -7776,25 +7786,25 @@
This method is mainly provided to augment error reports with some system
information.
(in case of system/version specific OS errors, conditional workarounds and patches
- may be based upon this info).
+ may be based upon this info).
Your application should NOT depend upon this in any way.
The returned info may (or may not) contain:
- #system -> some operating system identification (irix, Linux, nt, win32s ...)
- #version -> OS version (some os version identification)
- #release -> OS release (3.5, 1.2.1 ...)
- #node -> some host identification (hostname)
- #domain -> domain name (hosts domain)
- #machine -> type of machine (i586, mips ...)
+ #system -> some operating system identification (irix, Linux, nt, win32s ...)
+ #version -> OS version (some os version identification)
+ #release -> OS release (3.5, 1.2.1 ...)
+ #node -> some host identification (hostname)
+ #domain -> domain name (hosts domain)
+ #machine -> type of machine (i586, mips ...)
win32:
- #physicalRam -> total amount of physical memory
- #freeRam -> amount of free memory
- #swapSize -> size of swapSpace (page file)
- #freeSwap -> free bytes in swapSpace
- #virtualRam -> total amount of virtual memory
- #freeVirtual -> amount of free virtual memory
- #memoryLoad -> percentage of memory usage (useless)
+ #physicalRam -> total amount of physical memory
+ #freeRam -> amount of free memory
+ #swapSize -> size of swapSpace (page file)
+ #freeSwap -> free bytes in swapSpace
+ #virtualRam -> total amount of virtual memory
+ #freeVirtual -> amount of free virtual memory
+ #memoryLoad -> percentage of memory usage (useless)
"
|sys node rel ver minorVer majorVer mach dom info arch
@@ -7820,19 +7830,21 @@
majorVer = __mkSmallInteger(verMajor);
if (HIWORD(vsn) & 0x8000) {
- s = "win95";
+ sys = @symbol(win95);
} else {
- if ((verMajor > 5)
- || ((verMajor == 5) && (verMinor >= 1))) {
- s = "xp";
- if (verMajor >= 6) {
- s = "vista";
- }
- } else {
- s = "nt";
- }
- }
- sys = __MKSTRING(s);
+ if ((verMajor > 5)
+ || ((verMajor == 5) && (verMinor >= 1))) {
+ sys = @symbol(xp);
+ if (verMajor >= 6) {
+ sys = @symbol(vista);
+ if (verMinor >= 1) {
+ sys = @symbol(win7);
+ }
+ }
+ } else {
+ sys = @symbol(nt);
+ }
+ }
len = snprintf(vsnBuffer, sizeof(vsnBuffer), "%d.%d", verMajor, verMinor);
rel = __MKSTRING_L(vsnBuffer, len);
@@ -7857,166 +7869,155 @@
#endif
{
#ifdef PROCESSOR_ARCHITECTURE_INTEL
- case PROCESSOR_ARCHITECTURE_INTEL:
- s = "intel";
- break;
+ case PROCESSOR_ARCHITECTURE_INTEL:
+ arch = @symbol(intel);
+ break;
#endif
#ifdef PROCESSOR_ARCHITECTURE_MIPS
- case PROCESSOR_ARCHITECTURE_MIPS:
- s = "mips";
- break;
+ case PROCESSOR_ARCHITECTURE_MIPS:
+ arch = @symbol(mips);
+ break;
#endif
#ifdef PROCESSOR_ARCHITECTURE_ALPHA
- case PROCESSOR_ARCHITECTURE_ALPHA:
- s = "alpha";
- break;
+ case PROCESSOR_ARCHITECTURE_ALPHA:
+ arch = @symbol(alpha);
+ break;
#endif
#ifdef PROCESSOR_ARCHITECTURE_ALPHA64
- case PROCESSOR_ARCHITECTURE_ALPHA64:
- s = "alpha64";
- break;
+ case PROCESSOR_ARCHITECTURE_ALPHA64:
+ arch = @symbol(alpha64);
+ break;
#endif
#ifdef PROCESSOR_ARCHITECTURE_PPC
- case PROCESSOR_ARCHITECTURE_PPC:
- s = "ppc";
- break;
+ case PROCESSOR_ARCHITECTURE_PPC:
+ arch = @symbol(ppc);
+ break;
#endif
#ifdef PROCESSOR_ARCHITECTURE_ARM
- case PROCESSOR_ARCHITECTURE_ARM:
- s = "arm";
- break;
+ case PROCESSOR_ARCHITECTURE_ARM:
+ arch = @symbol(arm);
+ break;
#endif
#ifdef PROCESSOR_ARCHITECTURE_SHX
- case PROCESSOR_ARCHITECTURE_SHX:
- s = "shx";
- break;
+ case PROCESSOR_ARCHITECTURE_SHX:
+ arch = @symbol(shx);
+ break;
#endif
#ifdef PROCESSOR_ARCHITECTURE_IA64
- case PROCESSOR_ARCHITECTURE_IA64:
- s = "ia64";
- break;
+ case PROCESSOR_ARCHITECTURE_IA64:
+ arch = @symbol(ia64);
+ break;
#endif
#ifdef PROCESSOR_ARCHITECTURE_MSIL
- case PROCESSOR_ARCHITECTURE_MSIL:
- s = "msil";
- break;
-#endif
- default:
- s = "unknown";
- break;
- }
- arch = __MKSTRING(s);
+ case PROCESSOR_ARCHITECTURE_MSIL:
+ arch = @symbol(msil);
+ break;
+#endif
+ default:
+ arch = @symbol(unknown);
+ break;
+ }
switch (sysInfo.dwProcessorType) {
#ifdef PROCESSOR_INTEL_386
- case PROCESSOR_INTEL_386:
- s = "i386";
- break;
+ case PROCESSOR_INTEL_386:
+ mach = @symbol(i386);
+ break;
#endif
#ifdef PROCESSOR_INTEL_486
- case PROCESSOR_INTEL_486:
- s = "i486";
- break;
+ case PROCESSOR_INTEL_486:
+ mach = @symbol(i486);
+ break;
#endif
#ifdef PROCESSOR_INTEL_PENTIUM
- case PROCESSOR_INTEL_PENTIUM:
- s = "i586";
- break;
+ case PROCESSOR_INTEL_PENTIUM:
+ mach = @symbol(i586);
+ break;
#endif
#ifdef PROCESSOR_INTEL_860
- case PROCESSOR_INTEL_860:
- s = "i860";
- break;
+ case PROCESSOR_INTEL_860:
+ mach = @symbol(i860);
+ break;
#endif
#ifdef PROCESSOR_INTEL_IA64
- case PROCESSOR_INTEL_IA64:
- s = "ia64";
- break;
+ case PROCESSOR_INTEL_IA64:
+ mach = @symbol(ia64);
+ break;
#endif
#ifdef PROCESSOR_MIPS_R2000
- case PROCESSOR_MIPS_R2000:
- s = "r2000";
- break;
+ case PROCESSOR_MIPS_R2000:
+ mach = @symbol(r2000);
+ break;
#endif
#ifdef PROCESSOR_MIPS_R3000
- case PROCESSOR_MIPS_R3000:
- s = "r3000";
- break;
+ case PROCESSOR_MIPS_R3000:
+ mach = @symbol(r3000);
+ break;
#endif
#ifdef PROCESSOR_MIPS_R4000
- case PROCESSOR_MIPS_R4000:
- s = "r4000";
- break;
+ case PROCESSOR_MIPS_R4000:
+ mach = @symbol(r4000);
+ break;
#endif
#ifdef PROCESSOR_ALPHA_21064
- case PROCESSOR_ALPHA_21064:
- s = "alpha21064";
- break;
+ case PROCESSOR_ALPHA_21064:
+ mach = @symbol(alpha21064);
+ break;
#endif
#ifdef PROCESSOR_ARM720
- case PROCESSOR_ARM720:
- s = "arm720";
- break;
+ case PROCESSOR_ARM720:
+ mach = @symbol(arm720);
+ break;
#endif
#ifdef PROCESSOR_ARM820
- case PROCESSOR_ARM820:
- s = "arm820";
- break;
+ case PROCESSOR_ARM820:
+ mach = @symbol(arm820);
+ break;
#endif
#ifdef PROCESSOR_ARM920
- case PROCESSOR_ARM920:
- s = "arm920";
- break;
+ case PROCESSOR_ARM920:
+ mach = @symbol(arm920);
+ break;
#endif
#ifdef PROCESSOR_ARM_7TDMI
- case PROCESSOR_ARM_7TDMI:
- s = "arm70001";
- break;
+ case PROCESSOR_ARM_7TDMI:
+ mach = @symbol(arm70001);
+ break;
#endif
#ifdef PROCESSOR_PPC_601
- case PROCESSOR_PPC_601:
- s = "ppc601";
- break;
+ case PROCESSOR_PPC_601:
+ mach = @symbol(ppc601);
+ break;
#endif
#ifdef PROCESSOR_PPC_603
- case PROCESSOR_PPC_603:
- s = "ppc603";
- break;
+ case PROCESSOR_PPC_603:
+ mach = @symbol(ppc603);
+ break;
#endif
#ifdef PROCESSOR_PPC_604
- case PROCESSOR_PPC_604:
- s = "ppc604";
- break;
+ case PROCESSOR_PPC_604:
+ mach = @symbol(ppc604);
+ break;
#endif
#ifdef PROCESSOR_PPC_620
- case PROCESSOR_PPC_620:
- s = "ppc620";
- break;
-#endif
-
- default:
- sprintf(vsnBuffer, "%d", sysInfo.dwProcessorType);
- s = vsnBuffer;
- break;
- }
- mach = __MKSTRING(s);
+ case PROCESSOR_PPC_620:
+ mach = @symbol(ppc620);
+ break;
+#endif
+
+ default:
+ sprintf(vsnBuffer, "%d", sysInfo.dwProcessorType);
+ mach = __MKSTRING(vsnBuffer);
+ break;
+ }
numberOfCPUs = __MKUINT(sysInfo.dwNumberOfProcessors);
%}.
- sys isNil ifTrue:[
- sys := self getSystemType.
- ].
node isNil ifTrue:[
- node := self getHostName.
+ node := self getHostName.
].
dom isNil ifTrue:[
- dom := self getDomainName.
- ].
- mach isNil ifTrue:[
- mach := self getCPUType.
- ].
- arch isNil ifTrue:[
- arch := 'unknown'.
+ dom := self getDomainName.
].
info := IdentityDictionary new.
@@ -8055,7 +8056,7 @@
here ...
(except for slight differences between next/mach and other machs)"
- ^ 'win32'
+ ^ #win32
"
OperatingSystem getSystemType
@@ -8214,6 +8215,22 @@
"
!
+isWin7Like
+ "return true, if running on a Windows7 like system."
+
+ |sysInfo major|
+
+ sysInfo := self getSystemInfo.
+ major := sysInfo at:#majorVersion.
+
+ ^ (major == 6 and:[(sysInfo at:#minorVersion) >= 1])
+ or:[major > 6]
+
+ "
+ self isWin7Like
+ "
+!
+
maxFileNameLength
"return the max number of characters in a filename.
CAVEAT:
@@ -8251,14 +8268,14 @@
osName
- | os |
-
- os := 'Windows ', (#('3.x' '95' 'NT' '2000' 'XP') at: (#('3.0' '4.0' '4.1' '5.0' '5.1') indexOf: (OperatingSystem osVersion))).
-
- ^os
-
- "Created: / 18-01-2007 / 17:21:06 / User"
- "Modified: / 19-01-2007 / 13:15:59 / User"
+ ^ 'Windows ',
+ (#('NT' '2000' 'XP' 'VISTA' '7')
+ at: (#('4.1' '5.0' '5.1' '6.0' '6.1') indexOf:OperatingSystem osVersion)
+ ifAbsent:OperatingSystem osVersion).
+
+ "
+ self osName
+ "
!
osVersion
@@ -8291,112 +8308,6 @@
"Modified: 20.6.1997 / 17:37:26 / cg"
!
-primGetDomainName
-%{
-#if 0 /* not needed */
- HINSTANCE hNetApi32 = LoadLibrary("netapi32.dll");
- DWORD (__stdcall *pfnNetApiBufferFree)(LPVOID Buffer);
- DWORD (__stdcall *pfnNetWkstaGetInfo)(LPWSTR servername, DWORD level, void *bufptr);
-
- if (hNetApi32) {
- pfnNetApiBufferFree = (DWORD (__stdcall *)(void *)) GetProcAddress(hNetApi32, "NetApiBufferFree");
- pfnNetWkstaGetInfo = (DWORD (__stdcall *)(LPWSTR, DWORD, void *)) GetProcAddress(hNetApi32, "NetWkstaGetInfo");
- }
-
- if (hNetApi32 && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
- /* this way is more reliable, in case user has a local account. */
- char dname[256];
- DWORD dnamelen = sizeof(dname);
- struct {
- DWORD wki100_platform_id;
- LPWSTR wki100_computername;
- LPWSTR wki100_langroup;
- DWORD wki100_ver_major;
- DWORD wki100_ver_minor;
- } *pwi;
-
- /* NERR_Success *is* 0*/
- if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) {
- if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
- WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup,
- -1, (LPSTR)dname, dnamelen, NULL, NULL);
- }
- else {
- WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername,
- -1, (LPSTR)dname, dnamelen, NULL, NULL);
- }
- pfnNetApiBufferFree(pwi);
- FreeLibrary(hNetApi32);
- RETURN (__MKSTRING(dname));
- }
- FreeLibrary(hNetApi32);
- } else {
- /* Win95 doesn't have NetWksta*(), so do it the old way */
- char name[256];
- DWORD size = sizeof(name);
- if (hNetApi32)
- FreeLibrary(hNetApi32);
- if (GetUserName(name,&size)) {
- char sid[1024];
- DWORD sidlen = sizeof(sid);
- char dname[256];
- DWORD dnamelen = sizeof(dname);
- SID_NAME_USE snu;
- if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
- dname, &dnamelen, &snu)) {
- RETURN (__MKSTRING(dname)); /* all that for this */
- }
- }
- }
-#endif /* not needed */
-%}.
- ^ nil
-!
-
-primGetHostName
- "return the hostname we are running on - if there is
- a HOST environment variable, we are much faster here ...
- Notice:
- not all systems support this; on some, 'unknown' is returned."
-
- |name|
-
-%{ /* STACK: 2048 */
-#if defined(HAS_GETHOSTNAME)
- char buffer[256];
-
- if (gethostname(buffer, sizeof(buffer)) == 0) {
- name = __MKSTRING(buffer);
- }
-#else
- char buffer[128];
- DWORD buffSize = sizeof(buffer);
-
- if (GetComputerName(buffer, &buffSize) == TRUE) {
- name = __MKSTRING(buffer);
- }
-#endif
-%}.
- name isNil ifTrue:[
- name := self getEnvironment:'HOST'.
- name isNil ifTrue:[
- name := self getEnvironment:'HOSTNAME'.
- name isNil ifTrue:[
- name := self getEnvironment:'COMPUTERNAME'.
- name isNil ifTrue:[
- 'Win32OperatingSystem [warning]: cannot find out hostname' errorPrintCR.
- name := 'unknown'.
- ]
- ]
- ]
- ].
- ^ name
-
- "
- OperatingSystem primGetHostName
- "
-!
-
randomBytesInto:bufferOrInteger
"If bufferOrInteger is a String or a ByteArray,
fill a given buffer with random bytes from the RtlGenRandom function
@@ -10199,6 +10110,36 @@
!Win32OperatingSystem class methodsFor:'users & groups'!
+getApplicationDataDirectoryFor:appName
+ "return the directory, where user-and-application-specific private files are to be
+ located (ini-files, preferences etc.).
+ Under windows, something like 'C:\Users\Administrator\AppData\Roaming\<appName>'
+ is returned, here, the fallback ~/.<appName> is returned.
+ Notice that only the name is returned; the directory is not guaranteed to exist."
+
+ "{ Pragma: +optSpace }"
+
+ |appDataDirFromEnv appDataDirFromRegistry|
+
+ appDataDirFromEnv := self getEnvironment:'APPDATA'.
+ appDataDirFromEnv notNil ifTrue:[
+ ^ appDataDirFromEnv , '\' , appName
+ ].
+ appDataDirFromRegistry :=
+ (self registryEntry key:'HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders')
+ valueNamed:'AppData'.
+ appDataDirFromRegistry notNil ifTrue:[
+ ^ appDataDirFromRegistry , '\' , appName
+ ].
+ ^ super getApplicationDataDirectoryFor:appName
+
+ "
+ OperatingSystem getApplicationDataDirectoryFor:'expecco'
+ "
+
+ "Created: / 29-07-2010 / 12:13:12 / sr"
+!
+
getDesktopDirectory
"return the name of the users desktop directory (i.e. yours)."
@@ -16299,15 +16240,15 @@
!Win32OperatingSystem class methodsFor:'documentation'!
version
- ^ '$Id: Win32OperatingSystem.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Win32OperatingSystem.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.404 2010/07/07 14:58:13 cg Exp '
+ ^ 'Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.409 2010/08/03 15:08:47 cg Exp '
!
version_SVN
- ^ '$Id: Win32OperatingSystem.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: Win32OperatingSystem.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !
Win32OperatingSystem initialize!
@@ -16317,3 +16258,4 @@
+
--- a/stx_libbasic.st Sun Aug 01 12:11:07 2010 +0100
+++ b/stx_libbasic.st Tue Aug 10 09:55:15 2010 +0100
@@ -534,13 +534,13 @@
"Return a SVN revision number of myself.
This number is updated after a commit"
- ^ "$SVN-Revision:"'10561M'"$"
+ ^ "$SVN-Revision:"'10562M'"$"
! !
!stx_libbasic class methodsFor:'documentation'!
version
- ^ '$Id: stx_libbasic.st 10562 2010-08-01 11:11:07Z vranyj1 $'
+ ^ '$Id: stx_libbasic.st 10564 2010-08-10 08:55:15Z vranyj1 $'
!
version_CVS
@@ -548,5 +548,5 @@
!
version_SVN
- ^ '$Id: stx_libbasic.st 10562 2010-08-01 11:11:07Z vranyj1 $'
+ ^ '$Id: stx_libbasic.st 10564 2010-08-10 08:55:15Z vranyj1 $'
! !