--- a/Object.st Mon Oct 10 01:29:01 1994 +0100
+++ b/Object.st Mon Oct 10 01:29:28 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1988 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
@@ -13,22 +13,23 @@
Object subclass:#Object
instanceVariableNames:''
classVariableNames:'ErrorSignal HaltSignal
- MessageNotUnderstoodSignal UserInterruptSignal
- RecursionInterruptSignal ExceptionInterruptSignal
- SubscriptOutOfBoundsSignal NonIntegerIndexSignal
- NotFoundSignal KeyNotFoundSignal ElementOutOfBoundsSignal
- InformationSignal PrimitiveFailureSignal
- AbortSignal
- ErrorRecursion Dependencies'
+ MessageNotUnderstoodSignal UserInterruptSignal
+ RecursionInterruptSignal ExceptionInterruptSignal
+ SubscriptOutOfBoundsSignal NonIntegerIndexSignal
+ NotFoundSignal KeyNotFoundSignal ElementOutOfBoundsSignal
+ InformationSignal PrimitiveFailureSignal
+ DeepCopyErrorSignal
+ AbortSignal
+ ErrorRecursion Dependencies'
poolDictionaries:''
category:'Kernel-Objects'
!
Object comment:'
COPYRIGHT (c) 1988 by Claus Gittinger
- All Rights Reserved
-
-$Header: /cvs/stx/stx/libbasic/Object.st,v 1.22 1994-08-23 23:10:03 claus Exp $
+ All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic/Object.st,v 1.23 1994-10-10 00:27:00 claus Exp $
'!
!Object class methodsFor:'documentation'!
@@ -36,7 +37,7 @@
copyright
"
COPYRIGHT (c) 1988 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
@@ -49,50 +50,52 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Object.st,v 1.22 1994-08-23 23:10:03 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Object.st,v 1.23 1994-10-10 00:27:00 claus Exp $
"
!
documentation
"
- Class Object is the superclass of all other classes. Protocol common to
- all objects is defined here.
+ Object is the superclass of all other classes. Protocol common to
+ every object is defined here.
Also some utility stuff (like notify) and error handling is implemented here.
Object has no instance variables (and may not get any added). One reason is, that
- UndefinedObject and SmallIntegers are also object - these two cannot have instance
+ UndefinedObject and SmallInteger are also inheriting from Object - these two cannot have instance
variables (due to their implementation). The other reason is that the runtime system
- (VM) knows about the layout of some built-in classes (think of classes, methods, blocks
- and also integers). If you where allowed to add instance variables to Object, the
- VM had to be recompiled (and also rewritten in some places).
+ (VM) knows about the layout of some built-in classes (think of Class, Method, Block
+ and also Integer or Float). If you where allowed to add instance variables to Object,
+ the VM had to be recompiled (and also rewritten in some places).
Class variables:
- ErrorSignal <Signal> Signal raised for error/error: messages
-
- HaltSignal <Signal> Signal raised for halt/halt: messages
-
- MessageNotUnderstoodSignal Signals raised for various error conditions
- UserInterruptSignal
- RecursionInterruptSignal
- ExceptionInterruptSignal
- SubscriptOutOfBoundsSignal
- NonIntegerIndexSignal
- NotFoundSignal
- KeyNotFoundSignal
- ElementOutOfBoundsSignal
- InformationSignal
-
- AbortSignal <Signal> Signal raised by debugger, to abort a computation
- BUT, the debugger will only raise it if it is handled.
- By handling the abortSignal, you can control where the
- debuggers abort-function resumes execution in case of
- an error.
-
- ErrorRecursion <Boolean> controls behavior when recursive errors occur (i.e.
- an error while handling an error).
-
- Dependencies <Dictionary> keeps track of object dependencies
+ ErrorSignal <Signal> Signal raised for error/error: messages
+ also, parent of all other signals.
+
+ HaltSignal <Signal> Signal raised for halt/halt: messages
+
+ MessageNotUnderstoodSignal Signals raised for various error conditions
+ UserInterruptSignal
+ RecursionInterruptSignal
+ ExceptionInterruptSignal
+ SubscriptOutOfBoundsSignal
+ NonIntegerIndexSignal
+ NotFoundSignal
+ KeyNotFoundSignal
+ ElementOutOfBoundsSignal
+ InformationSignal
+ DeepCopyErrorSignal
+
+ AbortSignal <Signal> Signal raised by debugger, to abort a computation
+ BUT, the debugger will only raise it if it is handled.
+ By handling the abortSignal, you can control where the
+ debuggers abort-function resumes execution in case of
+ an error.
+
+ ErrorRecursion <Boolean> controls behavior when recursive errors occur (i.e.
+ an error while handling an error).
+
+ Dependencies <Dictionary> keeps track of object dependencies
"
! !
@@ -102,55 +105,73 @@
"called only once - initialize signals"
ErrorSignal isNil ifTrue:[
- ErrorSignal := (Signal new) mayProceed:true.
- ErrorSignal notifierString:'error encountered'.
-
- HaltSignal := (Signal new) mayProceed:true.
- HaltSignal notifierString:'halt encountered'.
-
- MessageNotUnderstoodSignal := (Signal new) mayProceed:true.
- MessageNotUnderstoodSignal notifierString:'message not understood'.
-
- "EXPERIMENTAL"
- PrivateMethodSignal := (Signal new) mayProceed:true.
- PrivateMethodSignal notifierString:'attempt to execute private method'.
-
- PrimitiveFailureSignal := (Signal new) mayProceed:true.
- PrimitiveFailureSignal notifierString:'primitive failed'.
-
- UserInterruptSignal := (Signal new) mayProceed:true.
- UserInterruptSignal notifierString:'user Interrupt'.
-
- RecursionInterruptSignal := (Signal new) mayProceed:false.
- RecursionInterruptSignal notifierString:'recursion limit reached'.
-
- ExceptionInterruptSignal := (Signal new) mayProceed:true.
- ExceptionInterruptSignal notifierString:'exception Interrupt'.
-
- SubscriptOutOfBoundsSignal := (Signal new) mayProceed:false.
- SubscriptOutOfBoundsSignal notifierString:'subscript out of bounds'.
-
- ElementOutOfBoundsSignal := (Signal new) mayProceed:false.
- ElementOutOfBoundsSignal notifierString:'element not appropriate or out of bounds'.
-
- NotFoundSignal := (Signal new) mayProceed:true.
- NotFoundSignal notifierString:'no such element'.
-
- KeyNotFoundSignal := (Signal new) mayProceed:true.
- KeyNotFoundSignal notifierString:'no such key'.
-
- NonIntegerIndexSignal := (Signal new) mayProceed:false.
- NonIntegerIndexSignal notifierString:'index must be integer'.
-
- InformationSignal := (Signal new) mayProceed:true.
- InformationSignal notifierString:'information'.
-
- AbortSignal := (Signal new) mayProceed:true.
- AbortSignal notifierString:'unhandled abort signal'.
-
- Dependencies isNil ifTrue:[
- Dependencies := WeakIdentityDictionary new.
- ]
+ ErrorSignal := (Signal new) mayProceed:true.
+ ErrorSignal nameClass:self message:#errorSignal.
+ ErrorSignal notifierString:'error encountered'.
+
+ HaltSignal := ErrorSignal newSignalMayProceed:true.
+ HaltSignal nameClass:self message:#haltSignal.
+ HaltSignal notifierString:'halt encountered'.
+
+ MessageNotUnderstoodSignal := ErrorSignal newSignalMayProceed:true.
+ MessageNotUnderstoodSignal nameClass:self message:#messageNotUnderstoodSignal.
+ MessageNotUnderstoodSignal notifierString:'message not understood'.
+
+ PrimitiveFailureSignal := ErrorSignal newSignalMayProceed:true.
+ PrimitiveFailureSignal nameClass:self message:#primitiveFailureSignal.
+ PrimitiveFailureSignal notifierString:'primitive failed'.
+
+ UserInterruptSignal := ErrorSignal newSignalMayProceed:true.
+ UserInterruptSignal nameClass:self message:#userInterruptSignal.
+ UserInterruptSignal notifierString:'user Interrupt'.
+
+ RecursionInterruptSignal := ErrorSignal newSignalMayProceed:false.
+ RecursionInterruptSignal nameClass:self message:#recursionInterruptSignal.
+ RecursionInterruptSignal notifierString:'recursion limit reached'.
+
+ ExceptionInterruptSignal := ErrorSignal newSignalMayProceed:true.
+ ExceptionInterruptSignal nameClass:self message:#exceptionInterruptSignal.
+ ExceptionInterruptSignal notifierString:'exception Interrupt'.
+
+ SubscriptOutOfBoundsSignal := ErrorSignal newSignalMayProceed:false.
+ SubscriptOutOfBoundsSignal nameClass:self message:#subscriptOutOfBoundsSignal.
+ SubscriptOutOfBoundsSignal notifierString:'subscript out of bounds'.
+
+ ElementOutOfBoundsSignal := ErrorSignal newSignalMayProceed:false.
+ ElementOutOfBoundsSignal nameClass:self message:#elementOutOfBoundsSignal.
+ ElementOutOfBoundsSignal notifierString:'element not appropriate or out of bounds'.
+
+ NotFoundSignal := ErrorSignal newSignalMayProceed:true.
+ NotFoundSignal nameClass:self message:#notFoundSignal.
+ NotFoundSignal notifierString:'no such element'.
+
+ KeyNotFoundSignal := ErrorSignal newSignalMayProceed:true.
+ KeyNotFoundSignal nameClass:self message:#keyNotFoundSignal.
+ KeyNotFoundSignal notifierString:'no such key'.
+
+ NonIntegerIndexSignal := ErrorSignal newSignalMayProceed:false.
+ NonIntegerIndexSignal nameClass:self message:#nonIntegerIndexSignal.
+ NonIntegerIndexSignal notifierString:'index must be integer'.
+
+ InformationSignal := ErrorSignal newSignalMayProceed:true.
+ InformationSignal nameClass:self message:#informationSignal.
+ InformationSignal notifierString:'information'.
+
+ DeepCopyErrorSignal := ErrorSignal newSignalMayProceed:true.
+ DeepCopyErrorSignal nameClass:self message:#deepCopyErrorSignal.
+ DeepCopyErrorSignal notifierString:'object cannot be deepCopy-ed'.
+
+ "
+ AbortSignal is not a child of ErrorSignal -
+ this would complicate abort from within a signal handler
+ "
+ AbortSignal := Signal new mayProceed:true.
+ AbortSignal nameClass:self message:#abortSignal.
+ AbortSignal notifierString:'unhandled abort signal'.
+
+ Dependencies isNil ifTrue:[
+ Dependencies := WeakIdentityDictionary new.
+ ]
]
"Object initialize"
@@ -246,6 +267,14 @@
^ InformationSignal
!
+deepCopyErrorSignal
+ "return the signal raised when a deepcopy is asked for
+ an object which cannot do this (for example, BlockClosures
+ or Contexts)."
+
+ ^ DeepCopyErrorSignal
+!
+
abortSignal
"return the signal used to abort user actions. This signal is only
raised if cought (by the debugger), and will lead way out of the
@@ -299,7 +328,7 @@
- the Collection-classes have been rewritten to not use it.)"
%{
if (__primBecome(self, anotherObject COMMA_CON))
- RETURN ( self );
+ RETURN ( self );
%}
.
self primitiveFailed
@@ -312,7 +341,7 @@
%{
if (__primBecomeNil(self COMMA_CON ))
- RETURN ( nil );
+ RETURN ( nil );
%}
.
self primitiveFailed
@@ -334,58 +363,58 @@
&& _isNonNilObject(otherClass)
&& (otherClass != UndefinedObject)
&& (otherClass != SmallInteger)) {
- ok = true;
+ ok = true;
} else {
- ok = false;
+ ok = false;
}
%}.
ok ifTrue:[
- ok := false.
- myClass := self class.
- myClass flags == otherClass flags ifTrue:[
- myClass instSize == otherClass instSize ifTrue:[
- "same instance layout and types: its ok to do it"
- ok := true.
- ] ifFalse:[
- myClass isPointers ifTrue:[
- myClass isVariable ifTrue:[
- ok := true
- ]
- ]
- ]
- ] ifFalse:[
- myClass isPointers ifTrue:[
- "if newClass is a variable class, with instSize <= my instsize,
- we can do it (effectively mapping additional instvars into the
- variable part) - usefulness is questionable, though"
-
- otherClass isPointers ifTrue:[
- otherClass isVariable ifTrue:[
- otherClass instSize <= (myClass instSize + self basicSize)
- ifTrue:[
- ok := true
- ]
- ] ifFalse:[
- otherClass instSize == (myClass instSize + self basicSize)
- ifTrue:[
- ok := true
- ]
- ]
- ] ifFalse:[
- "it does not make sense to convert pointers to bytes ..."
- ]
- ] ifFalse:[
- "does it make sense, to convert bits ?"
- "could allow byteArray->wordArray->longArray->floatArray->doubleArray here ..."
- ]
- ]
+ ok := false.
+ myClass := self class.
+ myClass flags == otherClass flags ifTrue:[
+ myClass instSize == otherClass instSize ifTrue:[
+ "same instance layout and types: its ok to do it"
+ ok := true.
+ ] ifFalse:[
+ myClass isPointers ifTrue:[
+ myClass isVariable ifTrue:[
+ ok := true
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ myClass isPointers ifTrue:[
+ "if newClass is a variable class, with instSize <= my instsize,
+ we can do it (effectively mapping additional instvars into the
+ variable part) - usefulness is questionable, though"
+
+ otherClass isPointers ifTrue:[
+ otherClass isVariable ifTrue:[
+ otherClass instSize <= (myClass instSize + self basicSize)
+ ifTrue:[
+ ok := true
+ ]
+ ] ifFalse:[
+ otherClass instSize == (myClass instSize + self basicSize)
+ ifTrue:[
+ ok := true
+ ]
+ ]
+ ] ifFalse:[
+ "it does not make sense to convert pointers to bytes ..."
+ ]
+ ] ifFalse:[
+ "does it make sense, to convert bits ?"
+ "could allow byteArray->wordArray->longArray->floatArray->doubleArray here ..."
+ ]
+ ]
].
ok ifTrue:[
- "now, change the receivers class ..."
+ "now, change the receivers class ..."
%{
- _qClass(self) = otherClass;
- __STORE(self, otherClass);
- RETURN ( self );
+ _qClass(self) = otherClass;
+ __STORE(self, otherClass);
+ RETURN ( self );
%}.
].
self primitiveFailed
@@ -428,34 +457,34 @@
*/
myClass = _qClass(self);
nbytes = _qSize(self)
- - OHDR_SIZE
- - __OBJS2BYTES__(_intVal(_ClassInstPtr(myClass)->c_ninstvars));
+ - OHDR_SIZE
+ - __OBJS2BYTES__(_intVal(_ClassInstPtr(myClass)->c_ninstvars));
switch (_intVal(_ClassInstPtr(myClass)->c_flags) & ARRAYMASK) {
- case BYTEARRAY:
- RETURN ( _MKSMALLINT(nbytes / sizeof(char)) );
-
- case WORDARRAY:
- RETURN ( _MKSMALLINT(nbytes / sizeof(short)) );
-
- case LONGARRAY:
- RETURN ( _MKSMALLINT(nbytes / sizeof(long)) );
-
- case FLOATARRAY:
- RETURN ( _MKSMALLINT(nbytes / sizeof(float)) );
-
- case DOUBLEARRAY:
+ case BYTEARRAY:
+ RETURN ( _MKSMALLINT(nbytes / sizeof(char)) );
+
+ case WORDARRAY:
+ RETURN ( _MKSMALLINT(nbytes / sizeof(short)) );
+
+ case LONGARRAY:
+ RETURN ( _MKSMALLINT(nbytes / sizeof(long)) );
+
+ case FLOATARRAY:
+ RETURN ( _MKSMALLINT(nbytes / sizeof(float)) );
+
+ case DOUBLEARRAY:
#ifdef NEED_DOUBLE_ALIGN
- /*
- * care for filler
- */
- nbytes -= sizeof(FILLTYPE);
+ /*
+ * care for filler
+ */
+ nbytes -= sizeof(FILLTYPE);
#endif
- RETURN ( _MKSMALLINT(nbytes / sizeof(double)) );
-
- case WKPOINTERARRAY:
- case POINTERARRAY:
- RETURN ( _MKSMALLINT(__BYTES2OBJS__(nbytes)) );
+ RETURN ( _MKSMALLINT(nbytes / sizeof(double)) );
+
+ case WKPOINTERARRAY:
+ case POINTERARRAY:
+ RETURN ( _MKSMALLINT(__BYTES2OBJS__(nbytes)) );
}
%}
.
@@ -615,11 +644,11 @@
isMemberOf:aClass
"return true, if the receiver is an instance of aClass, false otherwise.
Advice: use of this to check objects for certain attributes/protocoll should
- be avoided; it limits the reusability of your classes by limiting use
- to instances of a certain class.
- Use check-methods to check an object for a certain attributes/protocol
- (such as respondsTo: or isNumber);
- or check via #respondsTo: if a it understands your message."
+ be avoided; it limits the reusability of your classes by limiting use
+ to instances of a certain class.
+ Use check-methods to check an object for a certain attributes/protocol
+ (such as respondsTo: or isNumber);
+ or check via #respondsTo: if a it understands your message."
^ (self class) == aClass
!
@@ -628,21 +657,21 @@
"return true, if the receiver is an instance of aClass or one of its
subclasses, false otherwise.
Advice: use of this to check objects for certain attributes/protocoll should
- be avoided; it limits the reusability of your classes by limiting use
- to instances of certain classes and fences you into a specific inheritance
- hierarchy.
- Use check-methods to check an object for a certain attributes/protocol
- (such as isXXXX, respondsTo: or isNumber)"
+ be avoided; it limits the reusability of your classes by limiting use
+ to instances of certain classes and fences you into a specific inheritance
+ hierarchy.
+ Use check-methods to check an object for a certain attributes/protocol
+ (such as isXXXX, respondsTo: or isNumber)"
%{ /* NOCONTEXT */
register OBJ thisClass;
thisClass = _Class(self);
while (thisClass != nil) {
- if (thisClass == aClass) {
- RETURN ( true );
- }
- thisClass = _ClassInstPtr(thisClass)->c_superclass;
+ if (thisClass == aClass) {
+ RETURN ( true );
+ }
+ thisClass = _ClassInstPtr(thisClass)->c_superclass;
}
%}
.
@@ -678,7 +707,7 @@
extern OBJ lookup();
if (lookup(_Class(self), aSelector) == nil) {
- RETURN ( false );
+ RETURN ( false );
}
RETURN ( true );
%}
@@ -714,15 +743,15 @@
"check the instance variables"
numInst := myClass instSize.
1 to:numInst do:[:i |
- ((self instVarAt:i) == anObject) ifTrue:[^ true]
+ ((self instVarAt:i) == anObject) ifTrue:[^ true]
].
"check the indexed variables"
myClass isVariable ifTrue:[
- numInst := myClass basicSize.
- 1 to:numInst do:[:i |
- ((self basicAt:i) == anObject) ifTrue:[^ true]
- ]
+ numInst := myClass basicSize.
+ 1 to:numInst do:[:i |
+ ((self basicAt:i) == anObject) ifTrue:[^ true]
+ ]
].
^ false
!
@@ -742,10 +771,36 @@
^ Association key:self value:anObject
! !
+!Object methodsFor:'evaluation'!
+
+value
+ "this allows every object to be used where blocks are typically used.
+ Time will show, if this is a good idea or leads to sloppy programming
+ style ... (idea borrowed from the Self language).
+ WARNING: dont 'optimize' away ifXXX: blocks - the compilers will
+ only generate inline code for the if, if the argument(s) are blocks.
+ It will work, but run slower instead."
+
+ ^ self
+
+ "
+ #(1 2 3 4) indexOf:5 ifAbsent:0
+ "
+! !
+
!Object methodsFor:'copying'!
copy
- "return a copy of the receiver - defaults to shallowcopy here"
+ "return a copy of the receiver - defaults to shallowcopy here.
+ Notice, that copy does not copy dependents."
+
+ ^ self shallowCopy postCopyFrom:self
+!
+
+shallowCopyForFinalization
+ "this is used to aquire a copy to be used for finalization -
+ (the copy will get a dispose-notification; see the documentation in the Registry class)
+ This method can be redefined for more efficient copying - especially for large objects."
^ self shallowCopy
!
@@ -759,41 +814,58 @@
myClass := self class.
myClass isVariable ifTrue:[
- sz := self basicSize.
- aCopy := myClass basicNew:sz.
-
- "copy the indexed variables"
- 1 to:sz do:[:i |
- aCopy basicAt:i put:(self basicAt:i)
- ]
+ sz := self basicSize.
+ aCopy := myClass basicNew:sz.
+
+ "copy the indexed variables"
+ 1 to:sz do:[:i |
+ aCopy basicAt:i put:(self basicAt:i)
+ ]
] ifFalse:[
- aCopy := myClass basicNew
+ aCopy := myClass basicNew
].
"copy the instance variables"
sz := myClass instSize.
1 to:sz do:[:i |
- aCopy instVarAt:i put:(self instVarAt:i)
+ aCopy instVarAt:i put:(self instVarAt:i)
].
^ aCopy
!
+postCopy
+ "this is for compatibility with ST-80 code, which uses postCopy for
+ cleanup after copying, while ST/X passes the original in postCopyFrom:
+ (see there)"
+
+ ^ self
+!
+
+postCopyFrom:original
+ "sent to a freshly deep-copied object to give it a chance to adjust things.
+ (a font could flush its device-handle for example).
+ Notice, that for Sets/Dicts etc. a rehash is not needed, since the deepCopy
+ will have the same hash key as the receiver (as long as ST/X provides the
+ setHash: functionality)."
+
+ "for ST-80 compatibility, we try postCopy here ..."
+ ^ self postCopy
+!
+
deepCopy
"return a copy of the object with all subobjects also copied.
This method DOES handle cycles/self-refs; however the receivers
- class is not copied (to avoid the 'total' copy)."
+ class is not copied (to avoid the 'total' copy).
+ Notice, that copy does not copy dependents."
^ self deepCopyUsing:(IdentityDictionary new)
!
-finalizeCopyFrom:original
- "sent to a freshly deep-copied object to give it a chance to adjust things.
- (a font could flush its device-handle for example). Notice, that for Sets/Dicts
- etc. a rehash is not needed, since the deepCopy will have the same hash key as the
- receiver (as long as ST/X provides the setHash: functionality)."
-
- ^ self
+deepCopyError
+ "raise a signal, that deepCopy is not allowed for this object"
+
+ ^ DeepCopyErrorSignal raise
!
deepCopyUsing:aDictionary
@@ -808,52 +880,51 @@
myClass := self class.
myClass isVariable ifTrue:[
- sz := self basicSize.
- aCopy := myClass basicNew:sz.
+ sz := self basicSize.
+ aCopy := myClass basicNew:sz.
] ifFalse:[
- sz := 0.
- aCopy := myClass basicNew
+ sz := 0.
+ aCopy := myClass basicNew
].
aCopy setHashFrom:self.
aDictionary at:self put:aCopy.
sz ~~ 0 ifTrue:[
- self class isBits ifTrue:[
- "block-copy indexed instvars"
- aCopy replaceFrom:1 to:sz with:self startingAt:1
- ] ifFalse:[
- "individual deep copy the indexed variables"
- 1 to:sz do:[:i |
- iOrig := self basicAt:i.
- iOrig notNil ifTrue:[
- (aDictionary includesKey:iOrig) ifTrue:[
- iCopy := aDictionary at:iOrig
- ] ifFalse:[
- iCopy := iOrig deepCopyUsing:aDictionary.
- ].
- aCopy basicAt:i put:iCopy
- ]
- ]
- ]
+ self class isBits ifTrue:[
+ "block-copy indexed instvars"
+ aCopy replaceFrom:1 to:sz with:self startingAt:1
+ ] ifFalse:[
+ "individual deep copy the indexed variables"
+ 1 to:sz do:[:i |
+ iOrig := self basicAt:i.
+ iOrig notNil ifTrue:[
+ (aDictionary includesKey:iOrig) ifTrue:[
+ iCopy := aDictionary at:iOrig
+ ] ifFalse:[
+ iCopy := iOrig deepCopyUsing:aDictionary.
+ ].
+ aCopy basicAt:i put:iCopy
+ ]
+ ]
+ ]
].
"copy the instance variables"
sz := myClass instSize.
sz ~~ 0 ifTrue:[
- 1 to:sz do:[:i |
- iOrig := self instVarAt:i.
- iOrig notNil ifTrue:[
- (aDictionary includesKey:iOrig) ifTrue:[
- iCopy := aDictionary at:iOrig
- ] ifFalse:[
- iCopy := iOrig deepCopyUsing:aDictionary.
- ].
- aCopy instVarAt:i put:iCopy
- ]
- ].
+ 1 to:sz do:[:i |
+ iOrig := self instVarAt:i.
+ iOrig notNil ifTrue:[
+ (aDictionary includesKey:iOrig) ifTrue:[
+ iCopy := aDictionary at:iOrig
+ ] ifFalse:[
+ iCopy := iOrig deepCopyUsing:aDictionary.
+ ].
+ aCopy instVarAt:i put:iCopy
+ ]
+ ].
].
- aCopy finalizeCopyFrom:self.
^ aCopy
!
@@ -872,21 +943,21 @@
myClass := self class.
myClass isVariable ifTrue:[
- sz := self basicSize.
- aCopy := myClass basicNew:sz.
-
- "copy the indexed variables"
- 1 to:sz do:[:i |
- aCopy basicAt:i put:((self basicAt:i) simpleDeepCopy)
- ]
+ sz := self basicSize.
+ aCopy := myClass basicNew:sz.
+
+ "copy the indexed variables"
+ 1 to:sz do:[:i |
+ aCopy basicAt:i put:((self basicAt:i) simpleDeepCopy)
+ ]
] ifFalse:[
- aCopy := myClass basicNew
+ aCopy := myClass basicNew
].
"copy the instance variables"
sz := myClass instSize.
1 to:sz do:[:i |
- aCopy instVarAt:i put:((self instVarAt:i) simpleDeepCopy)
+ aCopy instVarAt:i put:((self instVarAt:i) simpleDeepCopy)
].
^ aCopy
@@ -911,9 +982,9 @@
REGISTER unsigned h;
if (_isNonNilObject(self) && _isNonNilObject(anObject)) {
- h = _GET_HASH(anObject);
- _SET_HASH(self, h);
- RETURN (self);
+ h = _GET_HASH(anObject);
+ _SET_HASH(self, h);
+ RETURN (self);
}
%}
.
@@ -993,32 +1064,32 @@
OBJ cls;
if (_isNonNilObject(self)) {
- v1 = _GET_HASH(self);
- if (v1 == 0) {
- v1 = nextHash++;
- if (v1 == 0)
- v1 = nextHash++;
- _SET_HASH(self, v1);
- }
+ v1 = _GET_HASH(self);
+ if (v1 == 0) {
+ v1 = nextHash++;
+ if (v1 == 0)
+ v1 = nextHash++;
+ _SET_HASH(self, v1);
+ }
#ifdef NOTDEF
- /*
- * this is no good - a class becoming another one or
- * if an object changes its class, hashkey would change.
- * changing hashkeys has bad effects on IdentityDictionary and
- * IdentitySet (and others as well).
- */
- cls = _qClass(self);
- v2 = _GET_HASH(cls);
- if (v2 == 0) {
- v2 = nextHash++;
- if (v2 == 0)
- v2 = nextHash++;
- _SET_HASH(cls, v2);
- }
- RETURN ( _MKSMALLINT((v2<<12) | v1) );
+ /*
+ * this is no good - a class becoming another one or
+ * if an object changes its class, hashkey would change.
+ * changing hashkeys has bad effects on IdentityDictionary and
+ * IdentitySet (and others as well).
+ */
+ cls = _qClass(self);
+ v2 = _GET_HASH(cls);
+ if (v2 == 0) {
+ v2 = nextHash++;
+ if (v2 == 0)
+ v2 = nextHash++;
+ _SET_HASH(cls, v2);
+ }
+ RETURN ( _MKSMALLINT((v2<<12) | v1) );
#endif
- RETURN ( _MKSMALLINT(v1 << 8) );
+ RETURN ( _MKSMALLINT(v1 << 8) );
}
%}
.
@@ -1032,7 +1103,8 @@
such as corrupted class, corrupted method/selector array
etc. (for example, if you set an objects class to a small-
integer, nil etc).
- Its not guaranteed, that the system is in a working condition ...."
+ Its not guaranteed, that the system is in a working condition once
+ this error occurred ...."
^ self error:msg
!
@@ -1099,16 +1171,16 @@
special case - since SIGPIPE has an ST-signal associated
"
(signalNumber == 13) ifTrue:[
- "SIGPIPE - write on a pipe with no one to read"
-
- ^ PipeStream brokenPipeSignal raise.
+ "SIGPIPE - write on a pipe with no one to read"
+
+ ^ PipeStream brokenPipeSignal raise.
].
"if there has been an ST-signal installed, use it ..."
sig := OperatingSystem operatingSystemSignal:signalNumber.
sig notNil ifTrue:[
- ^ sig raise
+ ^ sig raise
].
"
@@ -1128,21 +1200,21 @@
another signal - to avoid frustration, better not offer this option.
"
ignorable := (signalNumber ~~ OperatingSystem sigBUS)
- and:[signalNumber ~~ OperatingSystem sigILL
- and:[signalNumber ~~ OperatingSystem sigSEGV]].
+ and:[signalNumber ~~ OperatingSystem sigILL
+ and:[signalNumber ~~ OperatingSystem sigSEGV]].
ignorable ifFalse:[
- here isRecursive ifTrue:[
- 'fatal: signal ' errorPrint. signalNumber errorPrintNL.
- MiniDebugger enterWithMessage:'recursive signal'.
- ^ self
- ].
- "
- a hard signal - go into debugger immediately
- "
- Debugger enter:here withMessage:('Signal ', name).
- badContext return.
- ^ nil.
+ here isRecursive ifTrue:[
+ 'fatal: signal ' errorPrint. signalNumber errorPrintNL.
+ MiniDebugger enterWithMessage:'recursive signal'.
+ ^ self
+ ].
+ "
+ a hard signal - go into debugger immediately
+ "
+ Debugger enter:here withMessage:('Signal ', name).
+ badContext return.
+ ^ nil.
].
"
@@ -1150,42 +1222,42 @@
otherwise display stays locked
"
ActiveGrab notNil ifTrue:[
- Display ungrabPointer.
- ActiveGrab := nil
+ Display ungrabPointer.
+ ActiveGrab := nil
].
OptionBox isNil ifTrue:[
- "
- a system without GUI ...
- go into minidebugger (if there is one)
- "
- MiniDebugger isNil ifTrue:[
- "
- a system without debugging facilities
- (i.e. a standalone system)
- output a message and exit.
- "
- ('exit due to Signal ' , name) errorPrintNL.
- Smalltalk exit.
- ].
- MiniDebugger enterWithMessage:'Signal cought (' , name, ')'.
- ^ self
+ "
+ a system without GUI ...
+ go into minidebugger (if there is one)
+ "
+ MiniDebugger isNil ifTrue:[
+ "
+ a system without debugging facilities
+ (i.e. a standalone system)
+ output a message and exit.
+ "
+ ('exit due to Signal ' , name) errorPrintNL.
+ Smalltalk exit.
+ ].
+ MiniDebugger enterWithMessage:'Signal cought (' , name, ')'.
+ ^ self
].
box := OptionBox
- title:'Signal cought (' , name, ')'
- numberOfOptions:(ignorable ifTrue:[5] ifFalse:[4]).
+ title:'Signal cought (' , name, ')'
+ numberOfOptions:(ignorable ifTrue:[5] ifFalse:[4]).
titles := #('return' 'debug' 'dump' 'exit').
actions := Array
- with:[badContext return]
- with:[Debugger enter:here withMessage:('Signal ', name). ^nil]
- with:[Smalltalk fatalAbort]
- with:[Smalltalk exit].
+ with:[badContext return]
+ with:[Debugger enter:here withMessage:('Signal ', name). ^nil]
+ with:[Smalltalk fatalAbort]
+ with:[Smalltalk exit].
ignorable ifTrue:[
- titles := #('ignore') , titles.
- actions := (Array with:[^ nil]) , actions.
+ titles := #('ignore') , titles.
+ actions := (Array with:[^ nil]) , actions.
].
box buttonTitles:titles.
box actions:actions.
@@ -1199,7 +1271,7 @@
could be cought and the stackLimit increased in the handler."
thisContext isRecursive ifFalse:[
- ^ RecursionInterruptSignal raise
+ ^ RecursionInterruptSignal raise
]
!
@@ -1218,6 +1290,13 @@
^ SubscriptOutOfBoundsSignal raise
!
+subscriptBoundsError:anIndex
+ "report error that anIndex is out of bounds.
+ (when accessing indexable collections)"
+
+ ^ SubscriptOutOfBoundsSignal raiseRequestWith:anIndex
+!
+
indexNotInteger
"report error that index is not an Integer.
(when accessing collections indexed by an integer key)"
@@ -1281,7 +1360,7 @@
value assigned"
^ self error:'bad assign of ' , self printString ,
- ' (' , self class name , ') to integer-typed variable'
+ ' (' , self class name , ') to integer-typed variable'
!
typeCheckError
@@ -1289,7 +1368,7 @@
value assigned"
^ self error:'bad assign of ' , self printString ,
- ' (' , self class name , ') to typed variable'
+ ' (' , self class name , ') to typed variable'
!
primitiveFailed
@@ -1361,12 +1440,12 @@
|sel errorString|
aMessage selector isNil ifTrue:[
- "happens when things go mad, or a method has been
- called by valueWithReceiver: with a wrong receiver"
-
- sel := '(nil)'
+ "happens when things go mad, or a method has been
+ called by valueWithReceiver: with a wrong receiver"
+
+ sel := '(nil)'
] ifFalse:[
- sel := aMessage selector
+ sel := aMessage selector
].
errorString := 'Message not understood: ' , sel.
@@ -1374,46 +1453,44 @@
this only happens, when YOU play around with my classvars ...
"
MessageNotUnderstoodSignal isNil ifTrue:[
- ^ self enterDebuggerWith:nil
- message:'oops - MessageNotUnderstoodSignal is gone'.
+ ^ self enterDebuggerWith:nil
+ message:'oops - MessageNotUnderstoodSignal is gone'.
].
^ MessageNotUnderstoodSignal
- raiseRequestWith:aMessage
- errorString:errorString
+ raiseRequestWith:aMessage
+ errorString:errorString
!
-checkForRecursiveError
- "helper for all error-methods; catch error while in Debugger.
- If Debugger is DebugView, try switching to MiniDebugger (as
- a last chance) otherwise abort.
- There should not be an error in the debugger, this will only
- happen if some classes have been changed badly."
+appropriateDebugger:aMessage
+ "return an appropriate debugger to use.
+ If there is already a debugger active on the stack, and it is
+ the DebugView, return MiniDebugger (as a last chance) otherwise abort."
|context|
context := thisContext.
context := context sender.
[context notNil] whileTrue:[
- ((context receiver class == Debugger)
- and:[context selector == #enterWithMessage:]) ifTrue:[
- "we are already in some Debugger"
- (Debugger == MiniDebugger) ifTrue:[
- "we are in the MiniDebugger"
- ErrorRecursion ifFalse:[
- Smalltalk fatalAbort:'recursive error ...'
- ]
- ].
- MiniDebugger isNil ifTrue:[
- Smalltalk fatalAbort:'no debugger'
- ].
-
- "ok, an error occured while in the graphical debugger;
- lets try MiniDebugger"
- ^ MiniDebugger
- ].
- context := context sender
+ ((context receiver class == Debugger)
+ and:[context selector == aMessage]) ifTrue:[
+ "we are already in some Debugger"
+ (Debugger == MiniDebugger) ifTrue:[
+ "we are already in the MiniDebugger"
+ ErrorRecursion ifFalse:[
+ Smalltalk fatalAbort:'recursive error ...'
+ ]
+ ].
+ MiniDebugger isNil ifTrue:[
+ Smalltalk fatalAbort:'no debugger'
+ ].
+
+ "ok, an error occured while in the graphical debugger;
+ lets try MiniDebugger"
+ ^ MiniDebugger
+ ].
+ context := context sender
].
- "not within Debugger - go there"
+ "not within Debugger - no problem"
^ Debugger
!
@@ -1426,13 +1503,13 @@
if there is no debugger, exit smalltalk
"
Debugger isNil ifTrue:[
- 'error: ' errorPrint. aString errorPrintNL.
- Smalltalk fatalAbort:'no Debugger defined'
+ 'error: ' errorPrint. aString errorPrintNL.
+ Smalltalk fatalAbort:'no Debugger defined'
].
"
find an appropriate debugger to use
"
- debugger := self checkForRecursiveError.
+ debugger := self appropriateDebugger:#enterWithMessage.
^ debugger enterWithMessage:aString.
! !
@@ -1441,15 +1518,15 @@
notify:aString
"launch a Notifier, telling user something"
- Notifier isNil ifTrue:[
- "
- in systems without GUI, simply show
- the message on the Transcript.
- "
- Transcript showCr:aString.
- ^ self
+ DialogView isNil ifTrue:[
+ "
+ on systems without GUI, simply show
+ the message on the Transcript.
+ "
+ Transcript showCr:aString.
+ ^ self
].
- (Notifier new title:aString) showAtPointer
+ DialogView information:aString
"
nil notify:'hello there'
@@ -1460,15 +1537,7 @@
information:aString
"launch an InfoBox, telling user something"
- InfoBox isNil ifTrue:[
- "
- on systems without GUI, simply show
- the message on the Transcript.
- "
- Transcript showCr:aString.
- ^ self
- ].
- (InfoBox new title:aString) showAtPointer
+ self notify:aString
"
nil information:'hello there'
@@ -1479,15 +1548,15 @@
warn:aString
"launch a WarningBox, telling user something"
- WarningBox isNil ifTrue:[
- "
- on systems without GUI, simply show
- the message on the Transcript.
- "
- Transcript showCr:aString.
- ^ self
+ DialogView isNil ifTrue:[
+ "
+ on systems without GUI, simply show
+ the message on the Transcript.
+ "
+ Transcript showCr:aString.
+ ^ self
].
- (WarningBox new title:aString) showAtPointer
+ DialogView warn:aString
"
nil warn:'hello there'
@@ -1499,21 +1568,16 @@
"launch a confirmer, which allows user to enter yes or no.
return true for yes, false for no"
- |box|
-
- YesNoBox isNil ifTrue:[
- "
- on systems without GUI, output a message
- and return true (as if yes was answered)
- Q: should we ask user by reading Stdin ?
- "
- Transcript showCr:aString.
- ^ true
+ DialogView isNil ifTrue:[
+ "
+ on systems without GUI, output a message
+ and return true (as if yes was answered)
+ Q: should we ask user by reading Stdin ?
+ "
+ Transcript showCr:aString.
+ ^ true
].
- box := YesNoBox new.
- box title:aString.
- box yesAction:[^ true] noAction:[^ false].
- box showAtPointer
+ ^ DialogView confirm:aString
"
nil confirm:'hello'
@@ -1526,12 +1590,12 @@
this method should NOT be redefined in subclasses."
Inspector isNil ifTrue:[
- "
- for systems without GUI
- "
- Transcript showCr:'no Inspector'
+ "
+ for systems without GUI
+ "
+ Transcript showCr:'no Inspector'
] ifFalse:[
- Inspector openOn:self
+ Inspector openOn:self
]
!
@@ -1576,76 +1640,76 @@
* and SmallInteger
*/
if (_isSmallInteger(index)) {
- myClass = _qClass(self);
- indx = _intVal(index) - 1;
- ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
- nInstBytes = OHDR_SIZE + __OBJS2BYTES__(ninstvars);
- nbytes = _qSize(self) - nInstBytes;
- pFirst = (char *)(_InstPtr(self)) + nInstBytes;
-
- switch (_intVal(_ClassInstPtr(myClass)->c_flags) & ARRAYMASK) {
- case BYTEARRAY:
- if ((indx >= 0) && (indx < (nbytes / sizeof(char)))) {
- cp = (unsigned char *)pFirst + indx;
- RETURN ( _MKSMALLINT(*cp & 0xFF) );
- }
- break;
-
- case WORDARRAY:
- if ((indx >= 0) && (indx < (nbytes / sizeof(short)))) {
- sp = (unsigned short *)pFirst + indx;
- RETURN ( _MKSMALLINT(*sp & 0xFFFF) );
- }
- break;
-
- case LONGARRAY:
- if ((indx >= 0) && (indx < (nbytes / sizeof(long)))) {
- lp = (long *)pFirst + indx;
- if ((*lp >= _MIN_INT) && (*lp <= _MAX_INT))
- RETURN ( _MKSMALLINT(*lp) );
- RETURN ( _makeLarge(*lp) );
- }
- break;
-
- case FLOATARRAY:
- if ((indx >= 0) && (indx < (nbytes / sizeof(float)))) {
- float *fp;
-
- fp = (float *)pFirst + indx;
- RETURN ( _MKFLOAT((double)(*fp)) COMMA_CON );
- }
- break;
-
- case DOUBLEARRAY:
- if ((indx >= 0) && (indx < (nbytes / sizeof(double)))) {
- double *dp;
+ myClass = _qClass(self);
+ indx = _intVal(index) - 1;
+ ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
+ nInstBytes = OHDR_SIZE + __OBJS2BYTES__(ninstvars);
+ nbytes = _qSize(self) - nInstBytes;
+ pFirst = (char *)(_InstPtr(self)) + nInstBytes;
+
+ switch (_intVal(_ClassInstPtr(myClass)->c_flags) & ARRAYMASK) {
+ case BYTEARRAY:
+ if ((indx >= 0) && (indx < (nbytes / sizeof(char)))) {
+ cp = (unsigned char *)pFirst + indx;
+ RETURN ( _MKSMALLINT(*cp & 0xFF) );
+ }
+ break;
+
+ case WORDARRAY:
+ if ((indx >= 0) && (indx < (nbytes / sizeof(short)))) {
+ sp = (unsigned short *)pFirst + indx;
+ RETURN ( _MKSMALLINT(*sp & 0xFFFF) );
+ }
+ break;
+
+ case LONGARRAY:
+ if ((indx >= 0) && (indx < (nbytes / sizeof(long)))) {
+ lp = (long *)pFirst + indx;
+ if ((*lp >= _MIN_INT) && (*lp <= _MAX_INT))
+ RETURN ( _MKSMALLINT(*lp) );
+ RETURN ( _makeLarge(*lp) );
+ }
+ break;
+
+ case FLOATARRAY:
+ if ((indx >= 0) && (indx < (nbytes / sizeof(float)))) {
+ float *fp;
+
+ fp = (float *)pFirst + indx;
+ RETURN ( _MKFLOAT((double)(*fp)) COMMA_CON );
+ }
+ break;
+
+ case DOUBLEARRAY:
+ if ((indx >= 0) && (indx < (nbytes / sizeof(double)))) {
+ double *dp;
#ifdef NEED_DOUBLE_ALIGN
- /*
- * care for filler
- */
- pFirst += sizeof(FILLTYPE);
+ /*
+ * care for filler
+ */
+ pFirst += sizeof(FILLTYPE);
#endif
- dp = (double *)pFirst + indx;
- RETURN ( _MKFLOAT(*dp) COMMA_CON );
- }
- break;
-
- case WKPOINTERARRAY:
- case POINTERARRAY:
- if ((indx >= 0) && (indx < (__BYTES2OBJS__(nbytes)))) {
- op = (OBJ *)pFirst + indx;
- RETURN ( *op );
- }
- break;
- }
+ dp = (double *)pFirst + indx;
+ RETURN ( _MKFLOAT(*dp) COMMA_CON );
+ }
+ break;
+
+ case WKPOINTERARRAY:
+ case POINTERARRAY:
+ if ((indx >= 0) && (indx < (__BYTES2OBJS__(nbytes)))) {
+ op = (OBJ *)pFirst + indx;
+ RETURN ( *op );
+ }
+ break;
+ }
}
%}
.
index isInteger ifFalse:[
- ^ self indexNotInteger
+ ^ self indexNotInteger
].
- ^ self subscriptBoundsError
+ ^ self subscriptBoundsError:index
!
at:index put:anObject
@@ -1677,126 +1741,141 @@
and SmallInteger */
if (_isSmallInteger(index)) {
- indx = _intVal(index) - 1;
- myClass = _qClass(self);
- ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
- nInstBytes = OHDR_SIZE + __OBJS2BYTES__(ninstvars);
- nbytes = _qSize(self) - nInstBytes;
- pFirst = (char *)(_InstPtr(self)) + nInstBytes;
-
- switch (_intVal(_ClassInstPtr(myClass)->c_flags) & ARRAYMASK) {
- case BYTEARRAY:
- if (_isSmallInteger(anObject)) {
- val = _intVal(anObject);
- if ((val >= 0) && (val <= 255)) {
- if ((indx >= 0) && (indx < (nbytes / sizeof(char)))) {
- cp = pFirst + indx;
- *cp = val;
- RETURN ( anObject );
- }
- }
- }
- break;
-
- case WORDARRAY:
- if (_isSmallInteger(anObject)) {
- val = _intVal(anObject);
- if ((val >= 0) && (val <= 0xFFFF)) {
- if ((indx >= 0) && (indx < (nbytes / sizeof(short)))) {
- sp = (short *)pFirst + indx;
- *sp = val;
- RETURN ( anObject );
- }
- }
- }
- break;
-
- case LONGARRAY:
- if (_isSmallInteger(anObject)) {
- if ((indx >= 0) && (indx < (nbytes / sizeof(long)))) {
- lp = (long *)pFirst + indx;
- *lp = _intVal(anObject);
- RETURN ( anObject );
- }
- }
- /* XXX
- * XXX must add possibility to put in a large number here
- * XXX
- */
- break;
-
- case FLOATARRAY:
- if ((indx >= 0) && (indx < (nbytes / sizeof(float)))) {
- float *fp;
-
- fp = (float *)pFirst + indx;
- if (__isFloat(anObject)) {
- *fp = _floatVal(anObject);
- RETURN ( anObject );
- } else if (_isSmallInteger(anObject)) {
- *fp = (float) _intVal(anObject);
- RETURN ( anObject );
- }
- }
-
- break;
-
- case DOUBLEARRAY:
- if ((indx >= 0) && (indx < (nbytes / sizeof(double)))) {
- double *dp;
+ indx = _intVal(index) - 1;
+ myClass = _qClass(self);
+ ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
+ nInstBytes = OHDR_SIZE + __OBJS2BYTES__(ninstvars);
+ nbytes = _qSize(self) - nInstBytes;
+ pFirst = (char *)(_InstPtr(self)) + nInstBytes;
+
+ switch (_intVal(_ClassInstPtr(myClass)->c_flags) & ARRAYMASK) {
+ case BYTEARRAY:
+ if (_isSmallInteger(anObject)) {
+ val = _intVal(anObject);
+ if ((val >= 0) && (val <= 255)) {
+ if ((indx >= 0) && (indx < (nbytes / sizeof(char)))) {
+ cp = pFirst + indx;
+ *cp = val;
+ RETURN ( anObject );
+ }
+ }
+ }
+ break;
+
+ case WORDARRAY:
+ if (_isSmallInteger(anObject)) {
+ val = _intVal(anObject);
+ if ((val >= 0) && (val <= 0xFFFF)) {
+ if ((indx >= 0) && (indx < (nbytes / sizeof(short)))) {
+ sp = (short *)pFirst + indx;
+ *sp = val;
+ RETURN ( anObject );
+ }
+ }
+ }
+ break;
+
+ case LONGARRAY:
+ if (_isSmallInteger(anObject)) {
+ if ((indx >= 0) && (indx < (nbytes / sizeof(long)))) {
+ lp = (long *)pFirst + indx;
+ *lp = _intVal(anObject);
+ RETURN ( anObject );
+ }
+ }
+ /* XXX
+ * XXX must add possibility to put in a large number here
+ * XXX
+ */
+ break;
+
+ case FLOATARRAY:
+ if ((indx >= 0) && (indx < (nbytes / sizeof(float)))) {
+ float *fp;
+
+ fp = (float *)pFirst + indx;
+ if (__isFloat(anObject)) {
+ *fp = _floatVal(anObject);
+ RETURN ( anObject );
+ } else if (_isSmallInteger(anObject)) {
+ *fp = (float) _intVal(anObject);
+ RETURN ( anObject );
+ }
+ }
+
+ break;
+
+ case DOUBLEARRAY:
+ if ((indx >= 0) && (indx < (nbytes / sizeof(double)))) {
+ double *dp;
#ifdef NEED_DOUBLE_ALIGN
- /*
- * care for filler
- */
- pFirst += sizeof(FILLTYPE);
+ /*
+ * care for filler
+ */
+ pFirst += sizeof(FILLTYPE);
#endif
- dp = (double *)pFirst + indx;
- if (__isFloat(anObject)) {
- *dp = _floatVal(anObject);
- RETURN ( anObject );
- } else if (_isSmallInteger(anObject)) {
- *dp = (double) _intVal(anObject);
- RETURN ( anObject );
- }
- }
- break;
-
- case WKPOINTERARRAY:
- case POINTERARRAY:
- if ((indx >= 0) && (indx < (__BYTES2OBJS__(nbytes)))) {
- op = (OBJ *)pFirst + indx;
- *op = anObject;
- __STORE(self, anObject);
- RETURN ( anObject );
- }
- break;
-
- default:
- break;
- }
+ dp = (double *)pFirst + indx;
+ if (__isFloat(anObject)) {
+ *dp = _floatVal(anObject);
+ RETURN ( anObject );
+ } else if (_isSmallInteger(anObject)) {
+ *dp = (double) _intVal(anObject);
+ RETURN ( anObject );
+ }
+ }
+ break;
+
+ case WKPOINTERARRAY:
+ case POINTERARRAY:
+ if ((indx >= 0) && (indx < (__BYTES2OBJS__(nbytes)))) {
+ op = (OBJ *)pFirst + indx;
+ *op = anObject;
+ __STORE(self, anObject);
+ RETURN ( anObject );
+ }
+ break;
+
+ default:
+ break;
+ }
}
%}
.
index isInteger ifFalse:[
- ^ self indexNotInteger
+ "
+ the index should be an integer number
+ "
+ ^ self indexNotInteger
].
(index between:1 and:self size) ifFalse:[
- ^ self subscriptBoundsError
+ "
+ the index is less than 1 or greater than the size of the
+ recevier collection
+ "
+ ^ self subscriptBoundsError:index
].
(self class isFloats) ifTrue:[
- anObject isNumber ifTrue:[
- ^ self basicAt:index put:(anObject asFloat)
- ]
+ anObject isNumber ifTrue:[
+ ^ self basicAt:index put:(anObject asFloat)
+ ]
].
(self class isDoubles) ifTrue:[
- anObject isNumber ifTrue:[
- ^ self basicAt:index put:(anObject asFloat)
- ]
+ anObject isNumber ifTrue:[
+ ^ self basicAt:index put:(anObject asFloat)
+ ]
].
anObject isInteger ifFalse:[
- ^ self elementNotInteger
+ "
+ the object to put into the recevier collection
+ should be an integer number
+ "
+ ^ self elementNotInteger
].
+ "
+ the object to put into the recevier collection
+ is not an instance of the expected element class
+ "
^ self elementBoundsError
!
@@ -1811,19 +1890,19 @@
int idx, ninstvars;
if (_isSmallInteger(index)) {
- myClass = _Class(self);
- ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
- idx = _intVal(index) - 1;
- if ((idx >= 0) && (idx < ninstvars)) {
- RETURN ( _InstPtr(self)->i_instvars[idx] );
- }
+ myClass = _Class(self);
+ ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
+ idx = _intVal(index) - 1;
+ if ((idx >= 0) && (idx < ninstvars)) {
+ RETURN ( _InstPtr(self)->i_instvars[idx] );
+ }
}
%}
.
index isInteger ifFalse:[
- ^ self indexNotInteger
+ ^ self indexNotInteger
].
- ^ self subscriptBoundsError
+ ^ self subscriptBoundsError:index
!
instVarAt:index put:value
@@ -1837,21 +1916,21 @@
int idx, ninstvars;
if (_isSmallInteger(index)) {
- myClass = _Class(self);
- ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
- idx = _intVal(index) - 1;
- if ((idx >= 0) && (idx < ninstvars)) {
- _InstPtr(self)->i_instvars[idx] = value;
- __STORE(self, value);
- RETURN ( value );
- }
+ myClass = _Class(self);
+ ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
+ idx = _intVal(index) - 1;
+ if ((idx >= 0) && (idx < ninstvars)) {
+ _InstPtr(self)->i_instvars[idx] = value;
+ __STORE(self, value);
+ RETURN ( value );
+ }
}
%}
.
index isInteger ifFalse:[
- ^ self indexNotInteger
+ ^ self indexNotInteger
].
- ^ self subscriptBoundsError
+ ^ self subscriptBoundsError:index
! !
!Object methodsFor:'dependents access'!
@@ -1861,7 +1940,7 @@
The default implementation here uses a global Dictionary to store
dependents - some classes (Model) redefine this for better performance."
- ^ Dependencies at:self ifAbsent:[]
+ ^ Dependencies at:self ifAbsent:[nil]
!
dependents:aCollection
@@ -1870,9 +1949,20 @@
dependents - some classes (Model) redefine this for better performance."
(aCollection isNil or:[aCollection isEmpty]) ifTrue:[
- Dependencies removeKey:self ifAbsent:[]
+ Dependencies removeKey:self ifAbsent:[]
] ifFalse:[
- Dependencies at:self put:aCollection
+ Dependencies at:self put:aCollection
+ ]
+!
+
+dependentsDo:aBlock
+ "evaluate aBlock for all of my dependents"
+
+ |deps|
+
+ deps := self dependents.
+ deps notNil ifTrue:[
+ deps do:aBlock
]
!
@@ -1883,9 +1973,9 @@
deps := self dependents.
deps isNil ifTrue:[
- self dependents:(WeakIdentitySet with:anObject)
+ self dependents:(WeakIdentitySet with:anObject)
] ifFalse:[
- deps add:anObject
+ deps add:anObject
]
!
@@ -1896,10 +1986,10 @@
deps := self dependents.
deps notNil ifTrue:[
- deps remove:anObject ifAbsent:[].
- deps isEmpty ifTrue:[
- self dependents:nil
- ]
+ deps remove:anObject ifAbsent:[].
+ deps isEmpty ifTrue:[
+ self dependents:nil
+ ]
]
!
@@ -1911,19 +2001,44 @@
!Object methodsFor:'change and update'!
+changeRequest
+ "the receiver wants to change - check if all dependents
+ grant the request, and return true if so"
+
+ self dependentsDo:[:dependent |
+ dependent updateRequest ifFalse:[^ false].
+ ].
+ ^ true
+!
+
+changeRequest:aParameter
+ "the receiver wants to change - check if all dependents
+ grant the request, and return true if so"
+
+ self dependentsDo:[:dependent |
+ (dependent updateRequest:aParameter) ifFalse:[^ false].
+ ].
+ ^ true
+!
+
+changeRequestFrom:anObject
+ "the receiver wants to change - check if all dependents
+ except anObject grant the request, and return true if so"
+
+ self dependentsDo:[:dependent |
+ dependent == anObject ifFalse:[
+ (dependent updateRequest) ifFalse:[^ false].
+ ]
+ ].
+ ^ true
+!
+
changed
"notify all dependents that the receiver has changed.
Each dependent gets a '#update:'-message with the original
receiver as argument."
- |deps|
-
- deps := self dependents.
- deps notNil ifTrue:[
- deps do:[:dependent |
- dependent update:self
- ]
- ]
+ self changed:nil
!
changed:aParameter
@@ -1931,41 +2046,24 @@
Each dependent gets a '#update:'-message with aParameter
as argument."
- |deps|
-
- deps := self dependents.
- deps notNil ifTrue:[
- deps do:[:dependent |
- dependent update:aParameter
- ]
- ]
+ self changed:aParameter with:nil
!
changed:aParameter with:anArgument
"notify all dependents that the receiver has changed somehow.
- Each dependent gets a '#update:with:'-message, with aParameter
+ Each dependent gets a '#update:with:from:'-message, with aParameter
and anArgument as arguments."
- |deps|
-
- deps := self dependents.
- deps notNil ifTrue:[
- deps do:[:dependent |
- dependent update:aParameter with:anArgument
- ]
+ self dependentsDo:[:dependent |
+ dependent update:aParameter with:anArgument from:self
]
!
broadcast:aSelectorSymbol
"send a message with selector aSelectorSymbol to all my dependents"
- |deps|
-
- deps := self dependents.
- deps notNil ifTrue:[
- deps do:[:dependent |
- dependent perform:aSelectorSymbol
- ]
+ self dependentsDo:[:dependent |
+ dependent perform:aSelectorSymbol
]
!
@@ -1973,13 +2071,8 @@
"send a message with selector aSelectorSymbol with an additional
argument anArgument to all my dependents."
- |deps|
-
- deps := self dependents.
- deps notNil ifTrue:[
- deps do:[:dependent |
- dependent perform:aSelectorSymbol with:anArgument
- ]
+ self dependentsDo:[:dependent |
+ dependent perform:aSelectorSymbol with:anArgument
]
!
@@ -1995,16 +2088,32 @@
update:aParameter with:anArgument
"dependent is notified of some change -
- Default is to try simple update"
+ Default is to try update:"
^ self update:aParameter
!
update:aParameter with:anArgument from:sender
"dependent is notified of some change -
- Default is to try simple update"
+ Default is to try update:with:"
^ self update:aParameter with:anArgument
+!
+
+updateRequest
+ "return true, if an update request is granted.
+ Default here is to grant updates - may be used
+ to lock updates if someone is making other changes
+ from within an update"
+
+ ^ true
+!
+
+updateRequest:aSymbol
+ "return true, if an update request is granted.
+ Default here a simple updateRequest"
+
+ ^ self updateRequest
! !
!Object methodsFor:'secure message sending'!
@@ -2031,9 +2140,9 @@
|val|
MessageNotUnderstoodSignal handle:[:ex |
- ^ exceptionBlock value
+ ^ exceptionBlock value
] do:[
- val := self perform:aSelector
+ val := self perform:aSelector
].
^ val
@@ -2050,9 +2159,9 @@
|val|
MessageNotUnderstoodSignal handle:[:ex |
- ^ exceptionBlock value
+ ^ exceptionBlock value
] do:[
- val := self perform:aSelector with:argument
+ val := self perform:aSelector with:argument
].
^ val
@@ -2073,6 +2182,7 @@
%{ /* NOCONTEXT */
+#define PRE_2_11
#ifdef PRE_2_11
static struct inlineCache ilc = _ILC0;
struct inlineCache lilc = _DUMMYILC0;
@@ -2091,8 +2201,8 @@
#ifdef PRE_2_11
if (aSelector != lastSelector) {
- ilc.ilc_func = _SEND0;
- lastSelector = aSelector;
+ ilc.ilc_func = _SEND0;
+ lastSelector = aSelector;
}
#else
lilc = ilc;
@@ -2122,39 +2232,35 @@
#ifdef PRE_2_11
static struct inlineCache ilc = _ILC1;
struct inlineCache lilc = _DUMMYILC1;
-#else
- static struct inlineCache ilc = _DUMMYILC1;
- struct inlineCache lilc;
-#endif
+
static OBJ lastSelector = nil;
-#if defined(THIS_CONTEXT)
+# if defined(THIS_CONTEXT)
/*
* must set lineno in sender by hand here ... (because of NOCONTEXT)
*/
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
-#endif
-
-#ifdef PRE_2_11
+# endif
+
if (aSelector != lastSelector) {
- ilc.ilc_func = _SEND1;
- lastSelector = aSelector;
+ ilc.ilc_func = _SEND1;
+ lastSelector = aSelector;
}
-#else
- lilc = ilc;
-#endif
-
-#if defined(xxTHIS_CONTEXT)
-# ifdef PRE_2_11
ilc.ilc_lineNo = __pilc->ilc_lineNo;
-# else
- lilc.ilc_lineNo = __pilc->ilc_lineNo;
-# endif
-#endif
-
-#ifdef PRE_2_11
RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, anObject) );
#else
+ static struct inlineCache ilc = _DUMMYILC1;
+ struct inlineCache lilc;
+
+# if defined(THIS_CONTEXT)
+ /*
+ * must set lineno in sender by hand here ... (because of NOCONTEXT)
+ */
+ _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
+# endif
+
+ lilc = ilc;
+ lilc.ilc_lineNo = __pilc->ilc_lineNo;
RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &lilc, anObject) );
#endif
%}
@@ -2183,8 +2289,8 @@
#ifdef PRE_2_11
if (aSelector != lastSelector) {
- ilc.ilc_func = _SEND2;
- lastSelector = aSelector;
+ ilc.ilc_func = _SEND2;
+ lastSelector = aSelector;
}
#else
lilc = ilc;
@@ -2229,8 +2335,8 @@
#ifdef PRE_2_11
if (aSelector != lastSelector) {
- ilc.ilc_func = _SEND3;
- lastSelector = aSelector;
+ ilc.ilc_func = _SEND3;
+ lastSelector = aSelector;
}
#else
lilc = ilc;
@@ -2288,207 +2394,207 @@
#endif
if (_isSmallInteger(numberOfArgs)) {
- nargs = _intVal(numberOfArgs);
- if (nargs == 0) {
- if (aSelector != last0) {
- ilc0.ilc_func = _SEND0;
- last0 = aSelector;
- }
+ nargs = _intVal(numberOfArgs);
+ if (nargs == 0) {
+ if (aSelector != last0) {
+ ilc0.ilc_func = _SEND0;
+ last0 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc0.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc0.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ((*ilc0.ilc_func)(self, aSelector, CON_COMMA nil, &ilc0));
- }
-
- if (__isArray(argArray)) {
- argP = _ArrayInstPtr(argArray)->a_element;
- } else {
- argP = (OBJ *)(&a1);
- for (i=1; i <= nargs; i++) {
- *argP++ = _AT_(argArray, CON_COMMA _MKSMALLINT(i));
- }
- }
- switch (nargs) {
- case 1:
- if (aSelector != last1) {
- ilc1.ilc_func = _SEND1;
- last1 = aSelector;
- }
+ RETURN ((*ilc0.ilc_func)(self, aSelector, CON_COMMA nil, &ilc0));
+ }
+
+ if (__isArray(argArray)) {
+ argP = _ArrayInstPtr(argArray)->a_element;
+ } else {
+ argP = (OBJ *)(&a1);
+ for (i=1; i <= nargs; i++) {
+ *argP++ = _AT_(argArray, CON_COMMA _MKSMALLINT(i));
+ }
+ }
+ switch (nargs) {
+ case 1:
+ if (aSelector != last1) {
+ ilc1.ilc_func = _SEND1;
+ last1 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc1.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc1.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc1.ilc_func)(self, aSelector, CON_COMMA nil, &ilc1, argP[0]));
-
- case 2:
- if (aSelector != last2) {
- ilc2.ilc_func = _SEND2;
- last2 = aSelector;
- }
+ RETURN ( (*ilc1.ilc_func)(self, aSelector, CON_COMMA nil, &ilc1, argP[0]));
+
+ case 2:
+ if (aSelector != last2) {
+ ilc2.ilc_func = _SEND2;
+ last2 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc2.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc2.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc2.ilc_func)(self, aSelector, CON_COMMA nil, &ilc2,
- argP[0], argP[1]));
-
- case 3:
- if (aSelector != last3) {
- ilc3.ilc_func = _SEND3;
- last3 = aSelector;
- }
+ RETURN ( (*ilc2.ilc_func)(self, aSelector, CON_COMMA nil, &ilc2,
+ argP[0], argP[1]));
+
+ case 3:
+ if (aSelector != last3) {
+ ilc3.ilc_func = _SEND3;
+ last3 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc3.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc3.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc3.ilc_func)(self, aSelector, CON_COMMA nil, &ilc3,
- argP[0], argP[1], argP[2]));
-
- case 4:
- if (aSelector != last4) {
- ilc4.ilc_func = _SEND4;
- last4 = aSelector;
- }
+ RETURN ( (*ilc3.ilc_func)(self, aSelector, CON_COMMA nil, &ilc3,
+ argP[0], argP[1], argP[2]));
+
+ case 4:
+ if (aSelector != last4) {
+ ilc4.ilc_func = _SEND4;
+ last4 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc4.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc4.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc4.ilc_func)(self, aSelector, CON_COMMA nil, &ilc4,
- argP[0], argP[1], argP[2], argP[3]));
-
- case 5:
- if (aSelector != last5) {
- ilc5.ilc_func = _SEND5;
- last5 = aSelector;
- }
+ RETURN ( (*ilc4.ilc_func)(self, aSelector, CON_COMMA nil, &ilc4,
+ argP[0], argP[1], argP[2], argP[3]));
+
+ case 5:
+ if (aSelector != last5) {
+ ilc5.ilc_func = _SEND5;
+ last5 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc5.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc5.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc5.ilc_func)(self, aSelector, CON_COMMA nil, &ilc5,
- argP[0], argP[1], argP[2], argP[3], argP[4]));
-
- case 6:
- if (aSelector != last6) {
- ilc6.ilc_func = _SEND6;
- last6 = aSelector;
- }
+ RETURN ( (*ilc5.ilc_func)(self, aSelector, CON_COMMA nil, &ilc5,
+ argP[0], argP[1], argP[2], argP[3], argP[4]));
+
+ case 6:
+ if (aSelector != last6) {
+ ilc6.ilc_func = _SEND6;
+ last6 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc6.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc6.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc6.ilc_func)(self, aSelector, CON_COMMA nil, &ilc6,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5]));
-
- case 7:
- if (aSelector != last7) {
- ilc7.ilc_func = _SEND7;
- last7 = aSelector;
- }
+ RETURN ( (*ilc6.ilc_func)(self, aSelector, CON_COMMA nil, &ilc6,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5]));
+
+ case 7:
+ if (aSelector != last7) {
+ ilc7.ilc_func = _SEND7;
+ last7 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc7.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc7.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc7.ilc_func)(self, aSelector, CON_COMMA nil, &ilc7,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6]));
-
- case 8:
- if (aSelector != last8) {
- ilc8.ilc_func = _SEND8;
- last8 = aSelector;
- }
+ RETURN ( (*ilc7.ilc_func)(self, aSelector, CON_COMMA nil, &ilc7,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6]));
+
+ case 8:
+ if (aSelector != last8) {
+ ilc8.ilc_func = _SEND8;
+ last8 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc8.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc8.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc8.ilc_func)(self, aSelector, CON_COMMA nil, &ilc8,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7]));
-
- case 9:
- if (aSelector != last9) {
- ilc9.ilc_func = _SEND9;
- last9 = aSelector;
- }
+ RETURN ( (*ilc8.ilc_func)(self, aSelector, CON_COMMA nil, &ilc8,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7]));
+
+ case 9:
+ if (aSelector != last9) {
+ ilc9.ilc_func = _SEND9;
+ last9 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc9.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc9.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc9.ilc_func)(self, aSelector, CON_COMMA nil, &ilc9,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8]));
-
- case 10:
- if (aSelector != last10) {
- ilc10.ilc_func = _SEND10;
- last10 = aSelector;
- }
+ RETURN ( (*ilc9.ilc_func)(self, aSelector, CON_COMMA nil, &ilc9,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8]));
+
+ case 10:
+ if (aSelector != last10) {
+ ilc10.ilc_func = _SEND10;
+ last10 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc10.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc10.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc10.ilc_func)(self, aSelector, CON_COMMA nil, &ilc10,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8], argP[9]));
-
- case 11:
- if (aSelector != last11) {
- ilc11.ilc_func = _SEND11;
- last11 = aSelector;
- }
+ RETURN ( (*ilc10.ilc_func)(self, aSelector, CON_COMMA nil, &ilc10,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9]));
+
+ case 11:
+ if (aSelector != last11) {
+ ilc11.ilc_func = _SEND11;
+ last11 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc11.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc11.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc11.ilc_func)(self, aSelector, CON_COMMA nil, &ilc11,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8], argP[9],
- argP[10]));
-
- case 12:
- if (aSelector != last12) {
- ilc12.ilc_func = _SEND12;
- last12 = aSelector;
- }
+ RETURN ( (*ilc11.ilc_func)(self, aSelector, CON_COMMA nil, &ilc11,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10]));
+
+ case 12:
+ if (aSelector != last12) {
+ ilc12.ilc_func = _SEND12;
+ last12 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc12.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc12.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc12.ilc_func)(self, aSelector, CON_COMMA nil, &ilc12,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8], argP[9],
- argP[10], argP[11]));
-
- case 13:
- if (aSelector != last13) {
- ilc13.ilc_func = _SEND13;
- last13 = aSelector;
- }
+ RETURN ( (*ilc12.ilc_func)(self, aSelector, CON_COMMA nil, &ilc12,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10], argP[11]));
+
+ case 13:
+ if (aSelector != last13) {
+ ilc13.ilc_func = _SEND13;
+ last13 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc13.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc13.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc13.ilc_func)(self, aSelector, CON_COMMA nil, &ilc13,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8], argP[9],
- argP[10], argP[11], argP[12]));
-
- case 14:
- if (aSelector != last14) {
- ilc14.ilc_func = _SEND14;
- last14 = aSelector;
- }
+ RETURN ( (*ilc13.ilc_func)(self, aSelector, CON_COMMA nil, &ilc13,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10], argP[11], argP[12]));
+
+ case 14:
+ if (aSelector != last14) {
+ ilc14.ilc_func = _SEND14;
+ last14 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc14.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc14.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc14.ilc_func)(self, aSelector, CON_COMMA nil, &ilc14,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8], argP[9],
- argP[10], argP[11], argP[12], argP[13]));
-
- case 15:
- if (aSelector != last15) {
- ilc15.ilc_func = _SEND15;
- last15 = aSelector;
- }
+ RETURN ( (*ilc14.ilc_func)(self, aSelector, CON_COMMA nil, &ilc14,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10], argP[11], argP[12], argP[13]));
+
+ case 15:
+ if (aSelector != last15) {
+ ilc15.ilc_func = _SEND15;
+ last15 = aSelector;
+ }
#ifdef xxTHIS_CONTEXT
- ilc15.ilc_lineNo = __pilc->ilc_lineNo;
+ ilc15.ilc_lineNo = __pilc->ilc_lineNo;
#endif
- RETURN ( (*ilc15.ilc_func)(self, aSelector, CON_COMMA nil, &ilc15,
- argP[0], argP[1], argP[2], argP[3], argP[4],
- argP[5], argP[6], argP[7], argP[8], argP[9],
- argP[10], argP[11], argP[12], argP[13],
- argP[14]));
- }
+ RETURN ( (*ilc15.ilc_func)(self, aSelector, CON_COMMA nil, &ilc15,
+ argP[0], argP[1], argP[2], argP[3], argP[4],
+ argP[5], argP[6], argP[7], argP[8], argP[9],
+ argP[10], argP[11], argP[12], argP[13],
+ argP[14]));
+ }
}
%}
.
@@ -2502,7 +2608,7 @@
to execute a method in ANY superclass of the receiver (not just the
immediate superclass).
Thus, it is (theoretically) possible to do
- '5 perform:#< inClass:Magnitude withArguments:#(6)'
+ '5 perform:#< inClass:Magnitude withArguments:#(6)'
and evaluate Magnitudes compare method even if there was one in Number.
This method is used by the interpreter to evaluate super sends
and could be used for very special behavior (language extension ?).
@@ -2515,8 +2621,8 @@
check, if aClass is really a superclass of the receiver
"
(self class isSubclassOf:aClass) ifFalse:[
- self error:'class argument is not a superclass of the receiver'.
- ^ nil
+ self error:'class argument is not a superclass of the receiver'.
+ ^ nil
].
numberOfArgs := argArray size.
%{
@@ -2541,81 +2647,81 @@
static struct inlineCache ilc15 = _DUMMYILC15;
if (_isSmallInteger(numberOfArgs)) {
- nargs = _intVal(numberOfArgs);
- if (nargs == 0) {
- RETURN (_SEND0(self, aSelector, CON_COMMA aClass, &ilc0));
- }
-
- argP = (OBJ *)(&a1);
- if (_Class(argArray) == Array) {
- for (i=0; i < nargs; i++) {
- *argP++ = _ArrayInstPtr(argArray)->a_element[i];
- }
- } else {
- for (i=1; i <= nargs; i++) {
- *argP++ = _AT_(argArray, CON_COMMA _MKSMALLINT(i));
- }
- }
- switch (nargs) {
- case 1:
- RETURN ( _SEND1(self, aSelector, CON_COMMA aClass, &ilc1, a1));
-
- case 2:
- RETURN ( _SEND2(self, aSelector, CON_COMMA aClass, &ilc2, a1, a2));
-
- case 3:
- RETURN ( _SEND3(self, aSelector, CON_COMMA aClass, &ilc3, a1, a2, a3));
-
- case 4:
- RETURN ( _SEND4(self, aSelector, CON_COMMA aClass, &ilc4, a1, a2, a3, a4));
-
- case 5:
- RETURN ( _SEND5(self, aSelector, CON_COMMA aClass, &ilc5,
- a1, a2, a3, a4, a5));
-
- case 6:
- RETURN ( _SEND6(self, aSelector, CON_COMMA aClass, &ilc6,
- a1, a2, a3, a4, a5, a6));
-
- case 7:
- RETURN ( _SEND7(self, aSelector, CON_COMMA aClass, &ilc7,
- a1, a2, a3, a4, a5, a6, a7));
-
- case 8:
- RETURN ( _SEND8(self, aSelector, CON_COMMA aClass, &ilc8,
- a1, a2, a3, a4, a5, a6, a7, a8));
-
- case 9:
- RETURN ( _SEND9(self, aSelector, CON_COMMA aClass, &ilc9,
- a1, a2, a3, a4, a5, a6, a7, a8, a9));
-
- case 10:
- RETURN ( _SEND10(self, aSelector, CON_COMMA aClass, &ilc10,
- a1, a2, a3, a4, a5, a6, a7, a8, a9, a10));
-
- case 11:
- RETURN ( _SEND11(self, aSelector, CON_COMMA aClass, &ilc11,
- a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11));
-
- case 12:
- RETURN ( _SEND12(self, aSelector, CON_COMMA aClass, &ilc12,
- a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12));
-
- case 13:
- RETURN ( _SEND13(self, aSelector, CON_COMMA aClass, &ilc13,
- a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
- a13));
-
- case 14:
- RETURN ( _SEND14(self, aSelector, CON_COMMA aClass, &ilc14,
- a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
- a13, a14));
-
- case 15:
- RETURN ( _SEND15(self, aSelector, CON_COMMA aClass, &ilc15,
- a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
- a13, a14, a15));
- }
+ nargs = _intVal(numberOfArgs);
+ if (nargs == 0) {
+ RETURN (_SEND0(self, aSelector, CON_COMMA aClass, &ilc0));
+ }
+
+ argP = (OBJ *)(&a1);
+ if (_Class(argArray) == Array) {
+ for (i=0; i < nargs; i++) {
+ *argP++ = _ArrayInstPtr(argArray)->a_element[i];
+ }
+ } else {
+ for (i=1; i <= nargs; i++) {
+ *argP++ = _AT_(argArray, CON_COMMA _MKSMALLINT(i));
+ }
+ }
+ switch (nargs) {
+ case 1:
+ RETURN ( _SEND1(self, aSelector, CON_COMMA aClass, &ilc1, a1));
+
+ case 2:
+ RETURN ( _SEND2(self, aSelector, CON_COMMA aClass, &ilc2, a1, a2));
+
+ case 3:
+ RETURN ( _SEND3(self, aSelector, CON_COMMA aClass, &ilc3, a1, a2, a3));
+
+ case 4:
+ RETURN ( _SEND4(self, aSelector, CON_COMMA aClass, &ilc4, a1, a2, a3, a4));
+
+ case 5:
+ RETURN ( _SEND5(self, aSelector, CON_COMMA aClass, &ilc5,
+ a1, a2, a3, a4, a5));
+
+ case 6:
+ RETURN ( _SEND6(self, aSelector, CON_COMMA aClass, &ilc6,
+ a1, a2, a3, a4, a5, a6));
+
+ case 7:
+ RETURN ( _SEND7(self, aSelector, CON_COMMA aClass, &ilc7,
+ a1, a2, a3, a4, a5, a6, a7));
+
+ case 8:
+ RETURN ( _SEND8(self, aSelector, CON_COMMA aClass, &ilc8,
+ a1, a2, a3, a4, a5, a6, a7, a8));
+
+ case 9:
+ RETURN ( _SEND9(self, aSelector, CON_COMMA aClass, &ilc9,
+ a1, a2, a3, a4, a5, a6, a7, a8, a9));
+
+ case 10:
+ RETURN ( _SEND10(self, aSelector, CON_COMMA aClass, &ilc10,
+ a1, a2, a3, a4, a5, a6, a7, a8, a9, a10));
+
+ case 11:
+ RETURN ( _SEND11(self, aSelector, CON_COMMA aClass, &ilc11,
+ a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11));
+
+ case 12:
+ RETURN ( _SEND12(self, aSelector, CON_COMMA aClass, &ilc12,
+ a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12));
+
+ case 13:
+ RETURN ( _SEND13(self, aSelector, CON_COMMA aClass, &ilc13,
+ a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
+ a13));
+
+ case 14:
+ RETURN ( _SEND14(self, aSelector, CON_COMMA aClass, &ilc14,
+ a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
+ a13, a14));
+
+ case 15:
+ RETURN ( _SEND15(self, aSelector, CON_COMMA aClass, &ilc15,
+ a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
+ a13, a14, a15));
+ }
}
%}
.
@@ -2652,92 +2758,100 @@
size := self class instSize.
1 to:size do:[:i |
- self instVarAt:i put:(manager nextObject)
+ self instVarAt:i put:(manager nextObject)
].
size := self basicSize.
size ~~ 0 ifTrue:[
- self class isPointers ifTrue:[
- 1 to:size do:[:i |
- self basicAt:i put:(manager nextObject)
- ]
- ]
+ self class isPointers ifTrue:[
+ 1 to:size do:[:i |
+ self basicAt:i put:(manager nextObject)
+ ]
+ ]
]
!
storeBinaryDefinitionOn: stream manager: manager
"append a binary representation of the receiver onto stream.
+ This method first stores the class, then the body, which is done
+ in a separate method to allow redefinition of the bodies format.
+ Can be redefined in subclasses (see String, SmallInteger etc)."
+
+ manager putIdOf:(self class) on:stream.
+ self storeBinaryDefinitionBodyOn:stream manager:manager
+!
+
+storeBinaryDefinitionBodyOn: stream manager: manager
+ "append a binary representation of the receivers body onto stream.
This is a general implementation walking over instances storing
each recursively as an ID using manager.
- Can be redefined in subclasses (see String, SmallInteger etc)."
+ Can be redefined in subclasses."
|basicSize "{ Class: SmallInteger }"
instSize "{ Class: SmallInteger }"|
- manager putIdOf:(self class) on:stream.
-
instSize := self class instSize.
self class isPointers ifTrue:[
- stream nextPut:instSize. "mhmh this limits us to 255 named instvars"
-
- self class isVariable ifTrue:[
- stream nextNumber:3 put:(basicSize := self basicSize)
- ] ifFalse:[
- basicSize := 0
- ].
-
- 1 to:instSize do:[:i |
- manager putIdOf:(self instVarAt:i) on:stream
- ].
-
- 1 to:basicSize do:[:i |
- manager putIdOf:(self basicAt:i) on: stream
- ]
+ stream nextPut:instSize. "mhmh this limits us to 255 named instvars"
+
+ self class isVariable ifTrue:[
+ stream nextNumber:3 put:(basicSize := self basicSize)
+ ] ifFalse:[
+ basicSize := 0
+ ].
+
+ 1 to:instSize do:[:i |
+ manager putIdOf:(self instVarAt:i) on:stream
+ ].
+
+ 1 to:basicSize do:[:i |
+ manager putIdOf:(self basicAt:i) on: stream
+ ]
] ifFalse: [
- stream nextNumber:4 put:(basicSize := self basicSize).
- self class isBytes ifTrue:[
- 1 to:basicSize do:[:i |
- stream nextPut:(self basicAt:i)
- ]
- ] ifFalse:[
- self class isWords ifTrue:[
- 1 to:basicSize do:[:i |
- stream nextNumber:2 put: (self basicAt: i)
- ]
- ] ifFalse:[
- self class isLongs ifTrue:[
- 1 to:basicSize do:[:i |
- stream nextNumber:4 put: (self basicAt: i)
- ]
- ] ifFalse:[
- self class isFloats ifTrue:[
- "could do it in one big write on machines which use IEEE floats ..."
- 1 to:basicSize do:[:i |
- Float storeBinaryIEEESingle:(self basicAt:i) on:stream
- ]
- ] ifFalse:[
- self class isDoubles ifTrue:[
- "could do it in one big write on machines which use IEEE doubles ..."
- 1 to:basicSize do:[:i |
- Float storeBinaryIEEEDouble:(self basicAt:i) on:stream
- ]
- ] ifFalse:[
- 1 to:basicSize do:[:i |
- manager putIdOf:(self basicAt:i) on: stream
- ]
- ]
- ]
- ]
- ]
- ].
- "dont forget the instvars"
- 1 to:instSize do:[:i |
- manager putIdOf:(self instVarAt:i) on:stream
- ].
+ stream nextNumber:4 put:(basicSize := self basicSize).
+ self class isBytes ifTrue:[
+ 1 to:basicSize do:[:i |
+ stream nextPut:(self basicAt:i)
+ ]
+ ] ifFalse:[
+ self class isWords ifTrue:[
+ 1 to:basicSize do:[:i |
+ stream nextNumber:2 put: (self basicAt: i)
+ ]
+ ] ifFalse:[
+ self class isLongs ifTrue:[
+ 1 to:basicSize do:[:i |
+ stream nextNumber:4 put: (self basicAt: i)
+ ]
+ ] ifFalse:[
+ self class isFloats ifTrue:[
+ "could do it in one big write on machines which use IEEE floats ..."
+ 1 to:basicSize do:[:i |
+ Float storeBinaryIEEESingle:(self basicAt:i) on:stream
+ ]
+ ] ifFalse:[
+ self class isDoubles ifTrue:[
+ "could do it in one big write on machines which use IEEE doubles ..."
+ 1 to:basicSize do:[:i |
+ Float storeBinaryIEEEDouble:(self basicAt:i) on:stream
+ ]
+ ] ifFalse:[
+ 1 to:basicSize do:[:i |
+ manager putIdOf:(self basicAt:i) on: stream
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ "dont forget the instvars"
+ 1 to:instSize do:[:i |
+ manager putIdOf:(self instVarAt:i) on:stream
+ ].
]
!
-storeBinaryOn: stream manager: manager
+storeBinaryOn:stream manager:manager
"append a binary representation of the receiver onto stream."
manager putIdOf:self on:stream
@@ -2956,9 +3070,9 @@
|myClass hasSemi sz "{ Class: SmallInteger }" |
thisContext isRecursive ifTrue:[
- Transcript showCr:'Error: storeString of self referencing object.'.
- aStream nextPutAll:'#("recursive")'.
- ^ self
+ Transcript showCr:'Error: storeString of self referencing object.'.
+ aStream nextPutAll:'#("recursive")'.
+ ^ self
].
myClass := self class.
@@ -2967,34 +3081,34 @@
hasSemi := false.
myClass isVariable ifTrue:[
- aStream nextPutAll:' basicNew:'.
- self basicSize printOn:aStream
+ aStream nextPutAll:' basicNew:'.
+ self basicSize printOn:aStream
] ifFalse:[
- aStream nextPutAll:' basicNew'
+ aStream nextPutAll:' basicNew'
].
sz := myClass instSize.
1 to:sz do:[:i |
- aStream nextPutAll:' instVarAt:'.
- i printOn:aStream.
- aStream nextPutAll:' put:'.
- (self instVarAt:i) storeOn:aStream.
- aStream nextPut:$;.
- hasSemi := true
+ aStream nextPutAll:' instVarAt:'.
+ i printOn:aStream.
+ aStream nextPutAll:' put:'.
+ (self instVarAt:i) storeOn:aStream.
+ aStream nextPut:$;.
+ hasSemi := true
].
myClass isVariable ifTrue:[
- sz := self basicSize.
- 1 to:sz do:[:i |
- aStream nextPutAll:' basicAt:'.
- i printOn:aStream.
- aStream nextPutAll:' put:'.
- (self basicAt:i) storeOn:aStream.
- aStream nextPut:$;.
- hasSemi := true
- ]
+ sz := self basicSize.
+ 1 to:sz do:[:i |
+ aStream nextPutAll:' basicAt:'.
+ i printOn:aStream.
+ aStream nextPutAll:' put:'.
+ (self basicAt:i) storeOn:aStream.
+ aStream nextPut:$;.
+ hasSemi := true
+ ]
].
hasSemi ifTrue:[
- aStream nextPutAll:' yourself'
+ aStream nextPutAll:' yourself'
].
aStream nextPut:$).
!