--- a/AbstractOperatingSystem.st Sat May 16 06:48:37 2015 +0200
+++ b/AbstractOperatingSystem.st Mon May 18 07:10:20 2015 +0100
@@ -18,8 +18,7 @@
Object subclass:#AbstractOperatingSystem
instanceVariableNames:''
classVariableNames:'ConcreteClass LastErrorNumber LocaleInfo OSSignals PipeFailed
- ErrorSignal AccessDeniedErrorSignal FileNotFoundErrorSignal
- InvalidArgumentsSignal UnsupportedOperationSignal Resources'
+ ErrorSignal Resources'
poolDictionaries:''
category:'System-Support'
!
@@ -101,10 +100,10 @@
ErrorSignal <Signal> Parentsignal of all OS error signals.
not directly raised.
- AccessDeniedErrorSignal misc concrete error reporting signals
- FileNotFoundErrorSignal
- UnsupportedOperationSignal
- InvalidArgumentsSignal
+ misc concrete error reporting signals
+
+
+
[author:]
Claus Gittinger
@@ -238,10 +237,6 @@
OSErrorHolder initialize.
ErrorSignal := OsError.
- InvalidArgumentsSignal := OsInvalidArgumentsError.
- AccessDeniedErrorSignal := OSErrorHolder noPermissionsSignal.
- FileNotFoundErrorSignal := OSErrorHolder nonexistentSignal.
- UnsupportedOperationSignal := OSErrorHolder unsupportedOperationSignal.
Smalltalk addDependent:self. "/ to catch language changes
].
!
@@ -558,7 +553,7 @@
accessDeniedErrorSignal
"return the signal raised when a (file-) access is denied."
- ^ AccessDeniedErrorSignal
+ ^ OSErrorHolder noPermissionsSignal
!
errorSignal
@@ -572,14 +567,14 @@
fileNotFoundErrorSignal
"return the signal raised when a file was not found."
- ^ FileNotFoundErrorSignal
+ ^ OSErrorHolder nonexistentSignal
!
invalidArgumentsSignal
"return the signal which is raised for invalid arguments.
Currently, this is never raised."
- ^ InvalidArgumentsSignal
+ ^ OsInvalidArgumentsError
"Created: 13.9.1997 / 10:46:47 / cg"
"Modified: 13.9.1997 / 10:47:03 / cg"
@@ -590,7 +585,7 @@
is attempted, which is not supported by the OS.
(For example, creating a link on VMS or MSDOS)"
- ^ UnsupportedOperationSignal
+ ^ OSErrorHolder unsupportedOperationSignal.
! !
!AbstractOperatingSystem class methodsFor:'change & update'!
@@ -889,7 +884,7 @@
"/ not supported by OS
"/
- ^ UnsupportedOperationSignal raise
+ ^ self unsupportedOperationSignal raise
!
startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
@@ -2351,7 +2346,7 @@
"/
"/ assume that this OperatingSystem does not support links
"/
- ^ UnsupportedOperationSignal raise
+ ^ self unsupportedOperationSignal raise
"Created: / 13.8.1998 / 21:37:12 / cg"
"Modified: / 13.8.1998 / 21:38:39 / cg"
@@ -2365,7 +2360,7 @@
"/
"/ assume that this OperatingSystem does not support symbolic links
"/
- ^ UnsupportedOperationSignal raise
+ ^ self unsupportedOperationSignal raise
"Created: / 13.8.1998 / 21:38:24 / cg"
"Modified: / 13.8.1998 / 21:38:43 / cg"
@@ -3019,7 +3014,7 @@
createCOMFileForVMSCommand:aCommandString in:aDirectory
"this is only implemented/required for VMS systems, to execute commands"
- ^ UnsupportedOperationSignal raise
+ ^ self unsupportedOperationSignal raise
"Created: / 19.5.1999 / 12:16:31 / cg"
"Modified: / 19.5.1999 / 14:22:05 / cg"
@@ -3028,7 +3023,7 @@
createMailBox
"this is only implemented/required for VMS systems, to emulate pipes"
- ^ UnsupportedOperationSignal raise
+ ^ self unsupportedOperationSignal raise
"Created: / 19.5.1999 / 12:14:56 / cg"
"Modified: / 19.5.1999 / 14:22:22 / cg"
@@ -3037,7 +3032,7 @@
destroyMailBox:mbx
"this is only implemented/required for VMS systems, to emulate pipes"
- ^ UnsupportedOperationSignal raise
+ ^ self unsupportedOperationSignal raise
"Created: / 19.5.1999 / 12:16:43 / cg"
"Modified: / 19.5.1999 / 14:22:33 / cg"
@@ -3046,7 +3041,7 @@
mailBoxNameOf:mbx
"this is only implemented/required for VMS systems, to emulate pipes"
- ^ UnsupportedOperationSignal raise
+ ^ self unsupportedOperationSignal raise
"Created: / 19.5.1999 / 12:14:56 / cg"
"Modified: / 19.5.1999 / 14:22:40 / cg"
@@ -3084,7 +3079,11 @@
unblocking, in case of nested block/unblock calls."
%{ /* NOCONTEXT */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( __c__.blockInterrupts() ? STObject.True : STObject.False);
+#else
RETURN ( __BLOCKINTERRUPTS() );
+#endif /* not SCHTEAM */
%}
!
@@ -3443,7 +3442,11 @@
calls - you must only unblock after a blockcall if they where
really not blocked before. See OperatingSystemclass>>blockInterrupts."
%{
+#ifdef __SCHTEAM__
+ return __c__._RETURN( __c__.unblockInterrupts() ? STObject.True : STObject.False);
+#else
RETURN(__UNBLOCKINTERRUPTS());
+#endif
%}
! !
@@ -5799,7 +5802,7 @@
"low level entry to shmat()-system call.
Not supported on all operatingSystems"
- ^ UnsupportedOperationSignal raise
+ ^ self unsupportedOperationSignal raise
"Modified: / 19.5.1999 / 14:21:35 / cg"
!
@@ -5808,7 +5811,7 @@
"low level entry to shmdt()-system call.
Not supported on all operatingSystems"
- ^ UnsupportedOperationSignal raise
+ ^ self unsupportedOperationSignal raise
"Modified: / 19.5.1999 / 14:21:37 / cg"
!
@@ -5818,7 +5821,7 @@
This is not for public use and not supported with all operatingSystems.
- use the provided wrapper class SharedExternalBytes instead."
- ^ UnsupportedOperationSignal raise
+ ^ self unsupportedOperationSignal raise
"Modified: / 19.5.1999 / 14:21:41 / cg"
! !
@@ -7740,11 +7743,11 @@
!AbstractOperatingSystem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.299 2015-04-28 21:22:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.301 2015-05-18 00:16:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.299 2015-04-28 21:22:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.301 2015-05-18 00:16:20 cg Exp $'
! !
--- a/Autoload.st Sat May 16 06:48:37 2015 +0200
+++ b/Autoload.st Mon May 18 07:10:20 2015 +0100
@@ -758,7 +758,7 @@
!
isBehavior
- "return true, if the receiver is describing another objects behavior.
+ "return true, if the receiver is describing another objects' behavior.
Autoloaded classes are definitely; therefore return true."
^ true
@@ -847,11 +847,11 @@
!Autoload class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.170 2015-04-24 00:50:56 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.171 2015-05-16 09:51:57 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.170 2015-04-24 00:50:56 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.171 2015-05-16 09:51:57 cg Exp $'
! !
--- a/Behavior.st Sat May 16 06:48:37 2015 +0200
+++ b/Behavior.st Mon May 18 07:10:20 2015 +0100
@@ -1426,7 +1426,6 @@
^ self nameWithoutPrefix
! !
-
!Behavior methodsFor:'RefactoringBrowser'!
realClass
@@ -2508,7 +2507,9 @@
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
- return __c__._RETURN( self.basicNew() );
+ if (anInteger.isSmallInteger()) {
+ return __c__._RETURN( self.basicNew( anInteger.intValue()) );
+ }
#else
OBJ newobj;
unsigned INT nInstVars;
@@ -3542,7 +3543,7 @@
!
isBehavior
- "return true, if the receiver is describing another objects behavior.
+ "return true, if the receiver is describing another object's behavior.
Defined to avoid the need to use isKindOf:"
^ true
@@ -3912,6 +3913,18 @@
"return true, if I am a subclass of the argument, aClass"
%{ /* NOCONTEXT */
+#ifdef __SCHTEAM__
+ STClass theClass = self.superClazz();
+
+ while (theClass != null) {
+ if (theClass == aClass) {
+ return __c__._RETURN_true();
+ }
+ theClass = theClass.superClazz();
+ }
+ return __c__._RETURN_false();
+ /* NOTREACHED */
+#else
OBJ __theClass = __INST(superclass);
int n = 0;
@@ -3928,6 +3941,7 @@
}
RETURN (false);
vmError: ;
+#endif /* not SCHTEAM */
%}.
VMInternalError raiseErrorString:'deep inheritance'.
@@ -4058,9 +4072,9 @@
instances of SmallInteger and UndefinedObject"
self allInstancesDo:[:anObject |
- (predicate value:anObject) ifTrue:[
- action value:anObject
- ].
+ (predicate value:anObject) ifTrue:[
+ action value:anObject
+ ].
].
"
@@ -5283,10 +5297,10 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.374 2015-05-01 09:00:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.376 2015-05-18 00:16:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.374 2015-05-01 09:00:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.376 2015-05-18 00:16:20 cg Exp $'
! !
--- a/CharacterArray.st Sat May 16 06:48:37 2015 +0200
+++ b/CharacterArray.st Mon May 18 07:10:20 2015 +0100
@@ -2,7 +2,7 @@
"
COPYRIGHT (c) 1994 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
@@ -28,7 +28,7 @@
copyright
"
COPYRIGHT (c) 1994 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
@@ -42,7 +42,7 @@
documentation
"
CharacterArray is a superclass for all kinds of Strings (i.e.
- (singleByte-)Strings, TwoByteStrings, UnicodeStrings
+ (singleByte-)Strings, TwoByteStrings, UnicodeStrings
and whatever my come in the future.
This class is abstract, meaning that there are no instances of it;
@@ -52,30 +52,30 @@
All this class does is provide common protocol for concrete subclasses.
Notice:
- internally, ST/X uses a unicode encoding for ALL characters - both
- for individual chatacter entities and for strings of characters.
- When reading/writing files in different encodings, the conversion is
- done at read/write time by use of a CharacterEncoder instance.
- These know how to convert to a wide range of encodings.
+ internally, ST/X uses a unicode encoding for ALL characters - both
+ for individual chatacter entities and for strings of characters.
+ When reading/writing files in different encodings, the conversion is
+ done at read/write time by use of a CharacterEncoder instance.
+ These know how to convert to a wide range of encodings.
Also notice:
- UTF8 and UTF16 are external encodings of a Unicode string; they are never
- used internally. When interacting with a UTF8 interface (OS-API or files),
- you should convert UTF8 into the internal full Unicode right at the interface.
- Do not keep UTF8 around internally as String instances.
- The reason is that UTF8 makes it harder to manipulate strings (for example
- to insert/extract substrings or to get its size. Of such operations would
- require a scan of the UTF8, which would complicate them).
- Of course, there may be rare exceptions to this, for example if a file's contents
- is treated as raw data, and the strings have to be copied/shuffled around only,
- without any real processing on it.
+ UTF8 and UTF16 are external encodings of a Unicode string; they are never
+ used internally. When interacting with a UTF8 interface (OS-API or files),
+ you should convert UTF8 into the internal full Unicode right at the interface.
+ Do not keep UTF8 around internally as String instances.
+ The reason is that UTF8 makes it harder to manipulate strings (for example
+ to insert/extract substrings or to get its size. Of such operations would
+ require a scan of the UTF8, which would complicate them).
+ Of course, there may be rare exceptions to this, for example if a file's contents
+ is treated as raw data, and the strings have to be copied/shuffled around only,
+ without any real processing on it.
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- String TwoByteString Unicode16String Uniode32String
- StringCollection
+ String TwoByteString Unicode16String Uniode32String
+ StringCollection
"
! !
@@ -83,11 +83,11 @@
initialize
DecodingFailedSignal isNil ifTrue:[
- DecodingFailedSignal := DecodingError.
- DecodingFailedSignal notifierString:'error during decode'.
-
- EncodingFailedSignal :=EncodingError.
- EncodingFailedSignal notifierString:'error during encode'.
+ DecodingFailedSignal := DecodingError.
+ DecodingFailedSignal notifierString:'error during decode'.
+
+ EncodingFailedSignal :=EncodingError.
+ EncodingFailedSignal notifierString:'error during encode'.
]
"
@@ -115,19 +115,19 @@
nBytes := aByteCollection size.
mySize := self basicNew bitsPerCharacter.
mySize == 16 ifTrue:[
- newString := self uninitializedNew:(nBytes // 2).
- dstIdx := 1.
- aByteCollection pairWiseDo:[:hi :lo |
- newString at:dstIdx put:(Character value:(hi bitShift:8)+lo).
- dstIdx := dstIdx + 1
- ].
- ^ newString.
+ newString := self uninitializedNew:(nBytes // 2).
+ dstIdx := 1.
+ aByteCollection pairWiseDo:[:hi :lo |
+ newString at:dstIdx put:(Character value:(hi bitShift:8)+lo).
+ dstIdx := dstIdx + 1
+ ].
+ ^ newString.
].
^ (self uninitializedNew:nBytes) replaceFrom:1 with:aByteCollection
"
- Unicode16String fromBytes:#[16r02 16r20]
+ Unicode16String fromBytes:#[16r02 16r20]
"
"Modified: 30.6.1997 / 20:08:37 / cg"
@@ -139,7 +139,7 @@
^ (self uninitializedNew:aString size) replaceFrom:1 with:aString
"
- Unicode16String fromString:'hello'
+ Unicode16String fromString:'hello'
"
!
@@ -161,13 +161,13 @@
|stream|
aCollectionOfStrings do:[:eachString |
- stream isNil ifTrue:[
- stream := self writeStreamClass with:eachString.
- ] ifFalse:[
- stream
- nextPutAll:aSeparatorString;
- nextPutAll:eachString.
- ].
+ stream isNil ifTrue:[
+ stream := self writeStreamClass with:eachString.
+ ] ifFalse:[
+ stream
+ nextPutAll:aSeparatorString;
+ nextPutAll:eachString.
+ ].
].
stream isNil ifTrue:[^ ''].
^ stream contents
@@ -227,25 +227,25 @@
str skipSeparators.
(str peekOrNil == $') ifTrue:[
- str next.
- collected := self writeStream.
- [str atEnd] whileFalse:[
- char := str next.
- char == $' ifTrue:[
- "/ look for another quote
- str peekOrNil ~~ $' ifTrue:[
- "end of string reached"
- ^ collected contents.
- ].
- "eat doubled quote"
- str next.
- ].
- ((char ~~ Character return) or:[str peekOrNil ~~ Character lf]) ifTrue:[
- "compress CRLF to LF, but keep a single CR"
- collected nextPut:char.
- ].
- ].
- "if we come here, we reached the end without finding a closing $'"
+ str next.
+ collected := self writeStream.
+ [str atEnd] whileFalse:[
+ char := str next.
+ char == $' ifTrue:[
+ "/ look for another quote
+ str peekOrNil ~~ $' ifTrue:[
+ "end of string reached"
+ ^ collected contents.
+ ].
+ "eat doubled quote"
+ str next.
+ ].
+ ((char ~~ Character return) or:[str peekOrNil ~~ Character lf]) ifTrue:[
+ "compress CRLF to LF, but keep a single CR"
+ collected nextPut:char.
+ ].
+ ].
+ "if we come here, we reached the end without finding a closing $'"
].
^ exceptionBlock value
@@ -284,7 +284,7 @@
new := self new: anArray size.
1 to: anArray size do:[:index |
- new at: index put: (anArray at: index) asCharacter
+ new at: index put: (anArray at: index) asCharacter
].
^new
@@ -400,160 +400,160 @@
"/ Transcript showCR:('match: ''' , (aString copyFrom:sStart to:sStop) ,
"/ ''' against:' , (matchScanArray copyFrom:mStart to:mStop) printString).
- mSize := mStop - mStart + 1.
- sSize := sStop - sStart + 1.
-
- "empty strings match"
- (mSize == 0) ifTrue:[^ (sSize == 0)].
-
- matchEntry := matchScanArray at:mStart.
-
- "/ the most common case first:
- (sSize ~~ 0
- and:[(checkChar := (aString at:sStart)) = matchEntry]) ifTrue:[
- "advance by one and continue"
- mStart := mStart + 1.
- sStart := sStart + 1
- ] ifFalse:[
- (matchEntry == #any) ifTrue:[
- "restString empty -> no match"
- (sSize == 0) ifTrue:[^ false].
- "# matches single character"
- ((sSize == 1) and:[mSize == 1]) ifTrue:[^ true].
- "advance by one and continue"
- mStart := mStart + 1.
- sStart := sStart + 1
- ] ifFalse:[
- (matchEntry == #anyString) ifTrue:[
- "* alone matches anything"
- (mSize == 1) ifTrue:[^ true].
- "restString empty & matchString not empty -> no match"
- (sSize == 0) ifTrue:[^ false].
-
- "
- try to avoid some of the recursion by checking last
- character and continue with shortened strings if possible
- "
- quickCheck := false.
- (mStop >= mStart) ifTrue:[
- matchLast := matchScanArray at:mStop.
- (matchLast ~~ #anyString) ifTrue:[
- (matchLast == #any) ifTrue:[
- quickCheck := true
- ] ifFalse:[
- matchLast == (aString at:sStop) ifTrue:[
- quickCheck := true
- ] ifFalse:[
- matchLast isString ifTrue:[
- quickCheck := matchLast includes:(aString at:sStop)
- ]
- ]
- ]
- ]
- ].
- quickCheck ifTrue:[
- "
- quickCheck ok, advance from the right
- "
- mStop := mStop - 1.
- sStop := sStop - 1
- ] ifFalse:[
- "/ no quick check;
- "/ look for the next character(s)
- "/ and try matching there
- "/ (to avoid recursion)
-
- mStart < mStop ifTrue:[
- nextMatchEntry := matchScanArray at:mStart+1.
- nextMatchEntry isCharacter ifTrue:[
- sStart <= sStop ifTrue:[
- [
- caseSensitive ifTrue:[
- index := aString indexOf:nextMatchEntry startingAt:sStart
- ] ifFalse:[
- index := aString findFirst:[:c | c asLowercase = nextMatchEntry asLowercase]
- startingAt:sStart.
- ].
- (index == 0 or:[index > sStop]) ifTrue:[
- ^ false
- ].
- (self matchScan:matchScanArray
- from:(mStart + 1)
- to:mStop
- with:aString
- from:index
- to:sStop
- caseSensitive:caseSensitive
- ) ifTrue:[
- ^ true
- ].
- sStart := index + 1.
- ] loop.
- ]
- ]
- ].
-
- "
- no quick check possible;
- loop over all possible substrings
- "
- index := sStart.
- [index <= sStop] whileTrue:[
- (self matchScan:matchScanArray
- from:(mStart + 1)
- to:mStop
- with:aString
- from:index
- to:sStop
- caseSensitive:caseSensitive
- ) ifTrue:[
- ^ true
- ].
- index := index + 1
- ].
- ^ false
- ].
- ] ifFalse:[
- (matchEntry isString) ifTrue:[
- "testString empty -> no match"
- (sSize == 0) ifTrue:[^ false].
-
- included := false.
- "/ checkChar := aString at:sStart.
- included := matchEntry includes:checkChar.
- included ifFalse:[
- caseSensitive ifFalse:[
- checkChar isUppercase ifTrue:[
- included := matchEntry includes:checkChar asLowercase.
- ] ifFalse:[
- included := matchEntry includes:checkChar asUppercase.
- ]
- ].
- ].
- mStart := mStart + 1.
- mSize := mSize - 1.
- included ifFalse:[^ false].
-
- ((sSize == 1) and:[mSize == 0]) ifTrue:[^ true].
- ] ifFalse:[
- "/ must be single character
-
- "testString empty ?"
- (sSize == 0) ifTrue:[^ false].
-
- "first characters equal ?"
- "/ checkChar := aString at:sStart.
- caseSensitive ifTrue:[^ false].
- (checkChar asUppercase ~= matchEntry asUppercase) ifTrue:[^ false].
-
- "advance and continue"
- mStart := mStart + 1.
- ].
- "cut off 1st char and continue"
- sStart := sStart + 1
- ]
- ]
- ]
+ mSize := mStop - mStart + 1.
+ sSize := sStop - sStart + 1.
+
+ "empty strings match"
+ (mSize == 0) ifTrue:[^ (sSize == 0)].
+
+ matchEntry := matchScanArray at:mStart.
+
+ "/ the most common case first:
+ (sSize ~~ 0
+ and:[(checkChar := (aString at:sStart)) = matchEntry]) ifTrue:[
+ "advance by one and continue"
+ mStart := mStart + 1.
+ sStart := sStart + 1
+ ] ifFalse:[
+ (matchEntry == #any) ifTrue:[
+ "restString empty -> no match"
+ (sSize == 0) ifTrue:[^ false].
+ "# matches single character"
+ ((sSize == 1) and:[mSize == 1]) ifTrue:[^ true].
+ "advance by one and continue"
+ mStart := mStart + 1.
+ sStart := sStart + 1
+ ] ifFalse:[
+ (matchEntry == #anyString) ifTrue:[
+ "* alone matches anything"
+ (mSize == 1) ifTrue:[^ true].
+ "restString empty & matchString not empty -> no match"
+ (sSize == 0) ifTrue:[^ false].
+
+ "
+ try to avoid some of the recursion by checking last
+ character and continue with shortened strings if possible
+ "
+ quickCheck := false.
+ (mStop >= mStart) ifTrue:[
+ matchLast := matchScanArray at:mStop.
+ (matchLast ~~ #anyString) ifTrue:[
+ (matchLast == #any) ifTrue:[
+ quickCheck := true
+ ] ifFalse:[
+ matchLast == (aString at:sStop) ifTrue:[
+ quickCheck := true
+ ] ifFalse:[
+ matchLast isString ifTrue:[
+ quickCheck := matchLast includes:(aString at:sStop)
+ ]
+ ]
+ ]
+ ]
+ ].
+ quickCheck ifTrue:[
+ "
+ quickCheck ok, advance from the right
+ "
+ mStop := mStop - 1.
+ sStop := sStop - 1
+ ] ifFalse:[
+ "/ no quick check;
+ "/ look for the next character(s)
+ "/ and try matching there
+ "/ (to avoid recursion)
+
+ mStart < mStop ifTrue:[
+ nextMatchEntry := matchScanArray at:mStart+1.
+ nextMatchEntry isCharacter ifTrue:[
+ sStart <= sStop ifTrue:[
+ [
+ caseSensitive ifTrue:[
+ index := aString indexOf:nextMatchEntry startingAt:sStart
+ ] ifFalse:[
+ index := aString findFirst:[:c | c asLowercase = nextMatchEntry asLowercase]
+ startingAt:sStart.
+ ].
+ (index == 0 or:[index > sStop]) ifTrue:[
+ ^ false
+ ].
+ (self matchScan:matchScanArray
+ from:(mStart + 1)
+ to:mStop
+ with:aString
+ from:index
+ to:sStop
+ caseSensitive:caseSensitive
+ ) ifTrue:[
+ ^ true
+ ].
+ sStart := index + 1.
+ ] loop.
+ ]
+ ]
+ ].
+
+ "
+ no quick check possible;
+ loop over all possible substrings
+ "
+ index := sStart.
+ [index <= sStop] whileTrue:[
+ (self matchScan:matchScanArray
+ from:(mStart + 1)
+ to:mStop
+ with:aString
+ from:index
+ to:sStop
+ caseSensitive:caseSensitive
+ ) ifTrue:[
+ ^ true
+ ].
+ index := index + 1
+ ].
+ ^ false
+ ].
+ ] ifFalse:[
+ (matchEntry isString) ifTrue:[
+ "testString empty -> no match"
+ (sSize == 0) ifTrue:[^ false].
+
+ included := false.
+ "/ checkChar := aString at:sStart.
+ included := matchEntry includes:checkChar.
+ included ifFalse:[
+ caseSensitive ifFalse:[
+ checkChar isUppercase ifTrue:[
+ included := matchEntry includes:checkChar asLowercase.
+ ] ifFalse:[
+ included := matchEntry includes:checkChar asUppercase.
+ ]
+ ].
+ ].
+ mStart := mStart + 1.
+ mSize := mSize - 1.
+ included ifFalse:[^ false].
+
+ ((sSize == 1) and:[mSize == 0]) ifTrue:[^ true].
+ ] ifFalse:[
+ "/ must be single character
+
+ "testString empty ?"
+ (sSize == 0) ifTrue:[^ false].
+
+ "first characters equal ?"
+ "/ checkChar := aString at:sStart.
+ caseSensitive ifTrue:[^ false].
+ (checkChar asUppercase ~= matchEntry asUppercase) ifTrue:[^ false].
+
+ "advance and continue"
+ mStart := mStart + 1.
+ ].
+ "cut off 1st char and continue"
+ sStart := sStart + 1
+ ]
+ ]
+ ]
] loop.
"
@@ -562,13 +562,13 @@
scanArray := self matchScanArrayFrom:'*hello'.
s := 'foo bar hello world'.
CharacterArray
- matchScan:scanArray
- from:1
- to:scanArray size
- with:s
- from:1
- to:s size
- caseSensitive:true
+ matchScan:scanArray
+ from:1
+ to:scanArray size
+ with:s
+ from:1
+ to:s size
+ caseSensitive:true
"
"
|scanArray s|
@@ -576,13 +576,13 @@
scanArray := self matchScanArrayFrom:'*hello*'.
s := 'foo bar hello world'.
CharacterArray
- matchScan:scanArray
- from:1
- to:scanArray size
- with:s
- from:1
- to:s size
- caseSensitive:true
+ matchScan:scanArray
+ from:1
+ to:scanArray size
+ with:s
+ from:1
+ to:s size
+ caseSensitive:true
"
"Modified: / 24-07-2011 / 07:17:03 / cg"
@@ -600,7 +600,7 @@
pattern matching package should be added."
^ self
- matchScan:matchScanArray from:matchStart to:matchStop with:aString from:start to:stop caseSensitive:ignoreCase not
+ matchScan:matchScanArray from:matchStart to:matchStop with:aString from:start to:stop caseSensitive:ignoreCase not
"
|scanArray s|
@@ -608,13 +608,13 @@
scanArray := self matchScanArrayFrom:'*hello'.
s := 'foo bar hello world'.
CharacterArray
- matchScan:scanArray
- from:1
- to:scanArray size
- with:s
- from:1
- to:s size
- ignoreCase:false
+ matchScan:scanArray
+ from:1
+ to:scanArray size
+ with:s
+ from:1
+ to:s size
+ ignoreCase:false
"
"
|scanArray s|
@@ -622,13 +622,13 @@
scanArray := self matchScanArrayFrom:'*hello*'.
s := 'foo bar hello world'.
CharacterArray
- matchScan:scanArray
- from:1
- to:scanArray size
- with:s
- from:1
- to:s size
- ignoreCase:false
+ matchScan:scanArray
+ from:1
+ to:scanArray size
+ with:s
+ from:1
+ to:s size
+ ignoreCase:false
"
"Modified: / 24-07-2011 / 07:17:03 / cg"
@@ -673,61 +673,61 @@
coll := OrderedCollection new.
idx := 1. end := aString size.
[idx <= end] whileTrue:[
- |char this|
-
- char := aString at:idx.
- char == $* ifTrue:[
- previous ~~ #anyString ifTrue:[
- this := #anyString
- ]
- ] ifFalse:[
- char == $# ifTrue:[
- previous ~~ #anyString ifTrue:[
- this := #any
- ]
- ] ifFalse:[
- char == $[ ifTrue:[
- matchSet := IdentitySet new.
- idx := idx + 1.
- idx > end ifTrue:[^ nil].
- char := aString at:idx.
- c1 := nil.
- [char ~~ $]] whileTrue:[
- ((char == $-) and:[c1 notNil]) ifTrue:[
- idx := idx + 1.
- idx > end ifTrue:[^ nil].
- c2 := aString at:idx.
- c1 to:c2 do:[:c | matchSet add:c].
- c1 := nil.
- idx := idx + 1.
- ] ifFalse:[
- (char ~~ $]) ifTrue:[
- matchSet add:char.
- c1 := char.
- idx := idx + 1
- ]
- ].
- idx > end ifTrue:[^ nil].
- char := aString at:idx
- ].
- this := matchSet asString
- ] ifFalse:[
- char == escape ifTrue:[
- idx := idx + 1.
- idx > end ifTrue:[
- "/ mhmh - what should we do here ?
- this := char
- ] ifFalse:[
- this := aString at:idx.
- ]
- ] ifFalse:[
- this := char
- ]
- ]
- ]
- ].
- this notNil ifTrue:[coll add:this. previous := this].
- idx := idx + 1
+ |char this|
+
+ char := aString at:idx.
+ char == $* ifTrue:[
+ previous ~~ #anyString ifTrue:[
+ this := #anyString
+ ]
+ ] ifFalse:[
+ char == $# ifTrue:[
+ previous ~~ #anyString ifTrue:[
+ this := #any
+ ]
+ ] ifFalse:[
+ char == $[ ifTrue:[
+ matchSet := IdentitySet new.
+ idx := idx + 1.
+ idx > end ifTrue:[^ nil].
+ char := aString at:idx.
+ c1 := nil.
+ [char ~~ $]] whileTrue:[
+ ((char == $-) and:[c1 notNil]) ifTrue:[
+ idx := idx + 1.
+ idx > end ifTrue:[^ nil].
+ c2 := aString at:idx.
+ c1 to:c2 do:[:c | matchSet add:c].
+ c1 := nil.
+ idx := idx + 1.
+ ] ifFalse:[
+ (char ~~ $]) ifTrue:[
+ matchSet add:char.
+ c1 := char.
+ idx := idx + 1
+ ]
+ ].
+ idx > end ifTrue:[^ nil].
+ char := aString at:idx
+ ].
+ this := matchSet asString
+ ] ifFalse:[
+ char == escape ifTrue:[
+ idx := idx + 1.
+ idx > end ifTrue:[
+ "/ mhmh - what should we do here ?
+ this := char
+ ] ifFalse:[
+ this := aString at:idx.
+ ]
+ ] ifFalse:[
+ this := char
+ ]
+ ]
+ ]
+ ].
+ this notNil ifTrue:[coll add:this. previous := this].
+ idx := idx + 1
].
^ coll asArray
@@ -787,18 +787,18 @@
ds := WriteStream on:(self species new).
self do:[:eachChar |
- |repl|
-
- repl := expandTable at:eachChar ifAbsent:[nil].
- repl isNil ifTrue:[
- ds nextPut:eachChar
- ] ifFalse:[
- repl size == 0 ifTrue:[
- ds nextPut:repl
- ] ifFalse:[
- ds nextPutAll:repl
- ]
- ].
+ |repl|
+
+ repl := expandTable at:eachChar ifAbsent:[nil].
+ repl isNil ifTrue:[
+ ds nextPut:eachChar
+ ] ifFalse:[
+ repl size == 0 ifTrue:[
+ ds nextPut:repl
+ ] ifFalse:[
+ ds nextPutAll:repl
+ ]
+ ].
].
^ ds contents.
!
@@ -848,10 +848,10 @@
"
'do you prefer %1 or rather %2 (not talking about %3) ?'
- % #('smalltalk' 'c++' 'c')
+ % #('smalltalk' 'c++' 'c')
'do you %(what) ?'
- % (Dictionary new at:#'what' put:'understand'; yourself)
+ % (Dictionary new at:#'what' put:'understand'; yourself)
"
! !
@@ -862,7 +862,7 @@
separators (i.e. spaces & newlines) as word-delimiters.
This has been added for ST/V compatibility; the actual work is done
in asCollectionOfWords.
- (sigh: it is called #'subStrings' in V'Age, #'substrings' in Squeak
+ (sigh: it is called #'subStrings' in V'Age, #'substrings' in Squeak
and #'asCollectionOfWords' in ST/X) "
^ self asCollectionOfWords asArray
@@ -871,7 +871,7 @@
'1 one two three four 5 five' asArrayOfSubstrings
'1
one
- two three four 5 five' asArrayOfSubstrings
+ two three four 5 five' asArrayOfSubstrings
"
!
@@ -917,11 +917,11 @@
tmpStream := self species writeStream.
self do:[:element |
- element = oldChar ifTrue:[
- tmpStream nextPutAll:newString
- ] ifFalse:[
- tmpStream nextPut:element
- ].
+ element = oldChar ifTrue:[
+ tmpStream nextPutAll:newString
+ ] ifFalse:[
+ tmpStream nextPut:element
+ ].
].
^ tmpStream contents
@@ -943,7 +943,7 @@
'12345678901234567890' replString:'234' withString:'foo'
('a string with spaces' replChar:$ withString:' foo ')
- replString:'foo' withString:'bar'
+ replString:'foo' withString:'bar'
"
"Modified: / 12-05-2004 / 12:00:27 / cg"
@@ -1030,10 +1030,10 @@
nMax :=(self size) min:(aString size).
idx := 1.
[idx <= nMax] whileTrue:[
- (self at:idx) = (aString at:idx) ifFalse:[
- ^ idx - 1
- ].
- idx := idx + 1.
+ (self at:idx) = (aString at:idx) ifFalse:[
+ ^ idx - 1
+ ].
+ idx := idx + 1.
].
^ nMax
@@ -1073,9 +1073,9 @@
"cg: I am not sure, if this is really the squeak semantics (w.r.t. empty fields)"
delimiterOrDelimiters size == 0 ifTrue:[
- ^ self asCollectionOfSubstringsSeparatedBy:delimiterOrDelimiters
+ ^ self asCollectionOfSubstringsSeparatedBy:delimiterOrDelimiters
] ifFalse:[
- ^ self asCollectionOfSubstringsSeparatedByAny:delimiterOrDelimiters
+ ^ self asCollectionOfSubstringsSeparatedByAny:delimiterOrDelimiters
].
"
@@ -1120,7 +1120,7 @@
"/ for now, a q&d hack ...
caseSensitive ifFalse:[
- ^ self asLowercase includesString:aString asLowercase
+ ^ self asLowercase includesString:aString asLowercase
].
^ self includesString:aString
@@ -1154,7 +1154,7 @@
"pad left (leftOrRight==#left) or right"
leftOrRight == #left ifTrue:[
- ^ self leftPaddedTo:paddedSize with:padCharacter
+ ^ self leftPaddedTo:paddedSize with:padCharacter
].
^ self paddedTo:paddedSize with:padCharacter
@@ -1173,7 +1173,7 @@
Assumes the delimiters to be a non-empty string."
start to:self size do:[:i |
- delimiters detect:[:delim | delim = (self at:i) ] ifNone:[ ^ i ]
+ delimiters detect:[:delim | delim = (self at:i) ] ifNone:[ ^ i ]
].
^ self size + 1
@@ -1240,31 +1240,31 @@
listOfLines _ OrderedCollection new.
currentLast _ 0.
[currentLast < self size] whileTrue:
- [currentStart _ currentLast + 1.
- putativeLast _ (currentStart + aNumber - 1) min: self size.
- putativeLine _ self copyFrom: currentStart to: putativeLast.
- (crPosition _ putativeLine indexOf: Character cr) > 0 ifTrue:
- [putativeLast _ currentStart + crPosition - 1.
- putativeLine _ self copyFrom: currentStart to: putativeLast].
- currentLast _ putativeLast == self size
- ifTrue:
- [putativeLast]
- ifFalse:
- [currentStart + putativeLine lastSpacePosition - 1].
- currentLast <= currentStart ifTrue:
- ["line has NO spaces; baleout!!"
- currentLast _ putativeLast].
- listOfLines add: (self copyFrom: currentStart to: currentLast) withBlanksTrimmed].
+ [currentStart _ currentLast + 1.
+ putativeLast _ (currentStart + aNumber - 1) min: self size.
+ putativeLine _ self copyFrom: currentStart to: putativeLast.
+ (crPosition _ putativeLine indexOf: Character cr) > 0 ifTrue:
+ [putativeLast _ currentStart + crPosition - 1.
+ putativeLine _ self copyFrom: currentStart to: putativeLast].
+ currentLast _ putativeLast == self size
+ ifTrue:
+ [putativeLast]
+ ifFalse:
+ [currentStart + putativeLine lastSpacePosition - 1].
+ currentLast <= currentStart ifTrue:
+ ["line has NO spaces; baleout!!"
+ currentLast _ putativeLast].
+ listOfLines add: (self copyFrom: currentStart to: currentLast) withBlanksTrimmed].
listOfLines size > 0 ifFalse: [^ ''].
resultString _ listOfLines first.
2 to: listOfLines size do:
- [:i | resultString _ resultString, Character cr asString, (listOfLines at: i)].
+ [:i | resultString _ resultString, Character cr asString, (listOfLines at: i)].
^ resultString
"
#(5 7 20) collect:
- [:i | 'Fred the bear went down to the brook to read his book in silence' withNoLineLongerThan: i]
+ [:i | 'Fred the bear went down to the brook to read his book in silence' withNoLineLongerThan: i]
"
!
@@ -1339,7 +1339,7 @@
"
'do you prefer %1 or rather %2 ?'
- bindWith:'smalltalk' with:'c++'
+ bindWith:'smalltalk' with:'c++'
"
!
@@ -1352,7 +1352,7 @@
"
'do you prefer %1 or rather %2 (not talking about %3) ?'
- bindWith:'smalltalk' with:'c++' with:'c'
+ bindWith:'smalltalk' with:'c++' with:'c'
"
!
@@ -1365,7 +1365,7 @@
"
'do you prefer %1 or rather %2 (not talking about %3 or even %4) ?'
- bindWith:'smalltalk' with:'c++' with:'c' with:'assembler'
+ bindWith:'smalltalk' with:'c++' with:'c' with:'assembler'
"
!
@@ -1385,8 +1385,8 @@
This has been added for VisualAge compatibility."
^ self expandPlaceholdersWith:(Array with:str1 with:str2
- with:str3 with:str4
- with:str5 with:str6)
+ with:str3 with:str4
+ with:str5 with:str6)
!
bindWith:str1 with:str2 with:str3 with:str4 with:str5 with:str6 with:str7
@@ -1395,9 +1395,9 @@
This has been added for VisualAge compatibility."
^ self expandPlaceholdersWith:(Array with:str1 with:str2
- with:str3 with:str4
- with:str5 with:str6
- with:str7)
+ with:str3 with:str4
+ with:str5 with:str6
+ with:str7)
!
bindWith:str1 with:str2 with:str3 with:str4 with:str5 with:str6 with:str7 with:str8
@@ -1406,9 +1406,9 @@
This has been added for VisualAge compatibility."
^ self expandPlaceholdersWith:(Array with:str1 with:str2
- with:str3 with:str4
- with:str5 with:str6
- with:str7 with:str8)
+ with:str3 with:str4
+ with:str5 with:str6
+ with:str7 with:str8)
"Created: / 06-02-2012 / 10:33:18 / cg"
!
@@ -1419,10 +1419,10 @@
This has been added for VisualAge compatibility."
^ self expandPlaceholdersWith:(Array with:str1 with:str2
- with:str3 with:str4
- with:str5 with:str6
- with:str7 with:str8
- with:str9)
+ with:str3 with:str4
+ with:str5 with:str6
+ with:str7 with:str8
+ with:str9)
"Created: / 14-02-2012 / 17:42:31 / cg"
!
@@ -1437,10 +1437,10 @@
"
'do you prefer %1 or rather %2 (not talking about %3) ?'
- bindWithArguments:#('smalltalk' 'c++' 'c')
+ bindWithArguments:#('smalltalk' 'c++' 'c')
'do you %(what) ?'
- bindWithArguments:(Dictionary new at:#'what' put:'understand'; yourself)
+ bindWithArguments:(Dictionary new at:#'what' put:'understand'; yourself)
"
!
@@ -1463,12 +1463,12 @@
This is similar to split: and has been added for VisualAge compatibility."
separatorCharacterOrString isCharacter ifTrue:[
- ^ self asCollectionOfSubstringsSeparatedBy:separatorCharacterOrString
+ ^ self asCollectionOfSubstringsSeparatedBy:separatorCharacterOrString
].
^ self asCollectionOfSubstringsSeparatedByAny:separatorCharacterOrString
"
- 'foo:bar:baz:smalltalk' subStrings:$:
+ 'foo:bar:baz:smalltalk' subStrings:$:
'foo:bar:baz:smalltalk' subStrings:':'
'foo.bar,baz-smalltalk' subStrings:'.,-'
"
@@ -1579,94 +1579,94 @@
out := CharacterWriteStream on:(self species uninitializedNew:self size).
[in atEnd] whileFalse:[
- c := in next.
- c == $% ifTrue:[
- c := in next.
- out nextPut:c
- ] ifFalse:[c ~~ $< ifTrue:[
- out nextPut:c.
- ] ifFalse:[
- peekc := in peek.
- [peekc == $<] whileTrue:[
- out nextPut:$<.
- peekc := in nextPeek.
- ].
- peekc == $n ifTrue:[
- peekc := in nextPeek.
- peekc == $> ifTrue:[
- in next.
- out cr.
- ] ifFalse:[
- out nextPutAll:'<n'.
- ]
- ] ifFalse:[peekc == $t ifTrue:[
- peekc := in nextPeek.
- peekc == $> ifTrue:[
- in next.
- out tab.
- ] ifFalse:[
- out nextPutAll:'<t'.
- ]
- ] ifFalse:[
- peekc isDigit ifTrue:[
- "start an argument expansion ..."
- nr := Integer readFrom:in onError:nil.
- nr isNil ifTrue:[
- "this cannot happen (there is at least one digit)"
- self error:'invalid format' mayProceed:true.
- ^ self
- ].
- fmt := in next.
- (fmt ~~ $? and:[in peek ~~ $>]) ifTrue:[
- out nextPut:$<.
- nr printOn:out.
- out nextPut:fmt.
- ] ifFalse:[
- (nr between:1 and:argArray size) ifTrue:[
- arg := argArray at:nr.
- ] ifFalse:[
- arg := ''
- ].
-
- fmt == $p ifTrue:[
- "expand with args printString"
- arg printOn:out.
- ] ifFalse:[fmt == $s ifTrue:[
- "expand with arg itself"
- arg isText ifTrue:[
- out contentsSpecies isText ifFalse:[
- out := (TextStream ? CharacterWriteStream on:Text new) nextPutAll:out contents; yourself.
- ].
- out nextPutAll:arg.
- ] ifFalse:[
- out nextPutAll:arg asString string. "see method comment: arg must know #asString"
- ]
- ] ifFalse:[fmt == $? ifTrue:[
- s1 := in upTo:$:.
- s2 := in nextUpTo:$>.
- arg == true ifTrue:[
- out nextPutAll:s1
- ] ifFalse:[
- out nextPutAll:s2
- ].
- ] ifFalse:[
- "what does VW do here ?"
- self error:'invalid format' mayProceed:true.
- ^ self
- ]]].
- c := in next.
- c ~~ $> ifTrue:[
- "what does VW do here ?"
- self error:'invalid format' mayProceed:true.
- ^ self
- ]
-
- ].
- ] ifFalse:[
- out nextPut:$<.
- ].
- ]].
- ]].
+ c := in next.
+ c == $% ifTrue:[
+ c := in next.
+ out nextPut:c
+ ] ifFalse:[c ~~ $< ifTrue:[
+ out nextPut:c.
+ ] ifFalse:[
+ peekc := in peek.
+ [peekc == $<] whileTrue:[
+ out nextPut:$<.
+ peekc := in nextPeek.
+ ].
+ peekc == $n ifTrue:[
+ peekc := in nextPeek.
+ peekc == $> ifTrue:[
+ in next.
+ out cr.
+ ] ifFalse:[
+ out nextPutAll:'<n'.
+ ]
+ ] ifFalse:[peekc == $t ifTrue:[
+ peekc := in nextPeek.
+ peekc == $> ifTrue:[
+ in next.
+ out tab.
+ ] ifFalse:[
+ out nextPutAll:'<t'.
+ ]
+ ] ifFalse:[
+ peekc isDigit ifTrue:[
+ "start an argument expansion ..."
+ nr := Integer readFrom:in onError:nil.
+ nr isNil ifTrue:[
+ "this cannot happen (there is at least one digit)"
+ self error:'invalid format' mayProceed:true.
+ ^ self
+ ].
+ fmt := in next.
+ (fmt ~~ $? and:[in peek ~~ $>]) ifTrue:[
+ out nextPut:$<.
+ nr printOn:out.
+ out nextPut:fmt.
+ ] ifFalse:[
+ (nr between:1 and:argArray size) ifTrue:[
+ arg := argArray at:nr.
+ ] ifFalse:[
+ arg := ''
+ ].
+
+ fmt == $p ifTrue:[
+ "expand with args printString"
+ arg printOn:out.
+ ] ifFalse:[fmt == $s ifTrue:[
+ "expand with arg itself"
+ arg isText ifTrue:[
+ out contentsSpecies isText ifFalse:[
+ out := (TextStream ? CharacterWriteStream on:Text new) nextPutAll:out contents; yourself.
+ ].
+ out nextPutAll:arg.
+ ] ifFalse:[
+ out nextPutAll:arg asString string. "see method comment: arg must know #asString"
+ ]
+ ] ifFalse:[fmt == $? ifTrue:[
+ s1 := in upTo:$:.
+ s2 := in nextUpTo:$>.
+ arg == true ifTrue:[
+ out nextPutAll:s1
+ ] ifFalse:[
+ out nextPutAll:s2
+ ].
+ ] ifFalse:[
+ "what does VW do here ?"
+ self error:'invalid format' mayProceed:true.
+ ^ self
+ ]]].
+ c := in next.
+ c ~~ $> ifTrue:[
+ "what does VW do here ?"
+ self error:'invalid format' mayProceed:true.
+ ^ self
+ ]
+
+ ].
+ ] ifFalse:[
+ out nextPut:$<.
+ ].
+ ]].
+ ]].
].
^ out contents
@@ -1692,16 +1692,16 @@
|mySize|
(mySize := self size) >= 2 ifTrue:[
- ((self first == $") and:[self last == $"]) ifTrue:[
- ^ self copyFrom:2 to:mySize-1
- ].
+ ((self first == $") and:[self last == $"]) ifTrue:[
+ ^ self copyFrom:2 to:mySize-1
+ ].
].
^ self
"
'hello' quote unquote
- JavaScriptParser evaluate:'''hello''.quote.unquote'
+ JavaScriptParser evaluate:'''hello''.quote.unquote'
"
! !
@@ -1751,16 +1751,16 @@
sz := self size.
specialChars := '*#[\'.
(escape := self class matchEscapeCharacter) ~~ $\ ifTrue:[
- specialChars := specialChars copy.
- specialChars at:specialChars size put:escape
+ specialChars := specialChars copy.
+ specialChars at:specialChars size put:escape
].
[
- idx := self indexOfAny:specialChars startingAt:idx.
- idx == 0 ifTrue:[^ false].
- (self at:idx) == escape ifFalse:[^ true].
- idx := idx + 2.
- idx > sz ifTrue:[^ false].
+ idx := self indexOfAny:specialChars startingAt:idx.
+ idx == 0 ifTrue:[^ false].
+ (self at:idx) == escape ifFalse:[^ true].
+ idx := idx + 2.
+ idx > sz ifTrue:[^ false].
] loop.
"
@@ -1792,7 +1792,7 @@
mySize := self size.
start to:mySize do:[:index |
- (self at:index) isControlCharacter ifTrue:[^ index]
+ (self at:index) isControlCharacter ifTrue:[^ index]
].
^ 0
@@ -1832,7 +1832,7 @@
mySize := self size.
start to:mySize do:[:index |
- (self at:index) isSeparator ifFalse:[^ index]
+ (self at:index) isSeparator ifFalse:[^ index]
].
^ 0
@@ -1879,12 +1879,12 @@
^ idx.
"
- 'hello world' indexOfSeparatorOrEndStartingAt:3
+ 'hello world' indexOfSeparatorOrEndStartingAt:3
' hello world' indexOfSeparatorOrEndStartingAt:3
'hello world ' indexOfSeparatorOrEndStartingAt:3
'hello world ' indexOfSeparatorOrEndStartingAt:6
'hello world ' indexOfSeparatorOrEndStartingAt:7
- 'helloworld ' indexOfSeparatorOrEndStartingAt:7
+ 'helloworld ' indexOfSeparatorOrEndStartingAt:7
'helloworld' indexOfSeparatorOrEndStartingAt:7
"
!
@@ -1901,7 +1901,7 @@
mySize := self size.
start to:mySize do:[:index |
- (self at:index) isSeparator ifTrue:[^ index]
+ (self at:index) isSeparator ifTrue:[^ index]
].
^ 0
@@ -1943,7 +1943,7 @@
start := startIndex.
start to:1 by:-1 do:[:index |
- (self at:index) isSeparator ifTrue:[^ index]
+ (self at:index) isSeparator ifTrue:[^ index]
].
^ 0
@@ -1973,9 +1973,9 @@
n := mySize min:otherSize.
1 to:n do:[:index |
- c1 := self at:index.
- c2 := aString at:index.
- (c1 == c2 or:[c1 = c2]) ifFalse:[^ c1 < c2].
+ c1 := self at:index.
+ c2 := aString at:index.
+ (c1 == c2 or:[c1 = c2]) ifFalse:[^ c1 < c2].
].
^ mySize < otherSize
!
@@ -1991,13 +1991,13 @@
|mySize "{ Class: SmallInteger }"|
(aString isString or:[aString species == self species]) ifFalse:[
- ^ false
+ ^ false
].
mySize := self size.
mySize ~~ (aString size) ifTrue:[^ false].
1 to:mySize do:[:index |
- (self at:index) = (aString at:index) ifFalse:[^ false].
+ (self at:index) = (aString at:index) ifFalse:[^ false].
].
^ true
@@ -2029,9 +2029,9 @@
n := mySize min:otherSize.
1 to:n do:[:index |
- c1 := self at:index.
- c2 := aString at:index.
- (c1 == c2 or:[c1 = c2]) ifFalse:[^ c1 > c2].
+ c1 := self at:index.
+ c2 := aString at:index.
+ (c1 == c2 or:[c1 = c2]) ifFalse:[^ c1 > c2].
].
^ mySize > otherSize
@@ -2043,12 +2043,12 @@
receiver should come after the argument in a sorted list.
Otherwise return false.
NOTE: The comparison should be language specific, depending on the value of
- LC_COLLATE, which is initialized from the environment.
-
- Currently it is for Strings, but not for UnicodeStrings...
+ LC_COLLATE, which is initialized from the environment.
+
+ Currently it is for Strings, but not for UnicodeStrings...
STUPID:
- #after has a completely different meaning in SeqColl ..."
+ #after has a completely different meaning in SeqColl ..."
^ (self compareCollatingWith:aString) > 0
!
@@ -2062,7 +2062,7 @@
rev1 := self asCollectionOfSubstringsSeparatedBy:$..
aStringOrCollection isString ifTrue:[
- rev2 := aStringOrCollection asCollectionOfSubstringsSeparatedBy:$..
+ rev2 := aStringOrCollection asCollectionOfSubstringsSeparatedBy:$..
].
rev1 := rev1 collect:[:each| each asInteger].
rev2 := rev2 collect:[:each| each asInteger].
@@ -2070,20 +2070,20 @@
^ rev1 compareWith:rev2
"
- self assert:('1' compareAsVersionNumberWith:'2') < 0.
- self assert:('2' compareAsVersionNumberWith:'1') > 0.
- self assert:('1.1' compareAsVersionNumberWith:'2.1.2') < 0.
- self assert:('2.1' compareAsVersionNumberWith:'1.2.3') > 0.
- self assert:('1' compareAsVersionNumberWith:'1.1') < 0.
- self assert:('1.1' compareAsVersionNumberWith:'1') > 0.
- self assert:('1.1' compareAsVersionNumberWith:'1.2') < 0.
- self assert:('1.10' compareAsVersionNumberWith:'1.2') > 0.
- self assert:('1.2.3.4' compareAsVersionNumberWith:'1.2.3.5') < 0.
- self assert:('1.2.3.4' compareAsVersionNumberWith:'1.2.3.3') > 0.
- self assert:('1.2.3.4' compareAsVersionNumberWith:'1.2.3') > 0.
- self assert:('1.2.3.4' compareAsVersionNumberWith:'1.2.3.4') = 0.
- self assert:('1.2.3.4' compareAsVersionNumberWith:'01.002.03.004') = 0.
- self assert:('1.2.3.4' compareAsVersionNumberWith:#(1 2 3 4)) = 0.
+ self assert:('1' compareAsVersionNumberWith:'2') < 0.
+ self assert:('2' compareAsVersionNumberWith:'1') > 0.
+ self assert:('1.1' compareAsVersionNumberWith:'2.1.2') < 0.
+ self assert:('2.1' compareAsVersionNumberWith:'1.2.3') > 0.
+ self assert:('1' compareAsVersionNumberWith:'1.1') < 0.
+ self assert:('1.1' compareAsVersionNumberWith:'1') > 0.
+ self assert:('1.1' compareAsVersionNumberWith:'1.2') < 0.
+ self assert:('1.10' compareAsVersionNumberWith:'1.2') > 0.
+ self assert:('1.2.3.4' compareAsVersionNumberWith:'1.2.3.5') < 0.
+ self assert:('1.2.3.4' compareAsVersionNumberWith:'1.2.3.3') > 0.
+ self assert:('1.2.3.4' compareAsVersionNumberWith:'1.2.3') > 0.
+ self assert:('1.2.3.4' compareAsVersionNumberWith:'1.2.3.4') = 0.
+ self assert:('1.2.3.4' compareAsVersionNumberWith:'01.002.03.004') = 0.
+ self assert:('1.2.3.4' compareAsVersionNumberWith:#(1 2 3 4)) = 0.
"
!
@@ -2105,10 +2105,10 @@
n := mySize min:otherSize.
1 to:n do:[:index |
- c1 := (self at:index) asLowercase.
- c2 := (aString at:index) asLowercase.
- c1 > c2 ifTrue:[^ 1].
- c1 < c2 ifTrue:[^ -1].
+ c1 := (self at:index) asLowercase.
+ c2 := (aString at:index) asLowercase.
+ c1 > c2 ifTrue:[^ 1].
+ c1 < c2 ifTrue:[^ -1].
].
mySize > otherSize ifTrue:[^ 1].
mySize < otherSize ifTrue:[^ -1].
@@ -2129,7 +2129,7 @@
|s|
(s := self string) ~~ self ifTrue:[
- ^ s compareCollatingWith:aString
+ ^ s compareCollatingWith:aString
].
^ self compareWith:aString
!
@@ -2146,7 +2146,7 @@
s := self string.
s ~~ self ifTrue:[
- ^ s compareWith:aString string.
+ ^ s compareWith:aString string.
].
^ super compareWith:aString string.
!
@@ -2158,17 +2158,17 @@
|s|
(s := self string) ~~ self ifTrue:[
- ^ s endsWith:aStringOrCharacter
+ ^ s endsWith:aStringOrCharacter
].
- (self notEmpty and:[aStringOrCharacter isCharacter]) ifTrue:[
- ^ self last = aStringOrCharacter
+ (self size > 0 and:[aStringOrCharacter isCharacter]) ifTrue:[
+ ^ self last = aStringOrCharacter
].
^ super endsWith:aStringOrCharacter
"
'hello world' endsWith:'world'
'hello world' asText allBold endsWith:'world'
- 'hello world' endsWith:''
+ 'hello world' endsWith:''
'hello world' asText allBold endsWith:''
"
@@ -2199,55 +2199,55 @@
^ self hash_fnv1a
"
- 'a' hash
- 'a' asUnicode16String hash
- 'a' asUnicode32String hash
- 'aa' hash
- 'aa' asUnicode16String hash
- 'aa' asUnicode32String hash
- 'ab' hash
- 'ab' asUnicode16String hash
- 'ab' asUnicode32String hash
+ 'a' hash
+ 'a' asUnicode16String hash
+ 'a' asUnicode32String hash
+ 'aa' hash
+ 'aa' asUnicode16String hash
+ 'aa' asUnicode32String hash
+ 'ab' hash
+ 'ab' asUnicode16String hash
+ 'ab' asUnicode32String hash
'ab' hash
- 'ab' asArray hash
- "
-
- "
- |syms ms|
-
- syms := Symbol allInstances.
- Transcript show:'syms: '; showCR:syms size.
- Transcript show:'sdbm hashes: '; showCR:(syms collect:[:s| s hash]) asSet size.
- Transcript show:'dragonBook hashes: '; showCR:(syms collect:[:s| s hash_dragonBook]) asSet size.
-
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash].
- ].
- ].
- Transcript show:'sdbm hash: '; showCR:ms.
-
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash_dragonBook].
- ].
- ].
- Transcript show:'dragonBook: '; showCR:ms.
-
- syms := syms collect:[:each| each asUnicode16String].
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash].
- ].
- ].
- Transcript show:'unicode sdbm hash: '; showCR:ms.
-
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash_dragonBook].
- ].
- ].
- Transcript show:'unicode dragonBook:'; showCR:ms.
+ 'ab' asArray hash
+ "
+
+ "
+ |syms ms|
+
+ syms := Symbol allInstances.
+ Transcript show:'syms: '; showCR:syms size.
+ Transcript show:'sdbm hashes: '; showCR:(syms collect:[:s| s hash]) asSet size.
+ Transcript show:'dragonBook hashes: '; showCR:(syms collect:[:s| s hash_dragonBook]) asSet size.
+
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash].
+ ].
+ ].
+ Transcript show:'sdbm hash: '; showCR:ms.
+
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash_dragonBook].
+ ].
+ ].
+ Transcript show:'dragonBook: '; showCR:ms.
+
+ syms := syms collect:[:each| each asUnicode16String].
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash].
+ ].
+ ].
+ Transcript show:'unicode sdbm hash: '; showCR:ms.
+
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash_dragonBook].
+ ].
+ ].
+ Transcript show:'unicode dragonBook:'; showCR:ms.
"
"Modified: / 26-12-2011 / 14:09:07 / cg"
@@ -2265,14 +2265,14 @@
self reverseDo:[:char |
"/ Sorry, stc cannot compile this (as of 10.9.2007)
"/ h := (h bitShift:4) + char asciiValue.
- h := (h bitShift:4).
- h := h + char codePoint.
- h := h bitAnd:16rFFFFFFFF.
- g := (h bitAnd: 16rF0000000).
- g ~~ 0 ifTrue:[
- h := h bitXor:(g bitShift:-24).
- h := h bitXor:g.
- ].
+ h := (h bitShift:4).
+ h := h + char codePoint.
+ h := h bitAnd:16rFFFFFFFF.
+ g := (h bitAnd: 16rF0000000).
+ g ~~ 0 ifTrue:[
+ h := h bitXor:(g bitShift:-24).
+ h := h bitXor:g.
+ ].
].
"/
"/ multiply by large prime to spread values
@@ -2304,47 +2304,47 @@
h := 2166136261.
self do:[:eachChar |
- h := h bitXor:(eachChar codePoint).
- h := (h * 16777619) bitAnd:16rFFFFFFFF.
+ h := h bitXor:(eachChar codePoint).
+ h := (h * 16777619) bitAnd:16rFFFFFFFF.
].
"/ make sure, it fits into a smallInt
h := (h bitXor: (h >> 30)) bitAnd: 16r3FFFFFFF.
^ h
"
- 'abc' hash_fnv1a
- 'abc' asUnicode16String hash_fnv1a
- 'abc' asUnicode32String hash_fnv1a
-
- 'foofooHelloWorld' hash_fnv1a
- 'foofooHelloWorld' asUnicode16String hash_fnv1a
- 'foofooHelloWorld' asUnicode32String hash_fnv1a
-
- 'blablaHelloWorld' hash_fnv1a
- 'blablaHelloWorld' asUnicode16String hash_fnv1a
- 'blablaHelloWorld' asUnicode32String hash_fnv1a
+ 'abc' hash_fnv1a
+ 'abc' asUnicode16String hash_fnv1a
+ 'abc' asUnicode32String hash_fnv1a
+
+ 'foofooHelloWorld' hash_fnv1a
+ 'foofooHelloWorld' asUnicode16String hash_fnv1a
+ 'foofooHelloWorld' asUnicode32String hash_fnv1a
+
+ 'blablaHelloWorld' hash_fnv1a
+ 'blablaHelloWorld' asUnicode16String hash_fnv1a
+ 'blablaHelloWorld' asUnicode32String hash_fnv1a
"
!
hash_java
"return an integer useful as a hash-key.
This method uses the same algorithm as used in
- the java virtual machine
+ the java virtual machine
(which is actually not a very good one)."
|h|
h := 0.
self do:[:eachChar |
- h := (h * 31) + (eachChar codePoint).
- h := h bitAnd:16rFFFFFFFF.
+ h := (h * 31) + (eachChar codePoint).
+ h := h bitAnd:16rFFFFFFFF.
].
^ h
"
- 'abc' hash_java
- 'foofooHelloWorld' hash_java
- 'blablaHelloWorld' hash_java
+ 'abc' hash_java
+ 'foofooHelloWorld' hash_java
+ 'blablaHelloWorld' hash_java
"
!
@@ -2359,9 +2359,9 @@
"/
h := 0.
self do:[:char |
- h := (65599 times:h) plus:char codePoint.
+ h := (65599 times:h) plus:char codePoint.
].
- ^ h
+ ^ h
"
'a' hash
@@ -2375,41 +2375,41 @@
"
"
- |syms ms|
-
- syms := Symbol allInstances.
- Transcript show:'syms: '; showCR:syms size.
- Transcript show:'sdbm hashes: '; showCR:(syms collect:[:s| s hash]) asSet size.
- Transcript show:'dragonBook hashes: '; showCR:(syms collect:[:s| s hash_dragonBook]) asSet size.
-
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash].
- ].
- ].
- Transcript show:'sdbm hash: '; showCR:ms.
-
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash_dragonBook].
- ].
- ].
- Transcript show:'dragonBook: '; showCR:ms.
-
- syms := syms collect:[:each| each asUnicode16String].
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash].
- ].
- ].
- Transcript show:'unicode sdbm hash: '; showCR:ms.
-
- ms := Time millisecondsToRun:[
- 10 timesRepeat:[
- syms do:[:each| each hash_dragonBook].
- ].
- ].
- Transcript show:'unicode dragonBook:'; showCR:ms.
+ |syms ms|
+
+ syms := Symbol allInstances.
+ Transcript show:'syms: '; showCR:syms size.
+ Transcript show:'sdbm hashes: '; showCR:(syms collect:[:s| s hash]) asSet size.
+ Transcript show:'dragonBook hashes: '; showCR:(syms collect:[:s| s hash_dragonBook]) asSet size.
+
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash].
+ ].
+ ].
+ Transcript show:'sdbm hash: '; showCR:ms.
+
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash_dragonBook].
+ ].
+ ].
+ Transcript show:'dragonBook: '; showCR:ms.
+
+ syms := syms collect:[:each| each asUnicode16String].
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash].
+ ].
+ ].
+ Transcript show:'unicode sdbm hash: '; showCR:ms.
+
+ ms := Time millisecondsToRun:[
+ 10 timesRepeat:[
+ syms do:[:each| each hash_dragonBook].
+ ].
+ ].
+ Transcript show:'unicode dragonBook:'; showCR:ms.
"
"Modified: / 26-12-2011 / 14:09:07 / cg"
@@ -2425,18 +2425,18 @@
in the following, we assume that ommiting a character
is less of an error than inserting an extra character.
Therefore the different insertion (i) and deletion (d) values.
- s: substitution weight (4)
- k: keyboard weight (k) (typing a nearby key) - or nil (then use s)
- c: case weight (4) - or nil (then use s)
- e: exchange weight (8) - or nil (then use s*2)
- i: insertion of extra character weight (2)
- d: delete of a character weight (6)
+ s: substitution weight (4)
+ k: keyboard weight (k) (typing a nearby key) - or nil (then use s)
+ c: case weight (4) - or nil (then use s)
+ e: exchange weight (8) - or nil (then use s*2)
+ i: insertion of extra character weight (2)
+ d: delete of a character weight (6)
"
^ StringUtilities
- levenshteinDistanceFrom:self
- to:aString
- s:4 k:4 c:4 e:nil i:2 d:6
+ levenshteinDistanceFrom:self
+ to:aString
+ s:4 k:4 c:4 e:nil i:2 d:6
"
'computer' levenshteinTo:'computer'
@@ -2468,18 +2468,18 @@
this value corrensponds to the number of replacements that have to be
made to get aString from the receiver.
The arguments are the costs for
- s:substitution,
- k:keyboard type (substitution),
- c:case-change,
- i:insertion
- d:deletion
+ s:substitution,
+ k:keyboard type (substitution),
+ c:case-change,
+ i:insertion
+ d:deletion
of a character.
See IEEE transactions on Computers 1976 Pg 172 ff"
^ StringUtilities
- levenshteinDistanceFrom:self
- to:aString
- s:substWeight k:kbdTypoWeight c:caseWeight e:nil i:insrtWeight d:deleteWeight
+ levenshteinDistanceFrom:self
+ to:aString
+ s:substWeight k:kbdTypoWeight c:caseWeight e:nil i:insrtWeight d:deleteWeight
!
sameAs:aString
@@ -2496,11 +2496,11 @@
mySize == otherSize ifFalse:[^ false].
1 to:mySize do:[:index |
- c1 := self at:index.
- c2 := aString at:index.
- c1 == c2 ifFalse:[
- (c1 sameAs:c2) ifFalse:[^ false].
- ]
+ c1 := self at:index.
+ c2 := aString at:index.
+ c1 == c2 ifFalse:[
+ (c1 sameAs:c2) ifFalse:[^ false].
+ ]
].
^ true
@@ -2519,7 +2519,7 @@
if false, this is the same as #=."
caseSensitive ifFalse:[
- ^ self sameAs:aString
+ ^ self sameAs:aString
].
^ self = aString
@@ -2536,7 +2536,7 @@
if false, this is the same as #=."
ignoreCase ifTrue:[
- ^ self sameAs:aString
+ ^ self sameAs:aString
].
^ self = aString
@@ -2559,12 +2559,12 @@
cnt := 0.
1 to:n do:[:index |
- c1 := self at:index.
- c2 := aString at:index.
- ((c1 == c2)
- or:[c1 asLowercase = c2 asLowercase]) ifTrue:[
- cnt := cnt + 1
- ]
+ c1 := self at:index.
+ c2 := aString at:index.
+ ((c1 == c2)
+ or:[c1 asLowercase = c2 asLowercase]) ifTrue:[
+ cnt := cnt + 1
+ ]
].
^ cnt
@@ -2648,24 +2648,24 @@
score := 0.
i1 := i2 := 1.
[i1 <= size1 and: [i2 <= size2]] whileTrue:[
- next1 := i1 + 1.
- next2 := i2 + 1.
- (self at:i1) == (aString at:i2) ifTrue: [
- score := score+1.
- i1 := next1.
- i2 := next2
- ] ifFalse: [
- (i2 < size2 and: [(self at:i1) == (aString at:next2)]) ifTrue: [
- i2 := next2
- ] ifFalse: [
- (i1 < size1 and: [(self at:next1) == (aString at:i2)]) ifTrue: [
- i1 := next1
- ] ifFalse: [
- i1 := next1.
- i2 := next2
- ]
- ]
- ]
+ next1 := i1 + 1.
+ next2 := i2 + 1.
+ (self at:i1) == (aString at:i2) ifTrue: [
+ score := score+1.
+ i1 := next1.
+ i2 := next2
+ ] ifFalse: [
+ (i2 < size2 and: [(self at:i1) == (aString at:next2)]) ifTrue: [
+ i2 := next2
+ ] ifFalse: [
+ (i1 < size1 and: [(self at:next1) == (aString at:i2)]) ifTrue: [
+ i1 := next1
+ ] ifFalse: [
+ i1 := next1.
+ i2 := next2
+ ]
+ ]
+ ]
].
score == maxLen ifTrue: [^ 100].
@@ -2689,10 +2689,10 @@
|s|
aStringOrCharacter isCharacter ifTrue:[
- ^ (self size > 0) and:[ (self at:1) == aStringOrCharacter ]
+ ^ (self size > 0) and:[ (self at:1) == aStringOrCharacter ]
].
(s := self string) ~~ self ifTrue:[
- ^ s startsWith:aStringOrCharacter
+ ^ s startsWith:aStringOrCharacter
].
^ super startsWith:aStringOrCharacter
@@ -2739,8 +2739,8 @@
str := self string.
str ~~ self ifTrue:[
- "/ for text and other wrappers
- ^ str asByteArray
+ "/ for text and other wrappers
+ ^ str asByteArray
].
"/ for real strings, a fallback
@@ -2749,19 +2749,19 @@
bytes := ByteArray new:(sz * bytesPerCharacter).
idx := 1.
self do:[:char |
- |code|
-
- code := char codePoint.
- bytesPerCharacter == 2 ifTrue:[
- bytes unsignedShortAt:idx put:code
- ] ifFalse:[
- bytesPerCharacter == 4 ifTrue:[
- bytes unsignedLongAt:idx put:code
- ] ifFalse:[
- bytes at:idx put:code
- ].
- ].
- idx := idx + bytesPerCharacter.
+ |code|
+
+ code := char codePoint.
+ bytesPerCharacter == 2 ifTrue:[
+ bytes unsignedShortAt:idx put:code
+ ] ifFalse:[
+ bytesPerCharacter == 4 ifTrue:[
+ bytes unsignedLongAt:idx put:code
+ ] ifFalse:[
+ bytes at:idx put:code
+ ].
+ ].
+ idx := idx + bytesPerCharacter.
].
^ bytes
@@ -2771,7 +2771,7 @@
asCollectionOfLines
"return a collection containing the lines (separated by cr)
of the receiver. If multiple cr's occur in a row, the result will
- contain empty strings.
+ contain empty strings.
If the string ends with a cr, an empty line will be found as last element of the resulting collection.
See also #asCollectionOfLinesWithReturn
(would have rather changed this method instead of adding another one, but a lot of code already uses
@@ -2794,7 +2794,7 @@
lines := self asCollectionOfSubstringsSeparatedBy:Character cr.
(lines notEmpty and:[lines last isEmpty]) ifTrue:[
- ^ lines copyButLast:1
+ ^ lines copyButLast:1
].
^ lines
@@ -2809,15 +2809,15 @@
asCollectionOfSubstringsSeparatedBy:aCharacter
"return a collection containing substrings (separated by aCharacter)
- of the receiver.
+ of the receiver.
If aCharacter occurs multiple times in a row, the result will contain empty strings.
If the receiver ends with aCharacter, an empty string with be the last result element."
^ self asCollectionOfSubCollectionsSeparatedBy:aCharacter
"
- '1 one:2 two:3 three:4 four:5 five' asCollectionOfSubstringsSeparatedBy:$:
- '1 one:2 two:3 three:4 four:5 five:' asCollectionOfSubstringsSeparatedBy:$:
+ '1 one:2 two:3 three:4 four:5 five' asCollectionOfSubstringsSeparatedBy:$:
+ '1 one:2 two:3 three:4 four:5 five:' asCollectionOfSubstringsSeparatedBy:$:
'1 one 2 two 3 three 4 four 5 five' asCollectionOfSubstringsSeparatedBy:Character space
"
!
@@ -2825,8 +2825,8 @@
asCollectionOfSubstringsSeparatedBy:aCharacter exceptIn:ch
"return a collection containing the substrings (separated by aCharacter)
of the receiver. If aCharacter occurs multiple times in a row,
- the result will contain empty strings.
- The separation is not done, inside a matching pair of ch-substrings.
+ the result will contain empty strings.
+ The separation is not done, inside a matching pair of ch-substrings.
Can be used to tokenize csv-like strings, which may or may not be enclosed in quotes."
|lines myClass except i c
@@ -2839,26 +2839,26 @@
startIndex := 1.
except := false.
[
- i := startIndex-1.
- [
- i := i+1.
- c := self at:i.
- c = ch ifTrue:[ except := except not. ].
- i < self size and:[except or:[c ~= aCharacter]]
- ] whileTrue.
-
- c = aCharacter ifTrue:[
- stopIndex := i -1.
- ] ifFalse: [
- stopIndex := i.
- ].
- (stopIndex < startIndex) ifTrue: [
- lines add:(myClass new:0)
- ] ifFalse: [
- lines add:(self copyFrom:startIndex to:stopIndex)
- ].
- startIndex := stopIndex + 2.
- startIndex <= self size
+ i := startIndex-1.
+ [
+ i := i+1.
+ c := self at:i.
+ c = ch ifTrue:[ except := except not. ].
+ i < self size and:[except or:[c ~= aCharacter]]
+ ] whileTrue.
+
+ c = aCharacter ifTrue:[
+ stopIndex := i -1.
+ ] ifFalse: [
+ stopIndex := i.
+ ].
+ (stopIndex < startIndex) ifTrue: [
+ lines add:(myClass new:0)
+ ] ifFalse: [
+ lines add:(self copyFrom:startIndex to:stopIndex)
+ ].
+ startIndex := stopIndex + 2.
+ startIndex <= self size
] whileTrue.
^ lines
@@ -2876,64 +2876,64 @@
|aTextSeparatorChar items scanningWord inStream element lastIsFieldSeparator sz|
aTextSeparatorOrNil isNil ifTrue:[
- ^ self asCollectionOfSubstringsSeparatedByAll: aFieldSeparatorString
+ ^ self asCollectionOfSubstringsSeparatedByAll: aFieldSeparatorString
].
sz := aTextSeparatorOrNil size.
sz = 0 ifTrue:[
- aTextSeparatorChar := aTextSeparatorOrNil
+ aTextSeparatorChar := aTextSeparatorOrNil
] ifFalse:[sz = 1 ifTrue:[
- "this is a String. Fetch the first character - compatibility to older expecco libs"
- aTextSeparatorChar := aTextSeparatorOrNil first.
+ "this is a String. Fetch the first character - compatibility to older expecco libs"
+ aTextSeparatorChar := aTextSeparatorOrNil first.
] ifFalse:[
- self error:'textSeparatoSize > 1'.
+ self error:'textSeparatoSize > 1'.
]].
items := OrderedCollection new.
inStream := ReadStream on:self.
[
- inStream skipSeparators.
- inStream atEnd
+ inStream skipSeparators.
+ inStream atEnd
] whileFalse:[
- lastIsFieldSeparator := false.
- inStream peek == aTextSeparatorChar ifTrue:[
- inStream next.
- element := ''.
- scanningWord := true.
- [ scanningWord and:[inStream atEnd not] ] whileTrue:[
- element := element , (inStream upTo:aTextSeparatorChar).
- (inStream peek == aTextSeparatorChar) ifTrue:[
- element := element , aTextSeparatorChar .
- inStream next.
- ] ifFalse:[
- scanningWord := false.
- ].
- ].
- inStream upToAll_positionBefore:aFieldSeparatorString.
- ] ifFalse:[
- element := inStream upToAll_positionBefore:aFieldSeparatorString
- ].
- items add:element.
- lastIsFieldSeparator := (inStream skipThroughAll:aFieldSeparatorString) notNil.
+ lastIsFieldSeparator := false.
+ inStream peek == aTextSeparatorChar ifTrue:[
+ inStream next.
+ element := ''.
+ scanningWord := true.
+ [ scanningWord and:[inStream atEnd not] ] whileTrue:[
+ element := element , (inStream upTo:aTextSeparatorChar).
+ (inStream peek == aTextSeparatorChar) ifTrue:[
+ element := element , aTextSeparatorChar .
+ inStream next.
+ ] ifFalse:[
+ scanningWord := false.
+ ].
+ ].
+ inStream upToAll_positionBefore:aFieldSeparatorString.
+ ] ifFalse:[
+ element := inStream upToAll_positionBefore:aFieldSeparatorString
+ ].
+ items add:element.
+ lastIsFieldSeparator := (inStream skipThroughAll:aFieldSeparatorString) notNil.
].
lastIsFieldSeparator ifTrue:[
- "empty element at the end of the line"
- items add:''.
+ "empty element at the end of the line"
+ items add:''.
].
^ items
"
self assert:(('#First#, #Second,SecondAdd#, #Third#' asCollectionOfSubstringsSeparatedBy:',' textSeparator: $#)
- sameContentsAs:#('First' 'Second,SecondAdd' 'Third')).
+ sameContentsAs:#('First' 'Second,SecondAdd' 'Third')).
self assert:(('#Fir##st#, #Second,SecondAdd#, #Third#' asCollectionOfSubstringsSeparatedBy:',' textSeparator: $#)
- sameContentsAs:#('Fir#st' 'Second,SecondAdd' 'Third')).
+ sameContentsAs:#('Fir#st' 'Second,SecondAdd' 'Third')).
self assert:(('#Fir##st#, Second,SecondAdd, #Third#' asCollectionOfSubstringsSeparatedBy:',' textSeparator: $#)
- sameContentsAs:#('Fir#st' 'Second' 'SecondAdd' 'Third')).
+ sameContentsAs:#('Fir#st' 'Second' 'SecondAdd' 'Third')).
self assert:(('First,Second,Third,,' asCollectionOfSubstringsSeparatedBy:',' textSeparator:nil)
- sameContentsAs:#('First' 'Second' 'Third' '' '')).
+ sameContentsAs:#('First' 'Second' 'Third' '' '')).
self assert:(('First,Second,Third,,' asCollectionOfSubstringsSeparatedBy:',' textSeparator:'#')
- sameContentsAs:#('First' 'Second' 'Third' '' '')).
+ sameContentsAs:#('First' 'Second' 'Third' '' '')).
"
"Modified: / 07-04-2011 / 13:23:19 / cg"
@@ -3005,18 +3005,18 @@
start := 1.
mySize := self size.
[start <= mySize] whileTrue:[
- start := self indexOfNonSeparatorStartingAt:start.
- start == 0 ifTrue:[
- ^ count
- ].
- stop := self indexOfSeparatorStartingAt:start.
- stop == 0 ifTrue:[
- aBlock value:(self copyFrom:start to:mySize).
- ^ count + 1
- ].
- aBlock value:(self copyFrom:start to:(stop - 1)).
- start := stop.
- count := count + 1
+ start := self indexOfNonSeparatorStartingAt:start.
+ start == 0 ifTrue:[
+ ^ count
+ ].
+ stop := self indexOfSeparatorStartingAt:start.
+ stop == 0 ifTrue:[
+ aBlock value:(self copyFrom:start to:mySize).
+ ^ count + 1
+ ].
+ aBlock value:(self copyFrom:start to:(stop - 1)).
+ start := stop.
+ count := count + 1
].
^ count
@@ -3105,10 +3105,10 @@
'-1234' asInteger
The following raises an error:
- '0.123' asInteger <- reader finds more after reading 0
+ '0.123' asInteger <- reader finds more after reading 0
whereas the less strict readFrom does not:
- Integer readFrom:'0.123' <- reader stops at ., returning 0
+ Integer readFrom:'0.123' <- reader stops at ., returning 0
'0.123' asInteger
'0.123' asNumber <- returns what you expect
@@ -3129,12 +3129,12 @@
bitsPerCharacter := newStr bitsPerCharacter.
1 to:mySize do:[:i |
- c := (self at:i) asLowercase.
- (c bitsPerCharacter > bitsPerCharacter
- and:[c stringSpecies ~= newStr stringSpecies]) ifTrue:[
- newStr := c stringSpecies fromString:newStr.
- ].
- newStr at:i put:c
+ c := (self at:i) asLowercase.
+ (c bitsPerCharacter > bitsPerCharacter
+ and:[c stringSpecies ~= newStr stringSpecies]) ifTrue:[
+ newStr := c stringSpecies fromString:newStr.
+ ].
+ newStr at:i put:c
].
^ newStr
@@ -3157,9 +3157,9 @@
firstChar == firstCharAsLowercase ifTrue:[ ^ self].
firstCharAsLowercase bitsPerCharacter > self bitsPerCharacter ifTrue:[
- newString := firstCharAsLowercase stringSpecies fromString:self.
+ newString := firstCharAsLowercase stringSpecies fromString:self.
] ifFalse:[
- newString := self stringSpecies fromString:self.
+ newString := self stringSpecies fromString:self.
].
newString at:1 put:firstCharAsLowercase.
^ newString
@@ -3179,7 +3179,7 @@
sz := self size.
newString := self copyFrom:1 to:sz.
sz > 0 ifTrue:[
- newString at:sz put:(newString at:sz) asLowercase
+ newString at:sz put:(newString at:sz) asLowercase
].
^ newString
@@ -3210,7 +3210,7 @@
^ Number fromString:self
"
- '123' asNumber
+ '123' asNumber
'123.567' asNumber
'(5/6)' asNumber
'foo' asNumber
@@ -3278,14 +3278,14 @@
newString := String new:(self size).
1 to:self size do:[:idx |
- |char|
-
- char := self at:idx.
- char codePoint <= 16rFF ifTrue:[
- newString at:idx put:char
- ] ifFalse:[
- newString at:idx put:replacementCharacter
- ].
+ |char|
+
+ char := self at:idx.
+ char codePoint <= 16rFF ifTrue:[
+ newString at:idx put:char
+ ] ifFalse:[
+ newString at:idx put:replacementCharacter
+ ].
].
^ newString
@@ -3321,7 +3321,7 @@
asSymbolIfInterned
"If a symbol with the receiver's characters is already known, return it. Otherwise, return nil.
This can be used to query for an existing symbol and is the same as:
- self knownAsSymbol ifTrue:[self asSymbol] ifFalse:[nil]
+ self knownAsSymbol ifTrue:[self asSymbol] ifFalse:[nil]
but slightly faster, since the symbol lookup operation is only performed once.
The receiver must be a singleByte-String.
TwoByte- and FourByteSymbols are (currently ?) not allowed."
@@ -3375,15 +3375,15 @@
bitsPerCharacter := newStr bitsPerCharacter.
1 to:mySize do:[:i |
- i == 1 ifTrue:[
- c := (self at:i) asTitlecase.
- ] ifFalse:[
- c := (self at:i) asLowercase.
- ].
- c bitsPerCharacter > bitsPerCharacter ifTrue:[
- newStr := c stringSpecies fromString:newStr.
- ].
- newStr at:i put:c
+ i == 1 ifTrue:[
+ c := (self at:i) asTitlecase.
+ ] ifFalse:[
+ c := (self at:i) asLowercase.
+ ].
+ c bitsPerCharacter > bitsPerCharacter ifTrue:[
+ newStr := c stringSpecies fromString:newStr.
+ ].
+ newStr at:i put:c
].
^ newStr
@@ -3422,9 +3422,9 @@
firstChar == firstCharAsTitlecase ifTrue:[ ^ self].
firstCharAsTitlecase bitsPerCharacter > self bitsPerCharacter ifTrue:[
- newString := firstCharAsTitlecase stringSpecies fromString:self.
+ newString := firstCharAsTitlecase stringSpecies fromString:self.
] ifFalse:[
- newString := self stringSpecies fromString:self.
+ newString := self stringSpecies fromString:self.
].
newString at:1 put:firstCharAsTitlecase.
^ newString
@@ -3471,12 +3471,12 @@
sz := self size.
- ^ (Unicode16String new:sz)
- replaceFrom:1 to:sz with:self startingAt:1;
- yourself.
-
- "
- 'abc' asUnicode16String
+ ^ (Unicode16String new:sz)
+ replaceFrom:1 to:sz with:self startingAt:1;
+ yourself.
+
+ "
+ 'abc' asUnicode16String
"
!
@@ -3491,17 +3491,17 @@
sz := self size.
(self at:sz) == (Character codePoint:0) ifTrue:[
- ^ self asUnicode16String.
- ].
-
- ^ (Unicode16String new:sz+1)
- replaceFrom:1 to:sz with:self startingAt:1;
- at:sz+1 put:(Character codePoint:0);
- yourself.
+ ^ self asUnicode16String.
+ ].
+
+ ^ (Unicode16String new:sz+1)
+ replaceFrom:1 to:sz with:self startingAt:1;
+ at:sz+1 put:(Character codePoint:0);
+ yourself.
"
- 'abc' asUnicode16StringZ
- 'abc' asUnicode16String asUnicode16StringZ
+ 'abc' asUnicode16StringZ
+ 'abc' asUnicode16String asUnicode16StringZ
"
!
@@ -3546,11 +3546,11 @@
bitsPerCharacter := newStr bitsPerCharacter.
1 to:mySize do:[:i |
- c := (self at:i) asUppercase.
- c bitsPerCharacter > bitsPerCharacter ifTrue:[
- newStr := c stringSpecies fromString:newStr.
- ].
- newStr at:i put:c
+ c := (self at:i) asUppercase.
+ c bitsPerCharacter > bitsPerCharacter ifTrue:[
+ newStr := c stringSpecies fromString:newStr.
+ ].
+ newStr at:i put:c
].
^ newStr
@@ -3575,9 +3575,9 @@
"/ very seldom, the uppercase-char needs more bits than the lowercase one (turkish y-diaresis)
firstCharAsUppercase bitsPerCharacter > self bitsPerCharacter ifTrue:[
- newString := firstCharAsUppercase stringSpecies fromString:self.
+ newString := firstCharAsUppercase stringSpecies fromString:self.
] ifFalse:[
- newString := self stringSpecies fromString:self.
+ newString := self stringSpecies fromString:self.
].
newString at:1 put:firstCharAsUppercase.
^ newString
@@ -3598,7 +3598,7 @@
sz := self size.
newString := self copyFrom:1 to:sz.
sz > 0 ifTrue:[
- newString at:sz put:(newString at:sz) asUppercase
+ newString at:sz put:(newString at:sz) asUppercase
].
^ newString
@@ -3647,18 +3647,18 @@
|myWidth otherWidth|
aStringOrCharacter isCharacter ifTrue:[
- ^ self copyWith:aStringOrCharacter
+ ^ self copyWith:aStringOrCharacter
].
aStringOrCharacter isText ifTrue:[
- ^ aStringOrCharacter concatenateFromString:self
+ ^ aStringOrCharacter concatenateFromString:self
].
aStringOrCharacter isString ifTrue:[
- (otherWidth := aStringOrCharacter bitsPerCharacter) ~~ (myWidth := self bitsPerCharacter) ifTrue:[
- otherWidth > myWidth ifTrue:[
- ^ (aStringOrCharacter species fromString:self) , aStringOrCharacter
- ].
- ^ self , (self species fromString:aStringOrCharacter)
- ].
+ (otherWidth := aStringOrCharacter bitsPerCharacter) ~~ (myWidth := self bitsPerCharacter) ifTrue:[
+ otherWidth > myWidth ifTrue:[
+ ^ (aStringOrCharacter species fromString:self) , aStringOrCharacter
+ ].
+ ^ self , (self species fromString:aStringOrCharacter)
+ ].
].
^ super , aStringOrCharacter
@@ -3670,7 +3670,7 @@
(JISEncodedString fromString:'hello') , ' world'
Transcript showCR:
- (Text string:'hello' emphasis:#italic) , (Text string:' world' emphasis:#bold)
+ (Text string:'hello' emphasis:#italic) , (Text string:' world' emphasis:#bold)
"
"Modified: 28.6.1997 / 00:13:17 / cg"
@@ -3699,7 +3699,7 @@
n1 := n2 := maxLen // 2.
maxLen odd ifTrue:[
- n2 := n1 + 1
+ n2 := n1 + 1
].
^ (self copyFrom:1 to:n1) , (self copyFrom:sz - n2 + 1)
@@ -3848,13 +3848,13 @@
"/ ANSI seems to allow a sequence to be replaced by another sequence,
"/ whereas the old ST80 meant replace all occurrences... - sigh.
oldElement isByteCollection ifTrue:[
- newElement isByteCollection ifTrue:[
- ^ self copyReplaceString:oldElement withString:newElement.
- ].
- self halt:'check if this is legal'.
+ newElement isByteCollection ifTrue:[
+ ^ self copyReplaceString:oldElement withString:newElement.
+ ].
+ self halt:'check if this is legal'.
].
newElement isByteCollection ifTrue:[
- self halt:'check if this is legal'.
+ self halt:'check if this is legal'.
].
^ super copyReplaceAll:oldElement with:newElement
!
@@ -3868,13 +3868,13 @@
tmpStream := self species writeStream.
idx := 1.
[idx ~~ 0] whileTrue:[
- idx1 := idx.
- idx := self indexOfSubCollection:subString startingAt:idx.
- idx ~~ 0 ifTrue:[
- tmpStream nextPutAll:(self copyFrom:idx1 to:idx-1).
- tmpStream nextPutAll:newString.
- idx := idx + subString size
- ]
+ idx1 := idx.
+ idx := self indexOfSubCollection:subString startingAt:idx.
+ idx ~~ 0 ifTrue:[
+ tmpStream nextPutAll:(self copyFrom:idx1 to:idx-1).
+ tmpStream nextPutAll:newString.
+ idx := idx + subString size
+ ]
].
tmpStream nextPutAll:(self copyFrom:idx1).
^ tmpStream contents
@@ -3885,7 +3885,7 @@
'12345678901234567890' copyReplaceString:'234' withString:'foo'
('a string with spaces' copyReplaceAll:$ withAll:' foo ')
- copyReplaceString:'foo' withString:'bar'
+ copyReplaceString:'foo' withString:'bar'
"
"Modified: / 31-05-1999 / 12:33:59 / cg"
@@ -3903,11 +3903,11 @@
|sz newString|
aCharacter bitsPerCharacter > self bitsPerCharacter ifTrue:[
- sz := self size.
- newString := aCharacter stringSpecies new:sz + 1.
- newString replaceFrom:1 to:sz with:self startingAt:1.
- newString at:sz+1 put:aCharacter.
- ^ newString.
+ sz := self size.
+ newString := aCharacter stringSpecies new:sz + 1.
+ newString replaceFrom:1 to:sz with:self startingAt:1.
+ newString at:sz+1 put:aCharacter.
+ ^ newString.
].
^ super copyWith:aCharacter
!
@@ -3917,7 +3917,7 @@
if it matches return the right.
Finally, if strip is true, remove whiteSpace.
This method is used to match and extract lines of the form:
- something: rest
+ something: rest
where we are interested in rest, but only if the receiver string
begins with something.
@@ -3930,11 +3930,11 @@
|rest|
(self startsWith:keyword) ifTrue:[
- rest := self copyFrom:(keyword size + 1).
- strip ifTrue:[
- rest := rest withoutSeparators
- ].
- ^ rest
+ rest := self copyFrom:(keyword size + 1).
+ strip ifTrue:[
+ rest := rest withoutSeparators
+ ].
+ ^ rest
].
^ nil
@@ -3951,29 +3951,29 @@
splitAtString:subString withoutSeparators:strip
"If the receiver is of the form:
- <left><subString><right>
+ <left><subString><right>
return a collection containing left and right only.
If strip is true, remove whiteSpace in the returned substrings."
|idx left right|
(idx := self indexOfSubCollection:subString) ~~ 0 ifTrue:[
- left := self copyTo:(idx - 1).
- right := self copyFrom:(idx + subString size).
- strip ifTrue:[
- left := left withoutSeparators.
- right := right withoutSeparators.
- ].
- ^ StringCollection with:left with:right
+ left := self copyTo:(idx - 1).
+ right := self copyFrom:(idx + subString size).
+ strip ifTrue:[
+ left := left withoutSeparators.
+ right := right withoutSeparators.
+ ].
+ ^ StringCollection with:left with:right
].
self error:'substring not present in receiver' mayProceed:true.
^ self
"
- 'hello -> world' splitAtString:'->' withoutSeparators:false
- 'hello -> world' splitAtString:'->' withoutSeparators:true
- 'hello -> ' splitAtString:'->' withoutSeparators:true
- 'hello > error' splitAtString:'->' withoutSeparators:true
+ 'hello -> world' splitAtString:'->' withoutSeparators:false
+ 'hello -> world' splitAtString:'->' withoutSeparators:true
+ 'hello -> ' splitAtString:'->' withoutSeparators:true
+ 'hello > error' splitAtString:'->' withoutSeparators:true
"
"Created: 25.11.1995 / 11:04:18 / cg"
@@ -3995,9 +3995,9 @@
"q&d hack"
(start == 1 and:[stop == self size]) ifTrue:[
- self displayOn:aGC x:x y:y opaque:opaque.
+ self displayOn:aGC x:x y:y opaque:opaque.
] ifFalse:[
- (self copyFrom:start to:stop) displayOn:aGC x:x y:y opaque:opaque.
+ (self copyFrom:start to:stop) displayOn:aGC x:x y:y opaque:opaque.
].
!
@@ -4009,9 +4009,9 @@
s := self string.
opaque ifTrue:[
- aGc displayOpaqueString:s x:x y:y.
+ aGc displayOpaqueString:s x:x y:y.
] ifFalse:[
- aGc displayString:s x:x y:y.
+ aGc displayString:s x:x y:y.
].
"Modified: 11.5.1996 / 14:42:48 / cg"
@@ -4332,9 +4332,9 @@
is self-inverse, so the same code can be used for encoding and decoding."
^ self species
- streamContents:[:aStream |
- self do:[:char |
- aStream nextPut:(char rot:n) ]]
+ streamContents:[:aStream |
+ self do:[:char |
+ aStream nextPut:(char rot:n) ]]
"
'hello world' rot:13
@@ -4365,13 +4365,13 @@
|in out|
(self isWideString or:[self contains8BitCharacters]) ifFalse:[
- "speed up common case"
- ^ self.
+ "speed up common case"
+ ^ self.
].
out := CharacterWriteStream on:(String uninitializedNew:self size).
in := self readStream.
[in atEnd] whileFalse:[
- out nextPut:(Character utf8DecodeFrom:in).
+ out nextPut:(Character utf8DecodeFrom:in).
].
^ out contents
@@ -4389,12 +4389,12 @@
|utf8Encoding original readBack|
1 to:16rFFFF do:[:ascii |
- original := (Character value:ascii) asString.
- utf8Encoding := original utf8Encoded.
- readBack := utf8Encoding utf8Decoded.
- readBack = original ifFalse:[
- self halt
- ]
+ original := (Character value:ascii) asString.
+ utf8Encoding := original utf8Encoded.
+ readBack := utf8Encoding utf8Decoded.
+ readBack = original ifFalse:[
+ self halt
+ ]
]
"
!
@@ -4409,17 +4409,17 @@
out := WriteStream on:(String uninitializedNew:self size).
in := self readStream.
[in atEnd] whileFalse:[
- c := Character utf8DecodeFrom:in.
- c codePoint > 16rFF ifTrue:[
- c := replacementCharacter
- ].
- out nextPut:c.
+ c := Character utf8DecodeFrom:in.
+ c codePoint > 16rFF ifTrue:[
+ c := replacementCharacter
+ ].
+ out nextPut:c.
].
^ out contents
"
(Character value:16r220) utf8Encoded
- utf8DecodedWithTwoByteCharactersReplacedBy:(Character space)
+ utf8DecodedWithTwoByteCharactersReplacedBy:(Character space)
"
!
@@ -4430,12 +4430,12 @@
string := self string.
string ~~ self ifTrue:[
- ^ string utf8Encoded.
+ ^ string utf8Encoded.
].
(self isWideString or:[self contains8BitCharacters]) ifFalse:[
- "speed up common case"
- ^ self.
+ "speed up common case"
+ ^ self.
].
^ self basicUtf8Encoded.
@@ -4454,12 +4454,12 @@
string := self string.
string ~~ self ifTrue:[
- ^ string utf8EncodedOn:aStream.
+ ^ string utf8EncodedOn:aStream.
].
(self isWideString or:[self contains8BitCharacters]) ifFalse:[
- "speed up common case"
- aStream nextPutAll:self.
+ "speed up common case"
+ aStream nextPutAll:self.
].
aStream nextPutAllUtf8:self.
@@ -4480,7 +4480,7 @@
This is usable with fileName pattern fields.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -4505,7 +4505,7 @@
This is usable with fileName pattern fields.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -4535,7 +4535,7 @@
This is usable with fileName pattern fields.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -4543,10 +4543,10 @@
matchers := self asCollectionOfSubstringsSeparatedBy:$;.
withoutSeparators ifTrue:[ matchers := matchers collect:[:each | each withoutSeparators] ].
- ^ matchers
- contains:[:aPattern |
- aPattern match:aString ignoreCase:caseSensitive not escapeCharacter:nil
- ].
+ ^ matchers
+ contains:[:aPattern |
+ aPattern match:aString ignoreCase:caseSensitive not escapeCharacter:nil
+ ].
"
'f*' match:'foo'
@@ -4559,7 +4559,7 @@
'f*;b*' compoundMatch:'Bar' caseSensitive:false
'f*;b*' compoundMatch:'ccc' caseSensitive:false
- 'f* ; b*' compoundMatch:'foo'
+ 'f* ; b*' compoundMatch:'foo'
'f* ; b*' compoundMatch:'foo' caseSensitive:true withoutSeparators:true
"
@@ -4576,7 +4576,7 @@
This is usable with fileName pattern fields.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -4605,7 +4605,7 @@
if not found, return 0.
NOTICE: match-meta character interpretation is like in unix-matching,
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the argument is the match pattern"
@@ -4618,7 +4618,7 @@
if not found, return 0.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the argument is the match pattern"
@@ -4632,7 +4632,7 @@
This is a q&d hack - not very efficient.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the argument is the match pattern"
@@ -4647,41 +4647,41 @@
realMatchString := matchString.
(realMatchString endsWith:$*) ifFalse:[
- realMatchString := realMatchString , '*'.
- matchSize := matchSize + 1
+ realMatchString := realMatchString , '*'.
+ matchSize := matchSize + 1
].
mySize := self size.
firstChar := realMatchString at:1.
firstChar == self class matchEscapeCharacter ifTrue:[
- firstChar := realMatchString at:2.
+ firstChar := realMatchString at:2.
].
firstChar asString includesMatchCharacters ifTrue:[
- index to:mySize do:[:col |
- (realMatchString match:self from:col to:mySize caseSensitive:caseSensitive)
- ifTrue:[^ col]
- ].
- ^ exceptionBlock value.
+ index to:mySize do:[:col |
+ (realMatchString match:self from:col to:mySize caseSensitive:caseSensitive)
+ ifTrue:[^ col]
+ ].
+ ^ exceptionBlock value.
].
lcChar := firstChar asLowercase.
ucChar := firstChar asUppercase.
(caseSensitive not and:[ lcChar ~= ucChar ]) ifTrue:[
- firstSet := Array with:ucChar with:lcChar.
- startIndex := self indexOfAny:firstSet startingAt:index.
+ firstSet := Array with:ucChar with:lcChar.
+ startIndex := self indexOfAny:firstSet startingAt:index.
] ifFalse:[
- startIndex := self indexOf:firstChar startingAt:index.
+ startIndex := self indexOf:firstChar startingAt:index.
].
[startIndex == 0] whileFalse:[
- (realMatchString match:self from:startIndex to:mySize caseSensitive:caseSensitive)
- ifTrue:[^ startIndex].
-
- firstSet notNil ifTrue:[
- startIndex := self indexOfAny:firstSet startingAt:(startIndex + 1).
- ] ifFalse:[
- startIndex := self indexOf:firstChar startingAt:(startIndex + 1).
- ].
+ (realMatchString match:self from:startIndex to:mySize caseSensitive:caseSensitive)
+ ifTrue:[^ startIndex].
+
+ firstSet notNil ifTrue:[
+ startIndex := self indexOfAny:firstSet startingAt:(startIndex + 1).
+ ] ifFalse:[
+ startIndex := self indexOf:firstChar startingAt:(startIndex + 1).
+ ].
].
^ exceptionBlock value
@@ -4706,12 +4706,12 @@
This is a q&d hack - not very efficient.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the argument is the match pattern"
- ^ self
- findMatchString:matchString startingAt:index caseSensitive:ignoreCase not ifAbsent:exceptionBlock
+ ^ self
+ findMatchString:matchString startingAt:index caseSensitive:ignoreCase not ifAbsent:exceptionBlock
"
'one two three four' findMatchString:'o[nu]'
@@ -4727,7 +4727,7 @@
find matchstring; if found, return true, otherwise return false.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the argument is the match pattern"
@@ -4746,7 +4746,7 @@
find matchstring; if found, return true, otherwise return false.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the argument is the match pattern"
@@ -4777,7 +4777,7 @@
The escape character is the backQuote.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -4810,7 +4810,7 @@
The escape character is the backQuote.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -4829,14 +4829,14 @@
'*some*compl*ern*' match:'this is another complicated pattern match' caseSensitive:false
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '[ab]*' match:sym caseSensitive:true
- ]
+ Symbol allInstancesDo:[:sym |
+ '[ab]*' match:sym caseSensitive:true
+ ]
].
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '*at:*' match:sym caseSensitive:true
- ]
+ Symbol allInstancesDo:[:sym |
+ '*at:*' match:sym caseSensitive:true
+ ]
].
"
@@ -4850,7 +4850,7 @@
If caseSensitive is false, lower/uppercase are considered the same.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -4869,14 +4869,14 @@
'*some*compl*ern*' match:'this is another complicated pattern match' caseSensitive:false
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '[ab]*' match:sym caseSensitive:true
- ]
+ Symbol allInstancesDo:[:sym |
+ '[ab]*' match:sym caseSensitive:true
+ ]
].
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '*at:*' match:sym caseSensitive:true
- ]
+ Symbol allInstancesDo:[:sym |
+ '*at:*' match:sym caseSensitive:true
+ ]
].
"
@@ -4890,7 +4890,7 @@
Lower/uppercase are considered different.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -4911,13 +4911,13 @@
The escape character is the backQuote.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
^ self
- match:aString from:start to:stop caseSensitive:caseSensitive
- escapeCharacter:(self class matchEscapeCharacter)
+ match:aString from:start to:stop caseSensitive:caseSensitive
+ escapeCharacter:(self class matchEscapeCharacter)
"
'*ute*' match:'12345COMPUTER' from:1 to:5 caseSensitive:false
@@ -4935,7 +4935,7 @@
If caseSensitive is false, lower/uppercase are considered the same.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -4948,23 +4948,23 @@
"
(PreviousMatch notNil
and:[PreviousMatch key = self]) ifTrue:[
- matchScanArray := PreviousMatch value
+ matchScanArray := PreviousMatch value
] ifFalse:[
- matchScanArray := self class matchScanArrayFrom:self escapeCharacter:escape.
- matchScanArray isNil ifTrue:[
- 'CharacterArray [info]: invalid matchpattern:''' infoPrint. self infoPrint. ''' comparing for equality.' infoPrintCR.
- ^ self = aString
+ matchScanArray := self class matchScanArrayFrom:self escapeCharacter:escape.
+ matchScanArray isNil ifTrue:[
+ 'CharacterArray [info]: invalid matchpattern:''' infoPrint. self infoPrint. ''' comparing for equality.' infoPrintCR.
+ ^ self = aString
"/ ^ false
- ].
- PreviousMatch := self -> matchScanArray.
+ ].
+ PreviousMatch := self -> matchScanArray.
].
^ self class
- matchScan:matchScanArray
- from:1 to:matchScanArray size
- with:aString
- from:start to:stop
- caseSensitive:caseSensitive
+ matchScan:matchScanArray
+ from:1 to:matchScanArray size
+ with:aString
+ from:start to:stop
+ caseSensitive:caseSensitive
"
'*ute*' match:'12345COMPUTER' from:1 to:5 caseSensitive:false
@@ -4984,13 +4984,13 @@
The escape character is the backQuote.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
^ self
- match:aString from:start to:stop ignoreCase:ignoreCase
- escapeCharacter:(self class matchEscapeCharacter)
+ match:aString from:start to:stop ignoreCase:ignoreCase
+ escapeCharacter:(self class matchEscapeCharacter)
"
'*ute*' match:'12345COMPUTER' from:1 to:5 ignoreCase:true
@@ -5009,14 +5009,14 @@
If ignoreCase is true, lower/uppercase are considered the same.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
- ^ self
- match:aString from:start to:stop
- caseSensitive:ignoreCase not
- escapeCharacter:escape
+ ^ self
+ match:aString from:start to:stop
+ caseSensitive:ignoreCase not
+ escapeCharacter:escape
"
'*ute*' match:'12345COMPUTER' from:1 to:5 ignoreCase:true
@@ -5035,7 +5035,7 @@
The escape character is the backQuote.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5055,14 +5055,14 @@
'*some*compl*ern*' match:'this is another complicated pattern match' ignoreCase:true
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '[ab]*' match:sym ignoreCase:false
- ]
+ Symbol allInstancesDo:[:sym |
+ '[ab]*' match:sym ignoreCase:false
+ ]
].
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '*at:*' match:sym ignoreCase:false
- ]
+ Symbol allInstancesDo:[:sym |
+ '*at:*' match:sym ignoreCase:false
+ ]
].
"
@@ -5077,7 +5077,7 @@
If ignoreCase is true, lower/uppercase are considered the same.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5096,14 +5096,14 @@
'*some*compl*ern*' match:'this is another complicated pattern match' ignoreCase:true
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '[ab]*' match:sym ignoreCase:false
- ]
+ Symbol allInstancesDo:[:sym |
+ '[ab]*' match:sym ignoreCase:false
+ ]
].
Time millisecondsToRun:[
- Symbol allInstancesDo:[:sym |
- '*at:*' match:sym ignoreCase:false
- ]
+ Symbol allInstancesDo:[:sym |
+ '*at:*' match:sym ignoreCase:false
+ ]
].
"
@@ -5117,7 +5117,7 @@
Lower/uppercase are considered different.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5130,7 +5130,7 @@
or [...] to match a set of characters.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5145,7 +5145,7 @@
Lower/uppercase are considered different.
NOTICE: match-meta character interpretation is like in unix-matching (glob),
- NOT the ST-80 meaning.
+ NOT the ST-80 meaning.
NOTICE: this is GLOB, which is different from regex matching (see matchesRegex:)
NOTICE: the receiver is the match pattern"
@@ -5186,9 +5186,9 @@
len := self size.
(len < size) ifTrue:[
- s := self species new:size withAll:padCharacter.
- s replaceFrom:(size - len) // 2 + 1 with:self.
- ^ s
+ s := self species new:size withAll:padCharacter.
+ s replaceFrom:(size - len) // 2 + 1 with:self.
+ ^ s
]
"
@@ -5212,11 +5212,11 @@
(sounds complicated ? -> see examples below)."
^ self
- decimalPaddedTo:size
- and:afterPeriod
- at:decimalCharacter
- withLeft:(Character space)
- right:$0
+ decimalPaddedTo:size
+ and:afterPeriod
+ at:decimalCharacter
+ withLeft:(Character space)
+ right:$0
"
'123' decimalPaddedTo:10 and:3 at:$. -> ' 123 '
@@ -5245,25 +5245,25 @@
idx := self indexOf:decimalCharacter.
idx == 0 ifTrue:[
- "/
- "/ no decimal point found; adjust string to the left of the period column
- "/
- rightPadChar isNil ifTrue:[
- s := self , (self species new:afterPeriod + 1 withAll:leftPadChar)
- ] ifFalse:[
- s:= self , decimalCharacter asString , (self species new:afterPeriod withAll:rightPadChar).
- ].
+ "/
+ "/ no decimal point found; adjust string to the left of the period column
+ "/
+ rightPadChar isNil ifTrue:[
+ s := self , (self species new:afterPeriod + 1 withAll:leftPadChar)
+ ] ifFalse:[
+ s:= self , decimalCharacter asString , (self species new:afterPeriod withAll:rightPadChar).
+ ].
] ifFalse:[
- "/ the number of after-decimalPoint characters
- n := self size - idx.
- rest := afterPeriod - n.
- rest > 0 ifTrue:[
- s := (self species new:rest withAll:(rightPadChar ? leftPadChar)).
- ] ifFalse:[
- s := ''
- ].
- s := self , s.
+ "/ the number of after-decimalPoint characters
+ n := self size - idx.
+ rest := afterPeriod - n.
+ rest > 0 ifTrue:[
+ s := (self species new:rest withAll:(rightPadChar ? leftPadChar)).
+ ] ifFalse:[
+ s := ''
+ ].
+ s := self , s.
].
^ s leftPaddedTo:size with:leftPadChar
@@ -5322,46 +5322,46 @@
firstChar := (self at:1) asLowercase.
((firstChar isVowel and:[firstChar ~~ $u]) or:[firstChar == $x]) ifTrue:[
- ^ 'an'
+ ^ 'an'
].
(self size >= 3) ifTrue:[
- secondChar := (self at:2) asLowercase.
- thirdChar := (self at:3) asLowercase.
- (firstChar isVowel not
- and:[(secondChar isVowel or:[secondChar == $y]) not
- and:[thirdChar isVowel not ]]) ifTrue:[
- "/ exceptions: 3 non-vowels in a row: looks like an abbreviation
- (self size > 4) ifTrue:[
- (firstChar == $s) ifTrue:[
- ((secondChar == $c and:[thirdChar == $r])
- or:[ (secondChar == $t and:[thirdChar == $r]) ]) ifTrue:[
- (self at:4) isVowel ifTrue:[
- ^ 'a'
- ]
- ]
- ].
- ].
- "/ an abbreviation; treat x, s as vowels
- (firstChar == $x or:[ firstChar == $s ]) ifTrue:[^ 'an'].
- ]
+ secondChar := (self at:2) asLowercase.
+ thirdChar := (self at:3) asLowercase.
+ (firstChar isVowel not
+ and:[(secondChar isVowel or:[secondChar == $y]) not
+ and:[thirdChar isVowel not ]]) ifTrue:[
+ "/ exceptions: 3 non-vowels in a row: looks like an abbreviation
+ (self size > 4) ifTrue:[
+ (firstChar == $s) ifTrue:[
+ ((secondChar == $c and:[thirdChar == $r])
+ or:[ (secondChar == $t and:[thirdChar == $r]) ]) ifTrue:[
+ (self at:4) isVowel ifTrue:[
+ ^ 'a'
+ ]
+ ]
+ ].
+ ].
+ "/ an abbreviation; treat x, s as vowels
+ (firstChar == $x or:[ firstChar == $s ]) ifTrue:[^ 'an'].
+ ]
].
^ 'a'
"
- 'uboot' article.
- 'xmas' article.
- 'alarm' article.
- 'baby' article.
- 'sql' article.
- 'scr' article.
- 'screen' article.
- 'scrollbar' article.
- 'scrs' article.
- 'cvs' article.
- 'cvssource' article.
- 'symbol' article.
- 'string' article.
+ 'uboot' article.
+ 'xmas' article.
+ 'alarm' article.
+ 'baby' article.
+ 'sql' article.
+ 'scr' article.
+ 'screen' article.
+ 'scrollbar' article.
+ 'scrs' article.
+ 'cvs' article.
+ 'cvssource' article.
+ 'symbol' article.
+ 'string' article.
"
!
@@ -5372,26 +5372,26 @@
n := self occurrencesOf:$'.
n ~~ 0 ifTrue:[
- s := self species new:(n + 2 + self size).
- s at:1 put:$'.
- index := 2.
- self do:[:thisChar |
- (thisChar == $') ifTrue:[
- s at:index put:thisChar.
- index := index + 1.
- ].
- s at:index put:thisChar.
- index := index + 1.
- ].
- s at:index put:$'.
- ^ s
+ s := self species new:(n + 2 + self size).
+ s at:1 put:$'.
+ index := 2.
+ self do:[:thisChar |
+ (thisChar == $') ifTrue:[
+ s at:index put:thisChar.
+ index := index + 1.
+ ].
+ s at:index put:thisChar.
+ index := index + 1.
+ ].
+ s at:index put:$'.
+ ^ s
].
^ '''' , self , ''''
"
- '''immutable'' string' asImmutableString basicStoreString
- 'immutable string' asImmutableString basicStoreString
+ '''immutable'' string' asImmutableString basicStoreString
+ 'immutable string' asImmutableString basicStoreString
"
"Modified: / 14-07-2013 / 19:20:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -5408,8 +5408,8 @@
"/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
"/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
(aGCOrStream isStream) ifTrue:[
- self storeOn:aGCOrStream.
- ^ self
+ self storeOn:aGCOrStream.
+ ^ self
].
^ super displayOn:aGCOrStream
!
@@ -5430,8 +5430,8 @@
"put the raw storeString of myself on aStream"
self do:[:thisChar |
- (thisChar == $') ifTrue:[aStream nextPut:thisChar].
- aStream nextPut:thisChar
+ (thisChar == $') ifTrue:[aStream nextPut:thisChar].
+ aStream nextPut:thisChar
]
"Modified: / 15.6.1998 / 17:21:17 / cg"
@@ -5439,62 +5439,62 @@
!
printXmlQuotedOn:aStream
- "convert aString to a valid XML string
+ "convert aString to a valid XML string
that can be used for attributes, text, comments an PIs
TODO: care for 16bit UNICODE string and escape chars ..."
self do:[:eachChar |
- eachChar == $< ifTrue:[
- aStream nextPutAll:'<' "mapping needed for xml text"
- ] ifFalse:[ eachChar == $& ifTrue:[
- aStream nextPutAll:'&' "mapping needed for all"
- ] ifFalse:[ eachChar == $> ifTrue:[
- aStream nextPutAll:'>' "mapping needed for comments"
- ] ifFalse:[ eachChar == $' ifTrue:[
- aStream nextPutAll:''' "mapping needed for attributes"
- ] ifFalse:[ eachChar == $" ifTrue:[
- aStream nextPutAll:'"' "mapping needed for attributes"
- ] ifFalse:[
- |codePoint|
- codePoint := eachChar codePoint.
- (codePoint < 16r20 or:[codePoint >= 16r7F]) ifTrue:[
- aStream nextPutAll:'&#'.
- codePoint printOn:aStream.
- aStream nextPut:$;.
- ] ifFalse:[
- aStream nextPut:eachChar
- ]]]]]]
+ eachChar == $< ifTrue:[
+ aStream nextPutAll:'<' "mapping needed for xml text"
+ ] ifFalse:[ eachChar == $& ifTrue:[
+ aStream nextPutAll:'&' "mapping needed for all"
+ ] ifFalse:[ eachChar == $> ifTrue:[
+ aStream nextPutAll:'>' "mapping needed for comments"
+ ] ifFalse:[ eachChar == $' ifTrue:[
+ aStream nextPutAll:''' "mapping needed for attributes"
+ ] ifFalse:[ eachChar == $" ifTrue:[
+ aStream nextPutAll:'"' "mapping needed for attributes"
+ ] ifFalse:[
+ |codePoint|
+ codePoint := eachChar codePoint.
+ (codePoint < 16r20 or:[codePoint >= 16r7F]) ifTrue:[
+ aStream nextPutAll:'&#'.
+ codePoint printOn:aStream.
+ aStream nextPut:$;.
+ ] ifFalse:[
+ aStream nextPut:eachChar
+ ]]]]]]
].
!
printXmlTextQuotedOn:aStream
- "convert aString to a valid XML string
+ "convert aString to a valid XML string
that can be used for XML text.
Here line formatting characters are not escaped.
TODO: care for 16bit UNICODE string and escape chars ..."
self do:[:eachChar |
- eachChar == $< ifTrue:[
- aStream nextPutAll:'<' "mapping needed for xml text"
- ] ifFalse:[ eachChar == $& ifTrue:[
- aStream nextPutAll:'&' "mapping needed for all"
+ eachChar == $< ifTrue:[
+ aStream nextPutAll:'<' "mapping needed for xml text"
+ ] ifFalse:[ eachChar == $& ifTrue:[
+ aStream nextPutAll:'&' "mapping needed for all"
"/ ] ifFalse:[ eachChar == $> ifTrue:[
"/ aStream nextPutAll:'>' "mapping needed for comments"
"/ ] ifFalse:[ eachChar == $' ifTrue:[
"/ aStream nextPutAll:''' "mapping needed for attributes"
"/ ] ifFalse:[ eachChar == $" ifTrue:[
"/ aStream nextPutAll:'"' "mapping needed for attributes"
- ] ifFalse:[
- |codePoint|
- codePoint := eachChar codePoint.
- ((codePoint < 16r20 and:[codePoint ~~ 9 and:[codePoint ~~ 10 and:[codePoint ~~ 13]]])
- or:[codePoint >= 16r7F]) ifTrue:[
- aStream nextPutAll:'&#'.
- codePoint printOn:aStream.
- aStream nextPut:$;.
- ] ifFalse:[
- aStream nextPut:eachChar
- ]]]"/]]]
+ ] ifFalse:[
+ |codePoint|
+ codePoint := eachChar codePoint.
+ ((codePoint < 16r20 and:[codePoint ~~ 9 and:[codePoint ~~ 10 and:[codePoint ~~ 13]]])
+ or:[codePoint >= 16r7F]) ifTrue:[
+ aStream nextPutAll:'&#'.
+ codePoint printOn:aStream.
+ aStream nextPut:$;.
+ ] ifFalse:[
+ aStream nextPut:eachChar
+ ]]]"/]]]
].
!
@@ -5511,12 +5511,12 @@
!
xmlQuotedPrintString
- "convert aString to a valid XML string
+ "convert aString to a valid XML string
that can be used for attributes, text, comments an PIs
TODO: care for 16bit UNICODE string and escape chars ..."
^ String streamContents:[:s|
- self printXmlQuotedOn:s
+ self printXmlQuotedOn:s
].
! !
@@ -5530,12 +5530,12 @@
|string max|
(string := self string) ~~ self ifTrue:[
- ^ string bitsPerCharacter
+ ^ string bitsPerCharacter
].
max := 8.
self do:[:eachCharacter |
- max := max max:(eachCharacter bitsPerCharacter)
+ max := max max:(eachCharacter bitsPerCharacter)
].
^ max
@@ -5556,8 +5556,8 @@
idx := startIndex.
1 to:sz do:[:i |
- (self at:idx) ~~ (aString at:i) ifTrue:[^ false].
- idx := idx + 1
+ (self at:idx) ~~ (aString at:i) ifTrue:[^ false].
+ idx := idx + 1
].
^ true
@@ -5582,17 +5582,17 @@
start := 1.
mySize := self size.
[start <= mySize] whileTrue:[
- ch := self at:start.
- ch isSeparator ifTrue:[
- start := start + 1
- ] ifFalse:[
- stop := self indexOfSeparatorStartingAt:start.
- (stop == 0) ifTrue:[
- stop := mySize + 1
- ].
- tally := tally + 1.
- start := stop
- ]
+ ch := self at:start.
+ ch isSeparator ifTrue:[
+ start := start + 1
+ ] ifFalse:[
+ stop := self indexOfSeparatorStartingAt:start.
+ (stop == 0) ifTrue:[
+ stop := mySize + 1
+ ].
+ tally := tally + 1.
+ start := stop
+ ]
].
^ tally
@@ -5698,8 +5698,8 @@
coll := OrderedCollection new.
s := ReadStream on:self.
[s atEnd] whileFalse:[
- part := s through:$:.
- coll add:part
+ part := s through:$:.
+ coll add:part
].
^ coll asArray
@@ -5731,8 +5731,8 @@
index := 1.
end := self size.
[index <= end] whileTrue:[
- (self at:index) isSeparator ifFalse:[^ index - 1].
- index := index + 1
+ (self at:index) isSeparator ifFalse:[^ index - 1].
+ index := index + 1
].
^ end
@@ -5877,8 +5877,8 @@
dict at:$a put:'AAAAA'.
dict at:$b put:[ Time now ].
dict at:'foo' put:[ Date today ].
- 'hello $1 %a $b %(foo) $foo ' expandPlaceholders:$$ with:dict.
- 'hello $1 %a $b %(foo) $foo ' expandPlaceholders:$% with:dict.
+ 'hello $1 %a $b %(foo) $foo ' expandPlaceholders:$$ with:dict.
+ 'hello $1 %a $b %(foo) $foo ' expandPlaceholders:$% with:dict.
"
"Modified: 1.7.1997 / 00:53:24 / cg"
@@ -5910,98 +5910,98 @@
stop := self size.
start := 1.
[start <= stop] whileTrue:[
- idx := self indexOf:escapeCharacter startingAt:start.
- (idx == 0 or:[idx == stop]) ifTrue:[
- aStream nextPutAll:self startingAt:start to:stop.
- ^ self.
- ].
- "found an escapeCharacter"
- aStream nextPutAll:self startingAt:start to:(idx - 1).
- next := self at:(idx + 1).
- (next == escapeCharacter) ifTrue:[
- aStream nextPut:escapeCharacter.
- ] ifFalse:[
- next == $< ifTrue:[
- idx2 := self indexOf:$> startingAt:idx+2.
- key := self copyFrom:idx+2 to:idx2-1.
- idx := idx2 - 1.
- key := key asSymbolIfInterned.
- (#(cr tab nl return lf ff null) includesIdentical:key) ifTrue:[
- aStream nextPut:(Character perform:key).
- ].
- ] ifFalse:[
- next isDigit ifTrue:[
- v := argArrayOrDictionary at:(next digitValue) ifAbsent:''
- ] ifFalse:[
- next == $( ifTrue:[
- idx2 := self indexOf:$) startingAt:idx+2.
- key := self copyFrom:idx+2 to:idx2-1.
- idx := idx2 - 1.
- (argArrayOrDictionary includesKey:key) ifTrue:[
- v := argArrayOrDictionary at:key
- ] ifFalse:[
- key := key asSymbolIfInterned ? key.
- (argArrayOrDictionary includesKey:key) ifTrue:[
- v := argArrayOrDictionary at:key
- ] ifFalse:[
- (key size == 1 and:[ argArrayOrDictionary includesKey:(key at:1)]) ifTrue:[
- v := argArrayOrDictionary at:(key at:1)
- ] ifFalse:[
- key isNumeric ifTrue:[
- key := Integer readFrom:key onError:nil.
- ].
- v := argArrayOrDictionary at:key ifAbsent:''
- ]
- ].
- ].
- ] ifFalse:[
- (next isLetter and:[argArrayOrDictionary isSequenceable not "is a Dictionary"]) ifTrue:[
- "so next is a non-numeric single character."
- v := argArrayOrDictionary
- at:next
- ifAbsent:[
- "try symbol instead of character"
- argArrayOrDictionary
- at:next asSymbol
- ifAbsent:[String with:escapeCharacter with:next].
- ].
- ] ifFalse:[
- v := String with:$% with:next.
- ].
- ]
- ].
- "/ v notNil ifTrue:[
- v isBlock ifTrue:[
- v := v value
- ].
-
- v printOn:aStream.
- "/ ].
- ]
- ].
- start := idx + 2
+ idx := self indexOf:escapeCharacter startingAt:start.
+ (idx == 0 or:[idx == stop]) ifTrue:[
+ aStream nextPutAll:self startingAt:start to:stop.
+ ^ self.
+ ].
+ "found an escapeCharacter"
+ aStream nextPutAll:self startingAt:start to:(idx - 1).
+ next := self at:(idx + 1).
+ (next == escapeCharacter) ifTrue:[
+ aStream nextPut:escapeCharacter.
+ ] ifFalse:[
+ next == $< ifTrue:[
+ idx2 := self indexOf:$> startingAt:idx+2.
+ key := self copyFrom:idx+2 to:idx2-1.
+ idx := idx2 - 1.
+ key := key asSymbolIfInterned.
+ (#(cr tab nl return lf ff null) includesIdentical:key) ifTrue:[
+ aStream nextPut:(Character perform:key).
+ ].
+ ] ifFalse:[
+ next isDigit ifTrue:[
+ v := argArrayOrDictionary at:(next digitValue) ifAbsent:''
+ ] ifFalse:[
+ next == $( ifTrue:[
+ idx2 := self indexOf:$) startingAt:idx+2.
+ key := self copyFrom:idx+2 to:idx2-1.
+ idx := idx2 - 1.
+ (argArrayOrDictionary includesKey:key) ifTrue:[
+ v := argArrayOrDictionary at:key
+ ] ifFalse:[
+ key := key asSymbolIfInterned ? key.
+ (argArrayOrDictionary includesKey:key) ifTrue:[
+ v := argArrayOrDictionary at:key
+ ] ifFalse:[
+ (key size == 1 and:[ argArrayOrDictionary includesKey:(key at:1)]) ifTrue:[
+ v := argArrayOrDictionary at:(key at:1)
+ ] ifFalse:[
+ key isNumeric ifTrue:[
+ key := Integer readFrom:key onError:nil.
+ ].
+ v := argArrayOrDictionary at:key ifAbsent:''
+ ]
+ ].
+ ].
+ ] ifFalse:[
+ (next isLetter and:[argArrayOrDictionary isSequenceable not "is a Dictionary"]) ifTrue:[
+ "so next is a non-numeric single character."
+ v := argArrayOrDictionary
+ at:next
+ ifAbsent:[
+ "try symbol instead of character"
+ argArrayOrDictionary
+ at:next asSymbol
+ ifAbsent:[String with:escapeCharacter with:next].
+ ].
+ ] ifFalse:[
+ v := String with:$% with:next.
+ ].
+ ]
+ ].
+ "/ v notNil ifTrue:[
+ v isBlock ifTrue:[
+ v := v value
+ ].
+
+ v printOn:aStream.
+ "/ ].
+ ]
+ ].
+ start := idx + 2
].
"
String streamContents:[:s|
- 'hello %1' expandPlaceholders:$% with:#('world') on:s.
- s cr.
- 'hello $1; how is $2' expandPlaceholders:$$ with:#('world' 'this') on:s.
- s cr.
- 'hello %2; how is %1' expandPlaceholders:$% with:#('world' 'this') on:s.
- s cr.
- '%1 plus %2 gives %3 ' expandPlaceholders:$% with:#(4 5 9) on:s.
- s cr.
- '%%(1)0 gives %(1)0' expandPlaceholders:$% with:#(123) on:s.
- s cr.
- '%%10 gives %10' expandPlaceholders:$% with:#(123) on:s.
- s cr.
- '%%(10) gives %(10) %<cr>%<tab>next line' expandPlaceholders:$% with:#(123) on:s.
- s cr.
- '%%test gives %test' expandPlaceholders:$% with:#(123) on:s.
- s cr.
- '|%%<tab>|%%1|%%<cr>| gives |%<tab>|%1|%<cr>|' expandPlaceholders:$% with:#(foo) on:s.
- ]
+ 'hello %1' expandPlaceholders:$% with:#('world') on:s.
+ s cr.
+ 'hello $1; how is $2' expandPlaceholders:$$ with:#('world' 'this') on:s.
+ s cr.
+ 'hello %2; how is %1' expandPlaceholders:$% with:#('world' 'this') on:s.
+ s cr.
+ '%1 plus %2 gives %3 ' expandPlaceholders:$% with:#(4 5 9) on:s.
+ s cr.
+ '%%(1)0 gives %(1)0' expandPlaceholders:$% with:#(123) on:s.
+ s cr.
+ '%%10 gives %10' expandPlaceholders:$% with:#(123) on:s.
+ s cr.
+ '%%(10) gives %(10) %<cr>%<tab>next line' expandPlaceholders:$% with:#(123) on:s.
+ s cr.
+ '%%test gives %test' expandPlaceholders:$% with:#(123) on:s.
+ s cr.
+ '|%%<tab>|%%1|%%<cr>| gives |%<tab>|%1|%<cr>|' expandPlaceholders:$% with:#(foo) on:s.
+ ]
"
"
@@ -6012,7 +6012,7 @@
dict at:$a put:'AAAAA'.
dict at:$b put:[ Time now ].
String streamContents:[:s|
- 'hello $1 $a $b' expandPlaceholders:$$ with:dict on:s.
+ 'hello $1 $a $b' expandPlaceholders:$$ with:dict on:s.
].
"
@@ -6086,21 +6086,21 @@
"
String streamContents:[:s|
- 'hello %1' expandPlaceholdersWith:#('world') on:s.
- s cr.
- 'hello %1; how is %2' expandPlaceholdersWith:#('world' 'this') on:s.
- s cr.
- 'hello %2; how is %1' expandPlaceholdersWith:#('world' 'this') on:s.
- s cr.
- '%1 plus %2 gives %3 ' expandPlaceholdersWith:#(4 5 9) on:s.
- s cr.
- '%%(1)0 gives %(1)0' expandPlaceholdersWith:#(123) on:s.
- s cr.
- '%%10 gives %10' expandPlaceholdersWith:#(123) on:s.
- s cr.
- '%%(10) gives %(10) %<cr>%<tab>next line' expandPlaceholdersWith:#(123) on:s.
- s cr.
- '%test gives %1' expandPlaceholdersWith:#(123) on:s.
+ 'hello %1' expandPlaceholdersWith:#('world') on:s.
+ s cr.
+ 'hello %1; how is %2' expandPlaceholdersWith:#('world' 'this') on:s.
+ s cr.
+ 'hello %2; how is %1' expandPlaceholdersWith:#('world' 'this') on:s.
+ s cr.
+ '%1 plus %2 gives %3 ' expandPlaceholdersWith:#(4 5 9) on:s.
+ s cr.
+ '%%(1)0 gives %(1)0' expandPlaceholdersWith:#(123) on:s.
+ s cr.
+ '%%10 gives %10' expandPlaceholdersWith:#(123) on:s.
+ s cr.
+ '%%(10) gives %(10) %<cr>%<tab>next line' expandPlaceholdersWith:#(123) on:s.
+ s cr.
+ '%test gives %1' expandPlaceholdersWith:#(123) on:s.
]
"
@@ -6112,7 +6112,7 @@
dict at:$a put:'AAAAA'.
dict at:$b put:[ Time now ].
String streamContents:[:s|
- 'hello %1 %a %b' expandPlaceholdersWith:dict on:s.
+ 'hello %1 %a %b' expandPlaceholdersWith:dict on:s.
].
"
@@ -6133,7 +6133,7 @@
tokensBasedOn:aCharacter
"this is an ST-80 alias for the ST/X method
- asCollectionOfSubstringsSeparatedBy:"
+ asCollectionOfSubstringsSeparatedBy:"
^ self asCollectionOfSubstringsSeparatedBy:aCharacter
@@ -6151,20 +6151,20 @@
The resulting string will contain only 7-bit ascii characters.
Emphasis is not supported.
The following escapes are generated:
- \' single quote character
- \dQuote double quote character
- \r return character
- \r return character
- \n newline character
- \t tab character
- \\ the \ character itself
- \xnn two digit hex number defining the characters ascii value
- \unnnn four digit hex number defining the characters ascii value
- \Unnnnnnnn eight digit hex number defining the characters ascii value
+ \' single quote character
+ \dQuote double quote character
+ \r return character
+ \r return character
+ \n newline character
+ \t tab character
+ \\ the \ character itself
+ \xnn two digit hex number defining the characters ascii value
+ \unnnn four digit hex number defining the characters ascii value
+ \Unnnnnnnn eight digit hex number defining the characters ascii value
This is the opposite of withoutCEscapes.
Sigh: this is named completely wrong (opposite naming of withCRs/witoutCRs),
- but it cannot be changed easily, as these methods are already used heavily
+ but it cannot be changed easily, as these methods are already used heavily
"
|anyEscapeNeeded out seq|
@@ -6172,11 +6172,11 @@
"
first, check if any escape is needed and return the receiver unchanged if not
"
- anyEscapeNeeded := self
- contains:[:ch |
- ((ch codePoint between:32 and:126) not
- or:[ch == $' or:[ch == $"]])
- ].
+ anyEscapeNeeded := self
+ contains:[:ch |
+ ((ch codePoint between:32 and:126) not
+ or:[ch == $' or:[ch == $"]])
+ ].
anyEscapeNeeded ifFalse:[ ^ self ].
self hasChangeOfEmphasis ifTrue:[ self error:'emphasis not supported' ].
@@ -6184,45 +6184,45 @@
out := WriteStream on:(String uninitializedNew:self size-1).
self do:[:ch |
- |cp|
-
- (ch == $' or:[ch == $"]) ifTrue:[
- out nextPut:$\.
- out nextPut:ch.
- ] ifFalse:[
- (ch codePoint between:32 and:126) ifTrue:[
- out nextPut:ch
- ] ifFalse:[
- ch == Character return ifTrue:[
- seq := '\r'
- ] ifFalse:[ ch == Character nl ifTrue:[
- seq := '\n'
- ] ifFalse:[ ch == Character tab ifTrue:[
- seq := '\t'
- ] ifFalse:[ ch == $\ ifTrue:[
- seq := '\\'
- ] ifFalse:[
- cp := ch codePoint.
- cp <= 16rFF ifTrue:[
- seq := '\x' , (cp printStringRadix:16 padTo:2)
- ] ifFalse:[
- cp <= 16rFFFF ifTrue:[
- seq := '\u' , (cp printStringRadix:16 padTo:4)
- ] ifFalse:[
- seq := '\U',(cp printStringRadix:16 padTo:8)
- ]
- ]
- ]]]].
- out nextPutAll:seq
- ].
- ].
+ |cp|
+
+ (ch == $' or:[ch == $"]) ifTrue:[
+ out nextPut:$\.
+ out nextPut:ch.
+ ] ifFalse:[
+ (ch codePoint between:32 and:126) ifTrue:[
+ out nextPut:ch
+ ] ifFalse:[
+ ch == Character return ifTrue:[
+ seq := '\r'
+ ] ifFalse:[ ch == Character nl ifTrue:[
+ seq := '\n'
+ ] ifFalse:[ ch == Character tab ifTrue:[
+ seq := '\t'
+ ] ifFalse:[ ch == $\ ifTrue:[
+ seq := '\\'
+ ] ifFalse:[
+ cp := ch codePoint.
+ cp <= 16rFF ifTrue:[
+ seq := '\x' , (cp printStringRadix:16 padTo:2)
+ ] ifFalse:[
+ cp <= 16rFFFF ifTrue:[
+ seq := '\u' , (cp printStringRadix:16 padTo:4)
+ ] ifFalse:[
+ seq := '\U',(cp printStringRadix:16 padTo:8)
+ ]
+ ]
+ ]]]].
+ out nextPutAll:seq
+ ].
+ ].
].
^ out contents
"
- 'hello\n\tworld' withoutCEscapes.
+ 'hello\n\tworld' withoutCEscapes.
'hello\nworld\na\n\tnice\n\t\tstring' withoutCEscapes withCEscapes.
- ('hello ',(Character value:16r1234),' world') withCEscapes
+ ('hello ',(Character value:16r1234),' world') withCEscapes
"
"Created: / 25-01-2012 / 11:08:16 / cg"
@@ -6264,11 +6264,11 @@
in := self readStream.
out := WriteStream on:(self species new:self size).
[in atEnd] whileFalse:[
- c := in next.
- (c == escape or:['*[#' includes:c]) ifTrue:[
- out nextPut:$\.
- ].
- out nextPut:c.
+ c := in next.
+ (c == escape or:['*[#' includes:c]) ifTrue:[
+ out nextPut:$\.
+ ].
+ out nextPut:c.
].
^ out contents.
@@ -6291,32 +6291,32 @@
Preserves a leading/trailing space."
^ self species streamContents:[:s |
- |skipping|
-
- skipping := false.
- 1 to:self size do:[:idx |
- |char|
-
- char := self at:idx.
- char isSeparator ifFalse:[
- s nextPut:char.
- skipping := false.
- ] ifTrue:[
- skipping ifFalse:[
- s nextPut:(Character space).
- skipping := true
- ].
- ]
- ]
+ |skipping|
+
+ skipping := false.
+ 1 to:self size do:[:idx |
+ |char|
+
+ char := self at:idx.
+ char isSeparator ifFalse:[
+ s nextPut:char.
+ skipping := false.
+ ] ifTrue:[
+ skipping ifFalse:[
+ s nextPut:(Character space).
+ skipping := true
+ ].
+ ]
+ ]
]
"
- 'hello wwww' withSeparatorsCompacted
- 'hello wwww' withSeparatorsCompacted
- ' hello wwww' withSeparatorsCompacted
- ' hello wwww ' withSeparatorsCompacted
- ' hello wwww ' withSeparatorsCompacted
- 'hel lo www w' withSeparatorsCompacted
+ 'hello wwww' withSeparatorsCompacted
+ 'hello wwww' withSeparatorsCompacted
+ ' hello wwww' withSeparatorsCompacted
+ ' hello wwww ' withSeparatorsCompacted
+ ' hello wwww ' withSeparatorsCompacted
+ 'hel lo www w' withSeparatorsCompacted
"
!
@@ -6326,8 +6326,8 @@
Notice: if the receiver does not contain any tabs, it is returned unchanged;
otherwise a new string is returned.
Limitation: only the very first spaces are replaced
- (i.e. if the receiver contains newLine characters,
- no tabs are inserted after those lineBreaks)"
+ (i.e. if the receiver contains newLine characters,
+ no tabs are inserted after those lineBreaks)"
|idx "{ SmallInteger }"
nTabs "{ SmallInteger }"
@@ -6371,19 +6371,19 @@
('123456789' , Character tab asString , 'x') withTabsExpanded
(String with:Character tab
- with:Character tab
- with:$1) withTabsExpanded
+ with:Character tab
+ with:$1) withTabsExpanded
(String with:Character tab
- with:$1
- with:Character tab
- with:$2) withTabsExpanded
+ with:$1
+ with:Character tab
+ with:$2) withTabsExpanded
(String with:Character tab
- with:$1
- with:Character cr
- with:Character tab
- with:$2) withTabsExpanded
+ with:$1
+ with:Character cr
+ with:Character tab
+ with:$2) withTabsExpanded
"
"Modified: 12.5.1996 / 13:05:10 / cg"
@@ -6412,19 +6412,19 @@
col := 1. newSz := 0.
1 to:sz do:[:srcIdx |
- ch := self at:srcIdx.
- ch == Character tab ifFalse:[
- col := col + 1.
- newSz := newSz + 1.
- ch == Character cr ifTrue:[
- col := 1
- ].
- ] ifTrue:[
- (col \\ numSpaces) to:numSpaces do:[:ii |
- newSz := newSz + 1.
- col := col + 1
- ].
- ]
+ ch := self at:srcIdx.
+ ch == Character tab ifFalse:[
+ col := col + 1.
+ newSz := newSz + 1.
+ ch == Character cr ifTrue:[
+ col := 1
+ ].
+ ] ifTrue:[
+ (col \\ numSpaces) to:numSpaces do:[:ii |
+ newSz := newSz + 1.
+ col := col + 1
+ ].
+ ]
].
self isText ifTrue:[
@@ -6437,26 +6437,26 @@
col := 1. dstIdx := 1.
1 to:sz do:[:srcIdx |
- ch := self at:srcIdx.
-
- ch == Character tab ifFalse:[
- col := col + 1.
- ch == Character cr ifTrue:[
- col := 1
- ].
- hasEmphasis ifTrue:[
- e := self emphasisAt:srcIdx.
- str emphasisAt:dstIdx put:e
- ].
- str at:dstIdx put:ch.
- dstIdx := dstIdx + 1
- ] ifTrue:[
- (col \\ numSpaces) to:numSpaces do:[:ii |
- str at:dstIdx put:Character space.
- dstIdx := dstIdx + 1.
- col := col + 1
- ].
- ]
+ ch := self at:srcIdx.
+
+ ch == Character tab ifFalse:[
+ col := col + 1.
+ ch == Character cr ifTrue:[
+ col := 1
+ ].
+ hasEmphasis ifTrue:[
+ e := self emphasisAt:srcIdx.
+ str emphasisAt:dstIdx put:e
+ ].
+ str at:dstIdx put:ch.
+ dstIdx := dstIdx + 1
+ ] ifTrue:[
+ (col \\ numSpaces) to:numSpaces do:[:ii |
+ str at:dstIdx put:Character space.
+ dstIdx := dstIdx + 1.
+ col := col + 1
+ ].
+ ]
].
^ str
@@ -6470,19 +6470,19 @@
('123456789' , Character tab asString , 'x') withTabsExpanded
(String with:Character tab
- with:Character tab
- with:$1) withTabsExpanded
+ with:Character tab
+ with:$1) withTabsExpanded
(String with:Character tab
- with:$1
- with:Character tab
- with:$2) withTabsExpanded
+ with:$1
+ with:Character tab
+ with:$2) withTabsExpanded
(String with:Character tab
- with:$1
- with:Character cr
- with:Character tab
- with:$2) withTabsExpanded
+ with:$1
+ with:Character cr
+ with:Character tab
+ with:$2) withTabsExpanded
"
"Modified: / 12-05-1996 / 13:05:10 / cg"
@@ -6515,18 +6515,18 @@
with all \X-character escapes replaced by corresponding-characters.
(similar to the way C-language Strings are converted).
The following escapes are supported:
- \r return character
- \n newline character
- \b backspace character
- \f formfeed character
- \t tab character
- \e escape character
- \\ the \ character itself
- \nnn three digit octal number defining the characters ascii value
- \xnn two digit hex number defining the characters ascii value
- \unnnn four digit hex number defining the characters unicode value
- \Unnnnnnnn eight digit hex number defining the characters unicode value
- \other other
+ \r return character
+ \n newline character
+ \b backspace character
+ \f formfeed character
+ \t tab character
+ \e escape character
+ \\ the \ character itself
+ \nnn three digit octal number defining the characters ascii value
+ \xnn two digit hex number defining the characters ascii value
+ \unnnn four digit hex number defining the characters unicode value
+ \Unnnnnnnn eight digit hex number defining the characters unicode value
+ \other other
Notice, that \' is NOT a valid escape, since the general syntax of
string constants is not affected by this method.
@@ -6541,7 +6541,7 @@
This is the opposite of withCEscapes.
Sigh: this is named completely wrong (opposite naming of withCRs/witoutCRs),
- but it cannot be changed easily, as these methods are already used heavily
+ but it cannot be changed easily, as these methods are already used heavily
"
|val "{ SmallInteger }"
@@ -6557,87 +6557,87 @@
in := ReadStream on:self.
[in atEnd] whileFalse:[
- nextChar := in next.
- nextChar == $\ ifTrue:[
- in atEnd ifTrue:[
- ] ifFalse:[
- nextChar := in next.
- nextChar == $r ifTrue:[
- nextChar := Character return
- ] ifFalse:[ nextChar == $n ifTrue:[
- nextChar := Character nl
- ] ifFalse:[ nextChar == $b ifTrue:[
- nextChar := Character backspace
- ] ifFalse:[ nextChar == $f ifTrue:[
- nextChar := Character newPage
- ] ifFalse:[ nextChar == $t ifTrue:[
- nextChar := Character tab
- ] ifFalse:[ nextChar == $e ifTrue:[
- nextChar := Character esc
- ] ifFalse:[
- nextChar == $0 ifTrue:[
- val := 0.
- nextChar := in peek.
- nDigits := 1.
- [nextChar notNil and:[nextChar isDigit and:[nDigits <= 3]]] whileTrue:[
- val := (val * 8) + nextChar digitValue.
- nextChar := in nextPeek.
- nDigits := nDigits + 1.
- ].
- nextChar := Character value:val.
- ] ifFalse:[
- val := 0.
- nextChar == $x ifTrue:[
- 2 timesRepeat:[
- nextChar := in next.
- val := (val * 16) + nextChar digitValue.
- ].
- nextChar := Character value:val.
- ] ifFalse:[
- nextChar == $u ifTrue:[
- 4 timesRepeat:[
- nextChar := in next.
- val := (val * 16) + nextChar digitValue.
- ].
- nextChar := Character value:val.
- ] ifFalse:[
- nextChar == $U ifTrue:[
- 8 timesRepeat:[
- nextChar := in next.
- val := (val * 16) + nextChar digitValue.
- ].
- nextChar := Character value:val.
- ]
- ]
- ]
- ]
- ]]]]]].
- ].
- ].
- out nextPut:nextChar.
+ nextChar := in next.
+ nextChar == $\ ifTrue:[
+ in atEnd ifTrue:[
+ ] ifFalse:[
+ nextChar := in next.
+ nextChar == $r ifTrue:[
+ nextChar := Character return
+ ] ifFalse:[ nextChar == $n ifTrue:[
+ nextChar := Character nl
+ ] ifFalse:[ nextChar == $b ifTrue:[
+ nextChar := Character backspace
+ ] ifFalse:[ nextChar == $f ifTrue:[
+ nextChar := Character newPage
+ ] ifFalse:[ nextChar == $t ifTrue:[
+ nextChar := Character tab
+ ] ifFalse:[ nextChar == $e ifTrue:[
+ nextChar := Character esc
+ ] ifFalse:[
+ nextChar == $0 ifTrue:[
+ val := 0.
+ nextChar := in peek.
+ nDigits := 1.
+ [nextChar notNil and:[nextChar isDigit and:[nDigits <= 3]]] whileTrue:[
+ val := (val * 8) + nextChar digitValue.
+ nextChar := in nextPeek.
+ nDigits := nDigits + 1.
+ ].
+ nextChar := Character value:val.
+ ] ifFalse:[
+ val := 0.
+ nextChar == $x ifTrue:[
+ 2 timesRepeat:[
+ nextChar := in next.
+ val := (val * 16) + nextChar digitValue.
+ ].
+ nextChar := Character value:val.
+ ] ifFalse:[
+ nextChar == $u ifTrue:[
+ 4 timesRepeat:[
+ nextChar := in next.
+ val := (val * 16) + nextChar digitValue.
+ ].
+ nextChar := Character value:val.
+ ] ifFalse:[
+ nextChar == $U ifTrue:[
+ 8 timesRepeat:[
+ nextChar := in next.
+ val := (val * 16) + nextChar digitValue.
+ ].
+ nextChar := Character value:val.
+ ]
+ ]
+ ]
+ ]
+ ]]]]]].
+ ].
+ ].
+ out nextPut:nextChar.
].
^ out contents
"
- 'hello world' withoutCEscapes
- 'hello\world' withoutCEscapes
- 'hello\world\' withoutCEscapes
- 'hello world\' withoutCEscapes
- 'hello\tworld' withoutCEscapes
+ 'hello world' withoutCEscapes
+ 'hello\world' withoutCEscapes
+ 'hello\world\' withoutCEscapes
+ 'hello world\' withoutCEscapes
+ 'hello\tworld' withoutCEscapes
'hello\nworld\na\n\tnice\n\t\tstring' withoutCEscapes
- 'hello\tworld\n' withoutCEscapes
- 'hello\010world' withoutCEscapes
- 'hello\r\nworld' withoutCEscapes
- 'hello\r\n\x08world' withoutCEscapes
- '0\x080' withoutCEscapes
- '0\u12340' withoutCEscapes
- '0\U123456780' withoutCEscapes
- '0\0a' withoutCEscapes
- '0\00a' withoutCEscapes
- '0\000a' withoutCEscapes
- '0\0000a' withoutCEscapes
- '0\00000a' withoutCEscapes
- '0\03770' withoutCEscapes
+ 'hello\tworld\n' withoutCEscapes
+ 'hello\010world' withoutCEscapes
+ 'hello\r\nworld' withoutCEscapes
+ 'hello\r\n\x08world' withoutCEscapes
+ '0\x080' withoutCEscapes
+ '0\u12340' withoutCEscapes
+ '0\U123456780' withoutCEscapes
+ '0\0a' withoutCEscapes
+ '0\00a' withoutCEscapes
+ '0\000a' withoutCEscapes
+ '0\0000a' withoutCEscapes
+ '0\00000a' withoutCEscapes
+ '0\03770' withoutCEscapes
"
"Created: / 25-01-2012 / 10:41:44 / cg"
@@ -6667,10 +6667,10 @@
index := self indexOfNonSeparatorStartingAt:1.
index ~~ 0 ifTrue:[
- index == 1 ifTrue:[
- ^ self
- ].
- ^ self copyFrom:index
+ index == 1 ifTrue:[
+ ^ self
+ ].
+ ^ self copyFrom:index
].
^ ''
@@ -6695,13 +6695,13 @@
in := self readStream.
out := self species writeStream.
[in atEnd] whileFalse:[
- c := in next.
- c == escape ifTrue:[
- in atEnd ifFalse:[
- c := in next.
- ]
- ].
- out nextPut:c.
+ c := in next.
+ c == escape ifTrue:[
+ in atEnd ifFalse:[
+ c := in next.
+ ]
+ ].
+ out nextPut:c.
].
^ out contents.
@@ -6724,7 +6724,7 @@
Otherwise return the receiver"
(self startsWith:aString) ifTrue:[
- ^ self copyFrom:aString size + 1
+ ^ self copyFrom:aString size + 1
].
^ self
@@ -6745,16 +6745,16 @@
((firstChar == $") or:[firstChar == $']) ifFalse:[^ self].
self last == firstChar ifTrue:[
- ^ self copyFrom:2 to:(self size-1)
+ ^ self copyFrom:2 to:(self size-1)
].
^ self
"/
- "/ '"hello"' withoutQuotes
- "/ '''hello''' withoutQuotes
- "/ 'hello' withoutQuotes
- "/ '"hello' withoutQuotes
- "/ 'hello"' withoutQuotes
+ "/ '"hello"' withoutQuotes
+ "/ '''hello''' withoutQuotes
+ "/ 'hello' withoutQuotes
+ "/ '"hello' withoutQuotes
+ "/ 'hello"' withoutQuotes
"/
!
@@ -6956,45 +6956,45 @@
subSize := subString size.
subSize == 0 ifTrue:[
- subString isString ifFalse:[
- self error:'non string argument' mayProceed:true.
- ].
- "empty string does not match"
- ^ 0.
- "empty string matches"
+ subString isString ifFalse:[
+ self error:'non string argument' mayProceed:true.
+ ].
+ "empty string does not match"
+ ^ 0.
+ "empty string matches"
"/ ^ index
].
mySize := self size.
firstChar := subString at:1.
caseSensitive ifTrue:[
- tester := [:c1 :c2 | c1 = c2 ].
- startIndex := self indexOf:firstChar startingAt:index.
+ tester := [:c1 :c2 | c1 = c2 ].
+ startIndex := self indexOf:firstChar startingAt:index.
] ifFalse:[
- tester := [:c1 :c2 | c1 sameAs: c2 ].
- startIndex := self findFirst:[:c | c sameAs:firstChar] startingAt:index.
+ tester := [:c1 :c2 | c1 sameAs: c2 ].
+ startIndex := self findFirst:[:c | c sameAs:firstChar] startingAt:index.
].
[startIndex == 0] whileFalse:[
- runIdx := startIndex.
- found := true.
- 1 to:subSize do:[:i |
- runIdx > mySize ifTrue:[
- found := false
- ] ifFalse:[
- (tester value:(subString at:i) value:(self at:runIdx)) ifFalse:[
- found := false
- ]
- ].
- runIdx := runIdx + 1
- ].
- found ifTrue:[
- ^ startIndex
- ].
- caseSensitive ifTrue:[
- startIndex := self indexOf:firstChar startingAt:(startIndex + 1)
- ] ifFalse:[
- startIndex := self findFirst:[:c | c sameAs:firstChar] startingAt:(startIndex + 1).
- ].
+ runIdx := startIndex.
+ found := true.
+ 1 to:subSize do:[:i |
+ runIdx > mySize ifTrue:[
+ found := false
+ ] ifFalse:[
+ (tester value:(subString at:i) value:(self at:runIdx)) ifFalse:[
+ found := false
+ ]
+ ].
+ runIdx := runIdx + 1
+ ].
+ found ifTrue:[
+ ^ startIndex
+ ].
+ caseSensitive ifTrue:[
+ startIndex := self indexOf:firstChar startingAt:(startIndex + 1)
+ ] ifFalse:[
+ startIndex := self findFirst:[:c | c sameAs:firstChar] startingAt:(startIndex + 1).
+ ].
].
^ exceptionBlock value
@@ -7004,7 +7004,7 @@
indexOfSubCollection:subString startingAt:index ifAbsent:exceptionBlock caseSensitive:caseSensitive ignoreDiacritics:ignoreDiacritics
"find a substring, starting at index. if found, return the index;
if not found, return the result of evaluating exceptionBlock.
- This is a q&d hack - not very efficient
+ This is a q&d hack - not very efficient
(see implementation in string, for a much faster algorithm)"
|firstChar found
@@ -7016,53 +7016,53 @@
subSize := subString size.
subSize == 0 ifTrue:[
- subString isString ifFalse:[
- self error:'non string argument' mayProceed:true.
- ].
- "empty string does not match"
- ^ 0.
- "empty string matches"
+ subString isString ifFalse:[
+ self error:'non string argument' mayProceed:true.
+ ].
+ "empty string does not match"
+ ^ 0.
+ "empty string matches"
"/ ^ index
].
mySize := self size.
firstChar := subString at:1.
ignoreDiacritics ifTrue:[
- caseSensitive ifTrue:[
- charMap := [:ch | ch asLowercase withoutDiacritics].
- ] ifFalse:[
- charMap := [:ch | ch withoutDiacritics].
- ].
- tester := [:c1 :c2 | (charMap value:c1) = (charMap value:c2) ].
- firstCharMapped := (charMap value:firstChar).
- findNextIndex := [:index | self findFirst:[:ch | (charMap value:ch) = firstCharMapped] startingAt:index].
+ caseSensitive ifTrue:[
+ charMap := [:ch | ch asLowercase withoutDiacritics].
+ ] ifFalse:[
+ charMap := [:ch | ch withoutDiacritics].
+ ].
+ tester := [:c1 :c2 | (charMap value:c1) = (charMap value:c2) ].
+ firstCharMapped := (charMap value:firstChar).
+ findNextIndex := [:index | self findFirst:[:ch | (charMap value:ch) = firstCharMapped] startingAt:index].
] ifFalse:[
- caseSensitive ifTrue:[
- tester := [:c1 :c2 | c1 = c2 ].
- findNextIndex := [:index | self indexOf:firstChar startingAt:index].
- ] ifFalse:[
- tester := [:c1 :c2 | c1 sameAs: c2 ].
- findNextIndex := [:index | self findFirst:[:c | c sameAs:firstChar] startingAt:index].
- ].
+ caseSensitive ifTrue:[
+ tester := [:c1 :c2 | c1 = c2 ].
+ findNextIndex := [:index | self indexOf:firstChar startingAt:index].
+ ] ifFalse:[
+ tester := [:c1 :c2 | c1 sameAs: c2 ].
+ findNextIndex := [:index | self findFirst:[:c | c sameAs:firstChar] startingAt:index].
+ ].
].
startIndex := findNextIndex value:index.
[startIndex == 0] whileFalse:[
- runIdx := startIndex.
- found := true.
- 1 to:subSize do:[:i |
- runIdx > mySize ifTrue:[
- found := false
- ] ifFalse:[
- (tester value:(subString at:i) value:(self at:runIdx)) ifFalse:[
- found := false
- ]
- ].
- runIdx := runIdx + 1
- ].
- found ifTrue:[
- ^ startIndex
- ].
- startIndex := findNextIndex value:(startIndex + 1)
+ runIdx := startIndex.
+ found := true.
+ 1 to:subSize do:[:i |
+ runIdx > mySize ifTrue:[
+ found := false
+ ] ifFalse:[
+ (tester value:(subString at:i) value:(self at:runIdx)) ifFalse:[
+ found := false
+ ]
+ ].
+ runIdx := runIdx + 1
+ ].
+ found ifTrue:[
+ ^ startIndex
+ ].
+ startIndex := findNextIndex value:(startIndex + 1)
].
^ exceptionBlock value
@@ -7083,7 +7083,7 @@
i := self indexOfSubCollection:subString startingAt:start ifAbsent:0 caseSensitive:caseSensitive.
i == 0 ifTrue:[
- ^ exceptionValue value
+ ^ exceptionValue value
].
^ i to:(i + subString size - 1)
@@ -7102,7 +7102,7 @@
|string|
(string := self string) ~~ self ifTrue:[
- ^ string contains8BitCharacters
+ ^ string contains8BitCharacters
].
^ self contains:[:aCharacter | aCharacter codePoint > 16r7F ].
@@ -7117,8 +7117,8 @@
i.e. consists of a letter followed by letters or digits."
self size == 0 ifTrue:[
- "mhmh what is this ?"
- ^ false
+ "mhmh what is this ?"
+ ^ false
].
(self at:1) isLetter ifFalse:[^ false].
^ self conform:[:char | char isLetterOrDigit].
@@ -7183,16 +7183,16 @@
state := #initial.
self do:[:char |
- (state == #initial or:[ state == #gotColon]) ifTrue:[
- (char isLetterOrUnderline) ifFalse:[^ false].
- state := #gotCharacter.
- ] ifFalse:[
- char == $: ifTrue:[
- state := #gotColon.
- ] ifFalse:[
- (char isLetterOrDigit or:[char == $_]) ifFalse:[^ false].
- ].
- ].
+ (state == #initial or:[ state == #gotColon]) ifTrue:[
+ (char isLetterOrUnderline) ifFalse:[^ false].
+ state := #gotCharacter.
+ ] ifFalse:[
+ char == $: ifTrue:[
+ state := #gotColon.
+ ] ifFalse:[
+ (char isLetterOrDigit or:[char == $_]) ifFalse:[^ false].
+ ].
+ ].
].
^ state == #gotColon.
@@ -7218,7 +7218,7 @@
These are of the form ':<ns>::<sel>', where ns is the NameSpace and sel is the regular selector.
For example, the #+ selector as seen by the Foo namespace would be actually #':Foo::+'.
This special format (a symbol starting with a colon) was chosen, because almost every other selector
- is legal, and this can be checked quickly by just looking at the first character.
+ is legal, and this can be checked quickly by just looking at the first character.
You cannot easily change this algorithm here, as it is also known by the VM's lookup function."
|i|
@@ -7250,7 +7250,7 @@
i.e. consists only of digits."
self size == 0 ifTrue:[
- ^ false
+ ^ false
].
^ self conform:[:char | char isDigit]
@@ -7301,12 +7301,12 @@
scanner := Compiler new.
scanner source:(self readStream).
Parser parseErrorSignal handle:[:ex |
- tok := nil.
+ tok := nil.
] do:[
- tok := scanner nextToken.
+ tok := scanner nextToken.
].
tok ~~ #Identifier ifTrue:[
- ^ false
+ ^ false
].
scanner tokenPosition == 1 ifFalse:[^ false].
^ scanner sourceStream atEnd.
@@ -7325,7 +7325,7 @@
|string|
(string := self string) ~~ self ifTrue:[
- ^ string isWideString.
+ ^ string isWideString.
].
^ self contains:[:aCharacter | aCharacter codePoint > 16rFF].
!
@@ -7336,10 +7336,10 @@
|binopChars|
(self size <= Scanner maxBinarySelectorSize) ifTrue:[
- binopChars := Scanner binarySelectorCharacters.
- (self conform:[:eachChar | (binopChars includes:eachChar)]) ifTrue:[
- ^ 1
- ].
+ binopChars := Scanner binarySelectorCharacters.
+ (self conform:[:eachChar | (binopChars includes:eachChar)]) ifTrue:[
+ ^ 1
+ ].
].
^ self occurrencesOf:$:
@@ -7375,21 +7375,21 @@
idx1 := 1.
sz := self size.
[
- idx2 := self indexOf:$: startingAt:idx1.
- (idx2 == 0 or:[idx2 == sz]) ifTrue:[
- coll add:(self copyFrom:idx1).
- ^ coll
- ].
- coll add:(self copyFrom:idx1 to:idx2).
- idx1 := idx2 + 1
+ idx2 := self indexOf:$: startingAt:idx1.
+ (idx2 == 0 or:[idx2 == sz]) ifTrue:[
+ coll add:(self copyFrom:idx1).
+ ^ coll
+ ].
+ coll add:(self copyFrom:idx1 to:idx2).
+ idx1 := idx2 + 1
] loop.
"
- 'foo:' partsIfSelector
- 'foo:bar:' partsIfSelector
- 'foo::::' partsIfSelector
- #foo:bar: partsIfSelector
- 'hello' partsIfSelector
+ 'foo:' partsIfSelector
+ 'foo:bar:' partsIfSelector
+ 'foo::::' partsIfSelector
+ #foo:bar: partsIfSelector
+ 'hello' partsIfSelector
'+' partsIfSelector
"
! !
@@ -7416,11 +7416,11 @@
!CharacterArray class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.584 2015-05-06 08:51:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.585 2015-05-16 09:48:42 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.584 2015-05-06 08:51:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.585 2015-05-16 09:48:42 cg Exp $'
!
version_HG
--- a/Context.st Sat May 16 06:48:37 2015 +0200
+++ b/Context.st Mon May 18 07:10:20 2015 +0100
@@ -1016,7 +1016,7 @@
self receiverPrintString errorPrint. ' ' errorPrint. selector errorPrint.
self numArgs ~~ 0 ifTrue: [
- ' ' errorPrint. self argsDisplayString errorPrint
+ ' ' errorPrint. self argsDisplayString errorPrint
].
' [' errorPrint. self lineNumber errorPrint. ']' errorPrintCR
@@ -1161,7 +1161,8 @@
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
- ERROR("unimplemented");
+ return __c__.RESTART(self);
+ /* NOTREACHED */
#else
if (__INST(sender_) == nil) {
RETURN(nil);
@@ -2842,11 +2843,11 @@
!Context class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.220 2015-04-27 17:06:10 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.221 2015-05-18 00:16:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.220 2015-04-27 17:06:10 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.221 2015-05-18 00:16:20 cg Exp $'
!
version_HG
--- a/Date.st Sat May 16 06:48:37 2015 +0200
+++ b/Date.st Mon May 18 07:10:20 2015 +0100
@@ -260,15 +260,17 @@
Notice, that this is not able to represent dates before 1901!!.
Added for GNU/ST-80 compatibility"
- |year rest d yearIncrement|
+ |year rest d yearIncrement yearAsDays|
"approx. year"
year := (dayCount // 366) + 1901.
+ yearAsDays := (self yearAsDays:year).
+
dayCount < 0 ifTrue:[
- rest := dayCount negated - (self yearAsDays:year) + 1. "+1 for ST-80 compatibility"
+ rest := dayCount negated - yearAsDays + 1. "+1 for ST-80 compatibility"
yearIncrement := -1.
] ifFalse:[
- rest := dayCount - (self yearAsDays:year) + 1. "+1 for ST-80 compatibility"
+ rest := dayCount - yearAsDays + 1. "+1 for ST-80 compatibility"
yearIncrement := 1.
].
rest > 365 ifTrue:[
@@ -298,15 +300,17 @@
Date asDaysSince0 is the reverse operation.
Notice, that this is a private interface"
- |year rest d yearIncrement|
+ |year rest d yearIncrement yearAsDaysFrom0|
"approx. year"
year := (dayCount // 366).
+ yearAsDaysFrom0 := (self yearAsDaysFrom0:year).
+
dayCount < 0 ifTrue:[
- rest := dayCount negated - (self yearAsDaysFrom0:year) + 1. "+1 for ST-80 compatibility"
+ rest := dayCount negated - yearAsDaysFrom0 + 1. "+1 for ST-80 compatibility"
yearIncrement := -1.
] ifFalse:[
- rest := dayCount - (self yearAsDaysFrom0:year) + 1. "+1 for ST-80 compatibility"
+ rest := dayCount - yearAsDaysFrom0 + 1. "+1 for ST-80 compatibility"
yearIncrement := 1.
].
rest > 365 ifTrue:[
@@ -320,8 +324,8 @@
^ self newDay:rest year:year
"
- Date fromDaysSince0:0 -> 1 jan 0
- Date fromDaysSince0:366 -> 1 jan 1
+ Date fromDaysFrom0:0 -> 1 jan 0
+ Date fromDaysFrom0:366 -> 1 jan 1
"
!
@@ -882,7 +886,6 @@
^ self newDay:day month:mon year:yr
! !
-
!Date class methodsFor:'change & update'!
update:something with:aParameter from:changedObject
@@ -1697,7 +1700,6 @@
^ self leapYear:yearInteger
! !
-
!Date class methodsFor:'private'!
dayAbbrevsForLanguage:languageOrNilForDefault
@@ -1871,7 +1873,6 @@
"
! !
-
!Date methodsFor:'Compatibility-ANSI'!
dayOfWeek
@@ -2869,26 +2870,27 @@
"Return the first day of a previous month (0=this month).
CG: there are two such methods - which one is obsolete? (see firstDayInPreviousMonth:)"
- |month year|
+ |month year monthNegated|
month := self month.
year := self year.
month := month - nMonths.
month < 1 ifTrue:[
- year := year - 1 - (month negated // 12).
- month := (12 - (month negated \\ 12)).
+ monthNegated := month negated.
+ year := year - 1 - (monthNegated // 12).
+ month := (12 - (monthNegated \\ 12)).
].
^ Date newDay:1 month:month year:year.
"
(Date newDay:3 month:6 year:2009) firstDayInMonth
- (Date newDay:3 month:6 year:2009) firstDayOfPreviousMonth:0
+ (Date newDay:3 month:6 year:2009) firstDayOfPreviousMonth:0
(Date newDay:3 month:6 year:2009) firstDayOfPreviousMonth:5
(Date newDay:3 month:6 year:2009) firstDayOfPreviousMonth:6
(Date newDay:3 month:6 year:2009) firstDayOfPreviousMonth:7
(Date newDay:3 month:6 year:2009) firstDayOfPreviousMonth:17
- (Date newDay:3 month:6 year:2009) firstDayOfPreviousMonth:18
+ (Date newDay:3 month:6 year:2009) firstDayOfPreviousMonth:18
"
!
@@ -3028,7 +3030,6 @@
! !
-
!Date methodsFor:'obsolete'!
asAbsoluteTime
@@ -3099,7 +3100,6 @@
^ self addDays:days
! !
-
!Date methodsFor:'printing & storing'!
addPrintBindingsTo:aDictionary
@@ -3475,11 +3475,11 @@
!Date class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Date.st,v 1.169 2015-04-22 17:50:37 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Date.st,v 1.170 2015-05-17 20:49:07 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Date.st,v 1.169 2015-04-22 17:50:37 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Date.st,v 1.170 2015-05-17 20:49:07 cg Exp $'
! !
--- a/ExternalStream.st Sat May 16 06:48:37 2015 +0200
+++ b/ExternalStream.st Mon May 18 07:10:20 2015 +0100
@@ -3591,6 +3591,20 @@
|error|
%{
+#ifdef __SCHTEAM__
+ STObject handle = self.instVarAt(I_handle);
+
+ if (handle != STObject.Nil) {
+ STObject next;
+
+ next = handle.nextByte();
+ if (next != STObject.EOF) {
+ self.instVarAt_put(I_position, STObject.Nil);
+ return __c__._RETURN( next );
+ }
+ self.instVarAt_put(I_hitEOF, STObject.True);
+ }
+#else
FILEPOINTER f;
unsigned char byte;
int ret, _buffered;
@@ -3631,6 +3645,7 @@
}
}
}
+#endif /* not SCHTEAM */
%}.
hitEOF ifTrue:[^ self pastEndRead].
error notNil ifTrue:[
@@ -4892,6 +4907,24 @@
|c error|
%{
+#ifdef __SCHTEAM__
+ STObject handle = self.instVarAt(I_handle);
+
+ if (handle != STObject.Nil) {
+ STObject next;
+
+ if (self.instVarAt(I_binary) == STObject.True) {
+ next = handle.nextByte();
+ } else {
+ next = handle.nextChar();
+ }
+ if (next != STObject.EOF) {
+ self.instVarAt_put(I_position, STObject.Nil);
+ return __c__._RETURN( next );
+ }
+ self.instVarAt_put(I_hitEOF, STObject.True);
+ }
+#else
FILEPOINTER f;
int ret, _buffered;
OBJ pos, fp;
@@ -4931,9 +4964,9 @@
__INST(position) = nil;
if ((ret < 0)
-#ifdef ECONNRESET
+# ifdef ECONNRESET
&& (__threadErrno != ECONNRESET)
-#endif
+# endif
){
error = __mkSmallInteger(__threadErrno);
} else /* ret == 0 */ {
@@ -4941,6 +4974,7 @@
}
}
}
+#endif /* not SCHTEAM */
%}.
hitEOF == true ifTrue:[^ self pastEndRead].
error notNil ifTrue:[
@@ -5472,19 +5506,19 @@
wasBlocked := OperatingSystem blockInterrupts.
inputSema := Semaphore new name:'readWait'.
[
- timeoutOrNil notNil ifTrue:[
- Processor signal:inputSema afterMilliseconds:timeoutOrNil.
- ].
- Processor signal:inputSema onInput:fd.
- Processor activeProcess state:#ioWait.
- inputSema wait.
- hasTimedout := timeoutOrNil notNil and:[(OperatingSystem readCheck:fd) not].
+ timeoutOrNil notNil ifTrue:[
+ Processor signal:inputSema afterMilliseconds:timeoutOrNil.
+ ].
+ Processor signal:inputSema onInput:fd.
+ Processor activeProcess state:#ioWait.
+ inputSema wait.
+ hasTimedout := timeoutOrNil notNil and:[(OperatingSystem readCheck:fd) not].
] ifCurtailed:[
- Processor disableSemaphore:inputSema.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ Processor disableSemaphore:inputSema.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
].
timeoutOrNil notNil ifTrue:[
- Processor disableSemaphore:inputSema.
+ Processor disableSemaphore:inputSema.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ hasTimedout
@@ -5693,6 +5727,16 @@
|error|
%{
+#ifdef __SCHTEAM__
+ STObject handle = self.instVarAt(I_handle);
+
+ if ((handle != STObject.Nil)
+ && (aCharacter.isSTCharacter())) {
+ handle.writeChar( aCharacter );
+ self.instVarAt_put(I_position, STObject.Nil);
+ return __c__._RETURN_self();
+ }
+#else
FILEPOINTER f;
unsigned codePoint;
unsigned char c;
@@ -5747,11 +5791,11 @@
if (_buffered = (__INST(buffered) == true)) {
__WRITING__(f)
}
-#ifdef WIN32
+# ifdef WIN32
if ((f == __win32_stdout()) || (f == __win32_stderr())) {
cnt = __win32_fwrite(buff, 1, nBytes, f);
} else
-#endif
+# endif
{
__WRITEBYTES__(cnt, f, buff, nBytes, _buffered, __INST(handleType));
}
@@ -5779,6 +5823,7 @@
}
}
out: ;
+#endif /* not SCHTEAM */
%}.
error notNil ifTrue:[
lastErrorNumber := error.
@@ -5812,6 +5857,16 @@
|error|
%{
+#ifdef __SCHTEAM__
+ STObject handle = self.instVarAt(I_handle);
+
+ if ((handle != STObject.Nil)
+ && (aCollection.isSTString())) {
+ handle.writeCharacters( aCollection.asSTString().characters );
+ self.instVarAt_put(I_position, STObject.Nil);
+ return __c__._RETURN_self();
+ }
+#else
FILEPOINTER f;
INT len, cnt;
OBJ fp;
@@ -5908,21 +5963,21 @@
}
len = dp - buf;
-#ifdef WIN32
+# ifdef WIN32
if ((f == __win32_stdout()) || (f == __win32_stderr())) {
cnt = __win32_fwrite(buf, 1, len, f);
} else
-#endif
+# endif
{
__WRITEBYTES__(cnt, f, buf, len, _buffered, __INST(handleType));
}
free(buf);
} else { // No EOL conversion needed
-#ifdef WIN32
+# ifdef WIN32
if ((f == __win32_stdout()) || (f == __win32_stderr())) {
cnt = __win32_fwrite(stringP, 1, len, f);
} else
-#endif
+# endif
{
o_offs = stringP - (char *)__InstPtr(aCollection);
__WRITEBYTES_OBJ__(cnt, f, aCollection, o_offs, len, _buffered, __INST(handleType));
@@ -5940,11 +5995,11 @@
len = __byteArraySize(aCollection) - offs;
} else
goto out;
-#ifdef WIN32
+# ifdef WIN32
if ((f == __win32_stdout()) || (f == __win32_stderr())) {
cnt = __win32_fwrite(__stringVal(aCollection), 1, len, f);
} else
-#endif
+# endif
{
o_offs = (char *)(__ByteArrayInstPtr(aCollection)->ba_element) - (char *)__InstPtr(aCollection);
o_offs += offs;
@@ -5971,6 +6026,7 @@
}
}
out: ;
+#endif /* not SCHTEAM */
%}.
error notNil ifTrue:[
lastErrorNumber := error.
@@ -6210,13 +6266,19 @@
%{
#ifdef __SCHTEAM__
- char[] chars;
byte[] bytes;
STObject handle = self.instVarAt(I_handle);
if (anObject.isSTString()) {
- chars = anObject.asSTString().characters;
+ char[] chars = anObject.asSTString().characters;
handle.writeCharacters(chars, start.intValue(), count.intValue());
+ self.instVarAt_put(I_position, STObject.Nil);
+ return context._RETURN(count);
+ }
+ if (anObject.isSymbol()) {
+ java.lang.String chars = anObject.asSTSymbol().characters;
+ handle.writeString(chars, start.intValue(), count.intValue());
+ self.instVarAt_put(I_position, STObject.Nil);
return context._RETURN(count);
}
#else
@@ -6485,11 +6547,11 @@
!ExternalStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.418 2015-05-08 01:06:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.419 2015-05-18 00:16:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.418 2015-05-08 01:06:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.419 2015-05-18 00:16:20 cg Exp $'
! !
--- a/LongFloat.st Sat May 16 06:48:37 2015 +0200
+++ b/LongFloat.st Mon May 18 07:10:20 2015 +0100
@@ -249,46 +249,46 @@
to another.
NO GARANTY:
- on systems which do not support 'long doubles', LongFloats are (silently)
- represented as 'doubles'.
+ on systems which do not support 'long doubles', LongFloats are (silently)
+ represented as 'doubles'.
Representation:
- gcc-x386:
- 80bit extended IEEE floats stored in in 96bits (12bytes);
- 64 bit mantissa,
- 16 bit exponent,
- 19 decimal digits (approx)
-
- borland-i386 (WIN32):
- 80bit extended IEEE floats stored in in 80bits (10bytes);
- 64 bit mantissa,
- 16 bit exponent,
- 19 decimal digits (approx)
-
- gcc-sparc:
- 128bit quad IEEE floats (16bytes);
- 112 bit mantissa,
- 16 bit exponent,
- 34 decimal digits (approx)
+ gcc-x386:
+ 80bit extended IEEE floats stored in in 96bits (12bytes);
+ 64 bit mantissa,
+ 16 bit exponent,
+ 19 decimal digits (approx)
+
+ borland-i386 (WIN32):
+ 80bit extended IEEE floats stored in in 80bits (10bytes);
+ 64 bit mantissa,
+ 16 bit exponent,
+ 19 decimal digits (approx)
+
+ gcc-sparc:
+ 128bit quad IEEE floats (16bytes);
+ 112 bit mantissa,
+ 16 bit exponent,
+ 34 decimal digits (approx)
Mixed mode arithmetic:
- longFloat op longFloat -> longFloat
- longFloat op fix -> longFloat
- longFloat op fraction -> longFloat
- longFloat op integer -> longFloat
- longFloat op shortFloat -> longFloat
- longFloat op float -> longFloat
- longFloat op complex -> complex
+ longFloat op longFloat -> longFloat
+ longFloat op fix -> longFloat
+ longFloat op fraction -> longFloat
+ longFloat op integer -> longFloat
+ longFloat op shortFloat -> longFloat
+ longFloat op float -> longFloat
+ longFloat op complex -> complex
Range and Precision of Storage Formats: see LimitedPrecisionReal >> documentation
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Number
- Float ShortFloat Fraction FixedPoint Integer Complex
- FloatArray DoubleArray
+ Number
+ Float ShortFloat Fraction FixedPoint Integer Complex
+ FloatArray DoubleArray
"
! !
@@ -304,6 +304,9 @@
binary stored in a device independent format."
%{ /* NOCONTEXT */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( new STDouble(0.0) );
+#else
OBJ newFloat;
if (sizeof(LONGFLOAT) == sizeof(double)) {
__qMKFLOAT(newFloat, 0.0); /* OBJECT ALLOCATION */
@@ -311,6 +314,7 @@
__qMKLFLOAT(newFloat, 0.0); /* OBJECT ALLOCATION */
}
RETURN (newFloat);
+#endif /* not SCHTEAM */
%}
!
@@ -322,6 +326,14 @@
"return a new longFloat, given a float value"
%{ /* NOCONTEXT */
+#ifdef __SCHTEAM__
+ if (aFloat.isDouble()) {
+ return __c__._RETURN(aFloat);
+ }
+ if (aFloat.isFloat()) {
+ return __c__._RETURN( new STDouble(aFloat.floatValue()) );
+ }
+#else
OBJ newFloat;
LONGFLOAT f;
@@ -334,8 +346,9 @@
__qMKLFLOAT(newFloat, f); /* OBJECT ALLOCATION */
RETURN (newFloat);
}
+#endif
%}.
- self error:'invalid argumnet'
+ self error:'invalid argument'
"
LongFloat fromFloat:123.0
@@ -351,17 +364,18 @@
OBJ newFloat;
REGISTER union {
- unsigned int i;
- float f;
+ unsigned int i;
+ float f;
} r;
r.i = __unsignedLongIntVal( anInteger );
__qMKLFLOAT(newFloat, r.f);
RETURN( newFloat );
-%}
+%}.
+ ^ Float fromIEEE32Bit: anInteger
"
- LongFloat fromIEEE32Bit:(ShortFloat pi digitBytesMSB:true) asInteger
+ LongFloat fromIEEE32Bit:(ShortFloat pi digitBytesMSB:true) asInteger
"
!
@@ -372,21 +386,21 @@
__uint64__ __unsignedLongLongIntVal(OBJ);
REGISTER union {
- __uint64__ u64;
- double d;
+ __uint64__ u64;
+ double d;
} r;
if (__unsignedLong64IntVal(anInteger, &r.u64)) {
- OBJ newFloat;
-
- __qMKLFLOAT(newFloat, r.d);
- RETURN( newFloat );
+ OBJ newFloat;
+
+ __qMKLFLOAT(newFloat, r.d);
+ RETURN( newFloat );
}
%}.
- self primitiveFailed.
+ ^ Float fromIEEE32Bit: anInteger
"
- LongFloat fromIEEE64Bit:(Float pi digitBytesMSB:true) asInteger
+ LongFloat fromIEEE64Bit:(Float pi digitBytesMSB:true) asInteger
"
!
@@ -394,6 +408,11 @@
"return a new longFloat, given a float value"
%{ /* NOCONTEXT */
+#ifdef __SCHTEAM__
+ if (anInteger.isSmallInteger()) {
+ return __c__._RETURN( STDouble._new( (double)(anInteger.longValue()) ));
+ }
+#else
OBJ newFloat;
LONGFLOAT f;
@@ -402,6 +421,7 @@
__qMKLFLOAT(newFloat, f); /* OBJECT ALLOCATION */
RETURN (newFloat);
}
+#endif /* not SCHTEAM */
%}.
^ super fromInteger:anInteger
@@ -420,6 +440,14 @@
"return a new longFloat, given a shortFloat value"
%{ /* NOCONTEXT */
+#ifdef __SCHTEAM__
+ if (aFloat.isFloat()) {
+ return __c__._RETURN( new STDouble(aFloat.floatValue()) );
+ }
+ if (aFloat.isDouble()) {
+ return __c__._RETURN( aFloat );
+ }
+#else
OBJ newFloat;
LONGFLOAT f;
@@ -428,6 +456,7 @@
__qMKLFLOAT(newFloat, f); /* OBJECT ALLOCATION */
RETURN (newFloat);
}
+#endif /* not SCHTEAM */
%}.
self error:'invalid argumnet'
@@ -457,12 +486,12 @@
"do not write a literal constant here - we cannot depend on the underlying C-compiler here..."
Pi isNil ifTrue:[
- DefaultPrintFormat := '.19'. "/ 19 valid digits
- Epsilon := self computeEpsilon.
-
- "/ enough digits for 128bit IEEE quads
- Pi := self readFrom:'3.1415926535897932384626433832795029'. "/ 3.14159265358979323846264338327950288419716939937510582097494459q
- E := self readFrom:'2.7182818284590452353602874713526625'.
+ DefaultPrintFormat := '.19'. "/ 19 valid digits
+ Epsilon := self computeEpsilon.
+
+ "/ enough digits for 128bit IEEE quads
+ Pi := self readFrom:'3.1415926535897932384626433832795029'. "/ 3.14159265358979323846264338327950288419716939937510582097494459q
+ E := self readFrom:'2.7182818284590452353602874713526625'.
].
"
@@ -536,35 +565,35 @@
numBitsInExponent
"answer the number of bits in the exponent
i386: This is an 80bit longfloat stored in 96 bits (upper 16 bits are unused),
- where 15 bits are available in the exponent (i bit is ignored):
- 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ where 15 bits are available in the exponent (i bit is ignored):
+ 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
x86_64: This is an 80bit longfloat stored in 128 bits (upper 48 bits are unused),
- where 15 bits are available in the exponent:
- 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ where 15 bits are available in the exponent:
+ 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
sparc & others: This is an 128bit longfloat,
- where 15 bits are available in the exponent:
- 00000000 00000000 seeeeeee eeeeeeee mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm ...
+ where 15 bits are available in the exponent:
+ 00000000 00000000 seeeeeee eeeeeeee mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm ...
"
%{ /* NOCONTEXT */
#if defined(__i386__) || defined(__x86_64__)
- if (sizeof(LONGFLOAT) == 10) { /* i386 - WIN32: 80bit floats */
- RETURN (__mkSmallInteger(15));
+ if (sizeof(LONGFLOAT) == 10) { /* i386 - WIN32: 80bit floats */
+ RETURN (__mkSmallInteger(15));
}
if (sizeof(LONGFLOAT) == 12) { /* i386 - some unixes: 96bit floats */
- RETURN (__mkSmallInteger(15));
+ RETURN (__mkSmallInteger(15));
}
if (sizeof(LONGFLOAT) == 16) { /* amd64, i386-64bit */
- RETURN (__mkSmallInteger(15));
+ RETURN (__mkSmallInteger(15));
}
#else
if (sizeof(LONGFLOAT) == 16) {
- RETURN (__mkSmallInteger(15)); /* sparc */
+ RETURN (__mkSmallInteger(15)); /* sparc */
}
#endif
%}.
"systems without longFloat support use doubles instead"
self basicNew basicSize == Float basicNew basicSize ifTrue:[
- ^ Float numBitsInExponent
+ ^ Float numBitsInExponent
].
self error:'missing definition' "ifdef missing in above primitive code for this architecture"
@@ -576,35 +605,35 @@
numBitsInIntegerPart
"answer the number of bits in the integer part of the mantissa
i386: This is an 80bit longfloat stored in 96 bits (upper 16 bits are unused),
- where 1 bit is used for the integer part in the mantissa:
- 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ where 1 bit is used for the integer part in the mantissa:
+ 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
x86_64: This is an 80bit longfloat stored in 128 bits (upper 48 bits are unused),
- where 1+63 bits are available in the mantissa:
- 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ where 1+63 bits are available in the mantissa:
+ 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
sparc & others: This is an 128bit longfloat,
- where 112 bits are available in the mantissa:
- 00000000 00000000 seeeeeee eeeeeeee mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm ...
+ where 112 bits are available in the mantissa:
+ 00000000 00000000 seeeeeee eeeeeeee mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm ...
"
%{ /* NOCONTEXT */
#if defined(__i386__) || defined(__x86_64__)
if (sizeof(LONGFLOAT) == 10) { /* i386 - WIN32: 80bit floats */
- RETURN (__mkSmallInteger(1));
+ RETURN (__mkSmallInteger(1));
}
- if (sizeof(LONGFLOAT) == 12) { /* i386 - some other unixes: 96bit floats*/
- RETURN (__mkSmallInteger(1));
+ if (sizeof(LONGFLOAT) == 12) { /* i386 - some other unixes: 96bit floats*/
+ RETURN (__mkSmallInteger(1));
}
if (sizeof(LONGFLOAT) == 16) {
- RETURN (__mkSmallInteger(1)); /* amd64, i386-64bit */
+ RETURN (__mkSmallInteger(1)); /* amd64, i386-64bit */
}
#else
if (sizeof(LONGFLOAT) == 16) {
- RETURN (__mkSmallInteger(0)); /* sparc */
+ RETURN (__mkSmallInteger(0)); /* sparc */
}
#endif
%}.
"systems without longFloat support use doubles instead"
self basicNew basicSize == Float basicNew basicSize ifTrue:[
- ^ Float numBitsInIntegerPart
+ ^ Float numBitsInIntegerPart
].
self error:'missing definition' "ifdef missing in above primitive code for this architecture"
@@ -616,35 +645,35 @@
numBitsInMantissa
"answer the number of bits in the mantissa
i386: This is an 80bit longfloat stored in 96 bits (upper 16 bits are unused),
- where 1+63 bits are available in the mantissa:
- 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ where 1+63 bits are available in the mantissa:
+ 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
x86_64: This is an 80bit longfloat stored in 128 bits (upper 48 bits are unused),
- where 1+63 bits are available in the mantissa:
- 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ where 1+63 bits are available in the mantissa:
+ 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
sparc: This is an 128bit longfloat,
- where 112 bits are available in the mantissa:
- 00000000 00000000 seeeeeee eeeeeeee mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ where 112 bits are available in the mantissa:
+ 00000000 00000000 seeeeeee eeeeeeee mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
"
%{ /* NOCONTEXT */
#if defined(__i386__) || defined(__x86_64__)
if (sizeof(LONGFLOAT) == 10) { /* i386 - WIN32: 80bit */
- RETURN (__mkSmallInteger(64));
+ RETURN (__mkSmallInteger(64));
}
if (sizeof(LONGFLOAT) == 12) { /* i386 some unixes: 96bit */
- RETURN (__mkSmallInteger(64));
+ RETURN (__mkSmallInteger(64));
}
if (sizeof(LONGFLOAT) == 16) {
- RETURN (__mkSmallInteger(64)); /* amd64, i386-64bit */
+ RETURN (__mkSmallInteger(64)); /* amd64, i386-64bit */
}
#else
if (sizeof(LONGFLOAT) == 16) {
- RETURN (__mkSmallInteger(112)); /* sparc */
+ RETURN (__mkSmallInteger(112)); /* sparc */
}
#endif
%}.
"systems without longFloat support use doubles instead"
self basicNew basicSize == Float basicNew basicSize ifTrue:[
- ^ Float numBitsInMantissa
+ ^ Float numBitsInMantissa
].
self error:'missing definition' "ifdef missing in above primitive code for this architecture"
@@ -1466,25 +1495,25 @@
^ self printStringWithFormat:DefaultPrintFormat
"
- LongFloat pi printString.
- 1.234 asLongFloat printString.
- 1.0 asLongFloat printString.
- 1e10 asLongFloat printString.
- 1.2e3 asLongFloat printString.
- 1.2e30 asLongFloat printString.
- (1.0 uncheckedDivide:0) asLongFloat printString.
- (0.0 uncheckedDivide:0) asLongFloat printString.
- self pi printString.
-
- DecimalPointCharacterForPrinting := $,.
- 1.234 asLongFloat printString.
- 1.0 asLongFloat printString.
- 1e10 asLongFloat printString.
- 1.2e3 asLongFloat printString.
- 1.2e30 asLongFloat printString.
- (1.0 uncheckedDivide:0) asLongFloat printString.
- (0.0 uncheckedDivide:0) asLongFloat printString.
- DecimalPointCharacterForPrinting := $.
+ LongFloat pi printString.
+ 1.234 asLongFloat printString.
+ 1.0 asLongFloat printString.
+ 1e10 asLongFloat printString.
+ 1.2e3 asLongFloat printString.
+ 1.2e30 asLongFloat printString.
+ (1.0 uncheckedDivide:0) asLongFloat printString.
+ (0.0 uncheckedDivide:0) asLongFloat printString.
+ self pi printString.
+
+ DecimalPointCharacterForPrinting := $,.
+ 1.234 asLongFloat printString.
+ 1.0 asLongFloat printString.
+ 1e10 asLongFloat printString.
+ 1.2e3 asLongFloat printString.
+ 1.2e30 asLongFloat printString.
+ (1.0 uncheckedDivide:0) asLongFloat printString.
+ (0.0 uncheckedDivide:0) asLongFloat printString.
+ DecimalPointCharacterForPrinting := $.
"
!
@@ -1505,9 +1534,9 @@
int len ;
if (__isStringLike(format)) {
- fmt = (char *) __stringVal(format);
+ fmt = (char *) __stringVal(format);
} else {
- fmt = ".19";
+ fmt = ".19";
}
/*
* build a printf format string
@@ -1516,12 +1545,12 @@
strncpy(fmtBuffer+1, fmt, 10);
if (sizeof(LONGFLOAT) == sizeof(double)) {
#ifdef SYSV
- strcat(fmtBuffer, "lg");
+ strcat(fmtBuffer, "lg");
#else
- strcat(fmtBuffer, "G");
+ strcat(fmtBuffer, "G");
#endif
} else {
- strcat(fmtBuffer, "LG");
+ strcat(fmtBuffer, "LG");
}
/*
@@ -1534,33 +1563,33 @@
__END_PROTECT_REGISTERS__
if (len >= 0 && len < sizeof(buffer)-3) {
- /*
- * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
- * (i.e. look if string contains '.' or 'e' and append '.0' if not)
- */
- for (cp = buffer; *cp; cp++) {
- if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
- }
- if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
- if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
- *cp++ = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
- } else {
- *cp++ = '.';
- }
- *cp++ = '0';
- *cp = '\0';
- } else {
- if (cp && (*cp == '.')) {
- if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
- *cp = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
- }
- }
- }
-
- s = __MKSTRING(buffer);
- if (s != nil) {
- RETURN (s);
- }
+ /*
+ * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
+ * (i.e. look if string contains '.' or 'e' and append '.0' if not)
+ */
+ for (cp = buffer; *cp; cp++) {
+ if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
+ }
+ if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
+ if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
+ *cp++ = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
+ } else {
+ *cp++ = '.';
+ }
+ *cp++ = '0';
+ *cp = '\0';
+ } else {
+ if (cp && (*cp == '.')) {
+ if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
+ *cp = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
+ }
+ }
+ }
+
+ s = __MKSTRING(buffer);
+ if (s != nil) {
+ RETURN (s);
+ }
}
%}.
"
@@ -1573,24 +1602,24 @@
^ ObjectMemory allocationFailureSignal raise.
"
- 1.234 asLongFloat printString.
- 1.0 asLongFloat printString.
- 1e10 asLongFloat printString.
- 1.2e3 asLongFloat printString.
- 1.2e30 asLongFloat printString.
- (1.0 uncheckedDivide:0) asLongFloat printString.
- (0.0 uncheckedDivide:0) asLongFloat printString.
- self pi printString.
-
- DecimalPointCharacterForPrinting := $,.
- 1.234 asLongFloat printString.
- 1.0 asLongFloat printString.
- 1e10 asLongFloat printString.
- 1.2e3 asLongFloat printString.
- 1.2e30 asLongFloat printString.
- (1.0 uncheckedDivide:0) asLongFloat printString.
- (0.0 uncheckedDivide:0) asLongFloat printString.
- DecimalPointCharacterForPrinting := $.
+ 1.234 asLongFloat printString.
+ 1.0 asLongFloat printString.
+ 1e10 asLongFloat printString.
+ 1.2e3 asLongFloat printString.
+ 1.2e30 asLongFloat printString.
+ (1.0 uncheckedDivide:0) asLongFloat printString.
+ (0.0 uncheckedDivide:0) asLongFloat printString.
+ self pi printString.
+
+ DecimalPointCharacterForPrinting := $,.
+ 1.234 asLongFloat printString.
+ 1.0 asLongFloat printString.
+ 1e10 asLongFloat printString.
+ 1.2e3 asLongFloat printString.
+ 1.2e30 asLongFloat printString.
+ (1.0 uncheckedDivide:0) asLongFloat printString.
+ (0.0 uncheckedDivide:0) asLongFloat printString.
+ DecimalPointCharacterForPrinting := $.
"
!
@@ -1660,12 +1689,12 @@
*/
if (sizeof(LONGFLOAT) == sizeof(double)) {
#ifdef SYSV
- fmtBuffer = "%.17lg";
+ fmtBuffer = "%.17lg";
#else
- fmtBuffer = "%.17G";
+ fmtBuffer = "%.17G";
#endif
} else {
- fmtBuffer = "%.20LG";
+ fmtBuffer = "%.20LG";
}
__BEGIN_PROTECT_REGISTERS__
@@ -1673,23 +1702,23 @@
__END_PROTECT_REGISTERS__
if (len >= 0 && len < sizeof(buffer)-3) {
- /*
- * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
- * (i.e. look if string contains '.' or 'e' and append '.0' if not)
- */
- for (cp = buffer; *cp; cp++) {
- if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
- }
- if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
- *cp++ = '.';
- *cp++ = '0';
- *cp = '\0';
- }
-
- s = __MKSTRING(buffer);
- if (s != nil) {
- RETURN (s);
- }
+ /*
+ * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
+ * (i.e. look if string contains '.' or 'e' and append '.0' if not)
+ */
+ for (cp = buffer; *cp; cp++) {
+ if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
+ }
+ if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
+ *cp++ = '.';
+ *cp++ = '0';
+ *cp = '\0';
+ }
+
+ s = __MKSTRING(buffer);
+ if (s != nil) {
+ RETURN (s);
+ }
}
%}.
"
@@ -1702,26 +1731,26 @@
^ ObjectMemory allocationFailureSignal raise.
"
- 1.0 asLongFloat storeString
- 1.234 asLongFloat storeString
- 1e10 asLongFloat storeString
- 1.2e3 asLongFloat storeString
- 1.2e30 asLongFloat storeString
- LongFloat pi asLongFloat storeString
- (1.0 uncheckedDivide:0) asLongFloat storeString
- (0.0 uncheckedDivide:0) asLongFloat storeString
+ 1.0 asLongFloat storeString
+ 1.234 asLongFloat storeString
+ 1e10 asLongFloat storeString
+ 1.2e3 asLongFloat storeString
+ 1.2e30 asLongFloat storeString
+ LongFloat pi asLongFloat storeString
+ (1.0 uncheckedDivide:0) asLongFloat storeString
+ (0.0 uncheckedDivide:0) asLongFloat storeString
notice that the storeString is NOT affected by DecimalPointCharacterForPrinting:
- DecimalPointCharacterForPrinting := $,.
- 1.234 asLongFloat storeString.
- 1.0 asLongFloat storeString.
- 1e10 asLongFloat storeString.
- 1.2e3 asLongFloat storeString.
- 1.2e30 asLongFloat storeString.
- (1.0 uncheckedDivide:0) asLongFloat storeString.
- (0.0 uncheckedDivide:0) asLongFloat storeString.
- DecimalPointCharacterForPrinting := $.
+ DecimalPointCharacterForPrinting := $,.
+ 1.234 asLongFloat storeString.
+ 1.0 asLongFloat storeString.
+ 1e10 asLongFloat storeString.
+ 1.2e3 asLongFloat storeString.
+ 1.2e30 asLongFloat storeString.
+ (1.0 uncheckedDivide:0) asLongFloat storeString.
+ (0.0 uncheckedDivide:0) asLongFloat storeString.
+ DecimalPointCharacterForPrinting := $.
"
! !
@@ -1989,12 +2018,12 @@
%}.
"
- 0.0 asLongFloat negative
- -0.0 asLongFloat negative
- 1.0 asLongFloat negative
- -1.0 asLongFloat negative
- (1.0 uncheckedDivide: 0.0) asLongFloat negative
- (-1.0 uncheckedDivide: 0.0) asLongFloat negative
+ 0.0 asLongFloat negative
+ -0.0 asLongFloat negative
+ 1.0 asLongFloat negative
+ -1.0 asLongFloat negative
+ (1.0 uncheckedDivide: 0.0) asLongFloat negative
+ (-1.0 uncheckedDivide: 0.0) asLongFloat negative
"
!
@@ -2027,12 +2056,12 @@
%}.
"
- 0.0 asLongFloat positive
- -0.0 asLongFloat positive
- 1.0 asLongFloat positive
- -1.0 asLongFloat positive
- (1.0 uncheckedDivide: 0.0) asLongFloat positive
- (-1.0 uncheckedDivide: 0.0) asLongFloat positive
+ 0.0 asLongFloat positive
+ -0.0 asLongFloat positive
+ 1.0 asLongFloat positive
+ -1.0 asLongFloat positive
+ (1.0 uncheckedDivide: 0.0) asLongFloat positive
+ (-1.0 uncheckedDivide: 0.0) asLongFloat positive
"
!
@@ -2815,11 +2844,11 @@
!LongFloat class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.97 2015-03-25 19:18:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.98 2015-05-18 00:08:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.97 2015-03-25 19:18:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.98 2015-05-18 00:08:20 cg Exp $'
! !
--- a/Lookup.st Sat May 16 06:48:37 2015 +0200
+++ b/Lookup.st Mon May 18 07:10:20 2015 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
- All Rights Reserved
+ All Rights Reserved
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
@@ -37,7 +37,7 @@
copyright
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
- All Rights Reserved
+ All Rights Reserved
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
@@ -65,7 +65,6 @@
!Lookup class methodsFor:'initialization'!
initialize
-
self lookupObject: Lookup builtin
"Created: / 26-04-2010 / 21:15:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -74,7 +73,6 @@
!Lookup class methodsFor:'accessing'!
builtin
-
^BuiltinLookup instance
"Created: / 26-04-2010 / 19:26:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -83,37 +81,34 @@
!Lookup methodsFor:'lookup'!
lookupMethodForSelector: selector directedTo: initialSearchClass
-
- |cls md method|
+ |cls md method|
- "Following C code is just a performance optimization.
- It is not neccessary, however it speeds up UI code,
- since it heavily uses perform:"
+ "Following C code is just a performance optimization.
+ It is not neccessary, however it speeds up UI code,
+ since it heavily uses perform:"
%{
- RETURN ( __lookup(initialSearchClass, selector) );
+ RETURN ( __lookup(initialSearchClass, selector) );
%}.
- cls := initialSearchClass.
- [ cls notNil ] whileTrue:[
- md := cls methodDictionary.
- method := md at:selector ifAbsent:nil.
- method notNil ifTrue:[^ method ].
- cls := cls superclass.
- ].
- ^ nil
+ cls := initialSearchClass.
+ [ cls notNil ] whileTrue:[
+ md := cls methodDictionary.
+ method := md at:selector ifAbsent:nil.
+ method notNil ifTrue:[^ method ].
+ cls := cls superclass.
+ ].
+ ^ nil
"Created: / 27-04-2010 / 15:30:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
lookupMethodForSelector:selector directedTo:initialSearchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext
-
<resource: #obsolete>
- "
- This method is no longer sent by the VM as it nows pass
- inline/poly cache object.
- "
-
+ "
+ This method is no longer sent by the VM as it nows pass
+ inline/poly cache object.
+ "
"invoked by the VM to ask me for a method to call.
The arguments are: the selector, receiver and arguments,
@@ -127,13 +122,13 @@
|cls md method|
- "Following C code is just a performance optimization.
- It is not neccessary, however it speeds up UI code,
- since it heavily uses perform:"
+ "Following C code is just a performance optimization.
+ It is not neccessary, however it speeds up UI code,
+ since it heavily uses perform:"
%{
- RETURN ( __lookup(initialSearchClass, selector) );
+ RETURN ( __lookup(initialSearchClass, selector) );
%}.
- ^ self lookupMethodForSelector: selector
+ ^ self lookupMethodForSelector: selector
directedTo: initialSearchClass
@@ -145,33 +140,35 @@
The arguments are: the selector, receiver and arguments,
the class to start the search in (for here-, super and directed sends)
the sending context and the inline/poly cache (instance of
- PolymorphicInlineCache).
-
- The returned method object will NOT be put into the inline- and
+ PolymorphicInlineCache).
+
+ The returned method object will NOT be put into the inline- and
polyCache bu default. To update the call site's cache, you have to
call ilcCache bindTo: method forClass: initialSearch class. If you
dont call it, inline/poly cache won't be updated and next call
- won't be cached (therefore it will be relatively slow.
+ won't be cached (therefore it will be relatively slow.
If I return nil, a doesNotUnderstand: will be send."
| method |
- "Following C code is just a performance optimization.
- It is not neccessary, however it speeds up UI code,
- since it heavily uses perform:"
+ "Following C code is just a performance optimization.
+ It is not neccessary, however it speeds up UI code,
+ since it heavily uses perform:"
%{
method = __lookup(initialSearchClass, selector);
if ( method ) {
- __ilcBind(ilcCache, initialSearchClass, method, selector);
+ __ilcBind(ilcCache, initialSearchClass, method, selector);
}
RETURN (method);
%}.
method := self lookupMethodForSelector:selector directedTo:initialSearchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext.
- ilcCache bindTo: method forClass: initialSearchClass.
+ ilcCache notNil ifTrue:[
+ ilcCache bindTo: method forClass: initialSearchClass.
+ ].
^ method.
"Created: / 01-10-2011 / 13:18:40 / Jan Kurs <kursjan@fit.cvut.cz>"
@@ -180,11 +177,11 @@
!Lookup class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Lookup.st,v 1.3 2014-02-05 17:17:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Lookup.st,v 1.4 2015-05-18 00:39:03 cg Exp $'
!
version_SVN
- ^ '$Id: Lookup.st,v 1.3 2014-02-05 17:17:53 cg Exp $'
+ ^ '$Id: Lookup.st,v 1.4 2015-05-18 00:39:03 cg Exp $'
! !
--- a/NamespaceAwareLookup.st Sat May 16 06:48:37 2015 +0200
+++ b/NamespaceAwareLookup.st Mon May 18 07:10:20 2015 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
- All Rights Reserved
+ All Rights Reserved
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
@@ -37,7 +37,7 @@
copyright
"
COPYRIGHT (c) 2010 by Jan Vrany, SWING Research Group. CTU in Prague
- All Rights Reserved
+ All Rights Reserved
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
@@ -83,119 +83,122 @@
!NamespaceAwareLookup class methodsFor:'lookup'!
-lookupMethodForSelector: selector directedTo: initialSearchClass for: receiver withArguments: argArrayOrNil from: sendingContext
+lookupMethodForSelector: selector directedTo: initialSearchClass for: receiver withArguments: argArrayOrNil from: sendingContext
"JV @ 2010-07-24
Following C code is just a performance optimization.
It is not neccessary, however it speeds things in most
cases. Such optimization significantly speeds up the IDE
since class browser involves dozens of super-polymorphic
- sends (> 1000 receiver classes per send-site).
+ sends (> 1000 receiver classes per send-site).
"
-%{
+%{
OBJ sendingMthd = __ContextInstPtr(sendingContext)->c_method;
- if (__Class(sendingMthd) == Method &&
- __MethodInstPtr(sendingMthd)->m_annotation == nil) {
- OBJ m = __lookup(initialSearchClass, selector);
- if (m != nil) RETURN ( m );
- }
+ if (__Class(sendingMthd) == Method &&
+ __MethodInstPtr(sendingMthd)->m_annotation == nil) {
+ OBJ m = __lookup(initialSearchClass, selector);
+ if (m != nil) RETURN ( m );
+ }
%}.
^Instance lookupMethodForSelector: selector directedTo: initialSearchClass
- for: receiver withArguments: argArrayOrNil
- from: sendingContext
+ for: receiver withArguments: argArrayOrNil
+ from: sendingContext
! !
!NamespaceAwareLookup methodsFor:'lookup'!
-lookupMethodForSelector: selector directedTo: initialSearchClass for: receiver withArguments: argArrayOrNil from: sendingContext ilc: ilcCache
+lookupMethodForSelector: selector directedTo: initialSearchClass for: receiver withArguments: argArrayOrNil from: sendingContext ilc: ilcCache
"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 namespaces methods imports |
+ | sendingNs sendingMthd queue seen namespaces methods imports numMethods|
"JV @ 2010-07-24
Following C code is just a performance optimization.
It is not neccessary, however it speeds things in most
cases. Such optimization significantly speeds up the IDE
since class browser involves dozens of super-polymorphic
- sends (> 1000 receiver classes per send-site).
- "
-%{
+ sends (> 1000 receiver classes per send-site).
+ "
+%{
sendingMthd = __ContextInstPtr(sendingContext)->c_method;
- if (__Class(sendingMthd) == Method &&
- __MethodInstPtr(sendingMthd)->m_annotation == nil) {
- OBJ m = __lookup(initialSearchClass, selector);
- if (m != nil) {
- if (ilcCache != nil) __ilcBind(ilcCache, initialSearchClass, m, selector);
- RETURN ( m );
- }
- }
+ if (__Class(sendingMthd) == Method &&
+ __MethodInstPtr(sendingMthd)->m_annotation == nil) {
+ OBJ m = __lookup(initialSearchClass, selector);
+ if (m != nil) {
+ if (ilcCache != nil) __ilcBind(ilcCache, initialSearchClass, m, selector);
+ RETURN ( m );
+ }
+ }
%}.
"If you remove C code above, uncomment the line below."
"sendingMthd := sendingContext method."
sendingNs := sendingMthd isNil
- ifTrue:[nil]
- ifFalse:[sendingMthd nameSpace].
+ ifTrue:[nil]
+ ifFalse:[sendingMthd nameSpace].
- "Second chance to speed up things (in case sending method
- has resource or so)"
+ "Second chance to speed up things (in case sending method
+ has resource or so)"
%{
if (sendingNs == nil) {
- OBJ m = __lookup(initialSearchClass, selector);
- if (m != nil) {
- if (ilcCache != nil) __ilcBind(ilcCache, initialSearchClass, m, selector);
- RETURN ( m );
- }
+ OBJ m = __lookup(initialSearchClass, selector);
+ if (m != nil) {
+ if (ilcCache != nil) __ilcBind(ilcCache, initialSearchClass, m, selector);
+ RETURN ( m );
+ }
}
%}.
"
Stderr
- show: 'sel='; show: selector; show: ' ns='; show: sendingNs printString;
- show: ' method=', sendingMthd printString; cr.
- "
-
+ show: 'sel='; show: selector; show: ' ns='; show: sendingNs printString;
+ show: ' method=', sendingMthd printString; cr.
+ "
+
sendingNs notNil ifTrue: [
-
- seen := Set new.
- namespaces := Array with: sendingNs.
+ seen := Set new.
+ namespaces := Array with: sendingNs.
- [namespaces notEmpty] whileTrue:
- [
- methods := self
- lookupMethodsForSelector: selector
- directedTo: initialSearchClass
- inNamespaces: namespaces.
- methods size == 1 ifTrue:
- [^methods anyOne].
- methods size > 1 ifTrue:
- [^self ambiguousMessageSend: selector
- withArgs: argArrayOrNil].
- "No method found"
- seen addAll: namespaces.
- imports := Set new.
- namespaces do:
- [:namespace|
- namespace notNil ifTrue:
- [namespace imports do:
- [:import|
- (seen includes: import) ifFalse:
- [imports add: import]]]].
- namespaces := imports].
- ].
-
- methods := self lookupMethodsForSelector: selector
- directedTo: initialSearchClass.
+ [namespaces notEmpty] whileTrue:[
+ methods := self
+ lookupMethodsForSelector: selector
+ directedTo: initialSearchClass
+ inNamespaces: namespaces.
+ numMethods := methods size.
+ numMethods == 1 ifTrue:[
+ ^ methods anyOne
+ ].
+ numMethods > 1 ifTrue:[
+ ^self ambiguousMessageSend: selector withArgs: argArrayOrNil
+ ].
+ "No method found"
+ seen addAll: namespaces.
+ imports := Set new.
+ namespaces do:[:namespace|
+ namespace notNil ifTrue:[
+ namespace imports do:[:import|
+ (seen includes: import) ifFalse: [
+ imports add: import
+ ]
+ ]
+ ]
+ ].
+ namespaces := imports
+ ].
+ ].
+
+ methods := self lookupMethodsForSelector: selector
+ directedTo: initialSearchClass.
methods size == 1 ifTrue:[
- | m |
+ | m |
- m := methods anyOne.
- ilcCache notNil ifTrue:[ ilcCache bindTo: m forClass: initialSearchClass ].
- ^ m
+ m := methods anyOne.
+ ilcCache notNil ifTrue:[ ilcCache bindTo: m forClass: initialSearchClass ].
+ ^ m
].
-
+
^nil
"Created: / 19-02-2014 / 21:49:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -203,31 +206,31 @@
!NamespaceAwareLookup methodsFor:'lookup - helpers'!
-lookupMethodsForSelector: selector directedTo: initialSearchClass
-
+lookupMethodsForSelector: selector directedTo: initialSearchClass
"Searches initialSearchClass for a methods with in any namespace"
- ^self
- lookupMethodsForSelector: selector
- directedTo: initialSearchClass
- suchThat:[:sel :mthd|true].
+
+ ^self
+ lookupMethodsForSelector: selector
+ directedTo: initialSearchClass
+ suchThat:[:sel :mthd|true].
"Created: / 19-07-2010 / 15:37:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
lookupMethodsForSelector: selector directedTo: initialSearchClass inNamespaces: namespaces
+ "Searches initialSearchClass for a methods with given selector in given namespaces."
- "Searches initialSearchClass for a methods with given selector in given namespaces."
- ^self
- lookupMethodsForSelector: selector
- directedTo: initialSearchClass
- suchThat:[:sel :mthd|namespaces includes: mthd nameSpace].
+ ^self
+ lookupMethodsForSelector: selector
+ directedTo: initialSearchClass
+ suchThat:[:sel :mthd|namespaces includes: mthd nameSpace].
"Created: / 19-07-2010 / 15:13:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
lookupMethodsForSelector: selector directedTo: initialSearchClass suchThat: block
+ "Searches initialSearchClass for a method with given selector in given nameSpace.
- "Searches initialSearchClass for a method with given selector in given nameSpace.
if no method in given namespace is found, returns nil"
| searchClass methods seen |
@@ -235,15 +238,18 @@
searchClass := initialSearchClass.
methods := Set new.
seen := OrderedCollection new.
- [ searchClass notNil ] whileTrue:
- [searchClass selectorsAndMethodsDo:
- [:sel :mthd|
- (sel selector = selector
- and:[(seen includes: mthd nameSpace) not
- and:[block value: sel value: mthd]]) ifTrue:
- [methods add: mthd.
- seen add: mthd nameSpace]].
- searchClass := searchClass superclass].
+ [ searchClass notNil ] whileTrue:[
+ searchClass selectorsAndMethodsDo:[:sel :mthd|
+ (sel selector = selector
+ and:[ (seen includes: mthd nameSpace) not
+ and:[ block value: sel value: mthd]]
+ ) ifTrue:[
+ methods add: mthd.
+ seen add: mthd nameSpace
+ ]
+ ].
+ searchClass := searchClass superclass
+ ].
^methods
"Created: / 19-07-2010 / 15:34:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -255,10 +261,10 @@
ambiguousMessageSend
^self ambiguousMessage:
- (Message
- selector: #__placeholder__
- arguments: #()
- )
+ (Message
+ selector: #__placeholder__
+ arguments: #()
+ )
"Created: / 19-08-2010 / 22:05:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -268,22 +274,23 @@
| trampoline |
trampoline := self class methodDictionary at:
- (#(" 0"ambiguousMessageSend
- " 1"ambiguousMessageSendWith:
- " 2"ambiguousMessageSendWith:with:
- " 3"ambiguousMessageSendWith:with:with:
- " 4"ambiguousMessageSendWith:with:with:with:
- " 5"ambiguousMessageSendWith:with:with:with:with:
- " 6"ambiguousMessageSendWith:with:with:with:with:with:
- " 7"ambiguousMessageSendWith:with:with:with:with:with:with:
- " 8"ambiguousMessageSendWith:with:with:with:with:with:with:with:
- )
- at: argArrayOrNil size + 1).
+ (#(" 0"ambiguousMessageSend
+ " 1"ambiguousMessageSendWith:
+ " 2"ambiguousMessageSendWith:with:
+ " 3"ambiguousMessageSendWith:with:with:
+ " 4"ambiguousMessageSendWith:with:with:with:
+ " 5"ambiguousMessageSendWith:with:with:with:with:
+ " 6"ambiguousMessageSendWith:with:with:with:with:with:
+ " 7"ambiguousMessageSendWith:with:with:with:with:with:with:
+ " 8"ambiguousMessageSendWith:with:with:with:with:with:with:with:
+ )
+ at: argArrayOrNil size + 1).
trampoline := trampoline asByteCodeMethod.
- 1 to: trampoline numLiterals do:
- [:litNr|
- (trampoline literalAt: litNr) == #__placeholder__
- ifTrue:[(trampoline literalAt: litNr put: selector)]].
+ 1 to: trampoline numLiterals do: [:litNr|
+ (trampoline literalAt: litNr) == #__placeholder__ ifTrue:[
+ (trampoline literalAt: litNr put: selector)
+ ]
+ ].
^trampoline
"Created: / 19-08-2010 / 22:09:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -292,10 +299,10 @@
ambiguousMessageSendWith: a1
^self ambiguousMessage:
- (Message
- selector: #__placeholder__
- arguments: (Array with: a1)
- )
+ (Message
+ selector: #__placeholder__
+ arguments: (Array with: a1)
+ )
"Created: / 19-08-2010 / 22:06:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -303,10 +310,10 @@
ambiguousMessageSendWith: a1 with: a2
^self ambiguousMessage:
- (Message
- selector: #__placeholder__
- arguments: (Array with: a1 with: a2)
- )
+ (Message
+ selector: #__placeholder__
+ arguments: (Array with: a1 with: a2)
+ )
"Created: / 19-08-2010 / 22:06:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -314,10 +321,10 @@
ambiguousMessageSendWith: a1 with: a2 with: a3
^self ambiguousMessage:
- (Message
- selector: #__placeholder__
- arguments: (Array with: a1 with: a2 with: a3)
- )
+ (Message
+ selector: #__placeholder__
+ arguments: (Array with: a1 with: a2 with: a3)
+ )
"Created: / 19-08-2010 / 22:06:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -325,62 +332,62 @@
ambiguousMessageSendWith: a1 with: a2 with: a3 with: a4
^self ambiguousMessage:
- (Message
- selector: #__placeholder__
- arguments: (Array with: a1 with: a2 with: a3 with: a4)
- )
+ (Message
+ selector: #__placeholder__
+ arguments: (Array with: a1 with: a2 with: a3 with: a4)
+ )
"Created: / 19-08-2010 / 22:06:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
ambiguousMessageSendWith: a1 with: a2 with: a3 with: a4
- with: a5
+ with: a5
^self ambiguousMessage:
- (Message
- selector: #__placeholder__
- arguments: (Array with: a1 with: a2 with: a3 with: a4
- with: a5)
- )
+ (Message
+ selector: #__placeholder__
+ arguments: (Array with: a1 with: a2 with: a3 with: a4
+ with: a5)
+ )
"Created: / 19-08-2010 / 22:07:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
ambiguousMessageSendWith: a1 with: a2 with: a3 with: a4
- with: a5 with: a6
+ with: a5 with: a6
^self ambiguousMessage:
- (Message
- selector: #__placeholder__
- arguments: (Array with: a1 with: a2 with: a3 with: a4
- with: a5 with: a6)
- )
+ (Message
+ selector: #__placeholder__
+ arguments: (Array with: a1 with: a2 with: a3 with: a4
+ with: a5 with: a6)
+ )
"Created: / 19-08-2010 / 22:07:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
ambiguousMessageSendWith: a1 with: a2 with: a3 with: a4
- with: a5 with: a6 with: a7
+ with: a5 with: a6 with: a7
^self ambiguousMessage:
- (Message
- selector: #__placeholder__
- arguments: (Array with: a1 with: a2 with: a3 with: a4
- with: a5 with: a6 with: a7)
- )
+ (Message
+ selector: #__placeholder__
+ arguments: (Array with: a1 with: a2 with: a3 with: a4
+ with: a5 with: a6 with: a7)
+ )
"Created: / 19-08-2010 / 22:07:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
ambiguousMessageSendWith: a1 with: a2 with: a3 with: a4
- with: a5 with: a6 with: a7 with: a8
+ with: a5 with: a6 with: a7 with: a8
^self ambiguousMessage:
- (Message
- selector: #__placeholder__
- arguments: (Array with: a1 with: a2 with: a3 with: a4
- with: a5 with: a6 with: a7 with: a8)
- )
+ (Message
+ selector: #__placeholder__
+ arguments: (Array with: a1 with: a2 with: a3 with: a4
+ with: a5 with: a6 with: a7 with: a8)
+ )
"Created: / 19-08-2010 / 22:08:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
@@ -388,11 +395,11 @@
!NamespaceAwareLookup class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/NamespaceAwareLookup.st,v 1.3 2014-02-19 21:51:45 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/NamespaceAwareLookup.st,v 1.4 2015-05-18 00:05:38 cg Exp $'
!
version_SVN
- ^ '$Id: NamespaceAwareLookup.st,v 1.3 2014-02-19 21:51:45 vrany Exp $'
+ ^ '$Id: NamespaceAwareLookup.st,v 1.4 2015-05-18 00:05:38 cg Exp $'
! !
--- a/OSErrorHolder.st Sat May 16 06:48:37 2015 +0200
+++ b/OSErrorHolder.st Mon May 18 07:10:20 2015 +0100
@@ -45,169 +45,176 @@
for the same error on different systems.
[instance variables:]
- errorSymbol symbol associated with this error
- errorCategory symbol defining the error category.
- This is in fact a symbol that returns a
- Signal when sent to myself.
+ errorSymbol symbol associated with this error
+ errorCategory symbol defining the error category.
+ This is in fact a symbol that returns a
+ Signal when sent to myself.
- While the errorSymbol may be different on different platforms,
- the errorCategories (which refer to the Signals that will be raised)
- are identical.
- You can get an OS independent error message for an error by sending
- #errorCategoryString.
+ While the errorSymbol may be different on different platforms,
+ the errorCategories (which refer to the Signals that will be raised)
+ are identical.
+ You can get an OS independent error message for an error by sending
+ #errorCategoryString.
[author:]
- Stefan Vogel
+ Stefan Vogel
[see also:]
- OperatingSystem
+ OperatingSystem
"
! !
!OSErrorHolder class methodsFor:'Signal constants'!
+signals
+ Signals isNil ifTrue:[
+ self initializeSignals
+ ].
+ ^ Signals
+!
+
allocRetrySignal
- ^ Signals at:#allocRetrySignal
+ ^ self signals at:#allocRetrySignal
!
badAccessorSignal
- ^ Signals at:#badAccessorSignal
+ ^ self signals at:#badAccessorSignal
!
badArgumentsSignal
- ^ Signals at:#badArgumentsSignal
+ ^ self signals at:#badArgumentsSignal
!
classNotRegisteredSignal
- ^ Signals at:#classNotRegisteredSignal
+ ^ self signals at:#classNotRegisteredSignal
!
coNotInitializedSignal
- ^ Signals at:#coNotInitializedSignal
+ ^ self signals at:#coNotInitializedSignal
!
defaultOsErrorSignal
- ^ Signals at:#defaultOsErrorSignal
+ ^ self signals at:#defaultOsErrorSignal
!
existingReferentSignal
- ^ Signals at:#existingReferentSignal
+ ^ self signals at:#existingReferentSignal
!
illegalOperationSignal
- ^ Signals at:#illegalOperationSignal
+ ^ self signals at:#illegalOperationSignal
!
inaccessibleSignal
- ^ Signals at:#inaccessibleSignal
+ ^ self signals at:#inaccessibleSignal
!
inappropriateOperationSignal
- ^ Signals at:#inappropriateOperationSignal
+ ^ self signals at:#inappropriateOperationSignal
!
inappropriateReferentSignal
- ^ Signals at:#inappropriateReferentSignal
+ ^ self signals at:#inappropriateReferentSignal
!
invalidArgumentsSignal
"return the signal for invalid arguments (e.g. right class, wrong value)."
- ^ OsInvalidArgumentsError
+ ^ self signals at:#invalidArgumentsSignal
!
needRetrySignal
- ^ Signals at:#needRetrySignal
+ ^ self signals at:#needRetrySignal
!
noAggregationSignal
- ^ Signals at:#noAggregationSignal
+ ^ self signals at:#noAggregationSignal
!
noAssociationSignal
- ^ Signals at:#noAssociationSignal
+ ^ self signals at:#noAssociationSignal
!
noDataSignal
- ^ Signals at:#noDataSignal
+ ^ self signals at:#noDataSignal
!
noInterfaceSignal
- ^ Signals at:#noInterfaceSignal
+ ^ self signals at:#noInterfaceSignal
!
noMemorySignal
- ^ Signals at:#noMemorySignal
+ ^ self signals at:#noMemorySignal
!
noPermissionsSignal
- ^ Signals at:#noPermissionsSignal
+ ^ self signals at:#noPermissionsSignal
!
noResourcesSignal
- ^ Signals at:#noResourcesSignal
+ ^ self signals at:#noResourcesSignal
!
noVerbsSignal
- ^ Signals at:#noVerbsSignal
+ ^ self signals at:#noVerbsSignal
!
nonexistentSignal
"return the signal for non existing referents (i.e. device, file etc.)."
- ^ Signals at:#nonexistentSignal
+ ^ self signals at:#nonexistentSignal
!
notReadySignal
- ^ Signals at:#notReadySignal
+ ^ self signals at:#notReadySignal
!
peerFaultSignal
- ^ Signals at:#peerFaultSignal
+ ^ self signals at:#peerFaultSignal
!
rangeErrorSignal
- ^ Signals at:#rangeErrorSignal
+ ^ self signals at:#rangeErrorSignal
!
signalNamed:signalName
- ^ Signals at:signalName
+ ^ self signals at:signalName
!
transferFaultSignal
- ^ Signals at:#transferFaultSignal
+ ^ self signals at:#transferFaultSignal
!
transientErrorSignal
- ^ Signals at:#transientErrorSignal
+ ^ self signals at:#transientErrorSignal
!
unavailableReferentSignal
- ^ Signals at:#unavailableReferentSignal
+ ^ self signals at:#unavailableReferentSignal
!
underSpecifiedSignal
- ^ Signals at:#underSpecifiedSignal
+ ^ self signals at:#underSpecifiedSignal
!
unknownNameSignal
- ^ Signals at:#unknownNameSignal
+ ^ self signals at:#unknownNameSignal
!
unpreparedOperationSignal
- ^ Signals at:#unpreparedOperationSignal
+ ^ self signals at:#unpreparedOperationSignal
!
unsupportedOperationSignal
- ^ Signals at:#unsupportedOperationSignal
+ ^ self signals at:#unsupportedOperationSignal
!
volumeFullSignal
- ^ Signals at:#volumeFullSignal
+ ^ self signals at:#volumeFullSignal
!
wrongSubtypeForOperationSignal
- ^ Signals at:#wrongSubtypeForOperationSignal
+ ^ self signals at:#wrongSubtypeForOperationSignal
! !
!OSErrorHolder class methodsFor:'accessing'!
@@ -223,122 +230,128 @@
initialize
"init signals etc."
+ OSErrorSignal isNil ifTrue:[
+ OSErrorSignal := OsError.
+ OSErrorSignal notifierString:'OperatingSystem error'.
+ ]
+!
+
+initializeSignals
+ "init signals etc."
+
|unavailableReferentSignal|
- OSErrorSignal isNil ifTrue:[
- OSErrorSignal := OsError.
- OSErrorSignal notifierString:'OperatingSystem error'.
+ Signals isNil ifTrue:[
+ Signals := Dictionary new:40.
- Signals := Dictionary new:40.
+ OsNoResourcesError notifierString:'Not enough resources'.
+ Signals at:#noResourcesSignal put:OsNoResourcesError.
- OsNoResourcesError notifierString:'Not enough resources'.
- Signals at:#noResourcesSignal put:OsNoResourcesError.
+ OsIllegalOperation notifierString:'Illegal Operation'.
+ Signals at:#illegalOperationSignal put:OsIllegalOperation.
- OsIllegalOperation notifierString:'Illegal Operation'.
- Signals at:#illegalOperationSignal put:OsIllegalOperation.
-
- OsInvalidArgumentsError notifierString:'Invalid Arguments'.
- Signals at:#invalidArgumentsSignal put:OsInvalidArgumentsError.
+ OsInvalidArgumentsError notifierString:'Invalid Arguments'.
+ Signals at:#invalidArgumentsSignal put:OsInvalidArgumentsError.
- OsInaccessibleError notifierString:'Referent inaccessible'.
- Signals at:#inaccessibleSignal put:OsInaccessibleError.
+ OsInaccessibleError notifierString:'Referent inaccessible'.
+ Signals at:#inaccessibleSignal put:OsInaccessibleError.
- OsTransferFaultError notifierString:'Transfer fault'.
- Signals at:#transferFaultSignal put:OsTransferFaultError.
+ OsTransferFaultError notifierString:'Transfer fault'.
+ Signals at:#transferFaultSignal put:OsTransferFaultError.
- OsNeedRetryError notifierString:'Retry Operation'.
- Signals at:#needRetrySignal put:OsNeedRetryError.
+ OsNeedRetryError notifierString:'Retry Operation'.
+ Signals at:#needRetrySignal put:OsNeedRetryError.
- Signals at:#defaultOsErrorSignal put:OSErrorSignal.
+ Signals at:#defaultOsErrorSignal put:OSErrorSignal.
- "/ Information signals
+ "/ Information signals
-"/ s := self setupSignal:#informationSignal parent:OSErrorSignal
+"/ s := self setupSignal:#informationSignal parent:OSErrorSignal
"/ notifier:'Information'.
-"/ self setupSignal:#operationStartedSignal parent:s
+"/ self setupSignal:#operationStartedSignal parent:s
"/ notifier:'Operation started'.
- "/ Retry signals
+ "/ Retry signals
- self setupSignal:#notReadySignal parent:OsNeedRetryError
- notifier:' -- referent not ready'.
- self setupSignal:#transientErrorSignal parent:OsNeedRetryError
- notifier:' -- transient error'.
- self setupSignal:#allocRetrySignal parent:OsNeedRetryError
- notifier:' -- allocation failure'.
+ self setupSignal:#notReadySignal parent:OsNeedRetryError
+ notifier:' -- referent not ready'.
+ self setupSignal:#transientErrorSignal parent:OsNeedRetryError
+ notifier:' -- transient error'.
+ self setupSignal:#allocRetrySignal parent:OsNeedRetryError
+ notifier:' -- allocation failure'.
- "/ Resource signals
+ "/ Resource signals
- self setupSignal:#noMemorySignal parent:OsNoResourcesError
- notifier:' -- memory'.
+ self setupSignal:#noMemorySignal parent:OsNoResourcesError
+ notifier:' -- memory'.
- "/ Transfer faults
+ "/ Transfer faults
- self setupSignal:#noDataSignal parent:OsTransferFaultError
- notifier:'Data unavailable/EOF reached'.
- self setupSignal:#peerFaultSignal parent:OsTransferFaultError
- notifier:'Communication with peer failed'.
- self setupSignal:#volumeFullSignal parent:OsTransferFaultError
- notifier:'Volume full'.
+ self setupSignal:#noDataSignal parent:OsTransferFaultError
+ notifier:'Data unavailable/EOF reached'.
+ self setupSignal:#peerFaultSignal parent:OsTransferFaultError
+ notifier:'Communication with peer failed'.
+ self setupSignal:#volumeFullSignal parent:OsTransferFaultError
+ notifier:'Volume full'.
- "/ Inaccesible faults
+ "/ Inaccesible faults
- self setupSignal:#nonexistentSignal parent:OsInaccessibleError
- notifier:'File does not exist'.
- unavailableReferentSignal :=
- self setupSignal:#unavailableReferentSignal parent:OsInaccessibleError
- notifier:' currently'.
- self setupSignal:#noPermissionsSignal parent:OsInaccessibleError
- notifier:'Permission denied'.
- self setupSignal:#existingReferentSignal parent:OsInaccessibleError
- notifier:' -- already exists or currently in use'.
- self setupSignal:#inappropriateReferentSignal parent:OsInaccessibleError
- notifier:' -- operation inappropriate'.
+ self setupSignal:#nonexistentSignal parent:OsInaccessibleError
+ notifier:'File does not exist'.
+ unavailableReferentSignal :=
+ self setupSignal:#unavailableReferentSignal parent:OsInaccessibleError
+ notifier:' currently'.
+ self setupSignal:#noPermissionsSignal parent:OsInaccessibleError
+ notifier:'Permission denied'.
+ self setupSignal:#existingReferentSignal parent:OsInaccessibleError
+ notifier:' -- already exists or currently in use'.
+ self setupSignal:#inappropriateReferentSignal parent:OsInaccessibleError
+ notifier:' -- operation inappropriate'.
- "/ Illegal operations
+ "/ Illegal operations
- self setupSignal:#inappropriateOperationSignal parent:OsIllegalOperation
- notifier:'Inappropriate operation'.
- self setupSignal:#wrongSubtypeForOperationSignal parent:OsIllegalOperation
- notifier:' -- wrong subtype'.
- self setupSignal:#unsupportedOperationSignal parent:OsIllegalOperation
- notifier:' -- on this platform'.
- self setupSignal:#unpreparedOperationSignal parent:OsIllegalOperation
- notifier:' -- wrong sequence'.
+ self setupSignal:#inappropriateOperationSignal parent:OsIllegalOperation
+ notifier:'Inappropriate operation'.
+ self setupSignal:#wrongSubtypeForOperationSignal parent:OsIllegalOperation
+ notifier:' -- wrong subtype'.
+ self setupSignal:#unsupportedOperationSignal parent:OsIllegalOperation
+ notifier:' -- on this platform'.
+ self setupSignal:#unpreparedOperationSignal parent:OsIllegalOperation
+ notifier:' -- wrong sequence'.
- "/ Illegal arguments
+ "/ Illegal arguments
- self setupSignal:#badArgumentsSignal parent:OsInvalidArgumentsError
- notifier:' -- wrong class'.
- self setupSignal:#badAccessorSignal parent:OsInvalidArgumentsError
- notifier:' -- accessor invalid'.
- self setupSignal:#rangeErrorSignal parent:OsInvalidArgumentsError
- notifier:' -- out of range'.
- self setupSignal:#underSpecifiedSignal parent:OsInvalidArgumentsError
- notifier:' -- operation not fully specified'.
+ self setupSignal:#badArgumentsSignal parent:OsInvalidArgumentsError
+ notifier:' -- wrong class'.
+ self setupSignal:#badAccessorSignal parent:OsInvalidArgumentsError
+ notifier:' -- accessor invalid'.
+ self setupSignal:#rangeErrorSignal parent:OsInvalidArgumentsError
+ notifier:' -- out of range'.
+ self setupSignal:#underSpecifiedSignal parent:OsInvalidArgumentsError
+ notifier:' -- operation not fully specified'.
- "/ COM errors
- self setupSignal:#coNotInitializedSignal parent:OsIllegalOperation
- notifier:'COM not initialized'.
- self setupSignal:#noInterfaceSignal parent:unavailableReferentSignal
- notifier:'No such interface'.
- self setupSignal:#classNotRegisteredSignal parent:unavailableReferentSignal
- notifier:'Class not registered'.
- self setupSignal:#noAggregationSignal parent:OsIllegalOperation
- notifier:'No Aggregation'.
- self setupSignal:#unknownNameSignal parent:unavailableReferentSignal
- notifier:'Unknown member name'.
- self setupSignal:#noVerbsSignal parent:OsIllegalOperation
- notifier:'No verbs for OLE object'.
+ "/ COM errors
+ self setupSignal:#coNotInitializedSignal parent:OsIllegalOperation
+ notifier:'COM not initialized'.
+ self setupSignal:#noInterfaceSignal parent:unavailableReferentSignal
+ notifier:'No such interface'.
+ self setupSignal:#classNotRegisteredSignal parent:unavailableReferentSignal
+ notifier:'Class not registered'.
+ self setupSignal:#noAggregationSignal parent:OsIllegalOperation
+ notifier:'No Aggregation'.
+ self setupSignal:#unknownNameSignal parent:unavailableReferentSignal
+ notifier:'Unknown member name'.
+ self setupSignal:#noVerbsSignal parent:OsIllegalOperation
+ notifier:'No verbs for OLE object'.
- "/ Shell errors
- self setupSignal:#noAssociationSignal parent:unavailableReferentSignal
- notifier:'No association for file extension'.
+ "/ Shell errors
+ self setupSignal:#noAssociationSignal parent:unavailableReferentSignal
+ notifier:'No association for file extension'.
].
"
- OSErrorSignal := nil.
- self initialize
+ Signals := nil.
+ self initializeSignals
"
!
@@ -349,9 +362,9 @@
|s|
Signals at:aSymbol
- put:(s := parentSignal newSignal
- notifierString:aString;
- nameClass:self message:aSymbol).
+ put:(s := parentSignal newSignal
+ notifierString:aString;
+ nameClass:self message:aSymbol).
^ s
! !
@@ -361,7 +374,7 @@
^ errorCategory
!
-errorSymbol
+errorSymbol
^ errorSymbol
!
@@ -387,10 +400,10 @@
|signal|
signal := self class signalNamed:errorCategory.
- signal
- raiseWith:self
- errorString:(parameter isNil ifTrue:[nil] ifFalse:[' - ', parameter printString])
- in:(thisContext "sender").
+ signal
+ raiseWith:self
+ errorString:(parameter isNil ifTrue:[nil] ifFalse:[' - ', parameter printString])
+ in:(thisContext "sender").
"/ ^ self errorReporter reportOn:self
! !
@@ -402,7 +415,7 @@
s := OperatingSystem errorStringForSymbol:errorSymbol.
parameter notNil ifTrue:[
- ^ s,': ',parameter printString.
+ ^ s,': ',parameter printString.
].
^ s
@@ -412,23 +425,23 @@
!OSErrorHolder methodsFor:'printing'!
printOn:aStream
- aStream
- nextPutAll:self className;
- nextPut:$(;
- nextPutAll:errorSymbol;
- nextPutAll:', ';
- nextPutAll:errorCategory;
- nextPut:$).
+ aStream
+ nextPutAll:self className;
+ nextPut:$(;
+ nextPutAll:errorSymbol;
+ nextPutAll:', ';
+ nextPutAll:errorCategory;
+ nextPut:$).
! !
!OSErrorHolder class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/OSErrorHolder.st,v 1.23 2015-02-13 15:58:14 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OSErrorHolder.st,v 1.24 2015-05-16 09:59:00 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/OSErrorHolder.st,v 1.23 2015-02-13 15:58:14 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/OSErrorHolder.st,v 1.24 2015-05-16 09:59:00 cg Exp $'
! !
--- a/Object.st Sat May 16 06:48:37 2015 +0200
+++ b/Object.st Mon May 18 07:10:20 2015 +0100
@@ -256,7 +256,6 @@
"Modified: / 4.8.1999 / 08:54:06 / stefan"
! !
-
!Object class methodsFor:'Compatibility-ST80'!
rootError
@@ -495,7 +494,6 @@
InfoPrinting := aBoolean
! !
-
!Object class methodsFor:'queries'!
isAbstract
@@ -520,8 +518,6 @@
-
-
!Object methodsFor:'Compatibility-Dolphin'!
stbFixup: anSTBInFiler at: newObjectIndex
@@ -697,7 +693,6 @@
"
! !
-
!Object methodsFor:'accessing'!
_at:index
@@ -811,7 +806,7 @@
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
{
- int idx1Based = context.stArg(0).intValue(); // st index is 1 based
+ int idx1Based = index.intValue(); // st index is 1 based
return context.RETURN( self.basicAt( idx1Based ));
}
/* NOTREACHED */
@@ -1087,11 +1082,10 @@
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
{
- int idx1Based = context.stArg(0).intValue(); // st index is 1 based
- STObject val = context.stArg(1);
-
- self.basicAt_put(idx1Based, val );
- return context.RETURN( val );
+ int idx1Based = index.intValue(); // st index is 1 based
+
+ self.basicAt_put(idx1Based, anObject );
+ return context.RETURN( anObject );
}
/* NOTREACHED */
#else
@@ -1753,8 +1747,6 @@
"
! !
-
-
!Object methodsFor:'attributes access'!
objectAttributeAt:attributeKey
@@ -1877,7 +1869,6 @@
! !
-
!Object methodsFor:'change & update'!
broadcast:aSelectorSymbol
@@ -2058,7 +2049,6 @@
^ aBlock ensure:[ self addDependent:someone ]
! !
-
!Object methodsFor:'comparing'!
= anObject
@@ -2080,7 +2070,7 @@
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
- return context._RETURN( (self == context.stArg(0)) ? STObject.True : STObject.False );
+ return context._RETURN( (self == anObject) ? STObject.True : STObject.False );
#else
RETURN ( (self == anObject) ? true : false );
#endif
@@ -2307,7 +2297,7 @@
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
- return context._RETURN( (self == context.stArg(0)) ? STObject.False : STObject.True );
+ return context._RETURN( (self == anObject) ? STObject.False : STObject.True );
#else
RETURN ( (self == anObject) ? false : true );
#endif
@@ -7946,7 +7936,6 @@
^ self
! !
-
!Object methodsFor:'secure message sending'!
?:selector
@@ -8552,7 +8541,6 @@
"
! !
-
!Object methodsFor:'synchronized evaluation'!
freeSynchronizationSemaphore
@@ -9091,7 +9079,7 @@
!
isBehavior
- "return true, if the receiver is describing another objects behavior.
+ "return true, if the receiver is describing another object's behavior.
False is returned here - the method is only redefined in Behavior."
^ false
@@ -10284,17 +10272,14 @@
^ aVisitor visitObject:self with:aParameter
! !
-
-
-
!Object class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.803 2015-05-06 09:27:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.805 2015-05-18 00:07:35 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.803 2015-05-06 09:27:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.805 2015-05-18 00:07:35 cg Exp $'
!
version_HG
--- a/PolymorphicInlineCache.st Sat May 16 06:48:37 2015 +0200
+++ b/PolymorphicInlineCache.st Mon May 18 07:10:20 2015 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 2011 by Jan Vrany & Jan Kurs
- SWING Research Group, Czech Technical University in Prague
+ SWING Research Group, Czech Technical University in Prague
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
@@ -37,7 +37,7 @@
copyright
"
COPYRIGHT (c) 2011 by Jan Vrany & Jan Kurs
- SWING Research Group, Czech Technical University in Prague
+ SWING Research Group, Czech Technical University in Prague
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
@@ -69,14 +69,14 @@
used by the virtual machine.
[author:]
- Jan Vrany <jan.vrany@fit.cvut.cz>
- Janb Kurs <kursjan@fit.cvut.cz>
+ Jan Vrany <jan.vrany@fit.cvut.cz>
+ Janb Kurs <kursjan@fit.cvut.cz>
[instance variables:]
- address <ExternalAddress> a pointer to the VM inline cache structure.
- if the adress is NULL, then PolymorphicInlineCache
- is invalid.
- numArgs <SmallInteger> a number of arguments
+ address <ExternalAddress> a pointer to the VM inline cache structure.
+ if the adress is NULL, then PolymorphicInlineCache
+ is invalid.
+ numArgs <SmallInteger> a number of arguments
[class variables:]
[see also:]
@@ -87,11 +87,11 @@
!PolymorphicInlineCache methodsFor:'binding / unbinding'!
bindTo: aMethod forClass: aClass
+ | selector |
- | selector |
selector := aMethod selector.
%{
- __ilcBind(self, aClass, aMethod, selector);
+ __ilcBind(self, aClass, aMethod, selector);
RETURN(self);
%}.
self primitiveFailed.
@@ -102,10 +102,9 @@
!PolymorphicInlineCache class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/PolymorphicInlineCache.st,v 1.1 2014-02-05 17:17:34 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/PolymorphicInlineCache.st,v 1.2 2015-05-17 23:57:27 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/PolymorphicInlineCache.st,v 1.1 2014-02-05 17:17:34 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/PolymorphicInlineCache.st,v 1.2 2015-05-17 23:57:27 cg Exp $'
! !
-
--- a/ProtoObject.st Sat May 16 06:48:37 2015 +0200
+++ b/ProtoObject.st Mon May 18 07:10:20 2015 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 2004 by eXept Software AG
All Rights Reserved
@@ -11,6 +13,8 @@
"
"{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
+
nil subclass:#ProtoObject
instanceVariableNames:''
classVariableNames:''
@@ -149,7 +153,7 @@
!
isBehavior
- "return true, if the receiver is describing another objects behavior.
+ "return true, if the receiver is describing another object's behavior.
False is returned here - the method is only redefined in Behavior."
^ false
@@ -186,10 +190,10 @@
!ProtoObject class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProtoObject.st,v 1.14 2014-02-26 09:51:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProtoObject.st,v 1.15 2015-05-16 09:50:57 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ProtoObject.st,v 1.14 2014-02-26 09:51:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProtoObject.st,v 1.15 2015-05-16 09:50:57 cg Exp $'
! !
--- a/Smalltalk.st Sat May 16 06:48:37 2015 +0200
+++ b/Smalltalk.st Mon May 18 07:10:20 2015 +0100
@@ -545,19 +545,19 @@
"sent from VM via #initializeModules"
Error handle:[:ex |
- ObjectMemory printStackBacktrace.
- ClassesFailedToInitialize isNil ifTrue:[
- ClassesFailedToInitialize := IdentitySet new.
- ].
- ClassesFailedToInitialize add:aClass.
- ('Smalltalk [warning]: error during initialize of ' , aClass name,': ', ex description printString) errorPrintCR.
- ex suspendedContext fullPrintAll.
- '------------------------------------------------' errorPrintCR.
- ((DebuggingStandAlone == true) or:[ Smalltalk commandLineArguments includes:'--debug']) ifTrue:[
- ex reject
- ].
+ ObjectMemory printStackBacktrace.
+ ClassesFailedToInitialize isNil ifTrue:[
+ ClassesFailedToInitialize := IdentitySet new.
+ ].
+ ClassesFailedToInitialize add:aClass.
+ ('Smalltalk [warning]: error during initialize of ' , aClass name,': ', ex description printString) errorPrintCR.
+ ex suspendedContext fullPrintAll.
+ '------------------------------------------------' errorPrintCR.
+ ((DebuggingStandAlone == true) or:[ Smalltalk commandLineArguments includes:'--debug']) ifTrue:[
+ ex reject
+ ].
] do:[
- aClass initialize
+ aClass initialize
].
"Modified: / 11-09-2011 / 17:01:32 / cg"
@@ -589,10 +589,15 @@
Notice: this is not called when an image is restarted"
%{
+#ifdef __SCHTEAM__
+ STClass.initializeAllClasses(__c__);
+ return __c__._RETURN_self();
+#else
__init_registered_modules__(3);
@global(DemoMode) = __getDemoMode() ? true : false;
RETURN (self);
+#endif /* not SCHTEAM */
%}.
^ self primitiveFailed
!
@@ -604,8 +609,8 @@
Here, a few specific initializations are done, then the actual initialization is
done inside an error handler in basicInitializeSystem.
Notice:
- this is NOT called when an image is restarted;
- in this case the show starts in Smalltalk>>restart."
+ this is NOT called when an image is restarted;
+ in this case the show starts in Smalltalk>>restart."
|idx|
@@ -615,79 +620,79 @@
AbstractOperatingSystem initializeConcreteClass.
CommandLineArguments isEmptyOrNil ifTrue:[
- CommandLineArguments := #('stx') asOrderedCollection.
+ CommandLineArguments := #('stx') asOrderedCollection.
].
CommandLine := CommandLineArguments copy.
CommandLineArguments := CommandLineArguments asOrderedCollection.
CommandName := CommandLineArguments removeFirst. "/ the command
(idx := CommandLineArguments indexOf:'--silentStartup') ~~ 0 ifTrue:[
- SilentLoading := true.
- CommandLineArguments removeIndex:idx
+ SilentLoading := true.
+ CommandLineArguments removeIndex:idx
] ifFalse:[
- SilentLoading := false.
- ].
+ SilentLoading := false.
+ ].
(idx := CommandLineArguments indexOf:'--verboseLoading') ~~ 0 ifTrue:[
- VerboseLoading := true.
- CommandLineArguments removeIndex:idx
+ VerboseLoading := true.
+ CommandLineArguments removeIndex:idx
] ifFalse:[
- VerboseLoading := false.
- ].
+ VerboseLoading := false.
+ ].
(idx := CommandLineArguments indexOf:'--verboseStartup') ~~ 0 ifTrue:[
- VerboseLoading := true.
- VerboseStartup := true.
- CommandLineArguments removeIndex:idx
+ VerboseLoading := true.
+ VerboseStartup := true.
+ CommandLineArguments removeIndex:idx
] ifFalse:[
- VerboseStartup := false.
- ].
+ VerboseStartup := false.
+ ].
(idx := CommandLineArguments indexOf:'--verbose') ~~ 0 ifTrue:[
- Verbose := true.
- VerboseLoading := true.
- VerboseStartup := true.
- CommandLineArguments removeIndex:idx
+ Verbose := true.
+ VerboseLoading := true.
+ VerboseStartup := true.
+ CommandLineArguments removeIndex:idx
] ifFalse:[
- Verbose := false.
- ].
+ Verbose := false.
+ ].
DebuggingStandAlone := false.
StandAlone ifTrue:[
- InfoPrinting := false.
- ObjectMemory infoPrinting:false.
- IgnoreAssertions := true.
-
- idx := CommandLineArguments indexOf:'--debug'.
- idx ~~ 0 ifTrue:[
- DebuggingStandAlone := true.
- ].
- DebuggingStandAlone ifTrue:[
- Inspector := MiniInspector.
- Debugger := MiniDebugger.
- IgnoreAssertions := false.
- ].
+ InfoPrinting := false.
+ ObjectMemory infoPrinting:false.
+ IgnoreAssertions := true.
+
+ idx := CommandLineArguments indexOf:'--debug'.
+ idx ~~ 0 ifTrue:[
+ DebuggingStandAlone := true.
+ ].
+ DebuggingStandAlone ifTrue:[
+ Inspector := MiniInspector.
+ Debugger := MiniDebugger.
+ IgnoreAssertions := false.
+ ].
] ifFalse:[
- "/
- "/ define low-level debugging tools - graphical classes are not prepared yet
- "/ to handle things.
- "/ This will bring us into the MiniDebugger when an error occurs during startup.
- "/
- Inspector := MiniInspector.
- Debugger := MiniDebugger.
- IgnoreAssertions := false.
+ "/
+ "/ define low-level debugging tools - graphical classes are not prepared yet
+ "/ to handle things.
+ "/ This will bring us into the MiniDebugger when an error occurs during startup.
+ "/
+ Inspector := MiniInspector.
+ Debugger := MiniDebugger.
+ IgnoreAssertions := false.
].
Error handle:[:ex |
- StandAlone ifTrue:[
- DebuggingStandAlone ifFalse:[
- 'Startup Error - use "--debug" command line argument for more info' errorPrintCR.
- Smalltalk exit:1.
- ].
- 'Smalltalk [error]: Error during early initialization:' errorPrintCR.
- thisContext fullPrintAll.
- ].
- ex reject.
+ StandAlone ifTrue:[
+ DebuggingStandAlone ifFalse:[
+ 'Startup Error - use "--debug" command line argument for more info' errorPrintCR.
+ Smalltalk exit:1.
+ ].
+ 'Smalltalk [error]: Error during early initialization:' errorPrintCR.
+ thisContext fullPrintAll.
+ ].
+ ex reject.
] do:[
- self basicInitializeSystem
+ self basicInitializeSystem
].
"Modified: / 12-10-2010 / 11:27:47 / cg"
@@ -975,7 +980,7 @@
#ifdef __SCHTEAM__
{
STSymbol keySymbol = aKey.asSTSymbol();
- STObject val = SmalltalkEnvironment.getBindingOrNull(keySymbol);
+ STObject val = SmalltalkEnvironment.getResolvedBindingOrNull(keySymbol);
return context._RETURN( val == null ? Nil : val );
}
@@ -1045,8 +1050,7 @@
#ifdef __SCHTEAM__
{
STSymbol keySymbol = aKey.asSTSymbol();
- STObject oldValue = SmalltalkEnvironment.setBinding(keySymbol, aValue);
- __c__.setLocal0( oldValue );
+ oldValue = SmalltalkEnvironment.setBinding(keySymbol, aValue);
}
#else
oldValue = __GLOBAL_SET(aKey, aValue, (OBJ *)0);
@@ -2113,13 +2117,13 @@
basicKeys
"for rel > 5 only"
+%{
+#ifdef __SCHTEAM__
+ STObject[] keys = SmalltalkEnvironment.getKeyVector();
+ return __c__._RETURN( new STVector(keys) );
+#endif
+%}.
self primitiveFailed
-
-
-
-
-
-
!
do:aBlock
@@ -2245,12 +2249,12 @@
loadOK "exePath" errorInInitialize|
packageDirOrStringOrNil notNil ifTrue:[
- packageDirOrNil := packageDirOrStringOrNil asFilename.
+ packageDirOrNil := packageDirOrStringOrNil asFilename.
].
VerboseLoading ifTrue:[
- silent := false
+ silent := false
] ifFalse:[
- silent := (SilentLoading or:[ StandAlone ]) or:[ InfoPrinting not ].
+ silent := (SilentLoading or:[ StandAlone ]) or:[ InfoPrinting not ].
].
"For now: have to read the project definition first!!
@@ -2261,112 +2265,112 @@
"maybe, it is already in the image"
projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
(projectDefinitionClass notNil and:[projectDefinitionClass supportedOnPlatform not]) ifTrue:[
- ^ PackageNotCompatibleError raiseRequestWith:aPackageString errorString:' - package is not compatible with this platform'.
+ ^ PackageNotCompatibleError raiseRequestWith:aPackageString errorString:' - package is not compatible with this platform'.
].
"Is there a shared library (.dll or .so) ?"
binaryClassLibraryFilename := ObjectFileLoader
- binaryClassFilenameForPackage:aPackageString
- inDirectory:packageDirOrNil.
+ binaryClassFilenameForPackage:aPackageString
+ inDirectory:packageDirOrNil.
(binaryClassLibraryFilename notNil and:[binaryClassLibraryFilename exists]) ifTrue:[
- |loadErrorOccurred|
-
- loadErrorOccurred := false.
- ObjectFileLoader objectFileLoadErrorNotification handle:[:ex |
- loadErrorOccurred := true.
- ex proceedWith:true.
- ] do:[
- loadOK := (ObjectFileLoader loadObjectFile:binaryClassLibraryFilename) notNil.
- "/ loadOK := self loadPackage:aPackageString fromClassLibrary:binaryClassLibraryFilename.
- ].
- (loadOK and:[loadErrorOccurred not]) ifTrue:[
- silent ifFalse:[
- Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from binary classLib file: ' , binaryClassLibraryFilename pathName).
- ].
- "now, all compiled classes have been loaded.
- keep classes in the package which are autoloaded as autoloaded."
- ^ true
- ].
-
- loadErrorOccurred ifTrue:[
- self breakPoint:#cg.
- projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
- projectDefinitionClass notNil ifTrue:[
- projectDefinitionClass supportedOnPlatform ifTrue:[
- "/ load prerequisites...
- projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
- self breakPoint:#cg.
- ].
- ].
- ].
+ |loadErrorOccurred|
+
+ loadErrorOccurred := false.
+ ObjectFileLoader objectFileLoadErrorNotification handle:[:ex |
+ loadErrorOccurred := true.
+ ex proceedWith:true.
+ ] do:[
+ loadOK := (ObjectFileLoader loadObjectFile:binaryClassLibraryFilename) notNil.
+ "/ loadOK := self loadPackage:aPackageString fromClassLibrary:binaryClassLibraryFilename.
+ ].
+ (loadOK and:[loadErrorOccurred not]) ifTrue:[
+ silent ifFalse:[
+ Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from binary classLib file: ' , binaryClassLibraryFilename pathName).
+ ].
+ "now, all compiled classes have been loaded.
+ keep classes in the package which are autoloaded as autoloaded."
+ ^ true
+ ].
+
+ loadErrorOccurred ifTrue:[
+ self breakPoint:#cg.
+ projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
+ projectDefinitionClass notNil ifTrue:[
+ projectDefinitionClass supportedOnPlatform ifTrue:[
+ "/ load prerequisites...
+ projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
+ self breakPoint:#cg.
+ ].
+ ].
+ ].
].
packageDirOrNil isNil ifTrue:[
- ^ PackageNotFoundError raiseRequestWith:aPackageString.
+ ^ PackageNotFoundError raiseRequestWith:aPackageString.
].
"fallback - go through the project definition"
projectDefinitionClass isNil ifTrue:[
- projectDefinitionClassName := ProjectDefinition projectDefinitionClassNameForDefinitionOf:aPackageString.
- "/ try to load the project definition class
- projectDefinitionFilename := (packageDirOrNil / projectDefinitionClassName) withSuffix:'st'.
- projectDefinitionFilename exists ifFalse:[
- projectDefinitionFilename := (packageDirOrNil / 'source' / projectDefinitionClassName) withSuffix:'st'.
- ].
- projectDefinitionFilename exists ifTrue:[
- Class withoutUpdatingChangesDo:[
- Smalltalk silentlyLoadingDo:[
- Error handle:[:ex |
- "/ catch error during initialization;
- ex suspendedContext withAllSendersDo:[:sender |
- sender selector == #initialize ifTrue:[
- sender receiver isBehavior ifTrue:[
- sender receiver name = projectDefinitionClassName ifTrue:[
- errorInInitialize := true
- ]
- ]
- ]
- ].
- errorInInitialize ifFalse:[ ex reject ].
- ] do:[
- projectDefinitionFilename fileIn.
- ].
- ].
- ].
- errorInInitialize ifTrue:[
- Transcript showCR:'Smalltalk [warning]: an error happened in #initialize - retry after loading package.'.
- ].
- projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
- ].
+ projectDefinitionClassName := ProjectDefinition projectDefinitionClassNameForDefinitionOf:aPackageString.
+ "/ try to load the project definition class
+ projectDefinitionFilename := (packageDirOrNil / projectDefinitionClassName) withSuffix:'st'.
+ projectDefinitionFilename exists ifFalse:[
+ projectDefinitionFilename := (packageDirOrNil / 'source' / projectDefinitionClassName) withSuffix:'st'.
+ ].
+ projectDefinitionFilename exists ifTrue:[
+ Class withoutUpdatingChangesDo:[
+ Smalltalk silentlyLoadingDo:[
+ Error handle:[:ex |
+ "/ catch error during initialization;
+ ex suspendedContext withAllSendersDo:[:sender |
+ sender selector == #initialize ifTrue:[
+ sender receiver isBehavior ifTrue:[
+ sender receiver name = projectDefinitionClassName ifTrue:[
+ errorInInitialize := true
+ ]
+ ]
+ ]
+ ].
+ errorInInitialize ifFalse:[ ex reject ].
+ ] do:[
+ projectDefinitionFilename fileIn.
+ ].
+ ].
+ ].
+ errorInInitialize ifTrue:[
+ Transcript showCR:'Smalltalk [warning]: an error happened in #initialize - retry after loading package.'.
+ ].
+ projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
+ ].
].
projectDefinitionClass notNil ifTrue:[
- projectDefinitionClass autoload.
- projectDefinitionClass supportedOnPlatform ifFalse:[
- ^ PackageNotCompatibleError raiseRequestWith:aPackageString errorString:' - package is not compatible with this platform'.
- ].
- projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
- somethingHasBeenLoaded := projectDefinitionClass loadAsAutoloaded:doLoadAsAutoloaded.
- errorInInitialize ifTrue:[
- Transcript showCR:('Smalltalk [info]: retrying #initialize').
- projectDefinitionClass initialize.
- ].
- (silent not and:[somethingHasBeenLoaded]) ifTrue:[
- Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from project definition').
- ].
- ^ true.
+ projectDefinitionClass autoload.
+ projectDefinitionClass supportedOnPlatform ifFalse:[
+ ^ PackageNotCompatibleError raiseRequestWith:aPackageString errorString:' - package is not compatible with this platform'.
+ ].
+ projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
+ somethingHasBeenLoaded := projectDefinitionClass loadAsAutoloaded:doLoadAsAutoloaded.
+ errorInInitialize ifTrue:[
+ Transcript showCR:('Smalltalk [info]: retrying #initialize').
+ projectDefinitionClass initialize.
+ ].
+ (silent not and:[somethingHasBeenLoaded]) ifTrue:[
+ Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from project definition').
+ ].
+ ^ true.
].
"/ source files-file loading no longer supported
"/ however, allow for autoload-stub loaded
doLoadAsAutoloaded ifTrue:[
- self
- recursiveInstallAutoloadedClassesFrom:packageDirOrNil
- rememberIn:(Set new)
- maxLevels:2
- noAutoload:false
- packageTop:packageDirOrNil
- showSplashInLevels:0.
- ^ true
+ self
+ recursiveInstallAutoloadedClassesFrom:packageDirOrNil
+ rememberIn:(Set new)
+ maxLevels:2
+ noAutoload:false
+ packageTop:packageDirOrNil
+ showSplashInLevels:0.
+ ^ true
].
^ PackageNotFoundError raiseRequestWith:aPackageString errorString:' - no projectDef, dll or loadAll found'.
@@ -2727,13 +2731,13 @@
Smalltalk installAutoloadedClassesFrom:abbrevFile pathName.
doLoadAsAutoloaded ifFalse:[
- "/ force autoloading...
- Smalltalk allClassesInPackage:aPackageId do:[:eachClass | eachClass autoload].
+ "/ force autoloading...
+ Smalltalk allClassesInPackage:aPackageId do:[:eachClass | eachClass autoload].
].
self loadExtensionsFromDirectory:packageDir.
VerboseLoading ifTrue:[
- Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageId , ' from abbrev file: ' , abbrevFile pathName).
+ Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageId , ' from abbrev file: ' , abbrevFile pathName).
].
^ true
@@ -4145,243 +4149,243 @@
while reading patches- and rc-file, do not add things into change-file
"
Class withoutUpdatingChangesDo:[
- |commandFile defaultRC prevCatchSetting
- isEval isPrint isFilter isRepl idxFileArg process|
-
- isEval := isPrint := isFilter := isRepl := false.
- didReadRCFile := false.
-
- StandAlone ifFalse:[
- "/
- "/ look for any '-q', '-e', '-l' or '-f' command line arguments
- "/ and handle them;
- "/ read startup and patches file
- "/
- idx := CommandLineArguments indexOfAny:#('-R' '--repl').
- isRepl := (idx ~~ 0).
-
- idx := CommandLineArguments indexOfAny:#('-q' '--silent').
- idx ~~ 0 ifTrue:[
- Object infoPrinting:false.
- ObjectMemory infoPrinting:false.
- CommandLineArguments removeAtIndex:idx.
- SilentLoading := true.
- ].
-
- [
- idx := CommandLineArguments indexOfAny:#('-pp' '--packagePath').
- idx ~~ 0
- ] whileTrue:[
- arg := CommandLineArguments at:idx + 1.
- CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
- self packagePath addLast:arg.
- VerboseStartup == true ifTrue:[
- ('Smalltalk [info]: add to packagePath: "', arg, '".') infoPrintCR.
- ].
- ].
-
- [
- idx := CommandLineArguments indexOfAny:#('-l' '--load').
- idx ~~ 0
- ] whileTrue:[
- arg := CommandLineArguments at:idx + 1.
- CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
- arg asFilename exists ifTrue:[
- Smalltalk fileIn:arg
- ] ifFalse:[
- Smalltalk loadPackage:arg
- ].
- ].
-
- "/ look for a '-e filename' or '--execute filename' argument
- "/ this will force fileIn of filename only, no standard startup.
-
- idx := CommandLineArguments indexOfAny:#('-e' '--execute' '--script').
- idx ~~ 0 ifTrue:[
- SilentLoading := true.
- CommandName := arg := CommandLineArguments at:idx + 1.
-
- CommandLineArguments
- removeAtIndex:idx+1; removeAtIndex:idx.
-
- self startSchedulerAndBackgroundCollector.
- keepSplashWindow ifFalse:[ self hideSplashWindow ].
- Initializing := false.
-
- process := [
- VerboseStartup == true ifTrue:[
- ('Smalltalk [info]: reading script from: "', arg, '".') infoPrintCR.
- ].
- UserInterrupt handle:[:ex |
- self exit:128+(OperatingSystem sigINT).
- ] do:[
- arg = '-' ifTrue:[
- self fileInStream:Stdin
- lazy:nil
- silent:nil
- logged:false
- addPath:nil
- ] ifFalse:[
- IsSTScript := true.
- self fileIn:arg.
- ].
- ].
- "/ after the script, if Screen has been opened and there are any open windows,
- "/ then do not exit
- Display notNil ifTrue:[
- Display exitOnLastClose:true.
- Display checkForEndOfDispatch.
- Processor exitWhenNoMoreUserProcesses:true.
- ] ifFalse:[
- self exit.
- ].
- ] newProcess.
- process priority:(Processor userSchedulingPriority).
- process name:'main'.
- process beGroupLeader.
- process resume.
-
- Processor dispatchLoop.
- self exit
- ].
-
- "look for a '-f filename' or '--file filename' argument
- if scripting, thisis loaded before -P, -E or-R action.
- if not scripting, this will force evaluation of filename instead of smalltalk.rc"
- idxFileArg := CommandLineArguments indexOfAny:#('-f' '--file').
- (idxFileArg ~~ 0) ifTrue:[
- commandFile := CommandLineArguments at:idxFileArg+1.
- CommandLineArguments removeAtIndex:idxFileArg+1; removeAtIndex:idxFileArg.
- ].
-
- "/ look for a '-E expr' or '--eval expr' argument (-P or --print to print the result of evaluation)
- "/ or -F/--filter or a '--repl' argument
- "/ E, P and F this will force evaluation of expr only, no standard startup
- "/ repl go into an interactive loop.
- idx := CommandLineArguments indexOfAny:#('-E' '--eval').
- (isEval := (idx ~~ 0)) ifFalse:[
- idx := CommandLineArguments indexOfAny:#('-P' '--print').
- (isPrint := (idx ~~ 0)) ifFalse:[
- idx := CommandLineArguments indexOfAny:#('-F' '--filter').
- (isFilter := (idx ~~ 0)) ifFalse:[
- idx := CommandLineArguments indexOfAny:#('-R' '--repl').
- isRepl := (idx ~~ 0)
- ].
- ].
- ].
-
- (isEval | isPrint | isFilter | isRepl) ifTrue:[
- isRepl ifFalse:[
- CommandLineArguments size <= idx ifTrue:[
- 'stx: missing argument after -E/-P/-F' errorPrintCR.
- self exit:1.
- ].
- arg := CommandLineArguments at:idx + 1.
- CommandLineArguments removeAtIndex:idx+1.
- ].
- CommandLineArguments removeAtIndex:idx.
-
- self startSchedulerAndBackgroundCollector.
- keepSplashWindow ifFalse:[ self hideSplashWindow ].
- Initializing := false.
-
- "/ enable this, so we can provide $1..$n in the script
- ParserFlags allowDollarInIdentifier:true.
- ParserFlags warnDollarInIdentifier:false.
-
- "/ add bindings for arguments
- CommandLineArguments doWithIndex:[:arg :i |
- Workspace workspaceVariableAt:('_$',i printString) put:arg.
- ].
-
- "/ all of the above allow for a -f file to be loaded before any other action
- (commandFile notNil) ifTrue:[
- VerboseStartup == true ifTrue:[
- ('Smalltalk [info]: reading command file from: "', commandFile, '".') infoPrintCR.
- ].
- (self secureFileIn:commandFile) ifFalse:[
- ('Smalltalk [error]: "', commandFile, '" not found.') errorPrintCR.
- OperatingSystem exit:1.
- ]
- ].
-
- isRepl ifTrue:[
- self readEvalPrint.
- self exit.
- ].
- process := [
- VerboseStartup == true ifTrue:[
- ('Smalltalk [info]: executing expression: "', arg, '".') infoPrintCR.
- ].
- UserInterrupt handle:[:ex |
- self exit:128+(OperatingSystem sigINT).
- ] do:[
- isFilter ifTrue:[
- "/ --filter - apply code to each input line.
- "/ compile code only once
- Compiler
- compile:'doIt ',arg
- forClass:String
- notifying:(EvalScriptingErrorHandler new source:arg).
-
- [Stdin atEnd] whileFalse:[
- |line|
-
- line := Stdin nextLine.
- line doIt.
- ].
- ] ifFalse:[
- "/ --print or --eval
- |rslt|
-
- rslt := Parser new
- evaluate:arg
- notifying:(EvalScriptingErrorHandler new source:arg)
- compile:true.
- isPrint ifTrue:[
- rslt printCR.
- ].
- ].
- ].
-
- "/ after the script, if Screen has been opened and there are any open windows,
- "/ then do not exit
- Display notNil ifTrue:[
- Display exitOnLastClose:true.
- Display checkForEndOfDispatch.
- Processor exitWhenNoMoreUserProcesses:true.
- VerboseStartup == true ifTrue:[
- ('Smalltalk [info]: display opened.') infoPrintCR.
- ].
- ] ifFalse:[
- VerboseStartup == true ifTrue:[
- ('Smalltalk [info]: no display - exit after script.') infoPrintCR.
- ].
- self exit.
- ].
- ] newProcess.
- process priority:(Processor userSchedulingPriority).
- process name:'main'.
- process beGroupLeader.
- process resume.
-
- Processor dispatchLoop.
- VerboseStartup == true ifTrue:[
- ('Smalltalk [info]: exit normally.') infoPrintCR.
- ].
- self exit
- ].
- ].
-
- commandFile notNil ifTrue:[
- SilentLoading := true. "/ suppress the hello & copyright messages
- self addStartBlock:
- [
- (self secureFileIn:commandFile) ifFalse:[
- ('Smalltalk [error]: startup file "', commandFile, '" not found.') errorPrintCR.
- OperatingSystem exit:1.
- ].
- ].
+ |commandFile defaultRC prevCatchSetting
+ isEval isPrint isFilter isRepl idxFileArg process|
+
+ isEval := isPrint := isFilter := isRepl := false.
+ didReadRCFile := false.
+
+ StandAlone ifFalse:[
+ "/
+ "/ look for any '-q', '-e', '-l' or '-f' command line arguments
+ "/ and handle them;
+ "/ read startup and patches file
+ "/
+ idx := CommandLineArguments indexOfAny:#('-R' '--repl').
+ isRepl := (idx ~~ 0).
+
+ idx := CommandLineArguments indexOfAny:#('-q' '--silent').
+ idx ~~ 0 ifTrue:[
+ Object infoPrinting:false.
+ ObjectMemory infoPrinting:false.
+ CommandLineArguments removeAtIndex:idx.
+ SilentLoading := true.
+ ].
+
+ [
+ idx := CommandLineArguments indexOfAny:#('-pp' '--packagePath').
+ idx ~~ 0
+ ] whileTrue:[
+ arg := CommandLineArguments at:idx + 1.
+ CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
+ self packagePath addLast:arg.
+ VerboseStartup == true ifTrue:[
+ ('Smalltalk [info]: add to packagePath: "', arg, '".') infoPrintCR.
+ ].
+ ].
+
+ [
+ idx := CommandLineArguments indexOfAny:#('-l' '--load').
+ idx ~~ 0
+ ] whileTrue:[
+ arg := CommandLineArguments at:idx + 1.
+ CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
+ arg asFilename exists ifTrue:[
+ Smalltalk fileIn:arg
+ ] ifFalse:[
+ Smalltalk loadPackage:arg
+ ].
+ ].
+
+ "/ look for a '-e filename' or '--execute filename' argument
+ "/ this will force fileIn of filename only, no standard startup.
+
+ idx := CommandLineArguments indexOfAny:#('-e' '--execute' '--script').
+ idx ~~ 0 ifTrue:[
+ SilentLoading := true.
+ CommandName := arg := CommandLineArguments at:idx + 1.
+
+ CommandLineArguments
+ removeAtIndex:idx+1; removeAtIndex:idx.
+
+ self startSchedulerAndBackgroundCollector.
+ keepSplashWindow ifFalse:[ self hideSplashWindow ].
+ Initializing := false.
+
+ process := [
+ VerboseStartup == true ifTrue:[
+ ('Smalltalk [info]: reading script from: "', arg, '".') infoPrintCR.
+ ].
+ UserInterrupt handle:[:ex |
+ self exit:128+(OperatingSystem sigINT).
+ ] do:[
+ arg = '-' ifTrue:[
+ self fileInStream:Stdin
+ lazy:nil
+ silent:nil
+ logged:false
+ addPath:nil
+ ] ifFalse:[
+ IsSTScript := true.
+ self fileIn:arg.
+ ].
+ ].
+ "/ after the script, if Screen has been opened and there are any open windows,
+ "/ then do not exit
+ Display notNil ifTrue:[
+ Display exitOnLastClose:true.
+ Display checkForEndOfDispatch.
+ Processor exitWhenNoMoreUserProcesses:true.
+ ] ifFalse:[
+ self exit.
+ ].
+ ] newProcess.
+ process priority:(Processor userSchedulingPriority).
+ process name:'main'.
+ process beGroupLeader.
+ process resume.
+
+ Processor dispatchLoop.
+ self exit
+ ].
+
+ "look for a '-f filename' or '--file filename' argument
+ if scripting, thisis loaded before -P, -E or-R action.
+ if not scripting, this will force evaluation of filename instead of smalltalk.rc"
+ idxFileArg := CommandLineArguments indexOfAny:#('-f' '--file').
+ (idxFileArg ~~ 0) ifTrue:[
+ commandFile := CommandLineArguments at:idxFileArg+1.
+ CommandLineArguments removeAtIndex:idxFileArg+1; removeAtIndex:idxFileArg.
+ ].
+
+ "/ look for a '-E expr' or '--eval expr' argument (-P or --print to print the result of evaluation)
+ "/ or -F/--filter or a '--repl' argument
+ "/ E, P and F this will force evaluation of expr only, no standard startup
+ "/ repl go into an interactive loop.
+ idx := CommandLineArguments indexOfAny:#('-E' '--eval').
+ (isEval := (idx ~~ 0)) ifFalse:[
+ idx := CommandLineArguments indexOfAny:#('-P' '--print').
+ (isPrint := (idx ~~ 0)) ifFalse:[
+ idx := CommandLineArguments indexOfAny:#('-F' '--filter').
+ (isFilter := (idx ~~ 0)) ifFalse:[
+ idx := CommandLineArguments indexOfAny:#('-R' '--repl').
+ isRepl := (idx ~~ 0)
+ ].
+ ].
+ ].
+
+ (isEval | isPrint | isFilter | isRepl) ifTrue:[
+ isRepl ifFalse:[
+ CommandLineArguments size <= idx ifTrue:[
+ 'stx: missing argument after -E/-P/-F' errorPrintCR.
+ self exit:1.
+ ].
+ arg := CommandLineArguments at:idx + 1.
+ CommandLineArguments removeAtIndex:idx+1.
+ ].
+ CommandLineArguments removeAtIndex:idx.
+
+ self startSchedulerAndBackgroundCollector.
+ keepSplashWindow ifFalse:[ self hideSplashWindow ].
+ Initializing := false.
+
+ "/ enable this, so we can provide $1..$n in the script
+ ParserFlags allowDollarInIdentifier:true.
+ ParserFlags warnDollarInIdentifier:false.
+
+ "/ add bindings for arguments
+ CommandLineArguments doWithIndex:[:arg :i |
+ Workspace workspaceVariableAt:('_$',i printString) put:arg.
+ ].
+
+ "/ all of the above allow for a -f file to be loaded before any other action
+ (commandFile notNil) ifTrue:[
+ VerboseStartup == true ifTrue:[
+ ('Smalltalk [info]: reading command file from: "', commandFile, '".') infoPrintCR.
+ ].
+ (self secureFileIn:commandFile) ifFalse:[
+ ('Smalltalk [error]: "', commandFile, '" not found.') errorPrintCR.
+ OperatingSystem exit:1.
+ ]
+ ].
+
+ isRepl ifTrue:[
+ self readEvalPrint.
+ self exit.
+ ].
+ process := [
+ VerboseStartup == true ifTrue:[
+ ('Smalltalk [info]: executing expression: "', arg, '".') infoPrintCR.
+ ].
+ UserInterrupt handle:[:ex |
+ self exit:128+(OperatingSystem sigINT).
+ ] do:[
+ isFilter ifTrue:[
+ "/ --filter - apply code to each input line.
+ "/ compile code only once
+ Compiler
+ compile:'doIt ',arg
+ forClass:String
+ notifying:(EvalScriptingErrorHandler new source:arg).
+
+ [Stdin atEnd] whileFalse:[
+ |line|
+
+ line := Stdin nextLine.
+ line doIt.
+ ].
+ ] ifFalse:[
+ "/ --print or --eval
+ |rslt|
+
+ rslt := Parser new
+ evaluate:arg
+ notifying:(EvalScriptingErrorHandler new source:arg)
+ compile:true.
+ isPrint ifTrue:[
+ rslt printCR.
+ ].
+ ].
+ ].
+
+ "/ after the script, if Screen has been opened and there are any open windows,
+ "/ then do not exit
+ Display notNil ifTrue:[
+ Display exitOnLastClose:true.
+ Display checkForEndOfDispatch.
+ Processor exitWhenNoMoreUserProcesses:true.
+ VerboseStartup == true ifTrue:[
+ ('Smalltalk [info]: display opened.') infoPrintCR.
+ ].
+ ] ifFalse:[
+ VerboseStartup == true ifTrue:[
+ ('Smalltalk [info]: no display - exit after script.') infoPrintCR.
+ ].
+ self exit.
+ ].
+ ] newProcess.
+ process priority:(Processor userSchedulingPriority).
+ process name:'main'.
+ process beGroupLeader.
+ process resume.
+
+ Processor dispatchLoop.
+ VerboseStartup == true ifTrue:[
+ ('Smalltalk [info]: exit normally.') infoPrintCR.
+ ].
+ self exit
+ ].
+ ].
+
+ commandFile notNil ifTrue:[
+ SilentLoading := true. "/ suppress the hello & copyright messages
+ self addStartBlock:
+ [
+ (self secureFileIn:commandFile) ifFalse:[
+ ('Smalltalk [error]: startup file "', commandFile, '" not found.') errorPrintCR.
+ OperatingSystem exit:1.
+ ].
+ ].
"/ self startSchedulerAndBackgroundCollector.
"/ keepSplashWindow ifFalse:[ self hideSplashWindow ].
@@ -4391,67 +4395,67 @@
"/ ('Smalltalk [error]: startup file "', commandFile, '" not found.') errorPrintCR.
"/ OperatingSystem exit:1.
"/ ].
- ] ifFalse:[
- "/ look for <command>.rc
- "/ if not found, read smalltalk.rc (or stxapp.rc for standAlone operation)
-
- commandFile := self commandName asFilename withSuffix:'rc'.
- (didReadRCFile := commandFile exists and:[self secureFileIn:commandFile]) ifFalse:[
- StandAlone ifFalse:[
- defaultRC := 'smalltalk.rc' "/asFilename
- ] ifTrue:[
- defaultRC := 'stxapp.rc' "/asFilename
- ].
- "JV@2011-11-01: DO NOT check defaultRC exist - this prevents smalltalk to
- to be started with different working directory than stx/projects/smalltalk !!!!!!"
-
- "/didReadRCFile := defaultRC exists and:[self secureFileIn:defaultRC].
- didReadRCFile := (self getSystemFileName:defaultRC) notNil
- and:[self secureFileIn:defaultRC].
- didReadRCFile ifFalse:[
- StandAlone ifFalse:[
- 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
- graphicalMode := false.
- ]
- ]
- ].
-
- "/ ('StandAlone is %1' bindWith:StandAlone) printCR.
- "/ ('Headless is %1' bindWith:HeadlessOperation) printCR.
- "/ ('Display is %1' bindWith:Display) printCR.
- "/ ('Screen is %1' bindWith:Screen) printCR.
-
- keepSplashWindow ifFalse:[ self hideSplashWindow ].
- didReadRCFile ifFalse:[
- 'private.rc' asFilename exists ifTrue:[ self secureFileIn:'private.rc' ].
-
- "/
- "/ No RC file found;
- "/ Setup more default stuff
- "/
- StandAlone ifFalse:[
- "/ its a smalltalk - proceed in interpreter.
- 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
- graphicalMode := false.
- ].
-
- "/ setup more defaults...
+ ] ifFalse:[
+ "/ look for <command>.rc
+ "/ if not found, read smalltalk.rc (or stxapp.rc for standAlone operation)
+
+ commandFile := self commandName asFilename withSuffix:'rc'.
+ (didReadRCFile := commandFile exists and:[self secureFileIn:commandFile]) ifFalse:[
+ StandAlone ifFalse:[
+ defaultRC := 'smalltalk.rc' "/asFilename
+ ] ifTrue:[
+ defaultRC := 'stxapp.rc' "/asFilename
+ ].
+ "JV@2011-11-01: DO NOT check defaultRC exist - this prevents smalltalk to
+ to be started with different working directory than stx/projects/smalltalk !!!!!!"
+
+ "/didReadRCFile := defaultRC exists and:[self secureFileIn:defaultRC].
+ didReadRCFile := (self getSystemFileName:defaultRC) notNil
+ and:[self secureFileIn:defaultRC].
+ didReadRCFile ifFalse:[
+ StandAlone ifFalse:[
+ 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
+ graphicalMode := false.
+ ]
+ ]
+ ].
+
+ "/ ('StandAlone is %1' bindWith:StandAlone) printCR.
+ "/ ('Headless is %1' bindWith:HeadlessOperation) printCR.
+ "/ ('Display is %1' bindWith:Display) printCR.
+ "/ ('Screen is %1' bindWith:Screen) printCR.
+
+ keepSplashWindow ifFalse:[ self hideSplashWindow ].
+ didReadRCFile ifFalse:[
+ 'private.rc' asFilename exists ifTrue:[ self secureFileIn:'private.rc' ].
+
+ "/
+ "/ No RC file found;
+ "/ Setup more default stuff
+ "/
+ StandAlone ifFalse:[
+ "/ its a smalltalk - proceed in interpreter.
+ 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
+ graphicalMode := false.
+ ].
+
+ "/ setup more defaults...
"/ ObjectMemory startBackgroundCollectorAt:5.
"/ ObjectMemory startBackgroundFinalizationAt:5.
- self addStartBlock:[
- self startSchedulerAndBackgroundCollector
- ].
- ].
- ].
- (CommandLineArguments includes:'--scripting') ifTrue:[
- self addStartBlock:[
- StandaloneStartup handleScriptingOptionsFromArguments:CommandLineArguments.
- ].
- ].
+ self addStartBlock:[
+ self startSchedulerAndBackgroundCollector
+ ].
+ ].
+ ].
+ (CommandLineArguments includes:'--scripting') ifTrue:[
+ self addStartBlock:[
+ StandaloneStartup handleScriptingOptionsFromArguments:CommandLineArguments.
+ ].
+ ].
].
HeadlessOperation ifTrue:[
- graphicalMode := false.
+ graphicalMode := false.
].
keepSplashWindow ifFalse:[ self hideSplashWindow ].
@@ -8280,11 +8284,11 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1129 2015-05-08 01:20:17 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1131 2015-05-18 00:07:57 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1129 2015-05-08 01:20:17 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1131 2015-05-18 00:07:57 cg Exp $'
!
version_HG
--- a/String.st Sat May 16 06:48:37 2015 +0200
+++ b/String.st Mon May 18 07:10:20 2015 +0100
@@ -1511,7 +1511,13 @@
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
- return context._RETURN( self.stringEqualP(aString) );
+ if (aString == self) {
+ return __c__._RETURN_true();
+ }
+ if (aString.isStringLike()) {
+ return __c__._RETURN( self.stringEqual(aString) ? STObject.True : STObject.False );
+ }
+ return __c__._RETURN_false();
/* NOTREACHED */
#else
int l1, l2;
@@ -2053,7 +2059,7 @@
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
- return context._RETURN( self.stringEqualP( aString.not()) );
+ return context._RETURN( self.stringEqual( aString ) ? STObject.False : STObject.True);
/* NOTREACHED */
#else
int l1, l2;
@@ -4351,9 +4357,9 @@
!String class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.338 2015-05-15 06:54:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.340 2015-05-18 00:16:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.338 2015-05-15 06:54:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/String.st,v 1.340 2015-05-18 00:16:20 cg Exp $'
! !
--- a/Symbol.st Sat May 16 06:48:37 2015 +0200
+++ b/Symbol.st Mon May 18 07:10:20 2015 +0100
@@ -52,19 +52,19 @@
Also, symbols are used as key to map class names (global names) to actual class objects.
Special ST/X feature:
- The ST/X VM method lookup supports selector namespaces for method extensions.
- This means, that a class may contain method extensions in another namespace,
- which are only seen and invoked if called from a class within that namespace.
- Technically, this is done by storing the method under a special namespace-selector,
- which is a symbol consisting of the user visible name, prefixed by ':<ns>::'.
- The VM's method lookup algorithm contains special handling code for such constructs.
- Thus, if two methods are stored as 'foo' and ':NS::foo' are present in a class,
- any send of 'foo' from wíthin the NS-namespace will invoke the second method.
- Any other send will invoke the first one.
+ The ST/X VM method lookup supports selector namespaces for method extensions.
+ This means, that a class may contain method extensions in another namespace,
+ which are only seen and invoked if called from a class within that namespace.
+ Technically, this is done by storing the method under a special namespace-selector,
+ which is a symbol consisting of the user visible name, prefixed by ':<ns>::'.
+ The VM's method lookup algorithm contains special handling code for such constructs.
+ Thus, if two methods are stored as 'foo' and ':NS::foo' are present in a class,
+ any send of 'foo' from wíthin the NS-namespace will invoke the second method.
+ Any other send will invoke the first one.
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -280,7 +280,7 @@
They must be of the form :<ns>::<sel>,
where <ns> is the namespace and <sel> is the raw selector.
This special format (a symbol starting with a colon) was chosen, because almost every other selector
- is legal, and this can be checked quickly by just looking at the first character."
+ is legal, and this can be checked quickly by just looking at the first character."
|nsPart|
@@ -307,12 +307,12 @@
They must be of the form :<ns>::<sel>,
where <ns> is the namespace and <sel> is the raw selector.
This special format (a symbol starting with a colon) was chosen, because almost every other selector
- is legal, and this can be checked quickly by just looking at the first character."
+ is legal, and this can be checked quickly by just looking at the first character."
|parts ns|
self isNameSpaceSelector ifFalse:[
- ^ Array with:nil with:self
+ ^ Array with:nil with:self
].
parts := self nameSpaceAndSelectorParts.
ns := Smalltalk at:parts first asSymbol.
@@ -336,12 +336,12 @@
They must be of the form :<ns>::<sel>,
where <ns> is the namespace and <sel> is the raw selector.
This special format (a symbol starting with a colon) was chosen, because almost every other selector
- is legal, and this can be checked quickly by just looking at the first character."
+ is legal, and this can be checked quickly by just looking at the first character."
|nsPart selPart idx|
self isNameSpaceSelector ifFalse:[
- ^ Array with:nil with:self
+ ^ Array with:nil with:self
].
idx := self indexOf:$: startingAt:3.
nsPart := self copyFrom:2 to:idx - 1.
@@ -360,12 +360,12 @@
nameSpacePart
"if I have the format of a namespace-selector,
retrieve the namespace name. Otherwise, return nil.
- Namespace selectors have a special, fix defined format,
+ Namespace selectors have a special, fix defined format,
which is also known in the VM.
They must be of the form :<ns>::<sel>,
where <ns> is the namespace and <sel> is the raw selector.
This special format (a symbol starting with a colon) was chosen, because almost every other selector
- is legal, and this can be checked quickly by just looking at the first character."
+ is legal, and this can be checked quickly by just looking at the first character."
self isNameSpaceSelector ifFalse:[^ nil].
^ self nameSpaceAndSelectorParts first.
@@ -380,30 +380,30 @@
selector
<resource: #obsolete>
- "if I have the format of a namespace-selector, retrieve the raw selector.
+ "if I have the format of a namespace-selector, retrieve the raw selector.
Otherwise, return myself.
Namespace selectors have a special, fix defined format, which is also known in the VM.
They must be of the form :<ns>::<sel>,
where <ns> is the namespace and <sel> is the raw selector.
This special format (a symbol starting with a colon) was chosen, because almost every other selector
- is legal, and this can be checked quickly by just looking at the first character."
+ is legal, and this can be checked quickly by just looking at the first character."
self obsoleteMethodWarning:'use selectorWithoutNameSpace'.
- ^ self selectorWithoutNameSpace
+ ^ self selectorWithoutNameSpace
!
selectorWithoutNameSpace
- "if I have the format of a namespace-selector, retrieve the raw selector.
+ "if I have the format of a namespace-selector, retrieve the raw selector.
Otherwise, return myself.
Namespace selectors have a special, fix defined format, which is also known in the VM.
They must be of the form :<ns>::<sel>,
where <ns> is the namespace and <sel> is the raw selector.
This special format (a symbol starting with a colon) was chosen, because almost every other selector
- is legal, and this can be checked quickly by just looking at the first character."
+ is legal, and this can be checked quickly by just looking at the first character."
^ self isNameSpaceSelector
- ifTrue: [ self nameSpaceAndSelectorParts second ]
- ifFalse:[ self ]
+ ifTrue: [ self nameSpaceAndSelectorParts second ]
+ ifFalse:[ self ]
"
#':foo:' selectorWithoutNameSpace -> #':foo:' (bad format)
@@ -419,17 +419,18 @@
= something
"return true, if the receiver and argument consist of the same characters.
- Redefined here, for more efficient #= comparison of symbols
- (which ought to be compared using #==).
+ Redefined here, for more efficient comparison of symbols
+ (which can to be compared using #==).
If the argument is a symbol, we use a quick pointer compare, instead of
the inherited value compare."
%{ /* NOCONTEXT */
OBJ cls;
+ if (something == self) RETURN(true);
if (! __isNonNilObject(something)) RETURN(false);
if ((cls = __qClass(something)) == Symbol) {
- RETURN (self == something ? true : false);
+ RETURN (false);
}
if (cls == String || cls == ImmutableString) {
RETURN (strcmp(__stringVal(self), __stringVal(something)) == 0 ? true : false);
@@ -846,11 +847,11 @@
!Symbol class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.116 2015-02-19 12:12:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.117 2015-05-18 00:06:52 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.116 2015-02-19 12:12:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.117 2015-05-18 00:06:52 cg Exp $'
!
version_SVN
--- a/UninterpretedBytes.st Sat May 16 06:48:37 2015 +0200
+++ b/UninterpretedBytes.st Mon May 18 07:10:20 2015 +0100
@@ -83,28 +83,28 @@
"
UninterpretedBytes provides the common protocol for byte-storage
containers; concrete subclasses are
- ByteArray (which store the bytes within the Smalltalk object memory)
- String (which is a subclass of ByteArray) knows that the bytes represent characters
+ ByteArray (which store the bytes within the Smalltalk object memory)
+ String (which is a subclass of ByteArray) knows that the bytes represent characters
and
- ExternalBytes (which store the bytes in the malloc-heap).
+ ExternalBytes (which store the bytes in the malloc-heap).
UninterpretedBytes itself is abstract, so no instances of it can be created.
[See also:]
- ByteArray String ExternalBytes
+ ByteArray String ExternalBytes
[author:]
- Claus Gittinger
+ Claus Gittinger
[Notice:]
- Notice the confusion due to multiple methods with the same
- functionality (i.e. 'xxxx:MSB:' vs. 'xxxx:bigEndian:').
- The reason is that at the time this class was written,
- ST80 sid not offer protocol to specify the byteOrder, and
- ST/X provided methods ending in 'MSB:' for this.
- In the meanwhile, VW added protocol ending in 'bigEndian:',
- which has been added here for compatibility.
- (certainly a point, where an ansi-standard will help)
+ Notice the confusion due to multiple methods with the same
+ functionality (i.e. 'xxxx:MSB:' vs. 'xxxx:bigEndian:').
+ The reason is that at the time this class was written,
+ ST80 sid not offer protocol to specify the byteOrder, and
+ ST/X provided methods ending in 'MSB:' for this.
+ In the meanwhile, VW added protocol ending in 'bigEndian:',
+ which has been added here for compatibility.
+ (certainly a point, where an ansi-standard will help)
"
! !
@@ -144,9 +144,9 @@
bytes := self new: sz // 2.
s := aString readStream.
1 to: sz // 2 do: [ :idx |
- hi := s next digitValue.
- lo := s next digitValue.
- bytes at:idx put: ((hi bitShift:4) bitOr: lo)
+ hi := s next digitValue.
+ lo := s next digitValue.
+ bytes at:idx put: ((hi bitShift:4) bitOr: lo)
].
^ bytes
@@ -161,7 +161,7 @@
"
"
Time millisecondsToRun:[
- 1000000 timesRepeat:[ ByteArray fromHexString:'1234FEFF1234FEFF1234FEFF1234FEFF' ]
+ 1000000 timesRepeat:[ ByteArray fromHexString:'1234FEFF1234FEFF1234FEFF1234FEFF' ]
].
"
@@ -200,7 +200,7 @@
the radix-encoding used in good old PDP11 times ;-)
ST-80 uses this encoding for Images ...
This is a base64 encoding, very similar (but not equal) to the algorithm used in RFC1421.
- PS: It took a while to figure that one out ...
+ PS: It took a while to figure that one out ...
I don't like it ;-)"
|index "{ Class: SmallInteger }"
@@ -221,47 +221,47 @@
last := aString last codePoint.
last > 96 ifTrue:[
- stop := stop - 3 + (last - 96)
+ stop := stop - 3 + (last - 96)
].
bytes := self new:stop.
index := 1. dstIndex := 1.
[dstIndex <= stop] whileTrue:[
- "/ take 4 characters ...
- "/ allow a line break before each group of 4
- sixBits := (aString at:index) codePoint.
- [sixBits < 32] whileTrue:[
- index := index + 1.
- sixBits := (aString at:index) codePoint.
- ].
- sixBits := sixBits bitAnd:16r3F.
- n := sixBits.
-
- "/ self assert:(aString at:index+1) codePoint >= 32.
- sixBits := (aString at:index+1) codePoint bitAnd:16r3F.
- n := (n bitShift:6) + sixBits.
-
- "/ self assert:(aString at:index+2) codePoint >= 32.
- sixBits := (aString at:index+2) codePoint bitAnd:16r3F.
- n := (n bitShift:6) + sixBits.
-
- "/ self assert:(aString at:index+3) codePoint >= 32.
- sixBits := (aString at:index+3) codePoint bitAnd:16r3F.
- n := (n bitShift:6) + sixBits.
-
- index := index + 4.
-
- "/ now have 24 bits in n
-
- bytes at:dstIndex put:(n bitShift:-16).
-
- dstIndex < stop ifTrue:[
- bytes at:dstIndex+1 put:((n bitShift:-8) bitAnd:16rFF).
- dstIndex+2 <= stop ifTrue:[
- bytes at:dstIndex+2 put:(n bitAnd:16rFF).
- ]
- ].
- dstIndex := dstIndex + 3.
+ "/ take 4 characters ...
+ "/ allow a line break before each group of 4
+ sixBits := (aString at:index) codePoint.
+ [sixBits < 32] whileTrue:[
+ index := index + 1.
+ sixBits := (aString at:index) codePoint.
+ ].
+ sixBits := sixBits bitAnd:16r3F.
+ n := sixBits.
+
+ "/ self assert:(aString at:index+1) codePoint >= 32.
+ sixBits := (aString at:index+1) codePoint bitAnd:16r3F.
+ n := (n bitShift:6) + sixBits.
+
+ "/ self assert:(aString at:index+2) codePoint >= 32.
+ sixBits := (aString at:index+2) codePoint bitAnd:16r3F.
+ n := (n bitShift:6) + sixBits.
+
+ "/ self assert:(aString at:index+3) codePoint >= 32.
+ sixBits := (aString at:index+3) codePoint bitAnd:16r3F.
+ n := (n bitShift:6) + sixBits.
+
+ index := index + 4.
+
+ "/ now have 24 bits in n
+
+ bytes at:dstIndex put:(n bitShift:-16).
+
+ dstIndex < stop ifTrue:[
+ bytes at:dstIndex+1 put:((n bitShift:-8) bitAnd:16rFF).
+ dstIndex+2 <= stop ifTrue:[
+ bytes at:dstIndex+2 put:(n bitAnd:16rFF).
+ ]
+ ].
+ dstIndex := dstIndex + 3.
].
^ bytes
@@ -296,72 +296,72 @@
REGISTER OBJ *op;
if (__isSmallInteger(anInteger)) {
- nindexedinstvars = __intVal(anInteger);
- if (nindexedinstvars >= 0) {
- if (self == ByteArray) {
- /*
- * the most common case
- */
- instsize = OHDR_SIZE + nindexedinstvars;
- if (__CanDoQuickNew(instsize)) { /* OBJECT ALLOCATION */
- __qCheckedNew(newobj, instsize);
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
- RETURN (newobj );
- }
- } else {
- /*
- * Take care for subclasses like TwoByteString
- */
- switch (__smallIntegerVal(__ClassInstPtr(self)->c_flags) & ARRAYMASK) {
- case BYTEARRAY:
- break;
-
- case WORDARRAY:
- case SWORDARRAY:
- nindexedinstvars *= 2;
- break;
-
- case LONGARRAY:
- case SLONGARRAY:
- nindexedinstvars *= 4;
- break;
-
- default:
- /* don't know about this array type, delegate to super */
- goto out;
- }
- }
- nInstVars = __intVal(__ClassInstPtr(self)->c_ninstvars);
- instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars) + nindexedinstvars;
- __PROTECT_CONTEXT__
- __qNew(newobj, instsize); /* OBJECT ALLOCATION */
- __UNPROTECT_CONTEXT__
- if (newobj != nil) {
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
- if (nInstVars) {
- /*
- * still have to nil out named instvars ...
- */
+ nindexedinstvars = __intVal(anInteger);
+ if (nindexedinstvars >= 0) {
+ if (self == ByteArray) {
+ /*
+ * the most common case
+ */
+ instsize = OHDR_SIZE + nindexedinstvars;
+ if (__CanDoQuickNew(instsize)) { /* OBJECT ALLOCATION */
+ __qCheckedNew(newobj, instsize);
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
+ RETURN (newobj );
+ }
+ } else {
+ /*
+ * Take care for subclasses like TwoByteString
+ */
+ switch (__smallIntegerVal(__ClassInstPtr(self)->c_flags) & ARRAYMASK) {
+ case BYTEARRAY:
+ break;
+
+ case WORDARRAY:
+ case SWORDARRAY:
+ nindexedinstvars *= 2;
+ break;
+
+ case LONGARRAY:
+ case SLONGARRAY:
+ nindexedinstvars *= 4;
+ break;
+
+ default:
+ /* don't know about this array type, delegate to super */
+ goto out;
+ }
+ }
+ nInstVars = __intVal(__ClassInstPtr(self)->c_ninstvars);
+ instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars) + nindexedinstvars;
+ __PROTECT_CONTEXT__
+ __qNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+ if (newobj != nil) {
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
+ if (nInstVars) {
+ /*
+ * still have to nil out named instvars ...
+ */
#if defined(memset4) && defined(FAST_OBJECT_MEMSET4)
- memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
+ memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
#else
# if defined(FAST_MEMSET) && !defined(NEGATIVE_ADDRESSES)
- /*
- * knowing that nil is 0
- */
- memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+ /*
+ * knowing that nil is 0
+ */
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
# else
- op = __InstPtr(newobj)->i_instvars;
- while (nInstVars--)
- *op++ = nil;
+ op = __InstPtr(newobj)->i_instvars;
+ while (nInstVars--)
+ *op++ = nil;
# endif
#endif
- }
- RETURN ( newobj );
- }
- }
+ }
+ RETURN ( newobj );
+ }
+ }
}
out:;
%}.
@@ -430,7 +430,9 @@
RETURN (true);
# endif
#endif
-%}
+%}.
+ ^ false "/ an arbitrary default
+
"
UninterpretedBytes isBigEndian
"
@@ -538,22 +540,22 @@
|val|
val := 0.
- bigEndian ifTrue:[
- index to:index+n-1 do:[:i |
- val := (val<<8) + (self at:i)
- ]
- ] ifFalse:[
- index+n-1 to:index by:-1 do:[:i |
- val := (val<<8) + (self at:i)
- ]
+ bigEndian ifTrue:[
+ index to:index+n-1 do:[:i |
+ val := (val<<8) + (self at:i)
+ ]
+ ] ifFalse:[
+ index+n-1 to:index by:-1 do:[:i |
+ val := (val<<8) + (self at:i)
+ ]
].
^ val
"
|b|
b := #[ 16r01 16r02 16r03 16r04 16r05 ].
- (b unsignedIntegerAt:2 length:4 bigEndian:false).
- (b unsignedIntegerAt:2 length:4 bigEndian:true).
+ (b unsignedIntegerAt:2 length:4 bigEndian:false).
+ (b unsignedIntegerAt:2 length:4 bigEndian:true).
"
! !
@@ -709,12 +711,12 @@
|newFloat|
msb == IsBigEndian ifTrue:[
- ^ self doubleAt:index.
+ ^ self doubleAt:index.
].
newFloat := Float basicNew.
1 to:8 do:[:destIndex|
- newFloat basicAt:(9-destIndex) put:(self at:index - 1 + destIndex)
+ newFloat basicAt:(9-destIndex) put:(self at:index - 1 + destIndex)
].
^ newFloat.
@@ -737,40 +739,40 @@
* handle the most common cases fast ...
*/
if (__isSmallInteger(index)) {
- unsigned char *cp;
- INT sz;
-
- __fetchBytePointerAndSize__(self, &cp, &sz);
- if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
-
- if ((idx+(sizeof(double)-1)) < sz) {
- cp += idx;
- /*
- * aligned
- */
- if (((INT)cp & (sizeof(double)-1)) == 0) {
- if (__isFloat(aFloat)) {
- ((double *)cp)[0] = __floatVal(aFloat);
- RETURN (aFloat);
- }
- if (__isShortFloat(aFloat)) {
- ((double *)cp)[0] = (double)(__shortFloatVal(aFloat));
- RETURN (aFloat);
- }
- if (__isSmallInteger(aFloat)) {
- ((double *)cp)[0] = (double)(__intVal(aFloat));
- RETURN (aFloat);
- }
- }
- }
- }
+ unsigned char *cp;
+ INT sz;
+
+ __fetchBytePointerAndSize__(self, &cp, &sz);
+ if (cp) {
+ unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
+
+ if ((idx+(sizeof(double)-1)) < sz) {
+ cp += idx;
+ /*
+ * aligned
+ */
+ if (((INT)cp & (sizeof(double)-1)) == 0) {
+ if (__isFloat(aFloat)) {
+ ((double *)cp)[0] = __floatVal(aFloat);
+ RETURN (aFloat);
+ }
+ if (__isShortFloat(aFloat)) {
+ ((double *)cp)[0] = (double)(__shortFloatVal(aFloat));
+ RETURN (aFloat);
+ }
+ if (__isSmallInteger(aFloat)) {
+ ((double *)cp)[0] = (double)(__intVal(aFloat));
+ RETURN (aFloat);
+ }
+ }
+ }
+ }
}
%}.
flt := aFloat asFloat.
1 to:8 do:[:srcIndex|
- self at:index - 1 + srcIndex put:(flt basicAt:srcIndex)
+ self at:index - 1 + srcIndex put:(flt basicAt:srcIndex)
].
^ aFloat
!
@@ -787,12 +789,12 @@
|flt|
msb == IsBigEndian ifTrue:[
- ^ self doubleAt:index put:aFloat.
+ ^ self doubleAt:index put:aFloat.
].
flt := aFloat asFloat.
1 to:8 do:[:srcIndex|
- self at:index - 1 + srcIndex put:(flt basicAt:(9-srcIndex))
+ self at:index - 1 + srcIndex put:(flt basicAt:(9-srcIndex))
].
^ aFloat
@@ -861,12 +863,12 @@
|newFloat|
msb == IsBigEndian ifTrue:[
- ^ self floatAt:index
+ ^ self floatAt:index
].
newFloat := ShortFloat basicNew.
1 to:4 do:[:destIndex|
- newFloat basicAt:(5-destIndex) put:(self at:index - 1 + destIndex)
+ newFloat basicAt:(5-destIndex) put:(self at:index - 1 + destIndex)
].
^ newFloat.
@@ -890,41 +892,41 @@
* handle the most common cases fast ...
*/
if (__isSmallInteger(index)) {
- unsigned char *cp;
- INT sz;
-
- __fetchBytePointerAndSize__(self, &cp, &sz);
- if (cp) {
- unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
-
- if ((idx+(sizeof(float)-1)) < sz) {
- cp += idx;
- /*
- * aligned
- */
- if (((INT)cp & (sizeof(float)-1)) == 0) {
- if (__isShortFloat(aFloat)) {
- ((float *)cp)[0] = __shortFloatVal(aFloat);
- RETURN (self);
- }
- if (__isFloat(aFloat)) {
- ((float *)cp)[0] = (float)__floatVal(aFloat);
- RETURN (self);
- }
- if (__isSmallInteger(aFloat)) {
- ((float *)cp)[0] = (float)__intVal(aFloat);
- RETURN (self);
- }
- // bail out to smalltalk code
- }
- }
- }
+ unsigned char *cp;
+ INT sz;
+
+ __fetchBytePointerAndSize__(self, &cp, &sz);
+ if (cp) {
+ unsigned INT idx = ((unsigned INT)__intVal(index)) - 1;
+
+ if ((idx+(sizeof(float)-1)) < sz) {
+ cp += idx;
+ /*
+ * aligned
+ */
+ if (((INT)cp & (sizeof(float)-1)) == 0) {
+ if (__isShortFloat(aFloat)) {
+ ((float *)cp)[0] = __shortFloatVal(aFloat);
+ RETURN (self);
+ }
+ if (__isFloat(aFloat)) {
+ ((float *)cp)[0] = (float)__floatVal(aFloat);
+ RETURN (self);
+ }
+ if (__isSmallInteger(aFloat)) {
+ ((float *)cp)[0] = (float)__intVal(aFloat);
+ RETURN (self);
+ }
+ // bail out to smalltalk code
+ }
+ }
+ }
}
%}.
sflt := aFloat asShortFloat.
1 to:4 do:[:srcIndex|
- self at:index - 1 + srcIndex put:(sflt basicAt:srcIndex)
+ self at:index - 1 + srcIndex put:(sflt basicAt:srcIndex)
].
!
@@ -940,13 +942,13 @@
|sflt|
msb == IsBigEndian ifTrue:[
- self floatAt:index put:aFloat.
- ^ self.
+ self floatAt:index put:aFloat.
+ ^ self.
].
sflt := aFloat asShortFloat.
1 to:4 do:[:srcIndex|
- self at:index - 1 + srcIndex put:(sflt basicAt:(5-srcIndex))
+ self at:index - 1 + srcIndex put:(sflt basicAt:(5-srcIndex))
].
"Created: / 15.5.1998 / 17:20:41 / cg"
@@ -1045,7 +1047,7 @@
w := self unsignedLongLongAt:index bigEndian:IsBigEndian.
(w > (16r7FFFFFFFFFFFFFFF)) ifTrue:[
- ^ w - (16r10000000000000000)
+ ^ w - (16r10000000000000000)
].
^ w
@@ -2127,9 +2129,9 @@
|v|
value >= 0 ifTrue:[
- v := value
+ v := value
] ifFalse:[
- v := 16r10000 + value
+ v := 16r10000 + value
].
self unsignedShortAt:index put:v bigEndian:IsBigEndian.
^ value
@@ -3174,11 +3176,11 @@
!UninterpretedBytes class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.101 2015-04-24 12:17:11 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.102 2015-05-16 09:46:43 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.101 2015-04-24 12:17:11 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.102 2015-05-16 09:46:43 cg Exp $'
! !
--- a/UnixOperatingSystem.st Sat May 16 06:48:37 2015 +0200
+++ b/UnixOperatingSystem.st Mon May 18 07:10:20 2015 +0100
@@ -5074,6 +5074,17 @@
encodedPathName := self encodePath:aPathName.
%{
+#ifdef __SCHTEAM__
+ if (encodedPathName.isStringLike()) {
+ java.io.File file = new java.io.File( encodedPathName.asString() );
+ int _mode;
+
+ if (file.exists() && file.isDirectory()) {
+ return __c__._RETURN_true();
+ }
+ return __c__._RETURN_false();
+ }
+#else
int ret;
if (__isStringLike(encodedPathName)) {
@@ -5093,6 +5104,7 @@
}
RETURN ( ((buf.st_mode & S_IFMT) == S_IFDIR) ? true : false);
}
+#endif /* not SCHTEAM */
%}.
^ self primitiveFailed
@@ -5110,6 +5122,17 @@
encodedPathName := self encodePath:aPathName.
%{
+#ifdef __SCHTEAM__
+ if (encodedPathName.isStringLike()) {
+ java.io.File file = new java.io.File( encodedPathName.asString() );
+ int _mode;
+
+ if (file.exists() && file.canExecute()) {
+ return __c__._RETURN_true();
+ }
+ return __c__._RETURN_false();
+ }
+#else
int ret;
if (__isStringLike(encodedPathName)) {
@@ -5126,6 +5149,7 @@
}
RETURN ( ((ret == 0) ? true : false) );
}
+#endif /* not SCHTEAM */
%}.
^ self primitiveFailed
!
@@ -5138,6 +5162,17 @@
encodedPathName := self encodePath:aPathName.
%{
+#ifdef __SCHTEAM__
+ if (encodedPathName.isStringLike()) {
+ java.io.File file = new java.io.File( encodedPathName.asString() );
+ int _mode;
+
+ if (file.exists() && file.canRead()) {
+ return __c__._RETURN_true();
+ }
+ return __c__._RETURN_false();
+ }
+#else
int ret;
if (__isStringLike(encodedPathName)) {
@@ -5154,6 +5189,7 @@
}
RETURN ( ((ret == 0) ? true : false) );
}
+#endif /* not SCHTEAM */
%}.
^ self primitiveFailed
!
@@ -5166,6 +5202,17 @@
encodedPathName := self encodePath:aPathName.
%{
+#ifdef __SCHTEAM__
+ if (encodedPathName.isStringLike()) {
+ java.io.File file = new java.io.File( encodedPathName.asString() );
+ int _mode;
+
+ if (file.exists()) {
+ return __c__._RETURN_true();
+ }
+ return __c__._RETURN_false();
+ }
+#else
struct stat buf;
int ret;
@@ -5184,6 +5231,7 @@
}
RETURN ( ret ? false : true );
}
+#endif /* not SCHTEAM */
%}.
^ self primitiveFailed
@@ -5199,6 +5247,17 @@
encodedPathName := self encodePath:aPathName.
%{
+#ifdef __SCHTEAM__
+ if (encodedPathName.isStringLike()) {
+ java.io.File file = new java.io.File( encodedPathName.asString() );
+ int _mode;
+
+ if (file.exists() && file.canWrite()) {
+ return __c__._RETURN_true();
+ }
+ return __c__._RETURN_false();
+ }
+#else
int ret;
if (__isStringLike(encodedPathName)) {
@@ -5215,6 +5274,7 @@
}
RETURN ( ((ret == 0) ? true : false) );
}
+#endif /* not SCHTEAM */
%}.
^ self primitiveFailed
!
@@ -5224,7 +5284,7 @@
The info (for which corresponding access methods are understood by
the returned object) is:
- type - a symbol giving the files type
+ type - a symbol giving the file's type
mode - numeric access mode
uid - owners user id
gid - owners group id
@@ -5256,7 +5316,39 @@
encodedPathName := self encodePath:aPathName.
%{ /* STACK: 1200 */
-#if defined(S_IFLNK)
+#ifdef __SCHTEAM__
+ if (encodedPathName.isStringLike()) {
+ java.io.File file = new java.io.File( encodedPathName.asString() );
+ int _mode;
+
+ if (file.isDirectory()) {
+ type = STSymbol._new("directory");
+ } else if (file.isFile()) {
+ type = STSymbol._new("regular");
+ } else {
+ type = STSymbol._new("unknown");
+ }
+ _mode = 0;
+ if (file.canRead()) {
+ _mode |= 0444;
+ }
+ if (file.canWrite()) {
+ _mode |= 0222;
+ }
+ if (file.canExecute()) {
+ _mode |= 0111;
+ }
+ mode = STInteger._new( _mode );
+ uid = STInteger._0;
+ gid = STInteger._0;
+ nLink = STInteger._0;
+ size = STInteger._new( file.length());
+ aOStime = STInteger._new( file.lastModified() );
+ mOStime = STInteger._new( file.lastModified() );
+ cOStime = STInteger._new( file.lastModified() );
+ path = new STString( file.getPath() );
+ }
+#else
struct stat buf;
int ret;
char pathBuffer[1024];
@@ -5273,7 +5365,7 @@
RETURN ( nil );
}
switch (buf.st_mode & S_IFMT) {
- # ifdef S_IFLNK
+# ifdef S_IFLNK
case S_IFLNK:
type = @symbol(symbolicLink);
if ((ret = readlink((char *) __stringVal(encodedPathName), pathBuffer, sizeof(pathBuffer))) < 0) {
@@ -5283,7 +5375,7 @@
pathBuffer[ret] = '\0'; /* readlink does not 0-terminate */
path = __MKSTRING(pathBuffer);
break;
- # endif
+# endif
case S_IFDIR:
type = @symbol(directory);
break;
@@ -5291,36 +5383,36 @@
case S_IFREG:
type = @symbol(regular);
break;
- # ifdef S_IFCHR
+# ifdef S_IFCHR
case S_IFCHR:
type = @symbol(characterSpecial);
break;
- # endif
- # ifdef S_IFBLK
+# endif
+# ifdef S_IFBLK
case S_IFBLK:
type = @symbol(blockSpecial);
break;
- # endif
- # ifdef S_IFMPC
+# endif
+# ifdef S_IFMPC
case S_IFMPC:
type = @symbol(multiplexedCharacterSpecial);
break;
- # endif
- # ifdef S_IFMPB
+# endif
+# ifdef S_IFMPB
case S_IFMPB:
type = @symbol(multiplexedBlockSpecial);
break;
- # endif
- # ifdef S_IFSOCK
+# endif
+# ifdef S_IFSOCK
case S_IFSOCK:
type = @symbol(socket);
break;
- # endif
- # ifdef S_IFIFO
+# endif
+# ifdef S_IFIFO
case S_IFIFO:
type = @symbol(fifo);
break;
- # endif
+# endif
default:
type = @symbol(unknown);
break;
@@ -5344,9 +5436,7 @@
mOStime = __MKUINT(buf.st_mtime);
cOStime = __MKUINT(buf.st_ctime);
}
-#else
- RETURN ( nil );
-#endif
+#endif /* not SCHTEAM */
%}.
mode notNil ifTrue:[
@@ -5577,9 +5667,17 @@
|error|
%{ /* UNLIMITEDSTACK */
-
+#ifdef __SCHTEAM__
+ if (pathName.isStringLike()) {
+ java.io.File file = new java.io.File( pathName.asString() );
+
+ if (file.exists()) {
+ return __c__._RETURN( new STString( file.getAbsolutePath() ));
+ }
+ }
+#else
if (__isStringLike(pathName)) {
-#ifdef HAS_REALPATH
+# ifdef HAS_REALPATH
extern char *realpath();
// POSIX-2008 says, that a NULL namebuffer causes realPath to malloc()
@@ -5592,10 +5690,11 @@
RETURN ( ret );
}
// fprintf(stderr, "stx[warning]: realpath(\"%s\") failed: %s\n", __stringVal(pathName), strerror(errno));
-#endif /* ! HAS_REALPATH */
+# endif /* ! HAS_REALPATH */
} else {
error = @symbol(argument); // argument is not a string
}
+#endif
%}.
"/ Does not work as of 2013-04 (UNLIMITEDSTACK problem?)
"/ error notNil ifTrue:[
@@ -14285,11 +14384,11 @@
!UnixOperatingSystem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.438 2015-05-03 12:39:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.439 2015-05-16 09:47:43 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.438 2015-05-03 12:39:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.439 2015-05-16 09:47:43 cg Exp $'
! !