!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: object.gs,v 1.76.2.1 2008-04-21 21:45:02 dhenrich Exp $
!
! Superclass Hierarchy:
!   Object.
!
!=========================================================================

removeallmethods Object
removeallclassmethods Object

category: 'For Documentation Installation only'
classmethod: Object
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'Object defines the basic protocol for all objects.  Every object is an
 instance of Object or of some subclass of Object.' .
doc documentClassWith: txt.

txt := (GsDocText new) details:
'These methods allow you to congregate related objects in the smallest possible
 region, so that accessing those objects will, in general, require fewer disk
 accesses than would random placement.  For more information about clustering,
 see "Clustering Objects for Faster Retrieval" in the GemStone Programming
 Guide.'.
doc documentCategory: #Clustering with: txt.

self description: doc.
%

! _errorUncompiledMethod deleted

category: 'Error Handling'
method: Object
halt: messageString

"Raises an error.  This method is intended for use in raising
 application-defined or user-defined errors. Returns the receiver."

System genericSignal: #halt text: messageString.
^ self
%

category: 'Error Handling'
method: Object
error: messageString

"Raises an error.  This method is intended for use in raising
 application-defined or user-defined errors. Returns the receiver."

^ self halt: messageString.
%

category: 'Error Handling'
method: Object
halt

"Raises an error.  This method is intended for use in raising
 application-defined or user-defined errors. Returns the receiver."

^ self halt: '#halt encountered'
%

category: 'Error Handling'
method: Object
_halt: messageString

"Raises an error in response to a problem detected by kernel class methods.
 Intended for use to report seldom-occurring errors from kernel class
 methods.   The messageString arguments are not yet installed as individual
 messages in the language-dependent message dictionary."

| errorNumber allArgs |

allArgs := #[ messageString ] .
errorNumber := self _errorSymbolToNumber: #genericKernelError args: allArgs .
^ System signal: errorNumber args: allArgs signalDictionary: GemStoneError
%

category: 'Error Handling'
method: Object
pause

"Generates an error.  You can use this method to establish
 breakpoints in methods, aside from any debugger breakpoints that
 may be set."

<primitive: 906>
^ self  "continue with execution"
%

category: 'Error Handling'
method: Object
shouldNotImplement: aSelector

"Generates an error reporting that the receiver cannot respond to
 aSelector.  This is useful because sometimes a subclass should not
 respond to messages for which it has inherited methods from its
 superclass.  For instance, class Set should not respond to Object | at:.
 Defining Set | at: with a shouldNotImplement error hides
 the ordering information of Set from users of instances of Set."

^ self _error: #rtErrShouldNotImplement args: #[aSelector]
%

category: 'Error Handling'
method: Object
subclassResponsibility: aSelector

"This is used in an abstract superclass to detect a protocol error.
 It generates an error indicating that a concrete subclass
 should have implemented this method."

^ self _error: #rtErrSubclassResponsibility args: #[aSelector]
%

category: 'Error Handling'
method: Object
_checkReadStream: aStream forClass: aClass

""

(aStream contents isKindOf: aClass)
ifFalse:
  [ ^ self _error: #rtErrBadStreamColl args: #[aStream, aClass] ]
%

category: 'Error Handling'
method: Object
_error: errorSym

"Private Error Messages."

^ self _error: errorSym args:  #() 
%

category: 'Error Handling'
method: Object
_errIncorrectFormat: aStreamOrString

""

^ self _error: #rtErrBadFormat args: #[aStreamOrString]
%

category: 'Error Handling'
method: Object
_errorExpectedClass: aClass

"Sends an error message indicating that receiver was not a kind of aClass"

^ self _error: #rtErrBadArgKind args: #[aClass]
%

category: 'Error Handling'
method: Object
_errorIndexOutOfRange: anIndex

"Sends an error message indicating that anIndex was outside legal limits
 for the receiver."

^ self _error: #objErrBadOffsetIncomplete args: #[anIndex]
%

category: 'Error Handling'
method: Object
_errorNoModification

"Instances of invariant classes are immutable."

^ self _error: #objErrInvariant
%

category: 'Error Handling'
method: Object
_errorNonIntegerIndex: anIndex

"Sends an error message indicating that anIndex should have been an integer."

^ self _error: #rtErrBadSubscript args: #[anIndex]
%

category: 'Error Handling'
method: Object
_errorNotIndexable

"Sends an error message indicating that the receiver is not indexable."

^ self _error: #objErrNotIndexable
%

category: 'Error Handling'
method: Object
_doesNotUnderstand: aMessageDescriptor

"This private message is sent by the virtual machine.  This method must not be
 implemented as a primitive and must not be reimplemented in a subclass!"

^ self doesNotUnderstand: aMessageDescriptor
%

category: 'Error Handling'
method: Object
doesNotUnderstand: aMessageDescriptor

"Generates an error reporting that the receiver cannot respond to a message
 because no compiled method was found for the selector.  The argument
 aMessageDescriptor is a two-element Array.  The first element is the selector
 that was not found and the second is an Array of arguments for the message."

| selector argList |

selector := aMessageDescriptor at: 1 .  "put selector into temporary for easier"
				        "  debugging with topaz."
argList := #[ self, selector, (aMessageDescriptor at: 2) ].

System signal: 2010 "#rtErrDoesNotUnderstand, hard-coded for speed"
       args: argList signalDictionary: GemStoneError .

"If we continue from the error, re-try the send of the message that was
 not understood."

^ self perform: (aMessageDescriptor at: 1)
       withArguments: (aMessageDescriptor at: 2).
%

category: 'Error Handling'
method: Object
_errorSymbolToNumber: errorSymbol args: argList

"Translates the errorSymbol to an error number.
 returns the error number (a SmallInteger, and may modify argList."

 ^ ErrorSymbols at: errorSymbol
          ifAbsent: [ argList insertObject: errorSymbol at: 1 .
                        "hard code error number to ensure we can survive a
			 with damaged error dictionary"
                      2063 "ErrorSymbols at: #rtErrNoMessage " .
                    ].
%

category: 'Error Handling'
method: Object
_error: errorSymbol args: argList

"Private Error Messages."

| newArgList errorNumber|

newArgList := #[ self ] addAll: argList ; yourself .
errorNumber := self _errorSymbolToNumber: errorSymbol args: newArgList .

^ System signal: errorNumber args: newArgList signalDictionary: GemStoneError
%

category: 'Error Handling'
method: Object
_mustBeBoolean

"The virtual machine generates this when expected Booleans don't appear
 on the stack like they should."

| argList |

argList := #[ self ] .

System signal: (self _errorSymbolToNumber: #rtErrExpectedBoolean args: argList)
       args: argList signalDictionary: GemStoneError .

^ nil
%

category: 'Error Handling'
method: Object
_errorNotOnlyUser: numActualUsers

| argList |

argList := #[ numActualUsers ] .

System signal: (self _errorSymbolToNumber: #rtErrNotOnlyUser args: argList)
       args: argList signalDictionary: GemStoneError .

^ nil
%


category: 'Error Handling'
method: Object
_uncontinuableError

"An attempt was made to continue execution past an uncontinuable error."

[true] whileTrue:[ self _error: #rtErrUncontinuable args: #[ ] ]
%

category: 'Error Handling'
method: Object
_primitiveFailed: aSelector

"Methods which are implemented as primitives send _primitiveFailed:
 when a primitive fails and the failure is not attributable to any
 normal error such as bad argument kind, argument out of range, etc."

^ self _error: #rtErrPrimFailed args: #[ aSelector ] .
%

category: 'Accessing'
method: Object
_alias

"This method returns an alias for the receiver.  The alias is a
 kind of Integer.  It may be a SmallInteger, LargePositiveInteger, or
 LargeNegativeInteger.  The alias for any set of objects is unique."

<primitive: 609 >

self _primitiveFailed: #alias .
self _uncontinuableError
%

! deleted prim 816

category: 'Accessing'
method: Object
at: anIndex

"Returns the value of an indexed variable in the receiver.
 The argument anIndex must not be larger than the size of the
 receiver, and must not be less than 1.

 Generates an error if anIndex is not a SmallInteger or is out of
 bounds, or if the receiver is not indexable."

<primitive: 32>

(self class isIndexable) "not an indexable object"
  ifFalse: [^ self _errorNotIndexable].
(anIndex _isInteger)
  ifTrue: [^ self _errorIndexOutOfRange: anIndex]
  ifFalse: [^ self _errorNonIntegerIndex: anIndex].
self _primitiveFailed: #at: .
self _uncontinuableError
%

category: 'Accessing'
method: Object
instVarAt: anIndex

"If the receiver has an instance variable at anIndex, returns
 its value.  Generates an error if anIndex is not a SmallInteger or
 is out of bounds, or if the receiver has no instance variables."

<primitive: 611 >

| numInstVars |
(anIndex _isInteger)
ifTrue:
[
   numInstVars:= self class allInstVarNames size.
   (numInstVars == 0)
   ifTrue:
      [ ^ self _error: #rtErrNoInstVars].
   ((anIndex >= 1) & (anIndex <= numInstVars))
   ifFalse: "out of bounds"
      [ ^ self _errorIndexOutOfRange: anIndex]
]
ifFalse: "anIndex not an integer"
   [ ^ self _errorNonIntegerIndex: anIndex
].

self _primitiveFailed: #instVarAt: .
self _uncontinuableError
%

category: 'Accessing'
method: Object
size

"Returns the number of unnamed instance variables in the receiver."

<primitive: 0>
self _primitiveFailed: #size .
self _uncontinuableError
%

category: 'Accessing'
method: Object
_at: anIndex

"This method provides indexed access to indexable objects,
 and provides pseudo-indexed access to non-sequenceable collections,
 and provides logical indexed access to CharacterCollections whose
 Characters are composed of multiple physical bytes.

 May be reimplemented; for examples see Bag, CharacterCollection.

 The methods _at:, _basicAt:, and _basicSize operate on the logically
 indexable contents of the receiver.

 Implemented here as a direct call to a primitive for efficiency.  The
 primitive generates an error if the receiver is not indexable, or if anIndex
 is not a SmallInteger or is out of bounds."

<primitive: 32>

(self class isIndexable) "not an indexable object"
  ifFalse: [ ^ self _errorNotIndexable].
(anIndex _isInteger)
  ifTrue: [ ^ self _errorIndexOutOfRange: anIndex]
  ifFalse: [ ^ self _errorNonIntegerIndex: anIndex].

self _primitiveFailed: #_at: .
self _uncontinuableError
%

category: 'Accessing'
method: Object
_basicAt: anIndex

"This is a primitive.  The primitive generates an error if the receiver is not
 indexable, or if anIndex is not a SmallInteger or is out of bounds.

 This method is for internal use in implementation of the kernel classes.

 The methods _at:, _basicAt:, and _basicSize operate on the logically
 indexable contents of the receiver.

 This method must not be overridden."

<primitive: 32>

(self class isIndexable) "not an indexable object"
  ifFalse: [ ^ self _errorNotIndexable].
(anIndex _isInteger)
  ifTrue: [ ^ self _errorIndexOutOfRange: anIndex]
  ifFalse: [ ^ self _errorNonIntegerIndex: anIndex].

self _primitiveFailed: #_basicAt: .
self _uncontinuableError
%

category: 'Accessing'
method: Object
_basicSize

"This is a primitive.  The primitive generates an error if the
 receiver is not Variable-Length.  The returned value reflects the
 allowable bounds in Object|_basicAt: and Object|_basicAt:put:.
 This method must not be overridden; contrast with Object|size.

 The methods _at:, _basicAt:, and _basicSize operate on the logically
 indexable contents of the receiver.

 The primitive is equivalent to GciFetchIdxSize(self); "

<primitive: 0>

^0 "for non-indexable objects, returns zero for their size"
%

category: 'Accessing'
method: Object
_primitiveSize

"This is a primitive.  Returns the number of named instance
 variables plus the number of indexed instance variables in
 the receiver.  Equivalent to GciFetchSize(self)."

<primitive: 88>

self _primitiveFailed: #_primitiveSize .
self _uncontinuableError
%

! fix bug 11637 
category: 'Accessing'
method: Object
basicSize

"Returns the number of named instance variables plus the number of indexed
 instance variables in the receiver.  This result is equivalent to
 GciFetchSize(self).

 This method is implemented as a primitive, for improved performance."

<primitive: 88>

self _primitiveFailed: #basicSize .
self _uncontinuableError
%

category: 'Accessing'
method: Object
basicPhysicalSize

"Returns the number of bytes required to represent the receiver physically.  If
 the receiver is in special format (which implies that its representation is the
 same as its OOP), returns zero.

 This method is implemented as a primitive, for improved performance.

 The basicPhysicalSize method returns the same result as the default
 implementation (in class Object) of the physicalSize method.  It makes that
 default implementation available even when the physicalSize method is
 reimplemented in a subclass.  The basicPhysicalSize method should not itself
 be reimplemented."

<primitive: 364>
%

category: 'Accessing'
method: Object
physicalSize

"Returns the number of bytes required to represent the receiver physically.  If
 the receiver is in special format (which implies that its representation is the
 same as its OOP), returns zero.

 This method is implemented as a primitive, for improved performance.

 This method should be reimplemented for subclasses whose instances are (or may
 be) a composite of component parts which are objects themselves (such as B-tree
 nodes).  Since the composite object cannot be represented independently of its
 components, its physical size should include that of its components.

 However, the component objects of collection (such as an NSC) should not be
 confused with its contents or elements.  Elements or contained objects are in a
 logical relationship with the collection, whereas its components are in a
 physical relationship.  Logically related objects can be represented and stored
 independently."

<primitive: 364>
%

category: 'Accessing'
method: Object
_primitiveAt: anIndex

"This is a primitive.  The primitive generates an error if the
 if anIndex is less than 1 or greater than the sum of named plus
 indexed instance variables of the receiver.

 Equivalent to GciFetchOop(self, anIndex) if receiver is a pointer object or
 NSC object.  Equivalent to GciFetchByte(self, anIndex) if receiver is a byte
 object, in which case it returns the small integer value of the byte."

<primitive: 89>

(anIndex _isInteger)
  ifTrue: [ ^ self _errorIndexOutOfRange: anIndex]
  ifFalse: [ ^ self _errorNonIntegerIndex: anIndex].

self _primitiveFailed: #_primitiveAt: .
self _uncontinuableError
%

category: 'Updating'
method: Object
at: anIndex put: aValue

"Stores the argument aValue in the indexed variable of the
 receiver indicated by anIndex.  The argument anIndex must not be
 larger than 1 + the size of the receiver, and must not be less than 1.

 Generates an error if anIndex is not a SmallInteger or is out of
 bounds, if the receiver is not indexable, or if the
 receiver is not of the right class to store the given value.

 The primitive is equivalent to GciStoreIdxOop or GciStoreByte,
 depending on implementation of the receiver."

<primitive: 268>

(anIndex _isInteger)
  ifFalse: [ ^ self _errorNonIntegerIndex: anIndex].
(self class isIndexable) "not an indexable object"
  ifFalse: [ ^ self _errorNotIndexable].
((anIndex < 1) | (anIndex > (self size + 1))) "out of bounds"
  ifTrue: [ ^ self _errorIndexOutOfRange: anIndex].
(self class isBytes)
ifTrue: [ ((aValue class ~~ SmallInteger) _or: [ (aValue < 0) | (aValue > 255) ])
    ifTrue: [^ aValue _error: #rtErrExpectedByteValue].
  ].

self _primitiveFailed: #at:put: .
self _uncontinuableError
%

! changes for 31235
category: 'Updating'
method: Object
instVarAt: anIndex put: aValue

"Stores the argument aValue in the instance variable indicated by anIndex.
 Generates an error if anIndex is not a SmallInteger or is out of bounds, 
 or if the receiver has no instance variables, 
 or if aValue would violate constraints for the specified instance variable.

 Note that in Gemstone64 , this primitive method enforces constraints, 
 but instVar stores via compiled references to instVars do not check
 constraints.

 This primitive is equivalent to GciStoreNamedOop."

<primitive: 604 >
(self class allInstVarNames size == 0)
  ifTrue: [ ^ self _error: #rtErrNoInstVars].
(anIndex _isSmallInteger)
  ifTrue: [((anIndex < 1) | (anIndex > self class allInstVarNames size))
        ifTrue: [ ^ self _errorIndexOutOfRange: anIndex]] "out of bounds"
  ifFalse: [ ^ self _errorNonIntegerIndex: anIndex].

self _primitiveFailed: #instVarAt:put: .
self _uncontinuableError
%

category: 'Updating'
method: Object
size: anInteger

"Changes the size of the receiver to anInteger.

 If anInteger is less than the current size of the receiver, the
 receiver is shrunk accordingly.  If anInteger is greater than the
 current size of the receiver, the receiver is extended and new
 elements are initialized to nil.

 Generates an error if anInteger is not a SmallInteger,
 or if the receiver is not indexable."

<primitive: 603 >

(self class isIndexable not) "not an indexable object"
  ifTrue: [ ^ self _errorNotIndexable].
(anInteger _isInteger)
   ifTrue: [ ^ self _errorIndexOutOfRange: anInteger]
   ifFalse: [ ^ self _errorNonIntegerIndex: anInteger].
self _primitiveFailed: #size: .
self _uncontinuableError
%

category: 'Updating'
method: Object
_basicAt: anIndex put: aValue

"This is a primitive.  This primitive generates an error if the
 receiver is not indexable or variant, or if anIndex is not a
 SmallInteger or is out of bounds.

 This method must not be overridden; contrast with Object|at:put:."

"The primitive is equivalent to GciStoreIdxOop or GciStoreByte,
 depending on implementation of the receiver."

<primitive: 268>

(anIndex _isInteger)
  ifFalse: [ ^ self _errorNonIntegerIndex: anIndex].
(self class isIndexable) "not an indexable object"
  ifFalse: [ ^ self _errorNotIndexable].
((anIndex < 1) | (anIndex > (self size + 1))) "out of bounds"
  ifTrue: [ ^ self _errorIndexOutOfRange: anIndex].
(self class isBytes)
ifTrue:
  [ ((aValue class ~~ SmallInteger) _or: [ (aValue < 0) | (aValue > 255) ])
    ifTrue: [^ aValue _error: #rtErrExpectedByteValue].
  ].

self _primitiveFailed: #_basicAt:put: .
self _uncontinuableError
%

category: 'Updating'
method: Object
_at: anIndex put: aValue

"This is a primitive.  This primitive generates an error if the
 receiver is not indexable or variant, or if anIndex is not a
 SmallInteger or is out of bounds.

 May be reimplemented."

"The primitive is equivalent to GciStoreIdxOop or GciStoreByte,
 depending on implementation of the receiver."

<primitive: 268>

(anIndex _isInteger)
  ifFalse: [ ^ self _errorNonIntegerIndex: anIndex].
(self class isIndexable) "not an indexable object"
  ifFalse: [ ^ self _errorNotIndexable].
((anIndex < 1) | (anIndex > (self size + 1))) "out of bounds"
  ifTrue: [ ^ self _errorIndexOutOfRange: anIndex].
(self class isBytes)
ifTrue:
  [ ((aValue class ~~ SmallInteger) _or: [ (aValue < 0) | (aValue > 255) ])
    ifTrue: [^ aValue _error: #rtErrExpectedByteValue].
  ].

self _primitiveFailed: #_at:put: .
self _uncontinuableError
%

category: 'Updating'
method: Object
_basicSize: anInteger

"Changes the size of the receiver to anInteger.

 If anInteger is less than the current size of the receiver, the
 receiver is shrunk accordingly.  If anInteger is greater than the
 current size of the receiver, the receiver is extended and new
 elements are initialized to nil.

 Generates an error if anInteger is not a SmallInteger,
 or if the receiver is not indexable.  This method should not be
 overridden in subclasses."

<primitive: 603 >

(self class isIndexable not) "not an indexable object"
  ifTrue: [ ^ self _errorNotIndexable].
(anInteger _isInteger)
   ifTrue: [ ^ self _errorIndexOutOfRange: anInteger]
   ifFalse: [ ^ self _errorNonIntegerIndex: anInteger].
self _primitiveFailed: #size: .
self _uncontinuableError
%

category: 'Updating'
method: Object
_primitiveAt: anIndex put: aValue

"This is a primitive.  The primitive generates an error if anIndex is less than
 1 or greater than the sum of 1 plus the number of named plus the number of
 indexed instance variables of the receiver.

 Equivalent to GciStoreOop(self, anIndex, aValue) if receiver is a pointer
 object.  Equivalent to GciStoreByte(self, anIndex, aValue) if receiver is a
 byte object.

 Disallowed in Bag."

<primitive: 281>

(anIndex _isInteger)
  ifFalse: [ ^ self _errorNonIntegerIndex: anIndex].
((anIndex < 1) | (anIndex > (self _primitiveSize + 1))) "out of bounds"
  ifTrue: [ ^ self _errorIndexOutOfRange: anIndex].
(self class isBytes)
ifTrue:
  [ ((aValue class ~~ SmallInteger) _or: [ (aValue < 0) | (aValue > 255) ])
    ifTrue: [^ aValue _error: #rtErrExpectedByteValue].
  ].

self _primitiveFailed: #_primitiveAt:put: .
self _uncontinuableError
%

category: 'Updating'
method: Object
become: anObject

"Swaps the identities of the receiver and the argument.

 Intended only for experienced GemStone Smalltalk programmers who need to
 migrate instances of one class to another.

 The sender is responsible for checking the consistency of the class histories
 of the argument and the receiver.  This method makes no such checks.

 The argument, the receiver, or both are permitted to be invariant.

 Neither the argument nor the receiver may be special objects (instances of
 classes such as SmallInteger, Character, or Boolean).  Also, neither may be
 instances of a class that is a kind of StackSegment, StackBuffer, Activation,
 Process, VariableContext, or BlockClosure.

 Neither the argument nor the receiver may be a kind of Bag that has indexes
 built on it.  If either the receiver or the argument (or both) participate in
 an index, then either both must be in byte format or neither must be in byte
 format.  That is, one cannot be in byte format if the other is not also.  To
 avoid the error conditions triggered by presence of indexes, remove the
 indexes from the relevant NSCs prior to invoking this method.

 Neither the argument nor the receiver may exist as self below the sender of a
 become: message on the active GemStone Smalltalk stack.

 Once the identities have been swapped, the argument and receiver may no longer
 satisfy the constraints of objects that reference them.  This condition can
 lead to the failure of subsequent index creation attempts.  The GemStone
 Smalltalk programmer is responsible for correcting broken constraints.

 Any clusterIds that belong to an object on disk remain with the object.
 That is, the clusterIds do not follow the identities when they are swapped.

 The Segments of the objects do not follow the identities 
 when they are swapped.

 Any tags that belong to the argument and receiver are swapped between the
 objects.  That is, the tags do follow the identities when they are swapped."

| result |
result := self _become: anObject fullChecks: true .
result _resetParentRef .    " fix 35972"
anObject _resetParentRef .
^ result
%

category: 'Private'
method: Object
_resetParentRef

"Private. After a become:, child objects may need to be adjusted
 to point to the new parent.  Reimplemented in some dictionary classes."

^ self
%

category: 'Updating'
classmethod: Object
_checkKindForBecome: anObj

"Private

 do various checks on the argument to see if it is legal to
 participate in a become"

anObj isSpecial ifTrue: [ anObj _error: #rtErrCantBecomeSpecial ].

(anObj isKindOf: BlockClosure) ifTrue: [ 
   anObj _error: #rtErrCantBecomeClassKind args: #[ BlockClosure ]
   ].

(anObj isKindOf: GsMethod ) ifTrue: [ 
   anObj _error: #rtErrCantBecomeClassKind args: #[ GsMethod  ]
   ].

(anObj isKindOf: Metaclass ) ifTrue: [ 
   anObj _error: #rtErrCantBecomeClassKind args: #[ Metaclass  ]
   ].

(anObj isKindOf: Class ) ifTrue: [ 
   anObj _error: #rtErrCantBecomeClassKind args: #[ Class  ]
   ].

(anObj isKindOf: Symbol ) ifTrue: [ 
   anObj _error: #rtErrCantBecomeClassKind args: #[ Symbol  ]
   ].
(anObj isKindOf: GsMethodDictionary) ifTrue: [ 
   anObj _error: #rtErrCantBecomeClassKind args: #[ GsMethodDictionary  ]
   ].

(anObj isKindOf: SymbolDictionary) ifTrue: [ 
   anObj _error: #rtErrCantBecomeClassKind args: #[ SymbolDictionary  ]
   ].

(anObj isKindOf: SymbolList) ifTrue: [ 
   anObj _error: #rtErrCantBecomeClassKind args: #[ SymbolList  ]
   ].
%

category: 'Updating'
method: Object
_become: anObject fullChecks: aBoolean

"Performs the become operation (see documentation for Object|become: for
 more details).

 If aBoolean is true, receiver and argument must not be on the Smalltalk
 stack as self below the invocation of become."

<primitive: 901> "enter protected mode"
| refsToRcvr refsToObj rcvrInIndex objInIndex dlForRcvr dlForObj |
self == anObject
    ifTrue: [
        System _disableProtectedMode.
        ^ self
    ].

Object _checkKindForBecome: self .
Object _checkKindForBecome: anObject .

self _class instancesNonPersistent = anObject _class instancesNonPersistent ifFalse:[
  self _error: #rtErrCantBecomeGeneric args: #[ 'instancesNonPersistent' ].
].

self _class instancesDbTransient = anObject _class instancesDbTransient ifFalse:[
  self _error: #rtErrCantBecomeGeneric args: #[ 'instancesDbTransient' ].
].

aBoolean ifTrue: [
        (self _onStackAsSelfBelow: 2)
            ifTrue:[ self _error: #rtErrCantBecomeSelfOnStack ].
        (anObject _onStackAsSelfBelow: 2)
            ifTrue:[ anObject _error: #rtErrCantBecomeSelfOnStack ].
    ].

" get index participants that reference the receiver "
refsToRcvr := self _getIndexReferencesInto: Array new.

" get index participants that reference anObject "
refsToObj := anObject _getIndexReferencesInto: Array new.

rcvrInIndex := (refsToRcvr detect: [ :o | o _isIndexObject ] ifNone: [ nil ]) ~~ nil.
objInIndex := (refsToObj detect: [ :o | o _isIndexObject ] ifNone: [ nil ]) ~~ nil.

" if both participate in an index, check their formats "
(rcvrInIndex _or: [ objInIndex ])
    ifTrue: [
      (( self class isBytes _and: [ anObject class isBytes not ] ) _or:
      [ self class isBytes not _and: [ anObject class isBytes ] ] )
        ifTrue: [
          refsToRcvr size > 0
            ifTrue: [
              ^ self _error: #rtErrCantBecomeOneIdx args: #[ anObject ]
            ]
            ifFalse: [ 
              ^ anObject _error: #rtErrCantBecomeOneIdx args: #[ self ]
            ]
        ]
    ].

UnorderedCollection _disableRcIndexLogging.

self _removeIndexParticipation: refsToRcvr for: anObject.
anObject _removeIndexParticipation: refsToObj for: self.

"Make sure Dependency lists are gone or the primitive will fail"

(dlForObj := DependencyList for: anObject) == nil
        ifFalse:[DependencyList set: nil for: anObject.].
(dlForRcvr := DependencyList for: self ) == nil
        ifFalse:[DependencyList set: nil for: self.].

self _primitiveBecome: anObject.

" remember, the variable 'anObject' and 'self' have switched identities "

"Restore the DependencyLists.  Filter out empty ones, which are invalid anyway"
(dlForObj size ~~ 0)
        ifTrue:[DependencyList set: dlForObj for: anObject.].
(dlForRcvr size ~~ 0)
        ifTrue: [DependencyList set: dlForRcvr for: self.].

self _restoreIndexParticipation: refsToRcvr.
anObject _restoreIndexParticipation: refsToObj.

UnorderedCollection _enableRcIndexLogging.

System _disableProtectedMode.
%

! fix 33465
category: 'Private'
method: Object
_primitiveBecome: anObject

"Private.

 This method should only be invoked by Object/become: .  Other uses may
 corrupt the GemStone repository, if the checks in Object/become: are not
 performed prior to invoking this method.

 This primitive will fail if either the receiver or argument
 is a Class or Metaclass "

<protected primitive: 277>
self _primitiveFailed: #_primitiveBecome: .
self _uncontinuableError
%

category: 'Testing'
method: Object
isEquivalent: anObject

"Returns true if the receiver is equivalent to anObject.  This
 is used to test the equivalence of Characters and Strings.  At
 this level, two objects are equivalent if they are identical."

^self == anObject
%

category: 'Testing'
method: Object
isNil

"Returns true if the receiver is nil, false otherwise.
 If isNil is not reimplemented in the application, then 
   == nil 
 is faster than 
   isNil 
 "

^ self == nil
%

category: 'Testing'
method: Object
notNil

"Returns true if the receiver is not nil, false otherwise.
 If notNil is not reimplemented in the application, then 
   ~~ nil 
 is faster than 
   notNil 
"

^ self ~~ nil
%

! fixed 32218
category: 'Testing'
method: Object
isSymbol

"Returns true if the receiver is a Symbol or DoubleByteSymbol,
 false otherwise."

^ self _isSymbol
%

category: 'Testing'
method: Object
_class: aClass
includesSelector: aSymbol

"Used in testing only.  Generates an error if the selector aSymbol is not found
 in the method dictionary of the class aClass when the search for the selector
 begins in the class of the receiver."

| actualImplementor |
actualImplementor := self class whichClassIncludesSelector: aSymbol .
actualImplementor ~~ aClass
ifTrue:
   [ ^ self _error: #classErrSelectorLookup
       args: #[ actualImplementor, aClass, aSymbol ]
   ]
%

category: 'Testing'
method: Object
validateIsClass

"Generates an error if the receiver is not a kind of Class."

(self isKindOf: Class ) ifTrue:[^ self ] .
^ self _error: #rtErrExpectedClass
%

category: 'Testing'
method: Object
_validateIsClass

"Generates an error if the receiver is not a kind of Behavior, with
 error message specific to class modification attempt."

(self isKindOf: Behavior ) ifTrue:[^ self ] .
^ self _error: #rtErrConstrNotAClass
%

category: 'Testing'
method: Object
validateIsIdentifier

"Generates an error if the receiver is not a kind of Symbol, or contains
 Characters that are not allowed in a GemStone Smalltalk identifier."

<primitive: 37 >
^ self _primitiveFailed:#validateIsIdentifier
%

category: 'Testing'
method: Object
validateIsVariant

"Generates an error if the receiver is not variant."

self isInvariant ifTrue:[ ^ self _error: #rtErrObjInvariant ] .
^ self
%

category: 'Testing'
method: Object
_status

"Returns a SmallInteger with status information about the receiver
 encoded in the bit whose masks are defined below:

 16r01 isSpecial
     Set if the receiver is an AbstractCharacter, Boolean,
     SmallInteger, or nil.
 16r02 isCommitted
     Set if the receiver existed in GemStone at the time the current
     transaction began.
 16r04 isConnected  (obsolete bit, always 0)
 16r08 isWritten
     Set if the receiver has been written since the last
     commit, abort, or begin transaction command was executed.
 16r10 isWritable
     Set if the receiver canBeWritten by the current user.

 16rE0 levels  ( > 0 means a 'large object' implemented as a tree of
		smaller objects which are not visible to Smalltalk)"

<primitive: 39>
self _primitiveFailed: #_status .
self _uncontinuableError
%

category: 'Testing'
method: Object
isSpecial

"Returns true if the receiver is a special object (that is, AbstractCharacter,
 Boolean, SmallInteger, or nil).  Returns false otherwise."

^ false
%

category: 'Testing'
method: Object
_isLarge

"Returns true if the object is implemented as a tree of private smaller objects"

^ ( self _status bitShift: -5) > 0
%

category: 'Testing'
method: Object
_levels

"If the object is implemented as a tree of private smaller objects, returns
 the depth of the tree not including the leaf nodes, otherwise returns 0.

 The result will be a SmallInteger in the range 0..3  inclusive." 

^ (self _status bitShift: -5)
%

category: 'Testing'
method: Object
isCommitted

"Returns true if the receiver existed in GemStone at the time the current
 transaction began.  Returns false otherwise."

^(self _status bitAnd: 2) ~~ 0
%

category: 'Testing'
method: Object
isWritten

"Returns true if the receiver was a committed object at the start of the
 current transaction and as been written by the current transaction.
 Returns false otherwise."

^(self _status bitAnd: 16rA ) == 16rA
%

category: 'Obsolete'
method: Object
isConnected

"Always returns false.  this method is obsolete"

^ false
%

category: 'Testing'
method: Object
isBehavior

"Returns true if the receiver is a kind of Behavior (that is, a Class or
 Metaclass object).  Returns false otherwise."

^false
%

category: 'Testing'
method: Object
isClass

"Returns true if the receiver is a kind of Behavior (that is, a Class or
 Metaclass object).  Returns false otherwise."

^ self isBehavior.
%

category: 'Formatting'
method: Object
asEUCString

"Returns an EUCString that represents the receiver."

^EUCString withAll: (self asString)
%

category: 'Formatting'
method: Object
asString

"Returns a String that indicates the class of the receiver; for
 example, if the receiver is an instance of class Monkey, it returns
 a String of the form 'aMonkey'.  This method is often
 overridden in subclasses to provide behavior tailored to the class.

 The result should not contain any formatting information.  
 For example the following expression should evaluate to true:

   #abc asString = String withAll: 'abc'

 This method is used by Object | describe.  Thus GemStone error
 handling and Topaz are dependent upon this method being functional.

 Must conform to rules for reimplementation of Object | describe."

^ self class name describeClassName .
%

category: 'Formatting'
method: Object
describe

"Returns an instance of a subclass of CharacterCollection describing the
 receiver.  This method is required by Topaz and by GemStone internal error
 handling.  Any reimplementation must conform to the following rules:

 * This method must not return nil.

 * This method must return an instance of a subclass of CharacterCollection."

^ self printString
%

category: 'Clustering'
method: Object
page

"This method returns an Integer identifying the disk page on which an object is
 stored.  You can use this method to check your clustering methods for
 correctness.

 The page on which an object is stored may change for any of the following
 reasons:

 1.  A clustering message is sent to the object or to another object on the
     same page, and the current transaction is committed.
 2.  The current transaction is aborted.
 3.  The object is modified, and the current transaction is committed.
 4.  Another object on the page with the object is modified, 
     and the current transaction is committed.

 For self-defining objects (SmallIntegers, AbstractCharacters, Booleans,
 UndefinedObjects), this method returns zero.

 Note that this method may return nil if the receiver has not been committed to
 GemStone, regardless whether the receiver is referenced by a committed object.

 If the receiver is a recently created Symbol, this method may return zero
"

<primitive: 84>

self _primitiveFailed: #page .
self _uncontinuableError
%

category: 'Clustering'
method: Object
pageCreationTime

"Returns a DateTime that is the approximate beginning of the life of the page
 containing the receiver.  

 The result represents the time that the receiver was last modified, clustered,
 moved to a new page by the Garbage Collector Gem, regenerated from a
 transaction log or full backup file during recovery or restore, whichever
 happened last.  

 When an object is modified by a session, the resulting pageCreationTime is an
 approximate time of the object creation or modification, and may precede the
 time at which the modification was committed.

 If the receiver is not yet committed and has not yet been assigned to a page,
 returns the current time.

 If the receiver is special, returns the value of the class instance variable
 timeStamp of the receiver's class."

<primitive: 400>
^ self _primitiveFailed: #pageCreationTime 
%

! change comments with fix 33974 
category: 'Clustering'
method: Object
clusterInBucket: aClusterBucketOrId

"This method does not force an object to disk.  Rather an object not already on
 disk is tagged so that the object remembers what cluster bucket is supposed to
 be used at such time as the object actually goes disk.

 If the object is large, then all nodes of the object are clustered
 into the same bucket.

 If the object is a kind of UnorderedCollection with indexes, this method does
 not cluster indexes.  To cluster indexing objects, use the clusterIndexes
 method.  Alternatively, see the UnorderedCollection | clusterDepthFirst method.

 No action is taken to cluster objects referenced by user-defined tags.

 If the receiver was previously clustered in the current transaction,
 has no effect and returns true;

 else if the receiver is a special object has no effect and returns true;

 else if the receiver is a byte object and was not previously clustered
 in the current transaction  , clusters the receiver and returns true ;

 else if the receiver was not previously clustered in the current transaction,
 clusters the receiver and returns false. "

<primitive: 279>
self _primitiveFailed: #clusterInBucket: .
self _uncontinuableError
%

category: 'Clustering'
method: Object
moveToDiskInBucket: aClusterBucketOrId

" Has no effect , Returns the receiver"

 ^ self 
%

! deleted _moveToDisk
category: 'Clustering'
method: Object
isClustered

" Returns true if the object has been clustered in the current
  transaction, false otherwise"

<primitive: 278>
self _primitiveFailed: #isClustered
%

category: 'Clustering'
method: Object
moveToDisk

" Has no effect , Returns the receiver"

^ self 
%

category: 'Clustering'
method: Object
clusterDepthFirst

"This method clusters the receiver and its instance variables in depth-first
 order.  Clustering is performed on all of the objects that can be reached via a
 transitive traversal starting at the receiver.  If an object is referenced by
 more than one clustering operation during the current transaction (that is,
 since the last commit or abort), it is located nearest the first reference.  

 This routine assumes that if we need to cluster inside this object that the
 object contains only named instance variables or indexed instance variables.
 It cannot have unordered instance variables since that would have to be a kind
 of Bag and this method is overridden in Collection.

 Note that this implementation does not include clustering of any user-defined
 tags.

 After clustering, returns true if the receiver is a byte object, 
 otherwise returns false.

 Has no effect and returns true if the receiver was previously clustered 
 in the current transaction, or if the receiver is a special object."

self cluster
  ifTrue:
    [ ^ true ]
  ifFalse:
    [ 1 to: self class instSize do:
      [ :i | (self instVarAt: i) clusterDepthFirst ].
      1 to: self size do: [ :i | (self at: i) clusterDepthFirst ].
      ^ false
    ]
%

category: 'Clustering'
method: Object
cluster

"This method clusters an object using the current default ClusterBucket.  It
 does not force an object to disk.  Rather an object not yet on disk
 is tagged so that the object remembers what cluster bucket is supposed to be
 used at such time as the object actually goes disk.  If the object is large,
 then all nodes of the object are clustered into the same bucket.

 If the object is a kind of UnorderedCollection with indexes, this method does
 not cluster indexes.  To cluster indexing objects, use the clusterIndexes
 method.  Alternatively, see the UnorderedCollection | clusterDepthFirst method.

 No action is taken to cluster objects referenced by user-defined tags.

 Has no effect and returns true if the receiver was previously clustered 
 in the current transaction; otherwise returns false after clustering
 the receiver. "

^ self clusterInBucket: System currentClusterId
%

category: 'Clustering'
method: Object
clusterBucket

"Returns the cluster bucket for the object.  Returns nil if the object is a
 temporary object that is neither on disk nor previously clustered."

<primitive: 90>
self _primitiveFailed: #clusterBucket .
self _uncontinuableError
%

category: 'Comparing'
method: Object
= anObject

"Returns true if the receiver and the argument have the same value.
 This method is defined here for identity, and is commonly
 reimplemented in a subclass to check for equality.

 Ordinarily, a class which reimplements the = method should also 
 reimplement hash."

^self == anObject "default is identity check, unless overridden to"
                  "check for equality"
%

category: 'Comparing'
method: Object
equalsNoCase: aCharCollection

"Returns true if the receiver and the argument have the same value.
 Returns false otherwise.  

 Reimplemented in String and DoubleByteString to provide case-insensitive
 comparison.  This implementation is the default for non-string objects."

^ self = aCharCollection
%

category: 'Comparing'
method: Object
== anObject

"(Optimized selector.)  Returns true if the receiver and the argument are the
 same object.

 This selector is optimized by the compiler and may not be reimplemented
 in any subclass.  This implementation is so that perform will work."

^ self == anObject
%

category: 'Comparing'
method: Object
hash

"This method returns some Integer related to the contents of the
 receiver.  If two objects compare equal (=) to each other, the results
 of sending hash to each of those objects must also be equal.
 Ordinarily, a class which reimplements the = method should also reimplement
 hash.  Notice that an instance of class Object actually bases equality on
 identity, since it has no contents.  Therefore, this implementation of
 hash actually returns an Integer related to the identity of the
 receiver."

"If a repository is converted from GemStone 4.1 to GemStone 5.0, the value
 returned for an object is compatible, except for JIS characters ??? .  "

<primitive: 609 >

self _primitiveFailed: #hash .
self _uncontinuableError
%

category: 'Comparing'
method: Object
identityHash

"This method returns some Integer related to the identity of the receiver.  If
 two objects compare identically (==) to each other, the results of sending
identityHash to each of those objects will be equal."

"The result is compatible with the Object>>identityHash  in GemStone 4.1 . "

<primitive: 609 >

self _primitiveFailed: #identityHash .
self _uncontinuableError
%

category: 'Comparing'
method: Object
basicIdentityHash

"This method returns some Integer related to the identity of the receiver.  If
 two objects compare identically (==) to each other, the results of sending
 basicIdentityHash to each of those objects is equal."

"Faster than identityHash.  Used in GsMethodDictionary .
 The result is not compatible with the Object>>identityHash  in GemStone 4.1 ."

<primitive: 321>

self _primitiveFailed: #basicIdentityHash .
self _uncontinuableError
%

category: 'Comparing'
method: Object
~= anObject

"Returns true if the receiver and the argument do not have the same
 value."

^ (self = anObject) not
%

category: 'Comparing'
method: Object
~~ anObject

"(Optimized selector.)  Returns true if the receiver and the argument are not
 the same object.

 This selector is optimized by the compiler and may not be reimplemented
 in any subclass. This implementation is so that perform will work."

^ self ~~ anObject
%

category: 'Other Comparisons'
method: Object
asciiLessThan: anObject

"For objects that are not Characters or CharacterCollections, returns the result
 of an ordinary less-than compare.  This method is reimplemented in Character,
 String, and DoubleByteString to provide comparison based on the ASCII
 collating order."

"This method is provided to facilitate testing of the kernel classes."

^ self < anObject
%

category: 'Copying'
method: Object
copy

"Returns a copy of the receiver which shares the receiver's instance
 variables.

 Tags of the receiver are not copied."

<primitive: 55>
self _primitiveFailed: #copy .
self _uncontinuableError
%

category: 'Private'
method: Object
_deepCopyWith: copiedObjDict

"Private.

 Used internally to implement deepCopy."

| copy myClass |

self isSpecial ifTrue: [ ^ self ].

copy := copiedObjDict at: self otherwise: nil.
copy ~~ nil ifTrue: [ ^ copy ].

copy := self copy.
copiedObjDict at: self put: copy.

myClass := self _class.
myClass isBytes ifTrue: [ ^ copy ].

"make deep copies of all the instance variables"
1 to: myClass instSize do: [ :i | | instVar instVarCopy |
  instVar := self instVarAt: i.
  instVarCopy := instVar _deepCopyWith: copiedObjDict.
  (instVar == instVarCopy)
    ifFalse: [ copy instVarAt: i put: instVarCopy ].
  ].

"make deep copies of all the objects in the indexable part"
(myClass isIndexable)
  ifTrue: [
    1 to: self _basicSize do: [ :i | | element elementCopy |
      element := self basicAt: i.
      elementCopy := element _deepCopyWith: copiedObjDict.
      (element == elementCopy)
        ifFalse: [ copy basicAt: i put: elementCopy ].
      ].
    ].

^ copy
%

category: 'Copying'
method: Object
deepCopy

"Returns a deep copy of the receiver.  That is, if the receiver is a collection
 or a complex object, the copy has copies of the original's elements and
 any component parts.  Those copies are also deep copies.  In other words,
 deep copying is recursive.

                                 CAUTION:

 Use this method with care.  It makes copies of all objects that can be reached
 from the receiver, which in some cases could be very large."

| copiedObjDict copy |

copiedObjDict := IdentityKeyValueDictionary new.
copy := self _deepCopyWith: copiedObjDict.
^copy.
%

category: 'Invariance'
method: Object
immediateInvariant

"Makes the receiver immediately invariant.  (By comparison, when
 invariance is specified during subclass creation, instances become
 invariant when they are first committed.)

 There is no protocol to reverse the effect of this method.  If the 
 receiver is a temporary object , there is no way to undo the effect
 of this method.  If the receiver was committed before the start
 of the current transaction, the effect of this method can be undone 
 by aborting the transaction."

<primitive: 269>
self _primitiveFailed:#immediateInvariant .
self _uncontinuableError
%

category: 'Invariance'
method: Object
isInvariant

"Returns true if the receiver is currently invariant, false otherwise."

<primitive: 36>
self _primitiveFailed: #isInvariant .
self _uncontinuableError
%

category: 'Message Handling'
method: Object
perform: aSelectorSymbol

"Sends the receiver the unary message indicated by the argument.
 The argument is the selector of the message.  Generates an error if
 the selector is not unary."

<primitive: 904>
^self _perform: aSelectorSymbol asSymbol withArguments:  #() 
%

category: 'Message Handling'
method: Object
perform: aSelectorSymbol with: anObject

"Sends the receiver the message indicated by the arguments.  The
 first argument is the keyword or binary selector of the message.  The
 second argument is the argument of the message to be sent.  Generates
 an error if the number of arguments expected by the selector is not 1."

<primitive: 904>

^self _perform: aSelectorSymbol asSymbol withArguments: #[anObject]
%

category: 'Message Handling'
method: Object
perform: aSelectorSymbol with: firstObject with: secondObject

"Sends the receiver the message indicated by the arguments.  The first
 argument is the keyword selector of the message.  The other arguments
 are the arguments of the message to be sent.  Generates an error if the
 number of arguments expected by the selector is not 2."

<primitive: 904>

^self _perform: aSelectorSymbol asSymbol
      withArguments: #[firstObject, secondObject]
%

category: 'Message Handling'
method: Object
perform: aSelectorSymbol with: firstObject with: secondObject with: thirdObject

"Sends the receiver the message indicated by the arguments.  The first
 argument is the keyword selector of the message.  The other arguments
 are the arguments of the message to be sent.  Generates an error if the
 number of arguments expected by the selector is not 3."

<primitive: 904>

^self _perform: aSelectorSymbol asSymbol
      withArguments: #[firstObject, secondObject, thirdObject]
%

category: 'Message Handling'
method: Object
perform: aSelectorSymbol withArguments: anArray

"Sends the receiver the message indicated by the arguments.
 The argument, aSelectorSymbol, is the keyword selector of the message.
 The arguments of the message are the elements of anArray.  Generates an
 error if the number of arguments expected by aSelectorSymbol is not
 the same as the number of elements in anArray.

 anArray must be an instance of Array."

<primitive: 905>
anArray _validateClass: Array.

"Now just try the primitive again, but send asSymbol to the selector to convert
 it to a Symbol."
^ self _perform: aSelectorSymbol asSymbol withArguments: anArray
%

category: 'Message Handling'
method: Object
_perform: aSelectorSymbol withArguments: anArray

"Sends the receiver the message indicated by the arguments.
 The argument, aSelectorSymbol, is the keyword selector of the message.
 The arguments of the message are the elements of anArray.  Generates an
 error if the number of arguments expected by aSelectorSymbol is not
 the same as the number of elements in anArray."

<primitive: 905> "fail if selector not found, or wrong number of arguments"

aSelectorSymbol _validateClass: Symbol.
anArray _validateInstanceOf: Array.

"now implement the failure so that forwarders can reimplement the
 failure method and send self doesNotUnderstand: ."

^ self cantPerform: aSelectorSymbol withArguments: anArray
%

category: 'Message Handling'
method: Object
_performNoDebug: aSelectorSymbol

"Send the receiver the message indicated by the arguments.  The GemStone
 Smalltalk debugger, GemStone Smalltalk breakpoints, soft breaks, and hard
 breaks are all disabled during evaluation of this send.

 If an error occurs during this send, then this session is
 not allowed to commit.  This behavior may be used to ensure consistency
 of indexes, hash dictionaries, etc.

 zero to 10 `with:' keywords are supported by the primitive.
 International selectors are not supported by this method."

<primitive: 305>

aSelectorSymbol _validateClass: String.
self _error: #rtErrCantPerform args: #[aSelectorSymbol] .
^ self _primitiveFailed: #_performNoDebug:
%

category: 'Message Handling'
method: Object
_performNoDebug: aSelectorSymbol with: anArg

"Send the receiver the message indicated by the arguments.  The GemStone
 Smalltalk debugger, GemStone Smalltalk breakpoints, soft breaks, and hard
 breaks are all disabled during evaluation of this send.

 If an error occurs during this send, then this session is
 not allowed to commit.  This behavior may be used to ensure consistency
 of indexes, hash dictionaries, etc.

 zero to 10 `with:' keywords are supported by the primitive.
 International selectors are not supported by this method."

<primitive: 305>

aSelectorSymbol _validateClass: String.
self _error: #rtErrCantPerform args: #[aSelectorSymbol] .
^ self _primitiveFailed: #_performNoDebug:with:
%

category: 'Message Handling'
method: Object
_performNoDebug: aSelectorSymbol with: anArg1 with: anArg2

"Send the receiver the message indicated by the arguments.  The GemStone
 Smalltalk debugger, GemStone Smalltalk breakpoints, soft breaks, and hard
 breaks are all disabled during evaluation of this send.

 If an error occurs during this send, then this session is
 not allowed to commit.  This behavior may be used to ensure consistency
 of indexes, hash dictionaries, etc.

 zero to 10 `with:' keywords are supported by the primitive.
 International selectors are not supported by this method."

<primitive: 305>

aSelectorSymbol _validateClass: String.
self _error: #rtErrCantPerform args: #[aSelectorSymbol] .
^ self _primitiveFailed: #_performNoDebug:with:with:
%

category: 'Message Handling'
method: Object
_performNoDebug: aSelectorSymbol with: anArg1 with: anArg2 with: anArg3

"Sends the receiver the message indicated by the arguments.  The GemStone
 Smalltalk debugger, GemStone Smalltalk breakpoints, soft breaks, and hard
 breaks are all disabled during evaluation of this send.

 If an error occurs during this send, then this session is not allowed to
 commit.  This behavior may be used to ensure consistency of indexes and hash
 dictionaries.

 zero to 10 `with:' keywords are supported by the primitive.
 International selectors are not supported by this method."

<primitive: 305>

aSelectorSymbol _validateClass: String.
self _error: #rtErrCantPerform args: #[aSelectorSymbol] .
^ self _primitiveFailed: #_performNoDebug:with:with:with:
%

category: 'Tag Management'
method: Object
tagAt: tagNum put: tagValue

"Sets the receiver's tag (tagNum = 1 or 2) to the specified tag value.
 Returns the tagValue.

 new in Gemstone64:
   Tags may not be stored into kind of Behavior 
   (i.e.  tags on Classes and  Metaclasses are not supported).
   Tags may not be stored into instances of GsMethod."

<primitive: 280>
self _primitiveFailed: #tagAt:put: .
self _uncontinuableError
%

category: 'Tag Management'
method: Object
tagAt: tagNum

"Returns the receiver's value for the specified tagNum (1 or 2).
 Returns nil if the specified tag has never been stored into. "

<primitive: 87>
self _primitiveFailed: #tagAt: .
self _uncontinuableError
%

category: 'Backward Compatibility'
method: Object
in: aCollection

"If there is an element of aCollection identical to the receiver,
 returns true.  Otherwise, returns false."

^ aCollection includesIdentical: self "this means identity, not equality"
%

category: 'Copyright'
method: Object
_copyright

"Copyright notice"

^
'Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.'
%

category: 'Disk Space Management'
method: Object
findReferences

"Searches GemStone for objects that reference the receiver, and returns an Array 
 of any such objects.  The search continues until all such objects have been
 found, or until the result contains 20 elements.  (The method
 findReferencesWithLimit: allows you to specify an arbitrarily large limit for
 the result Array.)

 If an object contains multiple references to the receiver, that object occurs
 only once in the result.

 This method aborts the current transaction; if an abort would cause unsaved
 changes to be lost, it signals an error, #rtErrAbortWouldLoseData.       

 The result contains both permanent and temporary objects.  The temporary
 objects found may vary from run to run. "
 
^self findReferencesWithLimit: 20
%

category: 'Disk Space Management'
method: Object
findReferencesWithLimit: aSmallInt

"Returns an Array of objects in GemStone that reference the receiver.  
 The search continues until all such objects have been found, or until the 
 size of the result reaches the specified maximum aSmallInt.

 If aSmallInt is <=  0, the result size is unlimited.

 The result contains both permanent and temporary objects.  The temporary
 objects found may vary from run to run.

 This method aborts the current transaction; if an abort would cause unsaved
 changes to be lost, it signals an error, #rtErrAbortWouldLoseData.       

 Note that this method may take a considerable length of time to
 execute, and the result may occupy a large amount of disk space.
 (Compare with findReferences, which limits the result to 20 elements.). "

| argArray tmpArray resultArr |

System needsCommit
  ifTrue: [ self _error: #rtErrAbortWouldLoseData ] .

argArray := Array with: self.
tmpArray := SystemRepository _listReferences: argArray  
                             withLimit: (aSmallInt + 1).

resultArr := tmpArray at: 1.
resultArr removeIdentical: argArray ifAbsent: [ nil ].
aSmallInt > 0 ifTrue:[
  resultArr size > aSmallInt ifTrue:[ resultArr size: aSmallInt ].
].
^ resultArr 
%

category: 'Class Membership'
method: Object
changeClassTo: aClass

"Redefines the class of the receiver to be aClass.  For this method to execute
 successfully, all of the following conditions must be true:

 1.  The receiver's class must have the same implementation as aClass
     (byte array, pointer array, or non-sequenceable collection).
 2.  The constraints of the receiver's class must be the same as the
     constraints of aClass.
 3.  If aClass is a kind of IdentitySet, then the class of the receiver 
     must also be a kind of IdentitySet.  (This method cannot be used to
     change an IdentityBag to an IdentitySet.)
 4.  The argument aClass must not be a kernel class for which instance creation
     is disallowed.
 5.  The argument aClass must not be a GsMethod, GsMethodDictionary,
     SymbolDictionary, or SymbolList.

 Generates an error if any of these conditions is not true."

<primitive: 270>
aClass _validateClass: Class.  "argument must be a Class"
self _error: #rtErrCantChangeClass args: #[aClass]
%

category: 'Class Membership'
method: Object
_class

"(Optimized selector.)  Returns the object that is the receiver's class.

 This selector is optimized by the compiler and may not be reimplemented
 in any subclass.  This implementation is so that perform will work."

^ self _class  
%

category: 'Class Membership'
method: Object
_isSmallInteger

"(Optimized selector.)  Returns true if the receiver is an instance of
 SmallInteger, returns false otherwise. 

 This selector is optimized by the compiler and may not be reimplemented
 in any subclass.  This implementation is so that perform will work."

^ self _isSmallInteger  
%

category: 'Class Membership'
method: Object
_isInteger

"(Optimized selector.)  Returns true if the receiver is an kind of
 Integer, returns false otherwise.

 This selector is optimized by the compiler and may not be reimplemented
 in any subclass.  This implementation is so that perform will work."

^ self _isInteger  
%

category: 'Class Membership'
method: Object
_isSymbol

"(Optimized selector.)  Returns true if the receiver is an instance of
 Symbol or DoubleByteSymbol, returns false otherwise.

 This selector is optimized by the compiler and may not be reimplemented
 in any subclass.  This implementation is so that perform will work."

^ self _isSymbol  
%

category: 'Private'
method: Object
_trapOop

"(Optimized selector.)  Activates internal debugging logic for the receiver.
 Has no effect in customer executables.
 NOT IMPLEMENTED IN THIS RELEASE, HAS NO EFFECT .

 This selector is optimized by the compiler and may not be reimplemented
 in any subclass.  This implementation is so that perform will work."

"The internal debugging logic performed is
   Workspace.prevTrapOopManagement := Workspace.trapOopManagement .
   Workspace.trapOopManagement := self .
"

^ self _trapOop  
%

category: 'Class Membership'
method: Object
class

"Returns the object that is the receiver's class."

<primitive: 610 >
^ self _primitiveFailed: #class .
%

category: 'Class Membership'
method: Object
_validateClass: aClass

"Returns nil if self is a kind of aClass.  Otherwise, generates an error."

(self isKindOf: aClass)
ifFalse:
  [ ^ self _errorExpectedClass: aClass].
^ nil
%
category: 'Class Membership'
method: Object
_validateInstanceOf: aClass

"Returns nil if self is instance of aClass.  Otherwise, generates an error."

(self class == aClass)
ifFalse:
  [ ^ self _errorExpectedClass: aClass].
^ nil
%

category: 'Class Membership'
method: Object
_validateByteClass: aClass

"Returns nil if self is a kind of aClass and also has byte format.
 Otherwise generates an error."

(self isKindOf: aClass) ifFalse:[ ^ self _errorExpectedClass: aClass ].
self class isBytes ifFalse:[ ^ self _error: #objErrNotByteKind ].
^ nil
%

category: 'Class Membership'
method: Object
_validateClasses: anArray

"Returns nil if self is a kind of a class in anArray.  Otherwise, generates an
 error."

1 to: anArray size
  do: [:i | (self isKindOf: (anArray at: i))
            ifTrue: [^nil]
      ].
self _error: #rtErrInvalidArgClass args: #[anArray]
%

category: 'Class Membership'
method: Object
isKindOfClass: aClass

"Returns true if aClass is identical to the class of the receiver
 or aClass is a superclass of the class of the receiver."

<primitive: 34>

aClass _errorExpectedClass: Class.
"just assume the class was wrong; we can't ask if it isKindOf: Class"
self _primitiveFailed: #isKindOfClass: .
self _uncontinuableError
%

category: 'Class Membership'
method: Object
isKindOf: aClassHistoryOrClass

"(Optimized selector.)  Returns true if the class of the receiver is identical
 to, or is a subclass of any class in aClassHistoryOrClass; otherwise, returns
 false.

 If the aClassHistoryOrClass argument is actually a class rather than a class
 history, then this method uses the class history of the argument, instead of
 the class itself.

 This selector is optimized by the compiler and may not be reimplemented
 in any subclass.  This implementation is so that perform: will work."

^ self isKindOf: aClassHistoryOrClass 
%

category: 'Class Membership'
method: Object
isByteKindOf: aClass

"Returns true if the class of the receiver is a kind of aClass,
 and if the receiver has byte format."

(self isKindOf: aClass) ifFalse:[ ^ false ] .

^ self class isBytes
%

category: 'Class Membership'
method: Object
_validateKindOfClasses: anArray

"Returns nil if the receiver is a kind of class for any Class in anArray.
 Otherwise, generates an error."

1 to: anArray size
  do: [:i | (self isKindOfClass: (anArray at: i))
            ifTrue: [^nil]
      ].
self _error: #rtErrInvalidArgClass args: #[anArray]
%

category: 'Class Membership'
method: Object
isMemberOf: aClass

"Returns true if the receiver is an instance of aClass, or if aClass is
 contained in the class history of the receiver's class; otherwise, returns
 false."

| history rcvrClass |
rcvrClass := self class .
rcvrClass == aClass ifTrue:[ ^ true ] .
history := rcvrClass classHistory .
1 to: history size do:[:j| 
  aClass == (history at: j) ifTrue:[ ^ true ]
  ].
^ false
%

category: 'Class Membership'
method: Object
isMemberOfClass: aClass

"Returns true if the receiver is an instance of aClass."

^self class == aClass
%

category: 'Instance Migration'
method: Object
migrate

"Migrate the instance from its current class to its class's target class.
 If its class has no target class, do nothing."

| targetClass newInstance |

targetClass := self class migrationDestination.
targetClass ~~ nil ifTrue: [
  targetClass classHistory == self class classHistory ifFalse:[
    ^ self class _error: #errNotSameClassHist args: #[ targetClass ] .
    ] .
  newInstance := targetClass migrateNew.
  newInstance assignToSegment: self segment.
  newInstance migrateFrom: self.
  newInstance become: self.
  " remember, self and newInstance have changed identities (thus, we are
    really returning the newly created instance of targetClass) "
  ^ self
]
%

category: 'Instance Migration'
method: Object
migrateFrom: anotherObject

"Takes information from the given object and puts it in the receiver.
 This message is sent to an object when its class is being migrated to
 another class to account for changes in a schema.  Most of the work
 is done in migrateFrom:instVarMap:, which is the method that should
 be reimplemented in subclasses if additional work must be done.

 Note: If the receiver is a kind of Bag or IdentityBag, then the receiver may
 have objects from anotherObject added to it."

^self migrateFrom: anotherObject
  instVarMap: (self class instVarMappingTo: anotherObject class)
%

! fix 9315
! Fix 33779
category: 'Instance Migration'
method: Object
migrateFrom: anotherObject instVarMap: otherivi

"Takes information from the given object and puts it in the receiver.
 This message is sent to an object when its class is being migrated to
 another class to account for changes in a schema.  The otherivi
 argument is a precalculated indirection table associating the receiver's
 instance variables with instance variables in the other object.  If
 a table entry is 0, the other object is assumed to not have that
 instance variable.

 This method should be augmented to perform other necessary initializations
 in the receiver."

| cls othercls idx otheriviSize cons validate value oldVal |

cls := self class.
cons := cls _constraints.
validate := [ :val :aClass | (val isKindOf: aClass) ifTrue: [val] ifFalse: [nil] ].

othercls := anotherObject class.
cls classHistory == othercls classHistory ifFalse:[
  ^ cls _error: #errNotSameClassHist args: #[ othercls ] .
  ] .
otheriviSize := otherivi size.
cls firstPublicInstVar to: otheriviSize do: [:i |
  idx := otherivi at: i.
  idx > 0 ifTrue: [
    oldVal := anotherObject instVarAt: idx.
    value := validate value: oldVal value: (cons at: i).
    " see if old value was changed to nil due to instance variable constraint "
    ( oldVal ~~ nil _and: [ value == nil ] )
      ifTrue: [
        oldVal := anotherObject
          invalidInstVarConstraintWhenMigratingInstVar:
             (anotherObject class allInstVarNames at: idx)
          shouldBe: (cons at: i).

        value := validate value: oldVal value: (cons at: i).
      ].
    anotherObject _checkConstraint: (cons at: i) onInstVarAt: idx.
    self _unsafeAt: i put: value.
  ].
].
self migrateIndexable: anotherObject myClass: cls otherClass: othercls.
%

category: 'Instance Migration'
method: Object
migrateIndexable: anotherObject myClass: cls otherClass: othercls

"Handle migrating the indexable component of an object."

| validate instSize cons oldVal value |

validate := [ :val :cls | (val isKindOf: cls) ifTrue: [val] ifFalse: [nil] ].
instSize := cls instSize.
(cls isIndexable _and: [ othercls isIndexable])
  ifTrue:[ " both classes are indexable "
    cls isBytes
      ifTrue:[
        ( (cls isKindOf: CharacterCollection) _and:
        [ othercls isKindOf: CharacterCollection ] )
          ifTrue:[ " both are CharacterCollections "
            anotherObject copyFrom:1 to: anotherObject size into: self startingAt: 1.
          ]
         ifFalse:[
           instSize := cls instSize.
           self _basicSize: anotherObject _basicSize.
           1 to: anotherObject _basicSize do: [:j |
             self _unsafeAt: j+instSize put: (anotherObject _at: j) asciiValue 
           ].
         ].
      ]
      ifFalse: [
        instSize := cls instSize.
        cons := cls varyingConstraint.
        self _basicSize: anotherObject _basicSize.
        1 to: anotherObject _basicSize do: [:j |
          oldVal := anotherObject _at: j.
          value := validate value: oldVal value: cons.
          " see if old value was changed to nil due to varying constraint "
          ( oldVal ~~ nil _and: [ value == nil ] )
            ifTrue: [
              " raise error or possibly get new value "
              value := anotherObject
                invalidElementConstraintWhenMigratingInto: self
                for: oldVal.

              " if value was converted, insert it "
              value ~~ oldVal
                ifTrue: [ self _unsafeAt: j+instSize put: value ].
            ]
            ifFalse: [ self _unsafeAt: j+instSize put: value ]
        ].
      ].
  ].
%

category: 'Instance Migration'
method: Object
invalidInstVarConstraintWhenMigratingInstVar: instVarName shouldBe: aClass

"Raises an error because the receiver could not be migrated due to having
 an instance variable (named instVarName) whose value is not a kind of aClass
 (defined as the instance variable constraint in the migration destination).
 Users should override this method to perform value conversions.
 When overridden, this method should return a new value of kind aClass."

| offset |

offset := self class _ivOffsetOf: instVarName asSymbol .
self _error: #rtErrInvalidConstraintForMigration
  args: #[ instVarName, self instVarAt: offset, aClass ].

^ nil
%

category: 'Instance Migration'
method: Object
invalidElementConstraintWhenMigratingInto: aCollection for: anObject

"Raises an error because the receiver could not be migrated due to
 one of its elements (anObject) not being a kind of aCollection's
 varying constraint.  If users want to customize their migration
 behavior, they should override this method to return a new object
 that can be added to aCollection."

self _error: #rtErrInvalidElementConstraintForMigration
  args: #[ anObject, aCollection class varyingConstraint ].

" if error is continued, return anObject "
^ anObject
%

category: 'Instance Migration'
method: Object
_unsafeAt: anIndex put: aValue

"Updates the receiver at the given index, ignoring constraints.  This is to be
 used for upgrading GemStone releases and for schema migration only.  Named
 instance variables are considered to be indexed by this method, so an
 unnamed part would begin at (self class instSize + 1).

 If anIndex is less than 1 or greater than 1 plus the total number of 
 instance variables in the receiver, an error is generated.  

 If the receiver is a kind of Bag, then only named instance variables may be
 modified by this method.  Take care not to corrupt the private named instance
 variables defined in class Bag.

 This method does not check constraints nor invariance.  However,
 Indexes are updated if some index is dependent upon the instance variable
 that is modified."

<primitive: 273>

(anIndex _isInteger)
  ifFalse: [ self _errorNonIntegerIndex: anIndex .  self _uncontinuableError ].
(self class isBytes)
ifTrue:
  [ ((aValue class ~~ SmallInteger) _or: [ (aValue < 0) | (aValue > 255) ])
    ifTrue: [ ^ aValue _error: #rtErrExpectedByteValue].
  ] .
self _primitiveFailed: #_unsafeAt:put: .
self _uncontinuableError
%

category: 'Reduced Conflict Support'
method: Object
_rcAt: anIndex

"Returns the object at the given index (same as _at:, _basicAt:,
 and at:).  If the receiver is not a large object, places the receiver
 in the rcReadSet.  If the receiver is a large object or NSC, places
 the root object and any large object nodes that are accessed in the
 rcReadSet.  Does not place the value that it returns in the rcReadSet."

<primitive: 92>
self _primitiveFailed: #_rcAt: .
self _uncontinuableError
%

category: 'Reduced Conflict Support'
method: Object
_selectiveAbort

"Performs an abort operation on the receiver. That is, if the object is
 committed, it removes any changes made by the current transaction and allows
 access to the committed state of the object."

self isSpecial
  ifTrue:[ ^ self ].
^ self _primitiveSelectiveAbort.
%

category: 'Reduced Conflict Support'
method: Object
_primitiveSelectiveAbort

"Performs an abort operation on the receiver. That is, if the object is
 committed, it removes any changes made by the current transaction and allows
 access to the committed state of the object.

 The error #rtErrSelectiveAbort is thrown if the receiver has depMap entries."

<primitive: 274>

self _primitiveFailed: #_selectiveAbort .
self _uncontinuableError
%

category: 'Reduced Conflict Support'
method: Object
_resolveRcConflictsWith: conflictObjects

"A logical write-write conflict has occurred on the receiver.  The objects that
 had the actual physical write-write conflicts are in the conflictObjects
 Array.  Selectively abort the receiver and then attempt to replay the
 operations maintained in the System redo log.  Returns true if all the
 operations could be replayed; otherwise returns false."

^ self _abortAndReplay: conflictObjects
%

category: 'Error Handling'
method: Object
_errorInvalidOffset: ivName

"The object does not have an instance variable with the given name."

^ self _error: #rtErrObjectInvalidOffset args: #[ ivName ]
%

category: 'Error Handling'
method: Object
_errorNoDependencyList

"The object does not have a dependency list."

^ self _error: #rtErrObjectNoDependencyList
%

category: 'Error Handling'
method: Object
_errorPathTermNotInDependencyList: aPathTerm

"An object did not have the path term in its dependency list."

^ self _error: #rtErrObjectPathTermNotInDependencyList args: #[ aPathTerm name ]
%

category: 'Converting'
method: Object
-> anObject

"Returns an Association with the receiver as the key and the given object as
 the value."

^Association newWithKey: self value: anObject
%

! remove _makeVariant; it can corrupt indexes.; bug 11879

category: 'Converting'
method: Object
asOop

"Returns the value of the receiver's object-oriented pointer (OOP) as a
 positive Integer .  This is the receiver's unique identifier that 
 distinguishes it from all other objects.  For non-special objects
 and for instances of Character, Boolean, UndefinedObject, and JISCharacter
 the result will always be a SmallInteger.  For instances of SmallInteger
 and SmallDouble the result may be a LargePositiveInteger. 

 The result is different from the result obtained in Gemstone64 v1.x"

<primitive: 86>
self _primitiveFailed: #asOop
%

category: 'Encoded OOPs'
method: Object
asOopNumber

"If the receiver is a non-special object, return the receiver's 
 oopNumber as defined under OOP_TAG_POM_OOP in the file 
 $GEMSTONE/include/gcioop.ht  , otherwise return nil . "

| oop |
oop := self asOop .
oop _isSmallInteger ifFalse:[ ^ nil ].
(oop bitAnd:7) == 1 ifFalse:[ ^ nil ].
^ oop bitShift: -8
%

category: 'Accessing'
method: Object
basicAt: anIndex

"Returns the object at the given location in the receiver.  Subclasses
 should not reimplement this method."

^self _basicAt: anIndex
%

category: 'Updating'
method: Object
basicAt: anIndex put: aValue

"Puts the given object into the given location in the receiver.  Subclasses
 should not reimplement this method."

^self _basicAt: anIndex put: aValue
%

! edited comments to fix 38109
category: 'Testing'
method: Object
canBeWritten

"Returns true if the current user has write authorization for the
 receiver, false if not."

^ (self _status  bitAnd: 16r10) ~~ 0 
%

category: 'Error Handling'
method: Object
cantPerform: aSelectorSymbol withArguments: anArray

"This method implements the default response when a message can't be performed
 with _perform:withArguments:.  It raises the rtErrCantPerform exception."

self _error: #rtErrCantPerform args: #[aSelectorSymbol, anArray].
^ self _primitiveFailed: #perform:withArguments:
%

! delete duplicate isBehavior

category: 'Updating'
method: Object
nilFields

"Sets the instance variables of the receiver to nil.  This is sometimes useful
 as an aid to quicker garbage collection."

self class firstPublicInstVar to: self class instSize do: [:i |
  self instVarAt: i put: nil
].

(self class isNsc) ifTrue: [
  self removeAll: self
]
ifFalse: [
  (self class isIndexable _and: [self class isPointers]) ifTrue: [
    self size: 0
  ].
].
%

category: 'Formatting'
method: Object
printOn: aStream

"Puts a displayable representation of the receiver on the given stream."

"For classes whose instances can be literals, the result should contain
 formatting information.  For example, the following expression should
 evaluate to true:

 #abc asString = String withAll: '#abc'."

aStream nextPutAll: self asString
%

category: 'Formatting'
method: Object
printString

"Returns a String whose contents are a displayable representation of the
 receiver."

"This method uses the printOn: method to create the String."

"Reinstalled in bomlast.gs with to use PrintStream instead of WriteStream."

| ws str |

str := String new.

ws := WriteStream on: str.   "this implementation does not support EUCString"

self printOn: ws.
^ ws _collection "contents might have been converted to an EUCString."
%

category: 'Testing'
method: Object
_methodLookUp: aSelector
"Returns method corresponding to aSelector implemented in the receiver's class
 or one of its superclasses or nil if no method implemented. Takes advantage of 
 vm method caching and fast vm lookup."

  <primitive: 655>
  | cls |
  cls := self class whichClassIncludesSelector: aSelector.
  cls == nil ifTrue: [ ^nil ].
  ^cls _methodDict at: aSelector 
%

category: 'Testing'
method: Object
respondsTo: aSelector

"Returns true if the receiver's class has a method with the given selector
 and false if not."

^(self class whichClassIncludesSelector: aSelector) ~~ nil
%

category: 'Copying'
method: Object
shallowCopy

"Returns a copy of the receiver with none of its components copied."

"If the receiver does not reimplement shallowCopy, this is the same as
 copy."

^ self copy
%

category: 'Class Membership'
method: Object
species

"Returns a class similar to, or the same as, the receiver's class which
 can be used for containing derived copies of the receiver."

^self class
%

category: 'Class Membership'
method: Object
speciesForSelect

"Returns a class similar to, or the same as, the receiver's class which
 can be used for containing derived copies of the receiver for select:
 and reject: queries."

^self species
%

category: 'Accessing'
method: Object
yourself

"Returns the receiver.  Often useful as the last message in a series of
 cascaded message sends to ensure that the expression returns a known value."

^self
%

category: 'ObsoleteIDX - Indexing Support'
method: Object
_idxCompareLessThan: arg

"This comparison operation should no longer be used. Use the new double dispatching-based 
  protocol in category 'New Indexing Comparison'."

^ self _idxForCompareLessThan: arg
%

category: 'ObsoleteIDX - Indexing Support'
method: Object
_idxCompareLessThanOrEqual: arg

"This comparison operation should no longer be used. Use the new double dispatching-based 
  protocol in category 'New Indexing Comparison'."

^ self _idxForCompareLessThanOrEqualTo: arg
%

category: 'ObsoleteIDX - Indexing Support'
method: Object
_idxCompareGreaterThan: arg

"This comparison operation should no longer be used. Use the new double dispatching-based 
  protocol in category 'New Indexing Comparison'."

^ self _idxForCompareGreaterThan: arg
%

category: 'ObsoleteIDX - Indexing Support'
method: Object
_idxCompareGreaterThanOrEqual: arg

"This comparison operation should no longer be used. Use the new double dispatching-based 
  protocol in category 'New Indexing Comparison'."

^ self _idxForCompareGreaterThanOrEqualTo: arg
%

category: 'ObsoleteIDX - Indexing Support'
method: Object
_idxCompareEqualTo: arg

"This comparison operation should no longer be used. Use the new double dispatching-based 
  protocol in category 'New Indexing Comparison'."

^ self _idxForCompareEqualTo: arg
%

category: 'ObsoleteIDX - Indexing Support'
method: Object
_idxCompareNotEqualTo: arg

"This comparison operation should no longer be used. Use the new double dispatching-based 
  protocol in category 'New Indexing Comparison'."

^ self _idxForCompareNotEqualTo: arg
%

category: 'Indexing Support'
method: Object
_idxGreaterThanAndLessThanValues: valueArray

"This comparison operation is by the indexing subsystem to determine if the
 receiver is within the given range of values.  The 'valueArray' argument is a
 four-element Array consisting of #[ val1, bool1, val2, bool2 ].  val1 is the
 lower bound value and bool1 specifies whether equal values are allowed.  val2
 is the upper value and bool2 specifies whether equal values are allowed.
 Returns true if the receiver satisfies the criteria."

(valueArray at: 2)
    ifTrue: [
        (self _idxForCompareGreaterThanOrEqual: (valueArray at: 1))
            ifTrue: [
                (valueArray at: 4)
                    ifTrue: [ ^ self _idxForCompareLessThanOrEqual: (valueArray at: 3) ]
                    ifFalse: [ ^ self _idxForCompareLessThan: (valueArray at: 3) ]
            ]
            ifFalse: [ ^ false ]
    ]
    ifFalse: [
          (self _idxForCompareGreaterThan: (valueArray at: 1))
            ifTrue: [
                (valueArray at: 4)
                    ifTrue: [ ^ self _idxForCompareLessThanOrEqual: (valueArray at: 3) ]
                    ifFalse: [ ^ self _idxForCompareLessThan: (valueArray at: 3) ]
            ]
            ifFalse: [ ^ false ]
    ]
%

category: 'Locking Support'
method: Object
_lockableValues

"Returns a kind of object usable as an argument to _lockAll: primitives."

^ self
%

category: 'Indexing Support'
method: Object
removeObjectFromBtrees

"Remove the receiver from the B-trees of any equality indexes that it
 participates in.  Returns an Array of index object/value pairs."

Exception
    category: nil
    number: nil
    do: [ :ex :cat :num :args | | txt |
        " get the text for the raised error "
        txt := cat textForError: num args: args.
        " check for recursive signal "
        num == (ErrorSymbols at: #rtErrPreventingCommit)
            ifTrue: [ " remove this exception and resignal "
                ex resignal: cat number: num args: args
            ]
            ifFalse: [ " append additional message to the end of text "
                txt _error: #rtErrPreventingCommit
            ]
    ].

^ self _removeObjectFromBtrees
%

category: 'Indexing Support'
method: Object
addObjectToBtreesWithValues: anArray

"Add the receiver to the B-trees of any equality indexes that it participates
 in, using the given Array of index object/value pairs."

Exception
    category: nil
    number: nil
    do: [ :ex :cat :num :args | | txt |
        " get the text for the raised error "
        txt := cat textForError: num args: args.
        " check for recursive signal "
        num == (ErrorSymbols at: #rtErrPreventingCommit)
            ifTrue: [ " remove this exception and resignal "
                ex resignal: cat number: num args: args
            ]
            ifFalse: [ " append additional message to the end of text "
                txt _error: #rtErrPreventingCommit
            ]
    ].

^ self _addObjectToBtreesWithValues: anArray
%

category: 'Testing'
method: Object
_onStackAsSelfBelow: startLevel

"Returns true if the receiver exists as self anywhere on the current
 GemStone Smalltalk stack above specified Activation; returns false otherwise.

 startLevel is the Activation on the stack at which to begin searching
 downwards.  1 means top of stack, which will be the Activation of
 the sender of  _onStackAsSelfBelow: .  (Since _onStackAsSelfBelow: is
 a primitive, it has no Activation).

 startLevel < 1 is interpreted as  startLevel == 1.

 See Object|become: for a typical use of this method."

<primitive: 288>
startLevel _validateClass: SmallInteger.
self _primitiveFailed: #_onStackAsSelf .
^ false
%

category: 'Storing and Loading'
classmethod: Object
loadFrom: passiveObj

"Reads from passiveObj the passive form of an object with named instance
 variable format.  Converts the object to its active form by loading the
 information into a new instance of the receiver.  Returns the new instance."

| inst |
"create a new instance and fill it full of information contained
 in the passiveObj"
self isVariable ifTrue: [
  inst := self _basicNew: passiveObj readSize.
  ]
ifFalse: [
  inst := self _basicNew
  ].
inst loadFrom: passiveObj.
^inst
%

category: 'Storing and Loading'
method: Object
basicLoadFrom: passiveObj

"Reads from passiveObj the passive form of an object with named instance
 variable format.  Converts the object to its active form by loading the
 information into the receiver."

passiveObj hasRead: self.
^ self basicLoadFromNoRead: passiveObj 
%
 
category: 'Storing and Loading'
method: Object
basicLoadFromNoRead: passiveObj

"Private."

(passiveObj readNamedIV) ifFalse: [
  "may be an old format, with assumed instance variable positions"
  ^self basicLoadFromOld: passiveObj
  ].
self loadNamedIVsFrom: passiveObj.
self class isVariable ifTrue: [
  self loadVaryingFrom: passiveObj
  ].
%

category: 'Storing and Loading'
method: Object
basicLoadFrom: passiveObj size: varyingSize

"Read the structure from the given passiveObj, with named instance variable
 format.  This is similar to basicLoadFrom:, but is used for objects whose size
 can not be preallocated at instantiation time (such as a Set)."

passiveObj hasRead: self.
self basicLoadFromNoRead: passiveObj size: varyingSize
%

category: 'Storing and Loading'
method: Object
basicLoadFromNoRead: passiveObj size: varyingSize

"Private."

(passiveObj readNamedIV) ifFalse: [
  "may be an old format, with assumed instance variable positions"
  ^self basicLoadFromOld: passiveObj
].
self loadNamedIVsFrom: passiveObj.
self class isVariable ifTrue: [
  self loadVaryingFrom: passiveObj size: varyingSize
].
%

category: 'Storing and Loading'
method: Object
basicLoadFromOld: passiveObj

"Read my structure from the given passiveObj."

self class firstPublicInstVar to: self class instSize do: [:i |
  self instVarAt: i put: passiveObj readObject
].

self class isVariable ifTrue: [
  self loadVaryingFrom: passiveObj
].
%

category: 'Storing and Loading'
method: Object
basicWriteTo: passiveObj

"Converts the receiver to its passive form and writes that information on
 passiveObj."

| s variable cls ivs c |
  cls := self class.
  passiveObj writeClass: cls.

  ivs := cls _instVarNames .

  variable := cls isVariable.
  variable ifTrue: [ passiveObj writeSize: (s := self _basicSize) ].

  cls firstPublicInstVar to: cls instSize do: [:i |
    (self shouldWriteInstVar: (ivs at: i)) ifTrue: [
      passiveObj writeObject: (self instVarAt: i) named: (ivs at: i)
    ].
  ].

  passiveObj endNamedInstVars.

  variable ifTrue: [
    c := 0.
    1 to: s do: [:i |
      passiveObj writeObject: (self _at: i).
      c := c + 1.
      c > 99 ifTrue: [
        passiveObj lf.
        c := 0.
      ].
    ]
  ].
  passiveObj cr
%

category: 'Storing and Loading'
method: Object
containsIdentity

"Private."

^false
%

category: 'Storing and Loading'
method: Object
loadFrom: passiveObj

"Reads from passiveObj the passive form of an object with named instance
 variable format.  Converts the object to its active form by loading the
 information into the receiver."

^self basicLoadFrom: passiveObj
%

category: 'Storing and Loading'
method: Object
loadNamedIVsFrom: passiveObj

"Reads named instance variables from the given passive object.  The
 first instance variable should already have been parsed and be
 available in the passiveObj argument."

| name offset nameSym |

[ name := passiveObj ivName.
  name ~~ nil ifTrue: [
    nameSym := Symbol _existingWithAll: name .
    nameSym ~~ nil ifTrue:[
      offset := self class _ivOffsetOf: nameSym.
      offset ~~ nil ifTrue:[ self instVarAt: offset put: passiveObj ivValue ]
             ifFalse:[ self obsoleteInstVar: nameSym value: passiveObj ivValue].
    ]
    ifFalse:[ 
      self obsoleteInstVar: name value: passiveObj ivValue
    ].
    passiveObj readNamedIV
  ]
  ifFalse: [
    false
  ]
] untilFalse.

passiveObj skipNamedInstVars.
%

category: 'Storing and Loading'
method: Object
loadVaryingFrom: passiveObj

"Reads the varying part of the receiver from the given passive object.
 Does not record the receiver as having been read.  Does not read the
 receiver's named instance variables, if any."

1 to: self _basicSize do: [:i |
  self _basicAt: i put: passiveObj readObject
].
%

category: 'Storing and Loading'
method: Object
loadVaryingFrom: passiveObj size: varyingSize

"Reads the varying part of the receiver from the given passive object.
 Does not record the receiver as having been read.  Does not read the
 receiver's named instance variables, if any."

1 to: varyingSize do: [:i |
  self _basicAt: i put: passiveObj readObject
].
%

category: 'Storing and Loading Obsolete'
method: Object
obsoleteInstVar: instVarName value: instVarValue

"This is a placeholder method with no default behavior.  (It simply returns the
 receiver.)  It can be reimplemented in subclasses to permit user-specified
 operations.

 This message is sent when an instance of a class with the same name as the
 receiver's class is activated and it specifies a named instance variable that
 the receiver does not have.  The instance variable name and value are sent as
 arguments to this method so that the instance may do something with them if it
 desires (such as transform old values into a new format in other instance
 variables)."
%

category: 'Storing and Loading'
method: Object
shouldWriteInstVar: instVarName

"Returns whether the given instance variable should be written out.  The
 default is to write out all instance variables."
^true
%

category: 'Storing and Loading'
method: Object
storeString

"Returns a string that, when evaluated, will recreate a copy of the
 receiver.  The default is to use storeOn: to create the description."

| stream str |
str := String new.
stream := WriteStream on: str.
self storeOn: stream.
^str
%

category: 'Storing and Loading'
method: Object
writeTo: passiveObj

"Converts the receiver to its passive form and writes that information on
 passiveObj.  The argument must an instance of PassiveObject."

^self basicWriteTo: passiveObj
%

category: 'Testing'
method: Object
_isRcIdentityBag

"Returns true if the receiver is an RcIdentityBag; returns false otherwise."

^ false
%

! deleted _canonicalizeSymbolAt: offset oldSymbol: oldSym newSymbol: newSym

category: 'Private'
method: Object
_gsReturnTos

"Return top of stack to the caller.

 To be sent only from within the virtual machine.  Any other use corrupts 
 the virtual machine's stack.  Used when a GciSend resolves to a primitive."

<primitive: 909> 
self _primitiveFailed: #_gsReturnTos .
self _uncontinuableError
%

category: 'Private'
method: Object
_gsReturnNothingEnableEvents

"Returns nothing to the caller and reenables asynchronous Exception dispatch.

 To be sent only from within the virtual machine.  Any other use corrupts 
 the virtual machine's stack.  Used in dispatch of an Exception to field
 an asynchronous event error."

<primitive: 912> 
self _primitiveFailed: #_gsReturnTosEnableEvents .
self _uncontinuableError
%

! fix bug 9918
category: 'Storing and Loading'
method: Object
storeOn: stream

"Writes a string that, when evaluated, recreates a copy of the receiver to
 the given stream.  The default is to use PassiveObjects to create the
 description."
  
| p lf col extra litSize c appendStr idx needVariant |

p := (self passivate) contents.
lf := Character lf.
needVariant := false.

"Format the passive description so it can be filed in properly.
 This has to take into account the max literal size restriction in
 GemStone's compiler.  It still may fail if the content string is
 too large or has too many syntactically significant characters in it."
col := litSize := extra := 0.
1 to: p size do: [:i |
  idx := i+extra.
  c := p at: idx.
  (c == $% _and: [col == 0]) ifTrue: [
    p insertAll: ' ' at: idx.
    extra := extra + 1.
    litSize := litSize + 1.
    col := col + 1.
  ]
  ifFalse: [
    (c == $') ifTrue: [
      p insertAll: '''' at: idx.
      extra := extra + 1.
      litSize := litSize + 1.
      col := col + 1.
    ]
    ifFalse: [
      (c == lf) ifTrue: [col := -1]
    ]
  ].
  litSize := litSize + 1.
  col := col + 1.
  litSize > 9999 ifTrue: [
    appendStr := '''; addAll: '''.
    p insertAll: appendStr at: idx.
    extra := extra + appendStr size.
    litSize := 0.
    needVariant := true.
  ].
].

stream nextPutAll: '(PassiveObject newWithContents: '.
needVariant ifTrue: [
  stream nextPutAll: '(String new addAll: '
].
stream nextPutAll: '''';
  nextPutAll: p;
  nextPutAll: ''''.
needVariant ifTrue: [
  stream nextPutAll: '; yourself $' .
].
stream nextPutAll: ') activate'
%
! fix bug 14094

category: 'Storing and Loading'
method: Object
passivate

"Creates a passive description of the receiver that can be activated with an
 activate message to create a new object with the same value as the receiver.

 For large objects or large graphs of objects, consider using this form:

 PassiveObject passivate: anObject toStream: (GsFile openWrite: aFileName)"

^PassiveObject passivate: self
%

category: 'Testing'
method: Object
_isIndexObject

"Returns true if the receiver is an index object; returns false otherwise."

^ false
%

category: 'Testing'
method: Object
_isObsoletePathTerm

"Returns true if the receiver is an obsolete path term; returns false
 otherwise."

^ false
%

category: 'Modification Tracking'
method: Object
_clearModificationTrackingTo: tracker

"Remove the given tracker from the receiver's dependency list."

DependencyList removeTracker: tracker for: self.
%

category: 'Modification Tracking'
method: Object
_getDepListAndAddTracker: tracker withId: anInteger

"Add the given tracker to the receiver's dependency list."

| depList depListClass dl |
depListClass := DependencyList .
dl := depListClass for: self.
dl == nil
  ifTrue: [
    depList := depListClass new: 2.
    depList _basicAt: 1 put: tracker.
    depList _basicAt: 2 put: anInteger.
  ]
  ifFalse: [
    depList := dl copyAndAddTracker: tracker withId: anInteger for: self
  ].

depListClass
  set: (SharedDependencyLists at: depList logging: true)
  for: self.
%

category: 'Modification Tracking'
method: Object
_hasModificationTracking

"Returns true if the receiver's dependency list has any tracking objects;
 returns false otherwise."

| result depList |
depList := DependencyList for: self.
depList == nil
  ifTrue: [ result := false ]
  ifFalse: [ result := depList includesIdentical: 0 ].
^ result
%

category: 'Modification Tracking'
method: Object
_hasModificationTrackingTo: aTrackingObject

"Returns true if the receiver's dependency list has any tracking objects;
 returns false otherwise."

| result depList |
depList := DependencyList for: self.
depList == nil
  ifTrue: [ result := false ]
  ifFalse: [ result := depList includesIdentical: aTrackingObject ].
^ result
%

category: 'Modification Tracking'
method: Object
_setModificationTrackingTo: tracker

"Adds the given tracker to the dependency list of the receiver."

self isSpecial
  ifFalse: [
    self _getDepListAndAddTracker:tracker withId: 0
  ].
%

category: 'Indexing Support'
method: Object
_errorIndexCreationInProgress

"Raises an error because the receiver is currently in use building an index."

'Operation could not be performed because index creation is in progress.'
  _error: #rtErrCommitProhibitingError
%

category: 'Indexing Support'
method: Object
_errorCouldNotCommitDuringIndexCreation

"Raises an error because the receiver is currently in use building an index."

'Failed commit during index creation.'
  _error: #rtErrCommitProhibitingError
%

category: 'Queries'
method: Object
isMeta

"Returns false.  This method is reimplemented in Metaclass to return true."

^ false.
%

method: Object
_validateRcConflictsWith: conflictObjects

"The default validation for Rc conflicts is to return true.
 This satisfies the cases of changes to the root object"

^ true
%

category: 'Private'
method: Object
_checkLogEntriesForNoSelector: selector

"This method returns true only if the RcLogEntries for this transaction do 
 NOT contain the specified selector.  If the selector is found then we 
 take the conservative approach and fail the transaction because we cannot
 guarantee that it can succeed after performing the redo."
  
| redoLog logEntries |

redoLog := System _redoLog.
redoLog == nil
  ifTrue: [ ^ false ].
  
logEntries := redoLog getLogEntriesFor: self.
" if no log entries to replay, then we're done "
logEntries == nil
  ifTrue: [ ^ false ].
  
1 to: logEntries size do: [ :i |
  (logEntries at: i) selector == selector
    ifTrue: [ ^ false ]
].
^ true
%

category: 'Compression'
method: Object
_compress

"If the receiver is a byte format object, and is not a kind of Symbol,
 returns an instance of the class of the receiver with the body of the
 result being a compressed version of the body of the receiver. The
 compression will be in gzip format.

 If the receiver is not byte format, or is a kind of Symbol, or is of size
 zero, returns the receiver. 

 If the gzip algorithm reports errors, the primitive will fail. This should
 only happen if there is insufficient C virtual memory."

<primitive: 507>
self _primitiveFailed: #_compress 
%
category: 'Compression'
method: Object
_decompress

"If the receiver is a byte format object, and is not a kind of Symbol,
 attempts to decompress an object that was a result of _compress. If
 the body of the object decompresses successfully with the gzip algorithm,
 returns a decompressed instance of the class of the receiver.

 If the receiver is not byte format, or is a kind of Symbol, or is of size zero,
 returns the receiver.

 If the gunzip algorithm reports errors, returns nil."

<primitive: 508>
self _primitiveFailed: #_decompress 
%

! _canonicalSymbol deleted


category: 'Encoded OOPs'
classmethod: Object
getObjectWithOldLow: anInt high: anotherInt

"Convert the specified Gs64 v1.1 double encoded OOP into the object represented
 by that OOP.  nil is returned if the object does not exist."

^self _getOopWithOldLow: anInt high: anotherInt opCode: 0
%
category: 'Encoded OOPs'
classmethod: Object
getNewOopWithLow: anInt high: anotherInt

"Convert the specified double encoded OOP into an Integer representing
 the OOP of the object.  The object with the return OOP is not verified
 to exist."

^self _getOopWithOldLow: anInt high: anotherInt opCode: 1
%

category: 'Encoded OOPs'
classmethod: Object
getOldOopWithOldLow: anInt high: anotherInt

"Returns a SmallInteger representing the Old OOP
value of the specified double encoded OOP.  No checking is done to
ensure the object with OOP returned actually exists.  Answer nil if the
arguments are invalid or are not instances of SmallInteger."

(anInt < 0 _or:[ anInt > 65535]) ifTrue:[ ^ nil ].
(anotherInt < 0 _or:[ anotherInt > 65535]) ifTrue:[ ^ nil ].
^ (anotherInt bitShift:16)  bitOr: anInt .
%

category: 'Encoded OOPs'
method: Object
getOopFromInstVar: anOffset

"Return the oop for the object referenced by this one at the given
offset without reading the referenced object.  Note that in the case of
collections, the offset could reference either a named instance variable
or an indexable instance variable.  Named inst vars start at offset 1
and run up to the number of named inst vars.  Indexable inst vars follow
named inst vars in the sequence.  

The receiver must be a format-oop 
object;  kinds of IdentityBag , CharacterCollection, ByteArray are not allowed.

For example, to access the first element of an Array subclass with 3
named inst vars, an offset of 4 would be used."

<primitive: 637>
anOffset _validateClass: Integer .
(anOffset < 1 _or:[anOffset > self _primitiveSize]) ifTrue:[
  self _errorIndexOutOfRange: anOffset .
].
self _primitiveFailed: #getOopFromInstVar: .
%

category: 'Encoded OOPs'
classmethod: Object
_getOopWithOldLow: anInt high: anotherInt opCode: anOpCode

"Convert the specified Gs64 v1.1 double encoded OOP into either an object
 or an Integer representing the Gs64 v2.0 OOP of the object.
 If the opCode is zero, then the object is returned if it 
 exists.  nil is returned if the object does not exist.
 If the opCode is not zero, then a SmallInteger representing the OOP of the object is
 returned.  The object with this OOP is not verified to exist."

<primitive: 537>
anInt _validateClass: SmallInteger.
anotherInt _validateClass: SmallInteger.
anOpCode _validateClass: SmallInteger.
(anInt > 65535) ifTrue:[self _errorIndexOutOfRange: anInt].
(anotherInt > 65535) ifTrue:[self _errorIndexOutOfRange: anotherInt].
self _primitiveFailed: #_getOopWithOldLow:high:opcode:
%

category: 'Encoded OOPs'
classmethod: Object
getNewOopFromOldOop: anInteger

"Convert the specified old OOP in Gs64 v1.1 OOP format to
 an OOP in Gs64 v2.0 format.  For OOPs representing objects other
 than SmallIntegers or SmallDoubles the result will always be a SmallInteger;
 otherwise it is possible for the result to be a LargePositiveInteger.
 The argument may be a positive SmallInteger or LargePositiveInteger "

^self _getOopOrObjectFromOldOop: anInteger opCode: 1
%

category: 'Encoded OOPs'
classmethod: Object
getObjectFromOldOop: anInteger

"Convert the specified old OOP in Gs64 v1.1 OOP format to
 a Gs64 v2.0 object identifier. Return  the object represented by
 the new object identifier , or nil if it does not exist."

^self _getOopOrObjectFromOldOop: anInteger opCode: 0
%

category: 'Encoded OOPs'
classmethod: Object
_getOopOrObjectFromOldOop: anInt opCode: anOpCode

"Convert the specified old (Gs64 v1.1 OOP format) OOP to either
 an object or the new (Gs64 v2.0 OOP format) OOP, depending
 on the opCode.  An opCode of zero means return the
 object if it exists or nil if it does not.  A non-zero opCode
 means return a positive Integer representing the new OOP."
<primitive: 539>

self _primitiveFailed: #_getOopOrObjectFromOldOop:opCode:
%

category: 'Encoded OOPs'
method: Object
_getOldOop

"Return a SmallInteger which is the Gs64 v1.1 OOP for the object.
 Return nil if the object is not representable with a 4 byte OOP .
 Special objects will always return nil.
"
<primitive: 544 >
self _primitiveFailed: #_getOldOop
% 

category: 'Encoded OOPs'
method: Object
getOldLowEncodedOop

"Return a SmallInteger which is the low 16 bits of the Gs64 v1.1 OOP for the object.
 Return nil if the object is not representable with a 4 byte OOP .
 Special objects will always return nil.
"

| n |
n := self _getOldOop .
n == nil ifTrue:[ ^ nil ].
^ n bitAnd: 16rFFFF 
%

category: 'Encoded OOPs'
method: Object
getOldHighEncodedOop

"Return a SmallInteger which is the high 16 bits of the Gs64 v1.1 OOP for the object.
 Return nil if the object is not representable with a 4 byte OOP .
 Special objects will always return nil.
"
| n |
n := self _getOldOop .
n == nil ifTrue:[ ^ nil ].
^ n bitShift: 16 
%


category: 'Accessing'
method: Object
segment

"Returns the Segment where the receiver is located.  
 If the result is nil, the object has World write permission (segmentId 0)."

<primitive: 592>
self _primitiveFailed: #segment .
self _uncontinuableError
%

category: 'Accessing'
method: Object
segmentId

"Returns the segmentId of the Segment where the receiver is located. 
 If the result is 0, the object has World write permission."
| seg | 
seg := self segment.
seg == nil ifFalse:[ ^ seg segmentId ].
^ 0
%

category: 'Private'
method: Object
_changeToSegment: aSegment

"Reassigns the receiver to aSegment.  
 If the receiver's current segment and aSegment are the same,
 this method has no effect, otherwise all of the following apply:

 Generates an error if the user is not authorized to write to both 
 the receiver's current segment and aSegment, 
 or if the receiver is a special object (SmallInteger, AbstractCharacter, 
 Boolean, SmallDouble, or UndefinedObject),
 or if aSegment is not a committed object.

 aSegment may be nil, in which case the object is given World write
 permission (segmentId 0).  "

<primitive: 594>

(self isSpecial _or:[ self isSymbol]) ifTrue:[ 
   self _error: #segErrCantMoveObj
]. 
aSegment _validateClass: Segment.

self _primitiveFailed: #assignToSegment: .
self _uncontinuableError

%
category: 'Updating' 
method: Object
assignToSegment: aSegment

"Assign the receiver to the given segment.  does not affect components
 of the receiver.

 If the receiver's current segment and aSegment are the same,
 this method has no effect, otherwise all of the following apply:

 Generates an error if the user is not authorized to write to both 
 the receiver's current segment and aSegment, 
 or if the receiver is a special object (SmallInteger, AbstractCharacter, 
 Boolean, SmallDouble, or UndefinedObject),
 or if aSegment is not a committed object.

 aSegment may be nil, in which case the object is given World write
 permission (segmentId 0).  "

^ self _changeToSegment: aSegment
%

category: 'Updating'
method: Object
changeToSegment: aSegment

"Assign the receiver to the given segment.  This method may be reimplemented
 to assign components of the receiver as well.

 If the receiver's current segment and aSegment are the same,
 this method has no effect, otherwise all of the following apply:

 Generates an error if the user is not authorized to write to both 
 the receiver's current segment and aSegment, 
 or if the receiver is a special object (SmallInteger, AbstractCharacter, 
 Boolean, SmallDouble, or UndefinedObject),
 or if aSegment is not a committed object.

 aSegment may be nil, in which case the object is given World write
 permission (segmentId 0).  "

^self _changeToSegment: aSegment
%

category: 'Reduced Conflict Support'
method: Object
_abortAndReplay: conflictObjects
 
"Abort the receiver and replay operations on the receiver from the redo log."
 
| redoLog logEntries |
redoLog := System _redoLog.
 
" if no log entries to replay, then we're done "
redoLog == nil ifTrue: [ ^ false ].
logEntries := redoLog getLogEntriesFor: self .
logEntries == nil ifTrue:[ ^ false ].

" cannot perform selective abort if receiver has a dependency tag "
self _hasDependencyList ifTrue: [ ^ false ].
 
" refresh the state of the receiver "
self _selectiveAbort.
 
" tell the redo log to replay any operations on the receiver "
^ redoLog _redoOperationsForEntries: logEntries 
%


category: 'Reduced Conflict Support'
method: Object
_getInternalNodes
"PRIVATE. For large objects, return array of internal nodes."

<primitive: 639>
self _primitiveFailed: #_getInternalNodes .
self _uncontinuableError
%
category: 'Reduced Conflict Support'
method: Object
_refreshAfterCommitFailure
 
"Returns whether the receiver should be selectively aborted when there is a
 failed attempt to commit.  Only special Reduced Objects should answer true."
 
^ false
%
category: 'Private'
method: Object
_setNoStubbing

"While the object is in-memory, prevent stubbing of references from
 the receiver to in-memory committed objects.

 Has no effect if receiver is special , or is byte format.
 Otherwise the receiver must be a small object or an error is generated.
 Returns the receiver."

<primitive: 521>

self _primitiveFailed: #_setNoStubbing
%

! added _objectForOop: to fix 32731
category: 'Private'
classmethod: Object
_objectForOop: aPositiveInt

" return the object with the given objectId, or nil if no such
  object exists.  The objectId may specify a special object.

  The argument must be > 0 and must be either
  a SmallInteger or a LargePositiveInteger, othewise the primitive
  will fail."

<primitive: 38>
^ self _primitiveFailed: #_objectForOop:
%

category: 'Private'
classmethod: Object
_oop11toOop20: a11oop 

"Given the Integer value of a objectId from Gemstone64 v1.1,
 return the value of the Gemstone v2.0 objectId .  The objectId
 is assumed must be of a Pom object, not a special object."

(a11oop bitAnd: 1) == 0 ifTrue:[ nil error:'argument is not a Pom oop'].
^  ((a11oop bitShift:-1) bitShift:8 ) bitOr: 1 
%
category: 'Private'
classmethod: Object
_oop20toOop11: a20oop 

"Given the Integer value of a objectId from Gemstone64 v2.0,
 return the value of the Gemstone v1.1 objectId .  The objectId
 is assumed must be of a Pom object, not a special object."

(a20oop bitAnd: 1) == 0 ifTrue:[ nil error:'argument is not a Pom oop'].
^  ((a20oop bitShift:-8) bitShift:1 ) bitOr: 1 
%

category: 'Repository Conversion'
method: Object
_basicCopy

"Returns a copy of the receiver which shares the receiver's instance
 variables."

<primitive: 55>
self _primitiveFailed: #_basicCopy .
self _uncontinuableError
%

category: 'Repository Conversion'
classmethod: Object
_postConvertLargeObjectWithOop: anInt for61: aBoolean

"result true if successful, false if already converted,
 else returns String error status"
<primitive: 573>
anInt _validateClass: SmallInteger.
aBoolean _validateClass: Boolean.
self _primitiveFailed: #_postConvertLargeObjectWithOop:for61: .
self _uncontinuableError
%

category: 'New Indexing Comparison'
method: Object
_classSortsLessThan: anObject

^self _classSortOrdinal < anObject _classSortOrdinal 
%
category: 'New Indexing Comparison'
method: Object
_classSortsGreaterThan: anObject

^self _classSortOrdinal > anObject _classSortOrdinal 
%
category: 'New Indexing Comparison'
method: Object
_classSortOrdinal

^ 100
%
category: 'New Indexing Comparison'
method: Object
_idxForCompareEqualTo: arg

""

^self _idxForSortEqualTo: arg
%
category: 'New Indexing Comparison'
method: Object
_idxForCompareGreaterThan: arg

""

^arg _idxForCompareObjectGreaterThanSelf: self
%
category: 'New Indexing Comparison'
method: Object
_idxForCompareGreaterThanOrEqualTo: arg

""

^arg _idxForCompareObjectGreaterThanOrEqualToSelf: self
%
category: 'New Indexing Comparison'
method: Object
_idxForCompareLessThan: arg

""

^arg _idxForCompareObjectLessThanSelf: self
%
category: 'New Indexing Comparison'
method: Object
_idxForCompareLessThanOrEqualTo: arg

""

^arg _idxForCompareObjectLessThanOrEqualToSelf: self
%
category: 'New Indexing Comparison'
method: Object
_idxForSortEqualTo: arg

""

^arg _idxForSortEqualToObject: self
%
category: 'New Indexing Comparison'
method: Object
_idxForSortNotEqualTo: arg

""

^arg _idxForSortNotEqualToObject: self
%
category: 'New Indexing Comparison'
method: Object
_idxForSortGreaterThan: arg

""

^arg _idxForSortObjectGreaterThanSelf: self
%
category: 'New Indexing Comparison'
method: Object
_idxForSortGreaterThanOrEqualTo: arg

""

^arg _idxForSortObjectGreaterThanOrEqualToSelf: self
%
category: 'New Indexing Comparison'
method: Object
_idxForSortLessThan: arg

""

^arg _idxForSortObjectLessThanSelf: self
%
category: 'New Indexing Comparison'
method: Object
_idxForSortLessThanOrEqualTo: arg

""

^arg _idxForSortObjectLessThanOrEqualToSelf: self
%

category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortObjectLessThanOrEqualToSelf: anObject

""

(self _classSortOrdinal = anObject _classSortOrdinal)
  ifTrue: [ ^anObject <= self ].
^anObject _classSortsLessThan: self

%

category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortBooleanGreaterThanOrEqualToSelf: aBoolean

""

^aBoolean _classSortsGreaterThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortBooleanGreaterThanSelf: aBoolean

""

^aBoolean _classSortsGreaterThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortBooleanLessThanOrEqualToSelf: aBoolean

""

^aBoolean _classSortsLessThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortBooleanLessThanSelf: aBoolean

""

^aBoolean _classSortsLessThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortCharacterCollectionGreaterThanOrEqualToSelf: aCharacterCollection

""

^aCharacterCollection _classSortsGreaterThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortCharacterCollectionGreaterThanSelf: aCharacterCollection

""

^aCharacterCollection _classSortsGreaterThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortCharacterCollectionLessThanOrEqualToSelf: aCharacterCollection

""

^aCharacterCollection _classSortsLessThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortCharacterCollectionLessThanSelf: aCharacterCollection

""

^aCharacterCollection _classSortsLessThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortEqualToCharacterCollection: aCharacterCollection

""

^ false
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortEqualToNumber: aNumber

""

^ false
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortEqualToObject: anObject

""

(self _classSortOrdinal = anObject _classSortOrdinal)
  ifTrue: [ ^anObject = self ].
^false
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortNotEqualToCharacterCollection: aCharacterCollection

""

^ true
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortNotEqualToObject: anObject

""

(self _classSortOrdinal = anObject _classSortOrdinal)
  ifTrue: [ ^anObject ~= self ].
^true
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortNotEqualToNumber: aNumber

""

^ true
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortNumberGreaterThanOrEqualToSelf: aNumber

""

^aNumber _classSortsGreaterThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortNumberGreaterThanSelf: aNumber

""

^aNumber _classSortsGreaterThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortNumberLessThanOrEqualToSelf: aNumber

""

^aNumber _classSortsLessThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortNumberLessThanSelf: aNumber

""

^aNumber _classSortsLessThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortObjectGreaterThanOrEqualToSelf: anObject

""

^anObject >= self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortObjectGreaterThanSelf: anObject

""

(self _classSortOrdinal = anObject _classSortOrdinal)
  ifTrue: [ ^anObject > self ].
^anObject _classSortsGreaterThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortObjectGreaterThanOrEqualToSelf: anObject

""

(self _classSortOrdinal = anObject _classSortOrdinal)
  ifTrue: [ ^anObject >= self ].
^anObject _classSortsGreaterThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortObjectLessThanSelf: anObject

""

(self _classSortOrdinal = anObject _classSortOrdinal)
  ifTrue: [ ^anObject < self ].
^anObject _classSortsLessThan: self

%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortUndefinedObjectGreaterThanOrEqualToSelf: anUndefinedObject

""

^anUndefinedObject _classSortsGreaterThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortUndefinedObjectGreaterThanSelf: anUndefinedObject

""

^anUndefinedObject _classSortsGreaterThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortUndefinedObjectLessThanOrEqualToSelf: anUndefinedObject

""

^anUndefinedObject _classSortsLessThan: self
%
category: 'New Indexing Comparison - for Sort'
method: Object
_idxForSortUndefinedObjectLessThanSelf: anUndefinedObject

""

^anUndefinedObject _classSortsLessThan: self
%

category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareBooleanGreaterThanOrEqualToSelf: aBoolean

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareBooleanGreaterThanSelf: aBoolean

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareBooleanLessThanOrEqualToSelf: aBoolean

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareBooleanLessThanSelf: aBoolean

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareCharacterCollectionGreaterThanOrEqualToSelf: aCharacterCollection

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareCharacterCollectionGreaterThanSelf: aCharacterCollection

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareCharacterCollectionLessThanOrEqualToSelf: aCharacterCollection

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareCharacterCollectionLessThanSelf: aCharacterCollection

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareEqualToDoubleByteString: aString

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareEqualToDoubleByteSymbol: aSymbol

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareEqualToNumber: aNumber

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareEqualToString: aString

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareEqualToSymbol: aSymbol

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareObjectGreaterThanOrEqualToSelf: anObject

""

(self _classSortOrdinal = anObject _classSortOrdinal)
  ifTrue: [ ^anObject >= self ].
^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareObjectGreaterThanSelf: anObject

""

(self _classSortOrdinal = anObject _classSortOrdinal)
  ifTrue: [ ^anObject > self ].
^false

%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareObjectLessThanOrEqualToSelf: anObject

""

(self _classSortOrdinal = anObject _classSortOrdinal)
  ifTrue: [ ^anObject <= self ].
^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareObjectLessThanSelf: anObject

""

(self _classSortOrdinal = anObject _classSortOrdinal)
  ifTrue: [ ^anObject < self ].
^false

%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareUndefinedObjectGreaterThanOrEqualToSelf: anUndefinedObject

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareUndefinedObjectGreaterThanSelf: anUndefinedObject

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareUndefinedObjectLessThanOrEqualToSelf: anUndefinedObject

""

^false
%
category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareUndefinedObjectLessThanSelf: anUndefinedObject

""

^false
%

category: 'New Indexing Comparison - for Compare'
method: Object
_idxForCompareNotEqualToObject: anObject

""

(self _classSortOrdinal = anObject _classSortOrdinal)
  ifTrue: [ ^anObject ~= self ].
^true
%
category: 'New Indexing Comparison'
method: Object
_idxForCompareNotEqualTo: arg

""

^ arg _idxForCompareNotEqualToObject: self
%

category: 'Repository Conversion'
classmethod: Object
runPostConversionForGem: gemNum of: totalGems is61: is61 bmFile: bmFileName

"Load a bitmap of large objects produced during the conversion and perform
 post-conversion processing on each object.  Commit as object memory becomes
 full."

| totalObjs hiddenSetId numToClearFromFront numToClearFromEnd mod
 myShare firstOop lastOop msg lowMemoryPercentage done |

hiddenSetId := 41.

System _hiddenSetReinit: hiddenSetId.
(System readHiddenSet: hiddenSetId fromFile: bmFileName)
  ifFalse:[Object halt: ('unable to open file', bmFileName)].

totalObjs := System _hiddenSetSize: hiddenSetId.
(totalObjs == 0)
  ifTrue:[^true]. "not likely, but possible"
myShare := totalObjs // totalGems.
mod := totalObjs \\ totalGems.
numToClearFromFront := 0.
numToClearFromEnd := 0.

(myShare == 0) "more gems than objs to process?"
  ifTrue:[
    (gemNum == 1)
      ifTrue:[myShare := totalObjs] "we will do them all"
      ifFalse:[^true].] "gem #1 will do them all, exit now"
  ifFalse:[
     numToClearFromFront := myShare * (gemNum - 1).
     numToClearFromEnd := myShare * (totalGems - gemNum).
     (gemNum == totalGems) "last gem picks up the remainder"
       ifTrue:[myShare := myShare + mod].
].

"delete the ones from our bm that will be processed by other gems"
(numToClearFromFront > 0)
  ifTrue:[System removeFirst: numToClearFromFront objectsFromHiddenSet: hiddenSetId].
(numToClearFromEnd > 0)
  ifTrue:[System truncateHiddenSet: hiddenSetId toSize: myShare].

"sanity check: hidden set should now hold exactly myShare objs"
((System _hiddenSetSize: hiddenSetId) == myShare)
  ifFalse:[
  "Build a coherent error message"
    msg := String new.
    msg addAll: 'error: hidden set size mismatch.  expected=';
        addAll: myShare asString;
        addAll: ' actual=';
        addAll: (System _hiddenSetSize: hiddenSetId) asString.
    Object halt: msg.
  ].

"Now determine the first and last obj to be processed for the log file"
System _hiddenSetReinit: 42.
System addHiddenSet: hiddenSetId to: 42. "make a copy"
firstOop := (System _hiddenSetEnumerateAsInts: 42 limit: 1) at: 1.

((System _hiddenSetSize: 42) == 0)
  ifTrue:[lastOop := firstOop]
  ifFalse:[
		System truncateHiddenSet: 42 toSize: 1. "delete all but the last one"
		lastOop := (System _hiddenSetEnumerateAsInts: 42 limit: 1) at: 1.
  ].

"build a coherent log message"
msg := String new.
msg addAll: 'Starting post conversion for gem ';
    addAll: gemNum asString;
    addAll: ' of ';
    addAll: totalGems asString; lf;
    addAll: 'Oop range from ';
    addAll: firstOop asString;
    addAll: ' to ';
    addAll: lastOop asString;
    addAll: '  Total oops=';
    addAll: myShare asString; lf.

"print to topaz log file"
GsFile gciLogServer: msg.

"Install handler that will do a commit if we get low on memory"
Exception
  category: GemStoneError
  number: (ErrorSymbols at: #rtErrSignalAlmostOutOfMemory)
  do: [:ex :cat :num :args |
  "do a commit..."
  System commitTransaction
   ifFalse:[Object halt: 'error: commit failure!'].
   "run another markSweep, to see if we can drop below the threshold..."
   System _vmMarkSweep.
   System enableAlmostOutOfMemoryError.
].

lowMemoryPercentage := 75. "commit when object memory is 75% full"
System signalAlmostOutOfMemoryThreshold: lowMemoryPercentage.

done := false.
[done] whileFalse:[ 
  |result sz|
  result := System _hiddenSetEnumerateAsInts: hiddenSetId limit: 2000.
  sz := result size.
  done := sz == 0.
  1 to: sz do:[:n|
    Object _postConvertLargeObjectWithOop: (result at: n) for61: is61.
  ].
].

"Commit the last batch"
System commitTransaction
 ifFalse:[Object halt: 'error: commit failure!'].

"disable AlmostOutOfMemory signal"
System signalAlmostOutOfMemoryThreshold: -1.
^true
%
category: 'Repository Conversion'
method: Object
fixIndexableRefsAfterConversion

"Default method for fixing references LargePositiveInteger and 
 LargeNegativeInteger instances that can now be represented as a 
 SmallInteger and Floats and SmallFloats which can now be represented as
 a SmallDouble."

|myClass|

myClass := self class.

myClass isIndexable
  ifTrue:[
    1 to: self _basicSize do:[:n| |iv ivClass|
      iv := self _basicAt: n.
	iv needsFixingAfterConversion
		ifTrue:[self _basicAt: n put: (iv + 0)].
  ].
].
^true
%
category: 'Repository Conversion'
method: Object
fixInstVarRefsAfterConversion

"Default method for fixing references LargePositiveInteger and 
 LargeNegativeInteger instances that can now be represented as
 a SmallInteger and Floats and SmallFloats which can now be 
 represented as a SmallDouble."

|myClass|
myClass := self class.
"Check the named inst vars first..."
1 to: myClass allInstVarNames size do:[:n|
  |iv ivClass|
  iv := self instVarAt: n.
  iv needsFixingAfterConversion
	ifTrue:[self instVarAt: n put: (iv + 0)].
].
^true
%

! Fix 38056
category: 'Repository Conversion'
classmethod: Object
fixReferencesAfterConversionFromDirectory: string

"Attempt to old objects to special objects as follows:
	SmallFloat ->		SmallDouble
	Float ->		SmallDouble
	LargePositiveInteger ->	SmallInteger
	LargeNegativeInteger ->	SmallInteger

Note: some instances may not be converted for the following reasons:
	Instance is in an IdentitySet or IdentityBag larger than 2024 elements.
	Instances is in an Array or other oop collection larger than 2024 elements.
	Value of the instance is out of range of the new special object class."

|fn array aString |
System _hiddenSetReinit: 41. "where we will load in the objs with refs to be fixed"
System _hiddenSetReinit: 42. "where we will store objects to be fixed in the 2nd pass."
System _hiddenSetReinit: 45. "where we will put objects already fixed"

"Load in the 2 bitmaps that contain refs to LargeInts and Floats"
aString := String withAll: string.
(aString last == $/)
	ifFalse:[aString add: '/'].
fn := String new.
fn addAll: aString; addAll: 'AllLrgIntRefs.bm'.
(GsFile existsOnServer: fn)
	ifTrue:[System readHiddenSet: 41 fromFile: fn]
	ifFalse:[self halt: ('Cannot open file ', fn; yourself)].

fn size: 0; addAll: aString; addAll: 'AllFloatRefs.bm'.
"This one is optional because 6.1.5 conversion does not product AllFloatRefs.bm"
(GsFile existsOnServer: fn)
	ifTrue:[System readHiddenSet: 41 fromFile: fn].

(System _hiddenSetSize: 41) == 0
	ifTrue:[^false].

System transactionMode: #autoBegin.
System signalAlmostOutOfMemoryThreshold: 70 .
"Install an exception handler that will do a commit if we get low on memory"

Exception
  category: GemStoneError
  number: (ErrorSymbols at: #rtErrSignalAlmostOutOfMemory)
  do: [:ex :cat :num :args |
  "do a commit..."
  System commitTransaction
	   ifFalse:[Object halt: 'error: commit failure!'].
   "run another markSweep, to see if we can drop below the threshold..."
   System _vmMarkSweep.
   System signalAlmostOutOfMemoryThreshold: 70 .
   System enableAlmostOutOfMemoryError. "re-enable the exception"
].

[array := System _hiddenSetEnumerate: 41 limit: 2000. 
 array size == 0] whileFalse:[
	1 to: array size do:[:n| |obj|
		obj := array at: n.
		obj fixReferencesInFirstPass
			ifTrue:[obj fixRefsAfterConversion] "do it now"
			ifFalse:[System _add: obj to: 42.]. "save it for later"
	].
].
System commitTransaction
	ifFalse:[Object halt: 'error: commit failure!'].
[array := System _hiddenSetEnumerate: 42 limit: 2000. array size == 0] whileFalse:[
	1 to: array size do:[:n| |obj|
		obj := array at: n.
		obj fixRefsAfterConversion
	].
].
System commitTransaction
	ifFalse:[Object halt: 'error: commit failure!'].
^System _hiddenSetSize: 45

		
%
category: 'Repository Conversion'
method: Object
fixReferencesInFirstPass

"Return whether this object should have references to Float, SmallFloat, 
 LargePositiveInteger and LargeNegativeInteger fixed inthe first pass.
 false means fix them in the 2nd pass."

^true
%
category: 'Repository Conversion'
method: Object
fixRefsAfterConversion

"Default method for fixing references LargePositiveInteger and 
 LargeNegativeInteger instances that can now be represented as 
 a SmallInteger and Floats and SmallFloats which can now be represented as
 a SmallDouble."

|myClass|

(System _testIf: self isIn: 45)
	ifTrue:[^false]. "already fixed this one"

self isInternalObject
	ifFalse:[
		self fixInstVarRefsAfterConversion.
		self fixIndexableRefsAfterConversion.
	].

System _add: self to: 45.
^true
%
category: 'Repository Conversion'
method: Object
fixReferencesInFirstPass

"Return whether this object should have references to Float, 
 SmallFloat, LargePositiveInteger and LargeNegativeInteger
 fixed inthe first pass.  false means fix them in the 2nd pass."

^true
%
category: 'Repository Conversion'
method: Object
isInternalObject
"Deterine if the receiver is an instance of one of these special 
 internal classes:
#define OOP_CLASS_LRG_OBJ_NODE          209409
#define OOP_CLASS_NSC_INTERIOR_NODE     212225
#define OOP_CLASS_NSC_SET_LEAF          212481
#define OOP_CLASS_NSC_BAG_LEAF          212737
"
|classOop|
classOop := self class asOop.
^ (((classOop == 209409) _or:[classOop == 212225]) _or:[classOop == 212481]) _or:[classOop == 212737]
%
category: 'Repository Conversion'
method: Object
needsFixingAfterConversion
^false
%

category: 'Repository Conversion'
method: Object
_incrementBreakpointsToIgnore

"Private - used in exception handler for #rtErrCodeBreakpoint "

<primitive: 667>
self _primitiveFailed: #_incrementBreakpointsToIgnore.
%
