.
--- a/AbstrTime.st Tue Jun 27 04:15:21 1995 +0200
+++ b/AbstrTime.st Sun Jul 02 03:08:30 1995 +0200
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/AbstrTime.st,v 1.2 1995-02-21 01:05:47 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/AbstrTime.st,v 1.3 1995-07-02 01:05:19 claus Exp $
"
! !
@@ -70,9 +70,9 @@
^ self basicNew setSeconds:seconds
"
- Time fromSeconds:0 "/ should return midnight
- AbsoluteTime fromSeconds:0 "/ on UNIX: returns 1st. Jan 1970
- "/ on others: dont know
+ Time fromSeconds:0 should return midnight
+ AbsoluteTime fromSeconds:0 on UNIX: returns 1st. Jan 1970
+ on others: dont know
"
!
@@ -118,16 +118,26 @@
!
fromOSTimeTimeLow:lowTime and:hiTime
- "set my time, from operatingSystems time parts"
+ "set my time, from operatingSystems time parts.
+ Since I am abstract (not knowing how the time is actually
+ represented), this must be done by a concrete class."
^ self subclassResponsibility
!
setSeconds:secs
+ "set the seconds.
+ Since I am abstract (not knowing how the time is actually
+ represented), this must be done by a concrete class."
+
^ self subclassResponsibility
!
getSeconds
+ "get the seconds.
+ Since I am abstract (not knowing how the time is actually
+ represented), this must be done by a concrete class."
+
^ self subclassResponsibility
! !
--- a/AbstractTime.st Tue Jun 27 04:15:21 1995 +0200
+++ b/AbstractTime.st Sun Jul 02 03:08:30 1995 +0200
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/AbstractTime.st,v 1.2 1995-02-21 01:05:47 claus Exp $
+$Header: /cvs/stx/stx/libbasic/AbstractTime.st,v 1.3 1995-07-02 01:05:19 claus Exp $
"
! !
@@ -70,9 +70,9 @@
^ self basicNew setSeconds:seconds
"
- Time fromSeconds:0 "/ should return midnight
- AbsoluteTime fromSeconds:0 "/ on UNIX: returns 1st. Jan 1970
- "/ on others: dont know
+ Time fromSeconds:0 should return midnight
+ AbsoluteTime fromSeconds:0 on UNIX: returns 1st. Jan 1970
+ on others: dont know
"
!
@@ -118,16 +118,26 @@
!
fromOSTimeTimeLow:lowTime and:hiTime
- "set my time, from operatingSystems time parts"
+ "set my time, from operatingSystems time parts.
+ Since I am abstract (not knowing how the time is actually
+ represented), this must be done by a concrete class."
^ self subclassResponsibility
!
setSeconds:secs
+ "set the seconds.
+ Since I am abstract (not knowing how the time is actually
+ represented), this must be done by a concrete class."
+
^ self subclassResponsibility
!
getSeconds
+ "get the seconds.
+ Since I am abstract (not knowing how the time is actually
+ represented), this must be done by a concrete class."
+
^ self subclassResponsibility
! !
--- a/ArrColl.st Tue Jun 27 04:15:21 1995 +0200
+++ b/ArrColl.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/ArrColl.st,v 1.19 1995-06-27 02:11:19 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ArrColl.st,v 1.20 1995-07-02 01:05:24 claus Exp $
'!
!ArrayedCollection class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/ArrColl.st,v 1.19 1995-06-27 02:11:19 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ArrColl.st,v 1.20 1995-07-02 01:05:24 claus Exp $
"
!
@@ -50,6 +50,25 @@
"
ArrayedCollection is an abstract superclass for all collections where
the elements can be accessed via an integer index.
+ And the collection is a fixed size collection. Those fixed size collections
+ cannot easily grow, since they store the elements directly within the
+ object and a grow operation can only be done by becoming another object.
+ (other collections keep a reference to the physical container, which
+ can be easily replaced)
+
+ Notice: currently, ST/X supports growing fix-size collections
+ (such as Arrays, ByteArrays and Strings). However, this
+ can only be done in a very slow way (using become).
+ Therefore, you SHOULD rewrite any application that does this
+ to make use of OrderedCollection or any other collection which
+ can grow faster.
+ To remind you of that, a warning message is sent to the
+ standard error whenever such an operation is performed.
+
+ Also note, that some other smalltalk systems do NOT allow
+ fix size collection to change their size, and that future
+ ST/X versions may be changed to trigger an error (instead of a
+ warning) in those situations.
"
! !
@@ -218,16 +237,16 @@
|newArray oldSize|
- "/
- "/ output a warning - you should rewrite your application
- "/ to use some collection which implements grow: more efficient
- "/ (i.e. use OrderedCollection instead of Array ..)
- "/
- 'ARRCOLL: Warning: slow grow operation (' infoPrint.
- self class name infoPrint. ')' infoPrintNL.
-
oldSize := self size.
(newSize ~~ oldSize) ifTrue:[
+ "/
+ "/ output a warning - you should rewrite your application
+ "/ to use some collection which implements grow: more efficient
+ "/ (i.e. use OrderedCollection instead of Array ..)
+ "/
+ 'ARRCOLL: Warning: slow grow operation (' infoPrint.
+ self class name infoPrint. ')' infoPrintNL.
+
newArray := self species new:newSize.
newArray replaceFrom:1 to:(newSize min:oldSize) with:self.
self become:newArray.
@@ -239,6 +258,18 @@
'hello world' copy grow:5
'hello' copy grow:20
"
+!
+
+removeAll
+ 'ARRCOLL: Warning: slow remove operation (' infoPrint.
+ self class name infoPrint. ')' infoPrintNL.
+
+ self become:(self copyEmpty)
+
+ "
+ #(1 2 3 4 5) copy removeAll
+ #(1 2 3 4 5) removeAll
+ "
! !
!ArrayedCollection methodsFor:'error handling'!
--- a/Array.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Array.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Array.st,v 1.29 1995-06-27 02:11:23 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Array.st,v 1.30 1995-07-02 01:05:28 claus Exp $
'!
!Array class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Array.st,v 1.29 1995-06-27 02:11:23 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Array.st,v 1.30 1995-07-02 01:05:28 claus Exp $
"
!
@@ -121,7 +121,7 @@
/*
* knowing that nil is 0
*/
-#ifdef mips
+#ifdef XXmips
# undef FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
# undef FAST_ARRAY_MEMSET_LONGLONG_UNROLLED
/* seems to be slightly faster */
@@ -230,9 +230,16 @@
Bad luck - you should increase the swap space on your machine.
"
^ ObjectMemory allocationFailureSignal raise.
-!
+! !
+
+!Array class ignoredMethodsFor:'instance creation'!
with:one
+ "redefined for performance.
+ I really dont know, if it is worth it.
+ Detailed measurements may show that this can be removed to save some
+ space."
+
%{ /* NOCONTEXT */
if (_ClassInstPtr(self)->c_ninstvars == __MKSMALLINT(0)) {
if (_CanDoQuickAlignedNew(sizeof(struct __arrayheader) + __OBJS2BYTES__(1))) {
@@ -250,6 +257,11 @@
!
with:one with:two
+ "redefined for performance.
+ I really dont know, if it is worth it.
+ Detailed measurements may show that this can be removed to save some
+ space."
+
%{ /* NOCONTEXT */
if (_ClassInstPtr(self)->c_ninstvars == __MKSMALLINT(0)) {
if (_CanDoQuickAlignedNew(sizeof(struct __arrayheader) + __OBJS2BYTES__(2))) {
@@ -269,6 +281,11 @@
!
with:one with:two with:three
+ "redefined for performance.
+ I really dont know, if it is worth it.
+ Detailed measurements may show that this can be removed to save some
+ space."
+
%{ /* NOCONTEXT */
if (_ClassInstPtr(self)->c_ninstvars == __MKSMALLINT(0)) {
if (_CanDoQuickAlignedNew(sizeof(struct __arrayheader) + __OBJS2BYTES__(3))) {
@@ -290,6 +307,10 @@
!
with:one with:two with:three with:four
+ "redefined for performance.
+ I really dont know, if it is worth it.
+ Detailed measurements may show that this can be removed to save some
+ space."
%{ /* NOCONTEXT */
if (_ClassInstPtr(self)->c_ninstvars == __MKSMALLINT(0)) {
--- a/ArrayedCollection.st Tue Jun 27 04:15:21 1995 +0200
+++ b/ArrayedCollection.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/ArrayedCollection.st,v 1.19 1995-06-27 02:11:19 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ArrayedCollection.st,v 1.20 1995-07-02 01:05:24 claus Exp $
'!
!ArrayedCollection class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/ArrayedCollection.st,v 1.19 1995-06-27 02:11:19 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ArrayedCollection.st,v 1.20 1995-07-02 01:05:24 claus Exp $
"
!
@@ -50,6 +50,25 @@
"
ArrayedCollection is an abstract superclass for all collections where
the elements can be accessed via an integer index.
+ And the collection is a fixed size collection. Those fixed size collections
+ cannot easily grow, since they store the elements directly within the
+ object and a grow operation can only be done by becoming another object.
+ (other collections keep a reference to the physical container, which
+ can be easily replaced)
+
+ Notice: currently, ST/X supports growing fix-size collections
+ (such as Arrays, ByteArrays and Strings). However, this
+ can only be done in a very slow way (using become).
+ Therefore, you SHOULD rewrite any application that does this
+ to make use of OrderedCollection or any other collection which
+ can grow faster.
+ To remind you of that, a warning message is sent to the
+ standard error whenever such an operation is performed.
+
+ Also note, that some other smalltalk systems do NOT allow
+ fix size collection to change their size, and that future
+ ST/X versions may be changed to trigger an error (instead of a
+ warning) in those situations.
"
! !
@@ -218,16 +237,16 @@
|newArray oldSize|
- "/
- "/ output a warning - you should rewrite your application
- "/ to use some collection which implements grow: more efficient
- "/ (i.e. use OrderedCollection instead of Array ..)
- "/
- 'ARRCOLL: Warning: slow grow operation (' infoPrint.
- self class name infoPrint. ')' infoPrintNL.
-
oldSize := self size.
(newSize ~~ oldSize) ifTrue:[
+ "/
+ "/ output a warning - you should rewrite your application
+ "/ to use some collection which implements grow: more efficient
+ "/ (i.e. use OrderedCollection instead of Array ..)
+ "/
+ 'ARRCOLL: Warning: slow grow operation (' infoPrint.
+ self class name infoPrint. ')' infoPrintNL.
+
newArray := self species new:newSize.
newArray replaceFrom:1 to:(newSize min:oldSize) with:self.
self become:newArray.
@@ -239,6 +258,18 @@
'hello world' copy grow:5
'hello' copy grow:20
"
+!
+
+removeAll
+ 'ARRCOLL: Warning: slow remove operation (' infoPrint.
+ self class name infoPrint. ')' infoPrintNL.
+
+ self become:(self copyEmpty)
+
+ "
+ #(1 2 3 4 5) copy removeAll
+ #(1 2 3 4 5) removeAll
+ "
! !
!ArrayedCollection methodsFor:'error handling'!
--- a/Autoload.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Autoload.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.23 1995-06-27 02:11:28 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.24 1995-07-02 01:05:34 claus Exp $
'!
!Autoload class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.23 1995-06-27 02:11:28 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.24 1995-07-02 01:05:34 claus Exp $
"
!
@@ -95,6 +95,9 @@
!Autoload class methodsFor:'queries'!
isBehavior
+ "return true if the recevier is some kind of class.
+ Autoloaded classes are definitely; therefore return true."
+
^ true
!
@@ -284,6 +287,9 @@
!
comment
+ "return the classes comment.
+ Autoloaded classes have no comment; but I myself have one"
+
(self == Autoload) ifTrue:[^ super comment].
^ 'not yet loaded'
! !
--- a/BContext.st Tue Jun 27 04:15:21 1995 +0200
+++ b/BContext.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/BContext.st,v 1.14 1995-06-06 03:52:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/BContext.st,v 1.15 1995-07-02 01:05:37 claus Exp $
'!
!BlockContext class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/BContext.st,v 1.14 1995-06-06 03:52:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/BContext.st,v 1.15 1995-07-02 01:05:37 claus Exp $
"
!
@@ -66,6 +66,14 @@
^ true
!
+canReturn
+ "return true, if the receiver allows returning through it.
+ For normal method contexts, this normally returns true;
+ for blocks, it (currently) always returns false."
+
+ ^ false
+!
+
methodHome
"return the method-home for block contexts"
--- a/Behavior.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Behavior.st Sun Jul 02 03:08:30 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.41 1995-06-27 02:11:35 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.42 1995-07-02 01:05:42 claus Exp $
'!
!Behavior class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.41 1995-06-27 02:11:35 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.42 1995-07-02 01:05:42 claus Exp $
"
!
@@ -856,7 +856,7 @@
/*
* knowing that nil is 0
*/
-#ifdef mips
+#ifdef XXmips
# undef FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
# undef FAST_ARRAY_MEMSET_LONGLONG_UNROLLED
/* seems to be slightly faster */
--- a/BlockContext.st Tue Jun 27 04:15:21 1995 +0200
+++ b/BlockContext.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.14 1995-06-06 03:52:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.15 1995-07-02 01:05:37 claus Exp $
'!
!BlockContext class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.14 1995-06-06 03:52:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.15 1995-07-02 01:05:37 claus Exp $
"
!
@@ -66,6 +66,14 @@
^ true
!
+canReturn
+ "return true, if the receiver allows returning through it.
+ For normal method contexts, this normally returns true;
+ for blocks, it (currently) always returns false."
+
+ ^ false
+!
+
methodHome
"return the method-home for block contexts"
--- a/CharArray.st Tue Jun 27 04:15:21 1995 +0200
+++ b/CharArray.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/CharArray.st,v 1.25 1995-06-27 02:11:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/CharArray.st,v 1.26 1995-07-02 01:05:54 claus Exp $
'!
!CharacterArray class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/CharArray.st,v 1.25 1995-06-27 02:11:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/CharArray.st,v 1.26 1995-07-02 01:05:54 claus Exp $
"
!
@@ -614,6 +614,32 @@
"
!
+withoutLeadingSeparators
+ "return a copy of myself without leading separators.
+ Notice: this does remove tabs, newline or any other whitespace.
+ Returns an empty string, if the receiver consist only of whitespace."
+
+ |index|
+
+ index := self indexOfNonSeparatorStartingAt:1.
+ index ~~ 0 ifTrue:[
+ index == 1 ifTrue:[
+ ^ self
+ ].
+ ^ self copyFrom:index
+ ].
+ ^ ''
+
+ "
+ ' foo ' withoutLeadingSeparators
+ 'foo ' withoutLeadingSeparators
+ ' foo' withoutLeadingSeparators
+ ' ' withoutLeadingSeparators
+ 'foo' withoutLeadingSeparators
+ (' ' , Character tab asString , ' foo ') withoutLeadingSeparators inspect
+ "
+!
+
withTabs
"return a copy of the receiver where leading spaces are
replaced by tabulator characters (assuming 8-col tabs)"
--- a/CharacterArray.st Tue Jun 27 04:15:21 1995 +0200
+++ b/CharacterArray.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.25 1995-06-27 02:11:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.26 1995-07-02 01:05:54 claus Exp $
'!
!CharacterArray class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.25 1995-06-27 02:11:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.26 1995-07-02 01:05:54 claus Exp $
"
!
@@ -614,6 +614,32 @@
"
!
+withoutLeadingSeparators
+ "return a copy of myself without leading separators.
+ Notice: this does remove tabs, newline or any other whitespace.
+ Returns an empty string, if the receiver consist only of whitespace."
+
+ |index|
+
+ index := self indexOfNonSeparatorStartingAt:1.
+ index ~~ 0 ifTrue:[
+ index == 1 ifTrue:[
+ ^ self
+ ].
+ ^ self copyFrom:index
+ ].
+ ^ ''
+
+ "
+ ' foo ' withoutLeadingSeparators
+ 'foo ' withoutLeadingSeparators
+ ' foo' withoutLeadingSeparators
+ ' ' withoutLeadingSeparators
+ 'foo' withoutLeadingSeparators
+ (' ' , Character tab asString , ' foo ') withoutLeadingSeparators inspect
+ "
+!
+
withTabs
"return a copy of the receiver where leading spaces are
replaced by tabulator characters (assuming 8-col tabs)"
--- a/Class.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Class.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.46 1995-06-27 02:12:11 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Class.st,v 1.47 1995-07-02 01:06:03 claus Exp $
'!
!Class class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.46 1995-06-27 02:12:11 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Class.st,v 1.47 1995-07-02 01:06:03 claus Exp $
"
!
@@ -614,19 +614,22 @@
primitiveDefinitions:aString
"set the primitiveDefinition string"
- ^ self setPrimitiveSpecsAt:1 to:aString
+ self setPrimitiveSpecsAt:1 to:aString.
+ self addChangeRecordForPrimitiveDefinitions:self
!
primitiveVariables:aString
"set the primitiveVariable string"
- ^ self setPrimitiveSpecsAt:2 to:aString
+ self setPrimitiveSpecsAt:2 to:aString.
+ self addChangeRecordForPrimitiveVariables:self
!
primitiveFunctions:aString
"set the primitiveFunction string"
- ^ self setPrimitiveSpecsAt:3 to:aString
+ self setPrimitiveSpecsAt:3 to:aString.
+ self addChangeRecordForPrimitiveFunctions:self
!
classFilename
@@ -1024,6 +1027,33 @@
aStream nextPut:(aStream class chunkSeparator).
!
+addChangeRecordForPrimitiveVariables:aClass to:aStream
+ "append a primitiveVariables-record to aStream"
+
+ aStream nextPutAll:aClass name
+ , ' primitiveVariables: '
+ , aClass primitiveVariablesString storeString.
+ aStream nextPut:(aStream class chunkSeparator).
+!
+
+addChangeRecordForPrimitiveDefinitions:aClass to:aStream
+ "append a primitiveDefinitions-record to aStream"
+
+ aStream nextPutAll:aClass name
+ , ' primitiveDefinitions: '
+ , aClass primitiveDefinitionsString storeString.
+ aStream nextPut:(aStream class chunkSeparator).
+!
+
+addChangeRecordForPrimitiveFunctions:aClass to:aStream
+ "append a primitiveFunctions-record to aStream"
+
+ aStream nextPutAll:aClass name
+ , ' primitiveFunctions: '
+ , aClass primitiveFunctionsString storeString.
+ aStream nextPut:(aStream class chunkSeparator).
+!
+
addChangeRecordForClassRename:oldName to:newName to:aStream
"append a class-rename-record to aStream"
@@ -1123,6 +1153,24 @@
self writingChangePerform:#addChangeRecordForClassComment:to: with:aClass.
!
+addChangeRecordForPrimitiveVariables:aClass
+ "add a primitiveVariables-record to the changes file"
+
+ self writingChangePerform:#addChangeRecordForPrimitiveVariables:to: with:aClass.
+!
+
+addChangeRecordForPrimitiveDefinitions:aClass
+ "add a primitiveDefinitions-record to the changes file"
+
+ self writingChangePerform:#addChangeRecordForPrimitiveDefinitions:to: with:aClass.
+!
+
+addChangeRecordForPrimitiveFunctions:aClass
+ "add a primitiveFunctions-record to the changes file"
+
+ self writingChangePerform:#addChangeRecordForPrimitiveFunctions:to: with:aClass.
+!
+
addChangeRecordForClassRename:oldName to:newName
"add a class-rename-record to the changes file"
--- a/Coll.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Coll.st Sun Jul 02 03:08:30 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/Coll.st,v 1.34 1995-05-18 15:09:00 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/Coll.st,v 1.35 1995-07-02 01:06:10 claus Exp $
'!
!Collection class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/Coll.st,v 1.34 1995-05-18 15:09:00 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/Coll.st,v 1.35 1995-07-02 01:06:10 claus Exp $
"
!
@@ -433,7 +433,12 @@
!
removeAll:aCollection
- "remove all elements of the argument, aCollection from the receiver"
+ "remove all elements of the argument, aCollection from the receiver.
+ Notice: for some collections (those not tuned for
+ resizing themself) this may be very slow.
+ If the number of removed elements is big compared to to
+ the receivers size, it may be better to copy the
+ ones which are not to be removed into a new collection."
aCollection do:[:element | self remove:element].
^ aCollection
@@ -455,7 +460,9 @@
removeFirst:n
"remove the first n elements from the receiver.
- Return an array filled with the removed elements."
+ Return an array filled with the removed elements.
+ Notice: for some collections (those not tuned for
+ resizing themself) this may be very slow."
|ret|
@@ -471,7 +478,9 @@
removeLast:n
"remove the last n elements from the receiver.
- Return an array filled with the removed elements."
+ Return an array filled with the removed elements.
+ Notice: for some collections (those not tuned for
+ resizing themself) this may be very slow."
|ret|
@@ -488,7 +497,8 @@
!Collection methodsFor:'growing'!
growSize
- "return a suitable size increment for growing"
+ "return a suitable size increment for growing.
+ The default returned here may be (and is) redefined in subclasses."
^ self size max:2
!
@@ -520,7 +530,10 @@
!
includes:anElement
- "return true, if the argument, anObject is in the list"
+ "return true, if an object equal to the argument, anObject is in the list.
+ This compares using #= (i.e. it does not look for the object itself,
+ instead, one that compares equal).
+ See #includesIdentical: when identity is asked for."
self do:[:element |
(anElement = element) ifTrue:[^ true].
@@ -528,9 +541,23 @@
^ false
!
+includesIdentical:anElement
+ "return true, if the argument, anObject is in the list.
+ This compares using #== (i.e. object identity).
+ See #includes: when equality is asked for."
+
+ self do:[:element |
+ (anElement == element) ifTrue:[^ true].
+ ].
+ ^ false
+!
+
includesAll:aCollection
"return true, if the the receiver includes all elements of
- the argument, aCollection; false if any is missing"
+ the argument, aCollection; false if any is missing.
+ Notice: this method has O-square runtime behavior and may be
+ slow for big receivers/args. Think about using a Set,
+ or Dictionary."
aCollection do:[:element |
(self includes:element) ifFalse:[^ false].
@@ -546,7 +573,12 @@
includesAny:aCollection
"return true, if the the receiver includes any elements of
- the argument, aCollection; false if it includes none"
+ the argument, aCollection; false if it includes none.
+ Notice: this method has O-square runtime behavior and may be
+ slow for big receivers/args. Think about using a Set,
+ or Dictionary. Speedup is possible, by arrangy highly
+ probable elements towards the beginning of aCollection,
+ to avoid useless searches."
aCollection do:[:element |
(self includes:element) ifTrue:[^ true].
@@ -589,6 +621,16 @@
^ count
!
+capacity
+ "return the number of elements, that the receiver is
+ prepared to take. For most collections, this is the actual
+ size. However, some have more space preallocated to allow
+ for faster adding of elements.
+ Not used by the system; added for ST-80 compatibility."
+
+ ^ self size
+!
+
max
"return the maximum value in the receiver collection"
--- a/Collection.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Collection.st Sun Jul 02 03:08:30 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.34 1995-05-18 15:09:00 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.35 1995-07-02 01:06:10 claus Exp $
'!
!Collection class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.34 1995-05-18 15:09:00 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.35 1995-07-02 01:06:10 claus Exp $
"
!
@@ -433,7 +433,12 @@
!
removeAll:aCollection
- "remove all elements of the argument, aCollection from the receiver"
+ "remove all elements of the argument, aCollection from the receiver.
+ Notice: for some collections (those not tuned for
+ resizing themself) this may be very slow.
+ If the number of removed elements is big compared to to
+ the receivers size, it may be better to copy the
+ ones which are not to be removed into a new collection."
aCollection do:[:element | self remove:element].
^ aCollection
@@ -455,7 +460,9 @@
removeFirst:n
"remove the first n elements from the receiver.
- Return an array filled with the removed elements."
+ Return an array filled with the removed elements.
+ Notice: for some collections (those not tuned for
+ resizing themself) this may be very slow."
|ret|
@@ -471,7 +478,9 @@
removeLast:n
"remove the last n elements from the receiver.
- Return an array filled with the removed elements."
+ Return an array filled with the removed elements.
+ Notice: for some collections (those not tuned for
+ resizing themself) this may be very slow."
|ret|
@@ -488,7 +497,8 @@
!Collection methodsFor:'growing'!
growSize
- "return a suitable size increment for growing"
+ "return a suitable size increment for growing.
+ The default returned here may be (and is) redefined in subclasses."
^ self size max:2
!
@@ -520,7 +530,10 @@
!
includes:anElement
- "return true, if the argument, anObject is in the list"
+ "return true, if an object equal to the argument, anObject is in the list.
+ This compares using #= (i.e. it does not look for the object itself,
+ instead, one that compares equal).
+ See #includesIdentical: when identity is asked for."
self do:[:element |
(anElement = element) ifTrue:[^ true].
@@ -528,9 +541,23 @@
^ false
!
+includesIdentical:anElement
+ "return true, if the argument, anObject is in the list.
+ This compares using #== (i.e. object identity).
+ See #includes: when equality is asked for."
+
+ self do:[:element |
+ (anElement == element) ifTrue:[^ true].
+ ].
+ ^ false
+!
+
includesAll:aCollection
"return true, if the the receiver includes all elements of
- the argument, aCollection; false if any is missing"
+ the argument, aCollection; false if any is missing.
+ Notice: this method has O-square runtime behavior and may be
+ slow for big receivers/args. Think about using a Set,
+ or Dictionary."
aCollection do:[:element |
(self includes:element) ifFalse:[^ false].
@@ -546,7 +573,12 @@
includesAny:aCollection
"return true, if the the receiver includes any elements of
- the argument, aCollection; false if it includes none"
+ the argument, aCollection; false if it includes none.
+ Notice: this method has O-square runtime behavior and may be
+ slow for big receivers/args. Think about using a Set,
+ or Dictionary. Speedup is possible, by arrangy highly
+ probable elements towards the beginning of aCollection,
+ to avoid useless searches."
aCollection do:[:element |
(self includes:element) ifTrue:[^ true].
@@ -589,6 +621,16 @@
^ count
!
+capacity
+ "return the number of elements, that the receiver is
+ prepared to take. For most collections, this is the actual
+ size. However, some have more space preallocated to allow
+ for faster adding of elements.
+ Not used by the system; added for ST-80 compatibility."
+
+ ^ self size
+!
+
max
"return the maximum value in the receiver collection"
--- a/Context.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Context.st Sun Jul 02 03:08:30 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Context.st,v 1.33 1995-05-16 17:06:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Context.st,v 1.34 1995-07-02 01:06:16 claus Exp $
'!
!Context class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Context.st,v 1.33 1995-05-16 17:06:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Context.st,v 1.34 1995-07-02 01:06:16 claus Exp $
"
!
@@ -428,6 +428,26 @@
lineNr isNil ifTrue:[^ nil].
^ lineNr bitAnd:16rFFFF
+!
+
+canReturn
+ "return true, if the receiver allows returning through it.
+ For normal method contexts, this normally returns true;
+ for blocks, it (currently) always returns false.
+
+ However, the system can be compiled (for production code), to create
+ contexts which cannot be returned or restarted
+ (except, if the method contains a returning block).
+ This saves some administrative work in every method
+ invocation and makes overall execution faster. However, it limits
+ the debugger, in that it cannot return from or restart those contexts.
+ (unwinding and termination is not affected by this optimization)
+ Currently, the system as delivered has this optimization disabled."
+
+%{ /* NOCONTEXT */
+
+ RETURN ( (_intVal(_INST(flags)) & __CANNOT_RETURN) ? false : true );
+%}
! !
!Context methodsFor:'printing & storing'!
@@ -553,18 +573,45 @@
method in a block).
We raise a signal here, to allow catching of that situation."
- "
- in previous versions of ST/X and ST-80, this was no error;
- (instead, a normal blockreturn was performed to the value-sender)
- comment out the raise to get that (old) behavior
- BETTER REWRITE YOUR APPLICATION
- "
+ self canReturn ifTrue:[
+ "
+ in previous versions of ST/X and ST-80, this was no error;
+ (instead, a normal blockreturn was performed to the value-sender)
+ comment out the raise to get that (old) behavior
+ BETTER REWRITE YOUR APPLICATION
+ "
"/ new behavior:
- ^ InvalidReturnSignal raiseRequestWith:returnValue.
+ ^ InvalidReturnSignal
+ raiseRequestWith:returnValue.
"/ old behavior:
-"/ ^ returnValue
+"/ ^ returnValue
+ ].
+ ^ InvalidReturnSignal
+ raiseRequestWith:returnValue
+ errorString:'method was compiled non-resumable'
+!
+
+invalidReturnOrRestartError:how with:value
+ "common error reporter for restart/return errors"
+
+ self canReturn ifTrue:[
+ "
+ tried to return from/restart a context which is already dead
+ (i.e. the method/block has already executed a return)
+ "
+ ^ InvalidReturnSignal
+ raiseRequestWith:value
+ errorString:(how , ': context not on calling chain')
+ ].
+ "
+ tried to return from/restart a context of a method which was compiled
+ unrestartable or of a block (which is never restartable)
+ "
+ ^ InvalidReturnSignal
+ raiseRequestWith:value
+ errorString:(how , ': context cannot be restarted/returned from')
! !
!Context methodsFor:'non local control flow'!
@@ -585,24 +632,12 @@
sender isNil ifTrue:[^ nil].
%{
__RESUMECONTEXT__(SND_COMMA self, RESTART_VALUE, 0);
-
- /* when we reach here, something went wrong */
-%}
-.
+%}.
"
+ when we arrive here, something went wrong.
debugging ...
"
-"
- 'restart: context not on calling chain' errorPrintNL.
- ^ self error:'restart: context not on calling chain'.
-"
- "
- tried to restart a context which is already dead
- (i.e. the method/block has already executed a return)
- "
- ^ InvalidReturnSignal
- raiseRequestWith:nil
- errorString:'restart: context not on calling chain'
+ ^ self invalidReturnOrRestartError:#restart with:nil
!
return
@@ -634,23 +669,12 @@
%{
__RESUMECONTEXT__(SND_COMMA self, value, 0);
- /* when we reach here, something went wrong */
-%}
-.
+%}.
"
+ when we arrive here, something went wrong.
debugging ...
"
-"
- 'return: context not on calling chain' errorPrintNL.
- ^ self error:'return: context not on calling chain'.
-"
- "
- tried to return a context which is already dead
- (i.e. the method/block has already executed a return)
- "
- ^ InvalidReturnSignal
- raiseRequestWith:value
- errorString:'return: context not on calling chain'
+ ^ self invalidReturnOrRestartError:#return with:value
!
returnDoing:aBlock
@@ -669,30 +693,18 @@
sender isNil ifTrue:[^ nil].
%{
__RESUMECONTEXT__(SND_COMMA self, aBlock, 2);
-
- /* when we reach here, something went wrong */
-%}
-.
+%}.
"
+ when we arrive here, something went wrong.
debugging ...
"
-"
- 'return: context not on calling chain' errorPrintNL.
- ^ self error:'return: context not on calling chain'.
-"
- "
- tried to return a context which is already dead
- (i.e. the method/block has already executed a return)
- "
- ^ InvalidReturnSignal
- raiseRequestWith:aBlock
- errorString:'return: context not on calling chain'
+ ^ self invalidReturnOrRestartError:#return with:aBlock
!
resume
"resume execution in this context. I.e. as if the method called
last by the receiver did a ^ nil.
- If the context has already returned, do nothing.
+ If the context has already returned, report an error.
NOTICE:
NO unwind actions are performed (see Context>>unwind).
@@ -706,8 +718,9 @@
resume:value
"resume the receiver - as if it got 'value' from whatever
- it called.
- If the context has already returned - do nothing.
+ it called. This continues execution in the receivers method
+ after the point where it did its last send.
+ If the context has already returned - report an error.
NOTICE:
NO unwind actions are performed (see Context>>unwind:).
@@ -719,7 +732,8 @@
|con|
"
- starting with this context, find the one below and return from it
+ starting with this context, find the one below (i.e. the one that I
+ have called) and return from it.
"
con := thisContext.
%{
@@ -727,32 +741,20 @@
con = _ContextInstPtr(con)->c_sender;
}
%}.
-"/ [con notNil and:[con sender ~~ self]] whileTrue:[
-"/ con := con sender
-"/ ].
con isNil ifTrue:[
"
- debugging ...
- "
-"
- 'resume: context not on calling chain' errorPrintNL.
- ^ self error:'resume: context not on calling chain'.
-"
- "
- tried to continue in context which is already dead
+ tried to resume in context which is already dead
(i.e. the method/block has already executed a return)
"
- ^ InvalidReturnSignal
- raiseRequestWith:value
- errorString:'resume: context not on calling chain'
+ ^ con invalidReturnOrRestartError:#resume with:value
].
^ con return:value
!
unwind
"return nil from the receiver - i.e. simulate a '^ nil'.
- If the context has already retruned, do nothing.
+ If the context has already retruned, report an error.
Evaluate all unwind-blocks as specified in Block>>valueNowOrOnUnwind:
and Block>>valueOnUnwindDo: on the way.
@@ -765,7 +767,7 @@
unwind:value
"return value from the receiver - i.e. simulate a '^ value'.
- If the context has already returned , do nothing.
+ If the context has already returned , report an error.
Evaluate all unwind-blocks as specified in Block>>valueNowOrOnUnwind:
and Block>>valueOnUnwindDo: on the way.
@@ -780,9 +782,7 @@
tried to return to a context which is already dead
(i.e. the method/block has already executed a return)
"
- ^ InvalidReturnSignal
- raiseRequestWith:value
- errorString:'unwind: no sender to unwind to'
+ ^ self invalidReturnOrRestartError:#unwind with:value
].
"
@@ -812,19 +812,10 @@
"
con isNil ifTrue:[
"
- debugging ...
- "
-"
- 'unwind: context not on calling chain' errorPrintNL.
- ^ self error:'unwind: context not on calling chain'.
-"
- "
tried to return to a context which is already dead
(i.e. the method/block has already executed a return)
"
- ^ InvalidReturnSignal
- raiseRequestWith:value
- errorString:'unwind: context not on calling chain'
+ ^ self invalidReturnOrRestartError:#unwind with:value
].
"
now, that all unwind-actions are done, I can use the
@@ -872,19 +863,10 @@
"
con isNil ifTrue:[
"
- debugging ...
- "
-"
- 'unwindAndRestart: context not on calling chain' errorPrintNL.
- ^ self error:'unwindAndRestart: context not on calling chain'.
-"
- "
tried to return to a context which is already dead
(i.e. the method/block has already executed a return)
"
- ^ InvalidReturnSignal
- raiseRequestWith:nil
- errorString:'unwindAndRestart: context not on calling chain'
+ ^ self invalidReturnOrRestartError:#unwindAndRestart with:nil
].
"
now, that all unwind-actions are done, I can use the
@@ -895,7 +877,7 @@
unwindThenDo:aBlock
"return the value of aBlock from the receiver - i.e. simulate a '^ aBlock value'.
- If the context has already returned , do nothing.
+ If the context has already returned , report an error.
Evaluate all unwind-blocks as specified in Block>>valueNowOrOnUnwind:
and Block>>valueOnUnwindDo: on the way.
The block is evaluated AFTER all unwind actions are performed
@@ -913,9 +895,7 @@
tried to return to a context which is already dead
(i.e. the method/block has already executed a return)
"
- ^ InvalidReturnSignal
- raiseRequestWith:aBlock
- errorString:'unwind: no sender to unwind to'
+ ^ self invalidReturnOrRestartError:#unwind with:aBlock
].
"
@@ -945,19 +925,10 @@
"
con isNil ifTrue:[
"
- debugging ...
- "
-"
- 'unwind: context not on calling chain' errorPrintNL.
- ^ self error:'unwind: context not on calling chain'.
-"
- "
tried to return to a context which is already dead
(i.e. the method/block has already executed a return)
"
- ^ InvalidReturnSignal
- raiseRequestWith:aBlock
- errorString:'unwind: context not on calling chain'
+ ^ self invalidReturnOrRestartError:#unwind with:aBlock
].
"
now, that all unwind-actions are done, I can use the
--- a/Dict.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Dict.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/Dict.st,v 1.22 1995-06-27 02:12:26 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/Dict.st,v 1.23 1995-07-02 01:06:24 claus Exp $
'!
!Dictionary class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/Dict.st,v 1.22 1995-06-27 02:12:26 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/Dict.st,v 1.23 1995-07-02 01:06:24 claus Exp $
"
!
@@ -221,7 +221,7 @@
aKey isNil ifTrue:[
"nil is not allowed as key"
- ^ self errorInvalidKey
+ ^ self errorInvalidKey:aKey
].
"
I could have written:
@@ -256,7 +256,7 @@
aKey isNil ifTrue:[
"nil is not allowed as key"
- self errorInvalidKey
+ self errorInvalidKey:aKey
] ifFalse:[
index := self findKeyOrNil:aKey.
(valueArray basicAt:index) notNil ifTrue:[
@@ -296,7 +296,8 @@
new:
"
|aCollection|
- aCollection := OrderedCollection new:valueArray size..
+
+ aCollection := OrderedCollection new:valueArray size.
self do:[:value| aCollection add:value].
^ aCollection
!
@@ -338,9 +339,9 @@
].
"/ keyArray keysAndValuesDo:[:index :aKey |
-"/ (aKey notNil and:[aKey ~~ DeletedEntry]) ifTrue:[
-"/ (valueArray at:index) == aValue ifTrue:[^ aKey].
-"/ ].
+"/ (aKey notNil and:[aKey ~~ DeletedEntry]) ifTrue:[
+"/ (valueArray at:index) == aValue ifTrue:[^ aKey].
+"/ ].
"/ ].
^ exceptionBlock value
@@ -373,9 +374,9 @@
].
"/ keyArray keysAndValuesDo:[:index :aKey |
-"/ (aKey notNil and:[aKey ~~ DeletedEntry]) ifTrue:[
-"/ (valueArray at:index) = aValue ifTrue:[^ aKey].
-"/ ].
+"/ (aKey notNil and:[aKey ~~ DeletedEntry]) ifTrue:[
+"/ (valueArray at:index) = aValue ifTrue:[^ aKey].
+"/ ].
"/ ].
^ exceptionBlock value
@@ -433,7 +434,7 @@
next "{ Class:SmallInteger }" |
aKey isNil ifTrue:[
- self errorInvalidKey
+ self errorInvalidKey:aKey
] ifFalse:[
"
I could have written:
--- a/Dictionary.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Dictionary.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.22 1995-06-27 02:12:26 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.23 1995-07-02 01:06:24 claus Exp $
'!
!Dictionary class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.22 1995-06-27 02:12:26 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Dictionary.st,v 1.23 1995-07-02 01:06:24 claus Exp $
"
!
@@ -221,7 +221,7 @@
aKey isNil ifTrue:[
"nil is not allowed as key"
- ^ self errorInvalidKey
+ ^ self errorInvalidKey:aKey
].
"
I could have written:
@@ -256,7 +256,7 @@
aKey isNil ifTrue:[
"nil is not allowed as key"
- self errorInvalidKey
+ self errorInvalidKey:aKey
] ifFalse:[
index := self findKeyOrNil:aKey.
(valueArray basicAt:index) notNil ifTrue:[
@@ -296,7 +296,8 @@
new:
"
|aCollection|
- aCollection := OrderedCollection new:valueArray size..
+
+ aCollection := OrderedCollection new:valueArray size.
self do:[:value| aCollection add:value].
^ aCollection
!
@@ -338,9 +339,9 @@
].
"/ keyArray keysAndValuesDo:[:index :aKey |
-"/ (aKey notNil and:[aKey ~~ DeletedEntry]) ifTrue:[
-"/ (valueArray at:index) == aValue ifTrue:[^ aKey].
-"/ ].
+"/ (aKey notNil and:[aKey ~~ DeletedEntry]) ifTrue:[
+"/ (valueArray at:index) == aValue ifTrue:[^ aKey].
+"/ ].
"/ ].
^ exceptionBlock value
@@ -373,9 +374,9 @@
].
"/ keyArray keysAndValuesDo:[:index :aKey |
-"/ (aKey notNil and:[aKey ~~ DeletedEntry]) ifTrue:[
-"/ (valueArray at:index) = aValue ifTrue:[^ aKey].
-"/ ].
+"/ (aKey notNil and:[aKey ~~ DeletedEntry]) ifTrue:[
+"/ (valueArray at:index) = aValue ifTrue:[^ aKey].
+"/ ].
"/ ].
^ exceptionBlock value
@@ -433,7 +434,7 @@
next "{ Class:SmallInteger }" |
aKey isNil ifTrue:[
- self errorInvalidKey
+ self errorInvalidKey:aKey
] ifFalse:[
"
I could have written:
--- a/DirStr.st Tue Jun 27 04:15:21 1995 +0200
+++ b/DirStr.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/DirStr.st,v 1.17 1995-02-15 10:21:46 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/DirStr.st,v 1.18 1995-07-02 01:06:28 claus Exp $
'!
!DirectoryStream class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/DirStr.st,v 1.17 1995-02-15 10:21:46 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/DirStr.st,v 1.18 1995-07-02 01:06:28 claus Exp $
"
!
@@ -91,10 +91,12 @@
"low level close of a directoryStream"
%{
#ifdef HAS_OPENDIR
- if (__isSmallInteger(_INST(dirPointer))) {
- closedir((DIR *)MKFD(_INST(dirPointer)));
+ OBJ dp;
+
+ if ((dp = _INST(dirPointer)) != nil) {
+ _INST(dirPointer) = nil;
+ closedir( (DIR *)(MKFD(dp)) );
}
- _INST(dirPointer) = nil;
#endif
%}
! !
--- a/DirectoryStream.st Tue Jun 27 04:15:21 1995 +0200
+++ b/DirectoryStream.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/DirectoryStream.st,v 1.17 1995-02-15 10:21:46 claus Exp $
+$Header: /cvs/stx/stx/libbasic/DirectoryStream.st,v 1.18 1995-07-02 01:06:28 claus Exp $
'!
!DirectoryStream class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/DirectoryStream.st,v 1.17 1995-02-15 10:21:46 claus Exp $
+$Header: /cvs/stx/stx/libbasic/DirectoryStream.st,v 1.18 1995-07-02 01:06:28 claus Exp $
"
!
@@ -91,10 +91,12 @@
"low level close of a directoryStream"
%{
#ifdef HAS_OPENDIR
- if (__isSmallInteger(_INST(dirPointer))) {
- closedir((DIR *)MKFD(_INST(dirPointer)));
+ OBJ dp;
+
+ if ((dp = _INST(dirPointer)) != nil) {
+ _INST(dirPointer) = nil;
+ closedir( (DIR *)(MKFD(dp)) );
}
- _INST(dirPointer) = nil;
#endif
%}
! !
--- a/ExecFunc.st Tue Jun 27 04:15:21 1995 +0200
+++ b/ExecFunc.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/ExecFunc.st,v 1.13 1995-06-06 03:53:50 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ExecFunc.st,v 1.14 1995-07-02 01:06:34 claus Exp $
'!
!ExecutableFunction class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/ExecFunc.st,v 1.13 1995-06-06 03:53:50 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ExecFunc.st,v 1.14 1995-07-02 01:06:34 claus Exp $
"
!
@@ -151,8 +151,7 @@
if (__isSmallInteger(anAddress))
_INST(code_) = (OBJ)(_intVal(anAddress));
else {
- /**** need code for largeInt here ... ****/
- _INST(code_) = (OBJ)0;
+ _INST(code_) = (OBJ)(__longIntVal(anAddress));
}
%}
! !
--- a/ExecutableFunction.st Tue Jun 27 04:15:21 1995 +0200
+++ b/ExecutableFunction.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.13 1995-06-06 03:53:50 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.14 1995-07-02 01:06:34 claus Exp $
'!
!ExecutableFunction class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.13 1995-06-06 03:53:50 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ExecutableFunction.st,v 1.14 1995-07-02 01:06:34 claus Exp $
"
!
@@ -151,8 +151,7 @@
if (__isSmallInteger(anAddress))
_INST(code_) = (OBJ)(_intVal(anAddress));
else {
- /**** need code for largeInt here ... ****/
- _INST(code_) = (OBJ)0;
+ _INST(code_) = (OBJ)(__longIntVal(anAddress));
}
%}
! !
--- a/ExtStream.st Tue Jun 27 04:15:21 1995 +0200
+++ b/ExtStream.st Sun Jul 02 03:08:30 1995 +0200
@@ -24,7 +24,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.39 1995-06-27 02:12:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.40 1995-07-02 01:06:38 claus Exp $
'!
!ExternalStream primitiveDefinitions!
@@ -87,7 +87,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.39 1995-06-27 02:12:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.40 1995-07-02 01:06:38 claus Exp $
"
!
@@ -368,16 +368,19 @@
OBJ fp;
if ((fp = _INST(filePointer)) != nil) {
+ _INST(filePointer) = nil;
__immediateInterrupt__ = 1;
fclose(MKFD(fp));
__immediateInterrupt__ = 0;
- _INST(filePointer) = nil;
}
%}
!
closeFileDescriptor
- "alternative very low level close"
+ "alternative very low level close
+ This closes the underlying OS-fileDescriptor
+ - and will NOT write any buffered data to the stream.
+ You have been warned."
%{ /* NOCONTEXT */
@@ -385,11 +388,11 @@
FILE *f;
if ((fp = _INST(filePointer)) != nil) {
+ _INST(filePointer) = nil;
__immediateInterrupt__ = 1;
f = MKFD(fp);
close(fileno(f));
__immediateInterrupt__ = 0;
- _INST(filePointer) = nil;
}
%}
! !
--- a/ExternalStream.st Tue Jun 27 04:15:21 1995 +0200
+++ b/ExternalStream.st Sun Jul 02 03:08:30 1995 +0200
@@ -24,7 +24,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.39 1995-06-27 02:12:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.40 1995-07-02 01:06:38 claus Exp $
'!
!ExternalStream primitiveDefinitions!
@@ -87,7 +87,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.39 1995-06-27 02:12:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.40 1995-07-02 01:06:38 claus Exp $
"
!
@@ -368,16 +368,19 @@
OBJ fp;
if ((fp = _INST(filePointer)) != nil) {
+ _INST(filePointer) = nil;
__immediateInterrupt__ = 1;
fclose(MKFD(fp));
__immediateInterrupt__ = 0;
- _INST(filePointer) = nil;
}
%}
!
closeFileDescriptor
- "alternative very low level close"
+ "alternative very low level close
+ This closes the underlying OS-fileDescriptor
+ - and will NOT write any buffered data to the stream.
+ You have been warned."
%{ /* NOCONTEXT */
@@ -385,11 +388,11 @@
FILE *f;
if ((fp = _INST(filePointer)) != nil) {
+ _INST(filePointer) = nil;
__immediateInterrupt__ = 1;
f = MKFD(fp);
close(fileno(f));
__immediateInterrupt__ = 0;
- _INST(filePointer) = nil;
}
%}
! !
--- a/Filename.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Filename.st Sun Jul 02 03:08:30 1995 +0200
@@ -20,7 +20,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.28 1995-06-27 02:12:52 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.29 1995-07-02 01:06:48 claus Exp $
'!
!Filename class methodsFor:'documentation'!
@@ -41,7 +41,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.28 1995-06-27 02:12:52 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.29 1995-07-02 01:06:48 claus Exp $
"
!
@@ -70,6 +70,130 @@
Filename newTemporary writeStream
"
+!
+
+examples
+"
+ does a file/directory exist ?:
+
+ |f|
+
+ f := 'foobar' asFilename.
+ ^ f exists
+
+
+ is it a directory ?:
+
+ |f|
+
+ f := '/tmp' asFilename.
+ ^ f isDirectory.
+
+
+ get the working directory:
+
+ ^ Filename defaultDirectory
+
+
+ get a files full pathname
+ (caring for relative names or symbolic links):
+
+ |f|
+
+ f := '..' asFilename.
+ ^ f pathName
+
+
+ get a directories directory:
+
+ |f|
+
+ f := Filename defaultDirectory.
+ ^ f directory
+
+
+ get a files directory:
+
+ |f|
+
+ f := './smalltalk' asFilename.
+ ^ f directory
+
+
+ getting access & modification times:
+
+
+ |f|
+
+ f := '/tmp' asFilename.
+ ^ f dates
+
+ access time only:
+
+ |f|
+
+ f := '/tmp' asFilename.
+ ^ f dates at:#accessed
+
+
+ getting all information on a file/directory:
+
+
+ |f|
+
+ f := '/tmp' asFilename.
+ ^ f info
+
+
+ getting a temporary file (unique name):
+
+ |f|
+
+ f := Filename newTemporary.
+ ^ f
+
+
+ creating, writing, reading and removing a temporary file:
+
+
+ |f writeStream readStream|
+
+ f := Filename newTemporary.
+ writeStream := f writeStream.
+ writeStream nextPutAll:'hello world'.
+ writeStream cr.
+ writeStream close.
+
+ 'contents (as seen by unix''s cat command:' printNL.
+ OperatingSystem executeCommand:('cat ' , f pathName).
+
+ readStream := f readStream.
+ Transcript showCr:'contents as seen by smalltalk:'.
+ Transcript showCr:(readStream upToEnd).
+ readStream close.
+
+ f delete.
+
+
+ getting a directories contents:
+
+ |f files|
+
+ f := '.' asFilename.
+ files := f directoryContents.
+ Transcript showCr:'the files are:'.
+ Transcript showCr:(files printString).
+
+
+ editing a file:
+
+ |f|
+
+ f := '/tmp/fooBar' asFilename.
+ (f writeStream) nextPutAll:'hello world'; close.
+
+ f edit
+"
! !
!Filename class methodsFor:'instance creation'!
--- a/LinkList.st Tue Jun 27 04:15:21 1995 +0200
+++ b/LinkList.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/LinkList.st,v 1.12 1995-02-11 14:08:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/LinkList.st,v 1.13 1995-07-02 01:07:03 claus Exp $
'!
!LinkedList class methodsFor:'documentation'!
@@ -42,24 +42,71 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/LinkList.st,v 1.12 1995-02-11 14:08:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/LinkList.st,v 1.13 1995-07-02 01:07:03 claus Exp $
"
!
documentation
"
this class implements an anchor to a list of Links.
- The data itself is held in the Link elements.
+ The data itself is held in the link elements.
See (the abstract) Link, ValueLink and (possibly other) classes,
which can be used as elements of a linkedList.
+ LinkedList does not care for storage; all it does is handling
+ chained link elements, which must respond to #nextLink/#nextLink:.
+ (i.e. any object which can do this, can be used as elements of a linked
+ list).
+
Although LinkedList is a subclass of SequenceableCollection (and therefore
supports indexed access via at:), you should be careful in using it or
- other methods based upon at:. The reason is that at: walks the linkedlist,
- and is therefore slow. Also, linear in time algorithms inherited from
- SequenceableCollection become square in runtime due to this.
+ other methods based upon at:.
+ The reason is that #at: walks the linkedlist to find the indexed element
+ and is therefore slow.
+ This means that some linear-in-time algorithms inherited from
+ SequenceableCollection become square in runtime.
In general, if you need access via a numeric index, you better use Array,
OrderedCollection or similar.
+
+ For the above reasons, the system does not make heavily use of LinkedLists;
+ the only good application is where elements must be repeatedly be removed
+ at the front and added at the end.
+ (the schedulers process handling code does this to manage process lists.)
+"
+!
+
+examples
+"
+ |l|
+
+ l := LinkedList new.
+ l addLast:(ValueLink new value:'one').
+ l addLast:(ValueLink new value:'two').
+ l addLast:(ValueLink new value:'three').
+ l addLast:(ValueLink new value:'four').
+ l inspect
+
+
+ |l|
+
+ l := LinkedList new.
+ l addLast:(ValueLink new value:'one').
+ l addLast:(ValueLink new value:'two').
+ l addLast:(ValueLink new value:'three').
+ l addLast:(ValueLink new value:'four').
+ (l at:3) value inspect. 'slow operation for large lists'.
+
+
+ |l link|
+
+ l := LinkedList new.
+ l addLast:(ValueLink new value:'one').
+ l addLast:(ValueLink new value:'two').
+ l addLast:(ValueLink new value:'three').
+ l addLast:(ValueLink new value:'four').
+ link := l removeFirst.
+ l addLast:link.
+ l inspect.
"
! !
@@ -129,19 +176,6 @@
!LinkedList methodsFor:'testing'!
-includes:anObject
- "return true, if some nodes contents is anObject"
-
- |theNode|
-
- theNode := firstLink.
- [theNode notNil] whileTrue:[
- (anObject = theNode) ifTrue:[^ true].
- theNode := theNode nextLink
- ].
- ^ false
-!
-
indexOf:aLink startingAt:start
"search the collection for aLink, starting the search at index start;
if found, return the index otherwise return 0. Here, index is defined
--- a/LinkedList.st Tue Jun 27 04:15:21 1995 +0200
+++ b/LinkedList.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/LinkedList.st,v 1.12 1995-02-11 14:08:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic/LinkedList.st,v 1.13 1995-07-02 01:07:03 claus Exp $
'!
!LinkedList class methodsFor:'documentation'!
@@ -42,24 +42,71 @@
version
"
-$Header: /cvs/stx/stx/libbasic/LinkedList.st,v 1.12 1995-02-11 14:08:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic/LinkedList.st,v 1.13 1995-07-02 01:07:03 claus Exp $
"
!
documentation
"
this class implements an anchor to a list of Links.
- The data itself is held in the Link elements.
+ The data itself is held in the link elements.
See (the abstract) Link, ValueLink and (possibly other) classes,
which can be used as elements of a linkedList.
+ LinkedList does not care for storage; all it does is handling
+ chained link elements, which must respond to #nextLink/#nextLink:.
+ (i.e. any object which can do this, can be used as elements of a linked
+ list).
+
Although LinkedList is a subclass of SequenceableCollection (and therefore
supports indexed access via at:), you should be careful in using it or
- other methods based upon at:. The reason is that at: walks the linkedlist,
- and is therefore slow. Also, linear in time algorithms inherited from
- SequenceableCollection become square in runtime due to this.
+ other methods based upon at:.
+ The reason is that #at: walks the linkedlist to find the indexed element
+ and is therefore slow.
+ This means that some linear-in-time algorithms inherited from
+ SequenceableCollection become square in runtime.
In general, if you need access via a numeric index, you better use Array,
OrderedCollection or similar.
+
+ For the above reasons, the system does not make heavily use of LinkedLists;
+ the only good application is where elements must be repeatedly be removed
+ at the front and added at the end.
+ (the schedulers process handling code does this to manage process lists.)
+"
+!
+
+examples
+"
+ |l|
+
+ l := LinkedList new.
+ l addLast:(ValueLink new value:'one').
+ l addLast:(ValueLink new value:'two').
+ l addLast:(ValueLink new value:'three').
+ l addLast:(ValueLink new value:'four').
+ l inspect
+
+
+ |l|
+
+ l := LinkedList new.
+ l addLast:(ValueLink new value:'one').
+ l addLast:(ValueLink new value:'two').
+ l addLast:(ValueLink new value:'three').
+ l addLast:(ValueLink new value:'four').
+ (l at:3) value inspect. 'slow operation for large lists'.
+
+
+ |l link|
+
+ l := LinkedList new.
+ l addLast:(ValueLink new value:'one').
+ l addLast:(ValueLink new value:'two').
+ l addLast:(ValueLink new value:'three').
+ l addLast:(ValueLink new value:'four').
+ link := l removeFirst.
+ l addLast:link.
+ l inspect.
"
! !
@@ -129,19 +176,6 @@
!LinkedList methodsFor:'testing'!
-includes:anObject
- "return true, if some nodes contents is anObject"
-
- |theNode|
-
- theNode := firstLink.
- [theNode notNil] whileTrue:[
- (anObject = theNode) ifTrue:[^ true].
- theNode := theNode nextLink
- ].
- ^ false
-!
-
indexOf:aLink startingAt:start
"search the collection for aLink, starting the search at index start;
if found, return the index otherwise return 0. Here, index is defined
--- a/Method.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Method.st Sun Jul 02 03:08:30 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Method.st,v 1.37 1995-05-18 22:49:59 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Method.st,v 1.38 1995-07-02 01:07:10 claus Exp $
'!
!Method class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Method.st,v 1.37 1995-05-18 22:49:59 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Method.st,v 1.38 1995-07-02 01:07:10 claus Exp $
"
!
@@ -333,7 +333,7 @@
#ifdef F_PRIVATE
int f = _intVal(_INST(flags));
- f = f | F_PRIVATE;
+ f = (f & ~F_CLASSPRIVATE) | F_PRIVATE;
_INST(flags) = _MKSMALLINT(f);
#endif
%}
@@ -356,7 +356,7 @@
#ifdef F_CLASSPRIVATE
int f = _intVal(_INST(flags));
- f = f | F_CLASSPRIVATE;
+ f = (f & ~F_PRIVATE) | F_CLASSPRIVATE;
_INST(flags) = _MKSMALLINT(f);
#endif
%}
@@ -364,7 +364,11 @@
setToPublic
"clear any privacy of the receiver. The receiver may be executed by
- any send. This is the default."
+ any send. This is the default.
+ Notice: method privacy is a nonstandard feature, not supported
+ by other smalltalk implementations and not specified in the ANSI spec.
+ This is EXPERIMENTAL - and being evaluated for usability.
+ It may change or even vanish (if it shows to be not useful)."
%{ /* NOCONTEXT */
/* I made this a primitive to get the define constant from stc.h */
@@ -433,7 +437,11 @@
isPublic
"return true, if this is a public method - I.e. can be executed via any send.
- This is the default."
+ This is the default.
+ Notice: method privacy is a nonstandard feature, not supported
+ by other smalltalk implementations and not specified in the ANSI spec.
+ This is EXPERIMENTAL - and being evaluated for usability.
+ It may change or even vanish (if it shows to be not useful)."
%{ /* NOCONTEXT */
/* I made this a primitive to get the define constant from stc.h */
@@ -906,8 +914,23 @@
privateMethodCalled
"this error is triggered, if a private or protected method is called from
- outside.
- Methodprivacy is an EXPERIMENTAL feature."
+ outside.
+ If you continue in the debugger, the method will be called,
+ and further privacy exceptions will NOT be reported,
+ until any new method is compiled, or the privacy of any method changes,
+ or the caches are flushed.
+ (the reason is that after the continue, the method is enterred into the
+ calling cache, for which method privacy is not checked.
+ Any of the above actions flushes this cache and a privacy check
+ is performed again.)
+ Future versions may not enter private methods into the cache, to fix this
+ (unobvious) behavior. However, then you will get an exception for EVERY
+ call to a private method ...
+
+ Notice: method privacy is a nonstandard feature, not supported
+ by other smalltalk implementations and not specified in the ANSI spec.
+ This is EXPERIMENTAL - and being evaluated for usability.
+ It may change or even vanish (if it shows to be not useful)."
^ PrivateMethodSignal raise
! !
--- a/MiniDebug.st Tue Jun 27 04:15:21 1995 +0200
+++ b/MiniDebug.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/MiniDebug.st,v 1.12 1995-03-18 05:05:05 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/MiniDebug.st,v 1.13 1995-07-02 01:07:16 claus Exp $
'!
!MiniDebugger class methodsFor: 'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/MiniDebug.st,v 1.12 1995-03-18 05:05:05 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/MiniDebug.st,v 1.13 1995-07-02 01:07:16 claus Exp $
"
!
@@ -370,6 +370,7 @@
(cmd == $a) ifTrue:[valid := true. done := true].
(cmd == $T) ifTrue:[valid := true. Processor terminateActive].
(cmd == $Q) ifTrue:[valid := true. Processor terminateActiveNoSignal].
+ (cmd == $U) ifTrue:[MessageTracer unwrapAllMethods].
(cmd == $X) ifTrue:[Smalltalk fatalAbort].
(cmd == $x) ifTrue:[Smalltalk exit].
valid ifFalse: [
@@ -386,6 +387,7 @@
(P)rocess list
(T)terminate current process
(Q)uick terminate current process (no unwinds)
+ (U)nwrap all traced/breakpointed methods
(X)exit (+core)
(x)exit Smalltalk' errorPrintNewline
]
--- a/MiniDebugger.st Tue Jun 27 04:15:21 1995 +0200
+++ b/MiniDebugger.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.12 1995-03-18 05:05:05 claus Exp $
+$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.13 1995-07-02 01:07:16 claus Exp $
'!
!MiniDebugger class methodsFor: 'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.12 1995-03-18 05:05:05 claus Exp $
+$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.13 1995-07-02 01:07:16 claus Exp $
"
!
@@ -370,6 +370,7 @@
(cmd == $a) ifTrue:[valid := true. done := true].
(cmd == $T) ifTrue:[valid := true. Processor terminateActive].
(cmd == $Q) ifTrue:[valid := true. Processor terminateActiveNoSignal].
+ (cmd == $U) ifTrue:[MessageTracer unwrapAllMethods].
(cmd == $X) ifTrue:[Smalltalk fatalAbort].
(cmd == $x) ifTrue:[Smalltalk exit].
valid ifFalse: [
@@ -386,6 +387,7 @@
(P)rocess list
(T)terminate current process
(Q)uick terminate current process (no unwinds)
+ (U)nwrap all traced/breakpointed methods
(X)exit (+core)
(x)exit Smalltalk' errorPrintNewline
]
--- a/NPExtStr.st Tue Jun 27 04:15:21 1995 +0200
+++ b/NPExtStr.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/NPExtStr.st,v 1.13 1995-02-18 18:29:35 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/NPExtStr.st,v 1.14 1995-07-02 01:07:22 claus Exp $
'!
!NonPositionableExternalStream class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/NPExtStr.st,v 1.13 1995-02-18 18:29:35 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/NPExtStr.st,v 1.14 1995-07-02 01:07:22 claus Exp $
"
!
@@ -143,6 +143,14 @@
self error:'stream as no concept of a position'
! !
+!NonPositionableExternalStream methodsFor:'queries'!
+
+isPositionable
+ "return true, if the stream supports positioning (this one is not)"
+
+ ^ false
+! !
+
!NonPositionableExternalStream methodsFor:'positioning'!
position
--- a/NonPositionableExternalStream.st Tue Jun 27 04:15:21 1995 +0200
+++ b/NonPositionableExternalStream.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/NonPositionableExternalStream.st,v 1.13 1995-02-18 18:29:35 claus Exp $
+$Header: /cvs/stx/stx/libbasic/NonPositionableExternalStream.st,v 1.14 1995-07-02 01:07:22 claus Exp $
'!
!NonPositionableExternalStream class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/NonPositionableExternalStream.st,v 1.13 1995-02-18 18:29:35 claus Exp $
+$Header: /cvs/stx/stx/libbasic/NonPositionableExternalStream.st,v 1.14 1995-07-02 01:07:22 claus Exp $
"
!
@@ -143,6 +143,14 @@
self error:'stream as no concept of a position'
! !
+!NonPositionableExternalStream methodsFor:'queries'!
+
+isPositionable
+ "return true, if the stream supports positioning (this one is not)"
+
+ ^ false
+! !
+
!NonPositionableExternalStream methodsFor:'positioning'!
position
--- a/ObjMem.st Tue Jun 27 04:15:21 1995 +0200
+++ b/ObjMem.st Sun Jul 02 03:08:30 1995 +0200
@@ -34,7 +34,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.44 1995-06-27 02:13:31 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.45 1995-07-02 01:07:29 claus Exp $
'!
!ObjectMemory class methodsFor:'documentation'!
@@ -55,7 +55,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.44 1995-06-27 02:13:31 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.45 1995-07-02 01:07:29 claus Exp $
"
!
@@ -2179,7 +2179,11 @@
by '.chg', or, if not running from an image, the default name 'st.chg'"
^ 'changes'.
- ^ self imageBaseName , '.chg'
+
+"/ future versions will have:
+"/ (requires some additionas at other places)
+"/
+"/ ^ self imageBaseName , '.chg'
"
ObjectMemory nameForChanges
--- a/ObjectMemory.st Tue Jun 27 04:15:21 1995 +0200
+++ b/ObjectMemory.st Sun Jul 02 03:08:30 1995 +0200
@@ -34,7 +34,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.44 1995-06-27 02:13:31 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.45 1995-07-02 01:07:29 claus Exp $
'!
!ObjectMemory class methodsFor:'documentation'!
@@ -55,7 +55,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.44 1995-06-27 02:13:31 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.45 1995-07-02 01:07:29 claus Exp $
"
!
@@ -2179,7 +2179,11 @@
by '.chg', or, if not running from an image, the default name 'st.chg'"
^ 'changes'.
- ^ self imageBaseName , '.chg'
+
+"/ future versions will have:
+"/ (requires some additionas at other places)
+"/
+"/ ^ self imageBaseName , '.chg'
"
ObjectMemory nameForChanges
--- a/OrdColl.st Tue Jun 27 04:15:21 1995 +0200
+++ b/OrdColl.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/OrdColl.st,v 1.26 1995-05-18 15:33:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/OrdColl.st,v 1.27 1995-07-02 01:07:38 claus Exp $
'!
!OrderedCollection class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/OrdColl.st,v 1.26 1995-05-18 15:33:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/OrdColl.st,v 1.27 1995-07-02 01:07:38 claus Exp $
"
!
@@ -91,6 +91,14 @@
^ lastIndex - firstIndex + 1
!
+capacity
+ "return the number of elements, that the receiver is
+ prepared to take.
+ Not used by the system; added for ST-80 compatibility."
+
+ ^ contentsArray size
+!
+
isFixedSize
"return true if the receiver cannot grow - this will vanish once
Arrays and Strings learn how to grow ..."
--- a/OrderedCollection.st Tue Jun 27 04:15:21 1995 +0200
+++ b/OrderedCollection.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/OrderedCollection.st,v 1.26 1995-05-18 15:33:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/OrderedCollection.st,v 1.27 1995-07-02 01:07:38 claus Exp $
'!
!OrderedCollection class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/OrderedCollection.st,v 1.26 1995-05-18 15:33:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/OrderedCollection.st,v 1.27 1995-07-02 01:07:38 claus Exp $
"
!
@@ -91,6 +91,14 @@
^ lastIndex - firstIndex + 1
!
+capacity
+ "return the number of elements, that the receiver is
+ prepared to take.
+ Not used by the system; added for ST-80 compatibility."
+
+ ^ contentsArray size
+!
+
isFixedSize
"return true if the receiver cannot grow - this will vanish once
Arrays and Strings learn how to grow ..."
--- a/PipeStr.st Tue Jun 27 04:15:21 1995 +0200
+++ b/PipeStr.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/PipeStr.st,v 1.24 1995-05-16 17:08:18 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/PipeStr.st,v 1.25 1995-07-02 01:07:43 claus Exp $
'!
!PipeStream class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/PipeStr.st,v 1.24 1995-05-16 17:08:18 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/PipeStr.st,v 1.25 1995-07-02 01:07:43 claus Exp $
"
!
@@ -256,15 +256,16 @@
%{ /* UNLIMITEDSTACK */
#ifndef transputer
+ OBJ fp;
- if (_INST(filePointer) != nil) {
+ if ((fp = _INST(filePointer)) != nil) {
+ _INST(filePointer) = nil;
/*
* allow interrupt even when blocking here ...
*/
__immediateInterrupt__ = 1;
- pclose(MKFD(_INST(filePointer)));
+ pclose(MKFD(fp));
__immediateInterrupt__ = 0;
- _INST(filePointer) = nil;
}
#endif
%}
--- a/PipeStream.st Tue Jun 27 04:15:21 1995 +0200
+++ b/PipeStream.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.24 1995-05-16 17:08:18 claus Exp $
+$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.25 1995-07-02 01:07:43 claus Exp $
'!
!PipeStream class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.24 1995-05-16 17:08:18 claus Exp $
+$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.25 1995-07-02 01:07:43 claus Exp $
"
!
@@ -256,15 +256,16 @@
%{ /* UNLIMITEDSTACK */
#ifndef transputer
+ OBJ fp;
- if (_INST(filePointer) != nil) {
+ if ((fp = _INST(filePointer)) != nil) {
+ _INST(filePointer) = nil;
/*
* allow interrupt even when blocking here ...
*/
__immediateInterrupt__ = 1;
- pclose(MKFD(_INST(filePointer)));
+ pclose(MKFD(fp));
__immediateInterrupt__ = 0;
- _INST(filePointer) = nil;
}
#endif
%}
--- a/PosStream.st Tue Jun 27 04:15:21 1995 +0200
+++ b/PosStream.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/PosStream.st,v 1.25 1995-05-01 21:38:26 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/PosStream.st,v 1.26 1995-07-02 01:07:49 claus Exp $
'!
!PositionableStream class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/PosStream.st,v 1.25 1995-05-01 21:38:26 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/PosStream.st,v 1.26 1995-07-02 01:07:49 claus Exp $
"
!
@@ -130,6 +130,14 @@
^ collection species
! !
+!PositionableStream methodsFor:'queries'!
+
+isPositionable
+ "return true, if the stream supports positioning (this one is)"
+
+ ^ true
+! !
+
!PositionableStream methodsFor:'accessing'!
contents
--- a/PositionableStream.st Tue Jun 27 04:15:21 1995 +0200
+++ b/PositionableStream.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/PositionableStream.st,v 1.25 1995-05-01 21:38:26 claus Exp $
+$Header: /cvs/stx/stx/libbasic/PositionableStream.st,v 1.26 1995-07-02 01:07:49 claus Exp $
'!
!PositionableStream class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/PositionableStream.st,v 1.25 1995-05-01 21:38:26 claus Exp $
+$Header: /cvs/stx/stx/libbasic/PositionableStream.st,v 1.26 1995-07-02 01:07:49 claus Exp $
"
!
@@ -130,6 +130,14 @@
^ collection species
! !
+!PositionableStream methodsFor:'queries'!
+
+isPositionable
+ "return true, if the stream supports positioning (this one is)"
+
+ ^ true
+! !
+
!PositionableStream methodsFor:'accessing'!
contents
--- a/ProcSched.st Tue Jun 27 04:15:21 1995 +0200
+++ b/ProcSched.st Sun Jul 02 03:08:30 1995 +0200
@@ -34,7 +34,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.40 1995-06-06 03:55:15 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.41 1995-07-02 01:07:53 claus Exp $
'!
Smalltalk at:#Processor put:nil!
@@ -57,7 +57,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.40 1995-06-06 03:55:15 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.41 1995-07-02 01:07:53 claus Exp $
"
!
@@ -346,7 +346,12 @@
destroy the bad process
"
p id ~~ 0 ifTrue:[
- 'problem with process ' errorPrint. p id errorPrint. ' terminate it.' errorPrintNL.
+ 'SCHEDULRER: problem with process ' errorPrint.
+ p id errorPrint.
+ p name notNil ifTrue:[
+ ' (' errorPrint. p name errorPrint. ')' errorPrint.
+ ].
+ '; hard-terminate it.' errorPrintNL.
p state:#suspended.
self terminateNoSignal:p.
]
--- a/ProcessorScheduler.st Tue Jun 27 04:15:21 1995 +0200
+++ b/ProcessorScheduler.st Sun Jul 02 03:08:30 1995 +0200
@@ -34,7 +34,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.40 1995-06-06 03:55:15 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.41 1995-07-02 01:07:53 claus Exp $
'!
Smalltalk at:#Processor put:nil!
@@ -57,7 +57,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.40 1995-06-06 03:55:15 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.41 1995-07-02 01:07:53 claus Exp $
"
!
@@ -346,7 +346,12 @@
destroy the bad process
"
p id ~~ 0 ifTrue:[
- 'problem with process ' errorPrint. p id errorPrint. ' terminate it.' errorPrintNL.
+ 'SCHEDULRER: problem with process ' errorPrint.
+ p id errorPrint.
+ p name notNil ifTrue:[
+ ' (' errorPrint. p name errorPrint. ')' errorPrint.
+ ].
+ '; hard-terminate it.' errorPrintNL.
p state:#suspended.
self terminateNoSignal:p.
]
--- a/Rectangle.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Rectangle.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Rectangle.st,v 1.21 1995-06-27 02:14:08 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Rectangle.st,v 1.22 1995-07-02 01:08:04 claus Exp $
'!
!Rectangle class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Rectangle.st,v 1.21 1995-06-27 02:14:08 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Rectangle.st,v 1.22 1995-07-02 01:08:04 claus Exp $
"
!
@@ -1005,40 +1005,40 @@
----------------------------------------------------------------"
| collect iRect tmp |
- iRect _ self intersect: aRectangle.
+ iRect := self intersect: aRectangle.
(iRect = nil) ifTrue: [^nil]. "case of no intersection"
"the collect collection gathers Rectangles"
- collect _ OrderedCollection new: 4.
+ collect := OrderedCollection new: 4.
"is it floating or on the edge?"
(((((iRect top) ~= self top)
and: [ (iRect bottom) ~= self bottom ])
and: [ (iRect left) ~= self left ])
and: [ (iRect right) ~= self right ] )
ifTrue: "entirely in the center."
- [tmp _ Rectangle origin: (Point x: iRect left y: self top)
- corner: iRect bottomRight.
+ [tmp := Rectangle origin: (Point x: iRect left y: self top)
+ corner: iRect bottomRight.
collect add: tmp.
- iRect _ iRect merge: tmp].
+ iRect := iRect merge: tmp].
((iRect left) ~= self left)
ifTrue: "doesn't touch left edge so make it touch"
- [tmp _ Rectangle origin: (Point x: self left y: iRect top)
- corner: iRect bottomLeft.
+ [tmp := Rectangle origin: (Point x: self left y: iRect top)
+ corner: iRect bottomLeft.
collect add: tmp.
"merge new (tmp) with overlap to keep track"
- iRect _ iRect merge: tmp].
+ iRect := iRect merge: tmp].
((iRect right) ~= self right)
ifTrue: "doesn't touch right edge so extend it"
- [tmp _ Rectangle origin: iRect topRight
- corner: (Point x: self right y: iRect bottom).
+ [tmp := Rectangle origin: iRect topRight
+ corner: (Point x: self right y: iRect bottom).
collect add: tmp.
- iRect _ iRect merge: tmp].
+ iRect := iRect merge: tmp].
(((iRect left) ~= self left) or: [(iRect top) ~= self top])
ifTrue: "whole top part can be taken now"
- [tmp _ Rectangle origin: self origin corner: iRect topRight.
+ [tmp := Rectangle origin: self origin corner: iRect topRight.
collect add: tmp].
(((iRect right) ~= self right) or: [(iRect bottom) ~= self bottom])
ifTrue: "whole bottom open and can be taken"
- [tmp _ Rectangle origin: iRect bottomLeft corner: self corner.
+ [tmp := Rectangle origin: iRect bottomLeft corner: self corner.
collect add: tmp].
^collect
!
--- a/SeqColl.st Tue Jun 27 04:15:21 1995 +0200
+++ b/SeqColl.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/SeqColl.st,v 1.30 1995-06-27 02:14:17 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/SeqColl.st,v 1.31 1995-07-02 01:08:11 claus Exp $
'!
!SequenceableCollection class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/SeqColl.st,v 1.30 1995-06-27 02:14:17 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/SeqColl.st,v 1.31 1995-07-02 01:08:11 claus Exp $
"
!
@@ -58,14 +58,34 @@
!SequenceableCollection class methodsFor:'instance creation'!
new:size withAll:element
- "return a new Collection of size, where all elements are
- initialized to element"
+ "return a new collection of size, where all elements are
+ initialized to element."
|newCollection|
newCollection := self new:size.
newCollection atAllPut:element.
^ newCollection
+!
+
+withSize:size
+ "return a new collection of size.
+ For variable size collections, this is different from #new:,
+ in that #new: creates an empty collection with preallocated size,
+ while #withSize: creates a non empty one."
+
+ |newCollection|
+
+ newCollection := self new:size.
+ newCollection grow:size.
+ ^ newCollection
+
+ "
+ (OrderedCollection new:10) inspect.
+ (OrderedCollection withSize:10) inspect.
+ (Array new:10) inspect.
+ (Array withSize:10) inspect.
+ "
! !
!SequenceableCollection methodsFor:'accessing'!
@@ -1321,6 +1341,12 @@
#(10 20 30 40 50 60 70) identityIndexOf:40
#(10 20 30 40 50 60 70) identityIndexOf:40.0
#(10 20 30 40 50 60 70) indexOf:40.0
+
+ be careful:
+
+ #(10 20 30 40.0 50 60 70) indexOf:40.0
+ #(10 20 30 40.0 50 60 70) identityIndexOf:40.0
+
"
!
@@ -1428,6 +1454,132 @@
"
!
+lastIndexOf:anElement startingAt:start ifAbsent:exceptionBlock
+ "search the collection backwards for anElement starting the search at
+ index start; if found, return the index
+ otherwise return the value of the exceptionBlock.
+ The comparison is done using =
+ (i.e. equality test - not identity test)."
+
+ |index|
+
+ index := self lastIndexOf:anElement startingAt:start.
+ (index == 0) ifTrue:[^ exceptionBlock value].
+ ^ index
+
+ "
+ #(10 20 30 40 10 20 30 40) lastIndexOf:40 startingAt:8 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) lastIndexOf:40.0 startingAt:8 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) lastIndexOf:35 startingAt:8 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) lastIndexOf:10 startingAt:8 ifAbsent:['none']
+ "
+!
+
+lastIndexOf:anElement startingAt:start
+ "search the collection backwards for anElement, starting the search at index start;
+ if found, return the index otherwise return 0.
+ The comparison is done using =
+ (i.e. equality test - not identity test)."
+
+ |startIndex "{ Class: SmallInteger }"
+ stop "{ Class: SmallInteger }" |
+
+ startIndex := self size.
+ startIndex to:1 by:-1 do:[:index |
+ anElement = (self at:index) ifTrue:[^ index].
+ ].
+ ^ 0
+
+ "
+ #(10 20 30 40 10 20 30 40) lastIndexOf:40 startingAt:8
+ #(10 20 30 40 10 20 30 40) lastIndexOf:40.0 startingAt:8
+ #(10 20 30 40 10 20 30 40) lastIndexOf:35 startingAt:8
+ #(10 20 30 40 10 20 30 40) lastIndexOf:10 startingAt:8
+ "
+!
+
+lastIndexOf:anElement ifAbsent:exceptionBlock
+ "search the collection backwards for anElement;
+ if found, return the index otherwise return the value of the
+ exceptionBlock.
+ The comparison is done using =
+ (i.e. equality test - not identity test)."
+
+ |index|
+
+ index := self lastIndexOf:anElement startingAt:self size.
+ (index == 0) ifTrue:[^ exceptionBlock value].
+ ^ index
+
+ "
+ #(10 20 30 40 10 20 30 40) lastIndexOf:40 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) lastIndexOf:40.0 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) lastIndexOf:35 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) lastIndexOf:10 ifAbsent:['none']
+ "
+!
+
+lastIndexOf:anElement
+ "search the collection backwards for anElement;
+ if found, return the index otherwise return 0.
+ The comparison is done using =
+ (i.e. equality test - not identity test)."
+
+ ^ self lastIndexOf:anElement startingAt:self size
+
+ "
+ #(10 20 30 40 50 60 70) lastIndexOf:40
+ #(10 20 30 40 50 60 70) lastIndexOf:40.0
+ #(10 20 30 40 50 60 70) lastIndexOf:35
+ #(10 20 30 40 50 60 70) lastIndexOf:10
+ "
+!
+
+nextIndexOf:anElement from:start to:stop ifAbsent:exceptionBlock
+ "search the collection for anElement, starting the search at index start
+ and stopping at stop;
+ if found, return the index otherwise return the value of the
+ exceptionBlock.
+ The comparison is done using =
+ (i.e. equality test - not identity test)."
+
+ |index|
+
+ index := self nextIndexOf:anElement from:start to:stop.
+ (index == 0) ifTrue:[^ exceptionBlock value].
+ ^ index
+
+ "
+ #(10 20 30 40 10 20 30 40) nextIndexOf:40 from:2 to:6 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) nextIndexOf:40.0 from:2 to:6 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) nextIndexOf:35 from:2 to:6 ifAbsent:['none']
+ "
+!
+
+nextIndexOf:anElement from:start to:stop
+ "search the collection for anElement, starting the search at index start,
+ stopping at:stop;
+ if found, return the index otherwise return 0.
+ The comparison is done using =
+ (i.e. equality test - not identity test)."
+
+ |startIndex "{ Class: SmallInteger }"
+ stopIndex "{ Class: SmallInteger }" |
+
+ startIndex := start.
+ stopIndex := stop.
+ startIndex to:stop do:[:index |
+ anElement = (self at:index) ifTrue:[^ index].
+ ].
+ ^ 0
+
+ "
+ #(10 20 30 40 10 20 30 40) nextIndexOf:40 from:2 to:6
+ #(10 20 30 40 10 20 30 40) nextIndexOf:40.0 from:2 to:6
+ #(10 20 30 40 10 20 30 40) nextIndexOf:35 from:2 to:6
+ "
+!
+
findFirst:aBlock
"find the first element, for which evaluation of the argument, aBlock
returns true; return its index or 0 if none detected."
@@ -1469,7 +1621,7 @@
includes:anElement
"return true if the collection contains anElement; false otherwise.
Comparison is done using equality compare (i.e. =).
- Q: Should there also be some identityIncludes ?"
+ See #includesIdentical: if identity is asked for."
((self indexOf:anElement startingAt:1) == 0) ifTrue:[^ false].
^ true
@@ -1479,6 +1631,27 @@
#(10 20 30 40 50 60 70) includes:40
#(10 20 30 40 50 60 70) includes:40.0
"
+!
+
+includesIdentical:anElement
+ "return true if the collection contains anElement; false otherwise.
+ Comparison is done using identity compare (i.e. ==).
+ See #includes: if equality is asked for."
+
+ ((self identityIndexOf:anElement startingAt:1) == 0) ifTrue:[^ false].
+ ^ true
+
+ "
+ #(10 20 30 40 50 60 70) includesIdentical:40
+ #(10 20 30 40 50 60 70) includesIdentical:40.0
+ #(10 20 30 40 50 60 70) includes:40
+ #(10 20 30 40 50 60 70) includes:40.0
+
+ be careful:
+
+ #(10 20 30 40.0 50 60 70) includes:40.0
+ #(10 20 30 40.0 50 60 70) includesIdentical:40.0
+ "
! !
!SequenceableCollection methodsFor:'sorting & reordering'!
--- a/SequenceableCollection.st Tue Jun 27 04:15:21 1995 +0200
+++ b/SequenceableCollection.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.30 1995-06-27 02:14:17 claus Exp $
+$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.31 1995-07-02 01:08:11 claus Exp $
'!
!SequenceableCollection class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.30 1995-06-27 02:14:17 claus Exp $
+$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.31 1995-07-02 01:08:11 claus Exp $
"
!
@@ -58,14 +58,34 @@
!SequenceableCollection class methodsFor:'instance creation'!
new:size withAll:element
- "return a new Collection of size, where all elements are
- initialized to element"
+ "return a new collection of size, where all elements are
+ initialized to element."
|newCollection|
newCollection := self new:size.
newCollection atAllPut:element.
^ newCollection
+!
+
+withSize:size
+ "return a new collection of size.
+ For variable size collections, this is different from #new:,
+ in that #new: creates an empty collection with preallocated size,
+ while #withSize: creates a non empty one."
+
+ |newCollection|
+
+ newCollection := self new:size.
+ newCollection grow:size.
+ ^ newCollection
+
+ "
+ (OrderedCollection new:10) inspect.
+ (OrderedCollection withSize:10) inspect.
+ (Array new:10) inspect.
+ (Array withSize:10) inspect.
+ "
! !
!SequenceableCollection methodsFor:'accessing'!
@@ -1321,6 +1341,12 @@
#(10 20 30 40 50 60 70) identityIndexOf:40
#(10 20 30 40 50 60 70) identityIndexOf:40.0
#(10 20 30 40 50 60 70) indexOf:40.0
+
+ be careful:
+
+ #(10 20 30 40.0 50 60 70) indexOf:40.0
+ #(10 20 30 40.0 50 60 70) identityIndexOf:40.0
+
"
!
@@ -1428,6 +1454,132 @@
"
!
+lastIndexOf:anElement startingAt:start ifAbsent:exceptionBlock
+ "search the collection backwards for anElement starting the search at
+ index start; if found, return the index
+ otherwise return the value of the exceptionBlock.
+ The comparison is done using =
+ (i.e. equality test - not identity test)."
+
+ |index|
+
+ index := self lastIndexOf:anElement startingAt:start.
+ (index == 0) ifTrue:[^ exceptionBlock value].
+ ^ index
+
+ "
+ #(10 20 30 40 10 20 30 40) lastIndexOf:40 startingAt:8 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) lastIndexOf:40.0 startingAt:8 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) lastIndexOf:35 startingAt:8 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) lastIndexOf:10 startingAt:8 ifAbsent:['none']
+ "
+!
+
+lastIndexOf:anElement startingAt:start
+ "search the collection backwards for anElement, starting the search at index start;
+ if found, return the index otherwise return 0.
+ The comparison is done using =
+ (i.e. equality test - not identity test)."
+
+ |startIndex "{ Class: SmallInteger }"
+ stop "{ Class: SmallInteger }" |
+
+ startIndex := self size.
+ startIndex to:1 by:-1 do:[:index |
+ anElement = (self at:index) ifTrue:[^ index].
+ ].
+ ^ 0
+
+ "
+ #(10 20 30 40 10 20 30 40) lastIndexOf:40 startingAt:8
+ #(10 20 30 40 10 20 30 40) lastIndexOf:40.0 startingAt:8
+ #(10 20 30 40 10 20 30 40) lastIndexOf:35 startingAt:8
+ #(10 20 30 40 10 20 30 40) lastIndexOf:10 startingAt:8
+ "
+!
+
+lastIndexOf:anElement ifAbsent:exceptionBlock
+ "search the collection backwards for anElement;
+ if found, return the index otherwise return the value of the
+ exceptionBlock.
+ The comparison is done using =
+ (i.e. equality test - not identity test)."
+
+ |index|
+
+ index := self lastIndexOf:anElement startingAt:self size.
+ (index == 0) ifTrue:[^ exceptionBlock value].
+ ^ index
+
+ "
+ #(10 20 30 40 10 20 30 40) lastIndexOf:40 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) lastIndexOf:40.0 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) lastIndexOf:35 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) lastIndexOf:10 ifAbsent:['none']
+ "
+!
+
+lastIndexOf:anElement
+ "search the collection backwards for anElement;
+ if found, return the index otherwise return 0.
+ The comparison is done using =
+ (i.e. equality test - not identity test)."
+
+ ^ self lastIndexOf:anElement startingAt:self size
+
+ "
+ #(10 20 30 40 50 60 70) lastIndexOf:40
+ #(10 20 30 40 50 60 70) lastIndexOf:40.0
+ #(10 20 30 40 50 60 70) lastIndexOf:35
+ #(10 20 30 40 50 60 70) lastIndexOf:10
+ "
+!
+
+nextIndexOf:anElement from:start to:stop ifAbsent:exceptionBlock
+ "search the collection for anElement, starting the search at index start
+ and stopping at stop;
+ if found, return the index otherwise return the value of the
+ exceptionBlock.
+ The comparison is done using =
+ (i.e. equality test - not identity test)."
+
+ |index|
+
+ index := self nextIndexOf:anElement from:start to:stop.
+ (index == 0) ifTrue:[^ exceptionBlock value].
+ ^ index
+
+ "
+ #(10 20 30 40 10 20 30 40) nextIndexOf:40 from:2 to:6 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) nextIndexOf:40.0 from:2 to:6 ifAbsent:['none']
+ #(10 20 30 40 10 20 30 40) nextIndexOf:35 from:2 to:6 ifAbsent:['none']
+ "
+!
+
+nextIndexOf:anElement from:start to:stop
+ "search the collection for anElement, starting the search at index start,
+ stopping at:stop;
+ if found, return the index otherwise return 0.
+ The comparison is done using =
+ (i.e. equality test - not identity test)."
+
+ |startIndex "{ Class: SmallInteger }"
+ stopIndex "{ Class: SmallInteger }" |
+
+ startIndex := start.
+ stopIndex := stop.
+ startIndex to:stop do:[:index |
+ anElement = (self at:index) ifTrue:[^ index].
+ ].
+ ^ 0
+
+ "
+ #(10 20 30 40 10 20 30 40) nextIndexOf:40 from:2 to:6
+ #(10 20 30 40 10 20 30 40) nextIndexOf:40.0 from:2 to:6
+ #(10 20 30 40 10 20 30 40) nextIndexOf:35 from:2 to:6
+ "
+!
+
findFirst:aBlock
"find the first element, for which evaluation of the argument, aBlock
returns true; return its index or 0 if none detected."
@@ -1469,7 +1621,7 @@
includes:anElement
"return true if the collection contains anElement; false otherwise.
Comparison is done using equality compare (i.e. =).
- Q: Should there also be some identityIncludes ?"
+ See #includesIdentical: if identity is asked for."
((self indexOf:anElement startingAt:1) == 0) ifTrue:[^ false].
^ true
@@ -1479,6 +1631,27 @@
#(10 20 30 40 50 60 70) includes:40
#(10 20 30 40 50 60 70) includes:40.0
"
+!
+
+includesIdentical:anElement
+ "return true if the collection contains anElement; false otherwise.
+ Comparison is done using identity compare (i.e. ==).
+ See #includes: if equality is asked for."
+
+ ((self identityIndexOf:anElement startingAt:1) == 0) ifTrue:[^ false].
+ ^ true
+
+ "
+ #(10 20 30 40 50 60 70) includesIdentical:40
+ #(10 20 30 40 50 60 70) includesIdentical:40.0
+ #(10 20 30 40 50 60 70) includes:40
+ #(10 20 30 40 50 60 70) includes:40.0
+
+ be careful:
+
+ #(10 20 30 40.0 50 60 70) includes:40.0
+ #(10 20 30 40.0 50 60 70) includesIdentical:40.0
+ "
! !
!SequenceableCollection methodsFor:'sorting & reordering'!
--- a/Smalltalk.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Smalltalk.st Sun Jul 02 03:08:30 1995 +0200
@@ -27,7 +27,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.52 1995-06-27 02:14:32 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.53 1995-07-02 01:08:23 claus Exp $
'!
"
@@ -56,7 +56,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.52 1995-06-27 02:14:32 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.53 1995-07-02 01:08:23 claus Exp $
"
!
@@ -152,7 +152,7 @@
"return the revision number.
Incremented for releases which fix bugs/add features."
- ^ 3
+ ^ 5
"
Smalltalk releaseNr
@@ -967,7 +967,7 @@
it will be removed without notice"
%{
- printStack(__context);
+ __printStack(__context);
%}
"Smalltalk printStackBacktrace"
!
@@ -984,7 +984,7 @@
else
msg = "fatalAbort";
- fatal0(__context, msg);
+ __fatal0(__context, msg);
/* NEVER RETURNS */
%}
!
@@ -993,7 +993,7 @@
"report a fatal-error, print a stack backtrace and exit with core dump.
(You may turn off the stack print with debugPrinting:false)"
%{
- fatal0(__context, "fatalAbort");
+ __fatal0(__context, "fatalAbort");
/* NEVER RETURNS */
%}
!
--- a/Stream.st Tue Jun 27 04:15:21 1995 +0200
+++ b/Stream.st Sun Jul 02 03:08:30 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Stream.st,v 1.19 1995-05-16 18:01:39 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Stream.st,v 1.20 1995-07-02 01:08:30 claus Exp $
'!
!Stream class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Stream.st,v 1.19 1995-05-16 18:01:39 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Stream.st,v 1.20 1995-07-02 01:08:30 claus Exp $
"
!
@@ -770,6 +770,12 @@
^ false
!
+isPositionable
+ "return true, if the stream supports positioning (some do not)"
+
+ ^ false
+!
+
isStream
"return true, if the receiver is some kind of Stream."