!=========================================================================
! Copyright (C) VMware, Inc. 1991-2011.  All Rights Reserved
!
! $Id: passiveobject.gs,v 1.11 2008-01-09 22:50:13 stever Exp $
!
! Superclass Hierarchy:
!   PassiveObject, Object.
!
!=========================================================================

! fix bug 18387, force new definition of PassiveObject in upgrade
!   18387 was fixed in 5.1.3
!   gemstone64, _redefineKernelSubclass not implemented, use _newKernelSubclass
!     

expectvalue %String
run
^ Object _newKernelSubclass: #PassiveObject
  instVarNames: #(#contents #str #classes #objects #ivStrings #nextClassNo
                  #nextObjectNo #exitBlock #nextIVNo #ivName #ivVal #file
                  #epos #ivNames #version #oldClassMap #mapCache )
  classVars: #( #ClassNames41dict )
  classInstVars: #( )
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[ #[ #nextClassNo, SmallInteger],
                  #[ #nextObjectNo, SmallInteger],
                  #[ #nextIVNo, SmallInteger],
                  #[ #ivName, CharacterCollection],
                  #[ #version, SmallInteger],
                  #[ #oldClassMap, SymbolDictionary]  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: 885
%

! Remove existing behavior from PassiveObject
removeallmethods PassiveObject
removeallclassmethods PassiveObject

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

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

txt := (GsDocText new) details:
'PassiveObject provides a means for transferring data from one GemStone
 repository to another that is similar to VisualWorks'' Binary Object Streaming
 Service (BOSS) and Visual Smalltalk''s Object Filer.

 For a discussion of activation of passive objects that were written by
 GemStone version 4.1.3 or earlier, see comments in the class method  
 initialize41ClassNames.

 An instance of PassiveObject converts the form of a given GemStone object from
 active to passive or from passive to active.  A GemStone object is called
 active because it can respond to messages.  The object''s passive form cannot
 respond to messages, but it can be written to a text file in a standard file
 system outside of GemStone.  A text file is the normal intermediary storage for
 objects that are being transferred between GemStone repositories.
 PassiveObjects themselves need never be transferred or committed, and are
 intended to exist only within a given GemStone session.

                              Note:
    This class provides useful protocols, but it does not represent a full 
    or complete inter-repository data transfer facility.  Not all GemStone
    objects can be converted into passive form.  Please see the GemStone
    Programming Guide for more background information.

			      Note:
    Objects referenced by the user defined tags (tagAt:1, tagAt:2) of
    an object are not included in the default passivation of an object.

 Data transfers are ordinarily accomplished by gathering all objects to be
 transferred into one collection, which is then passivated and reactivated.
 If data is transferred piecemeal, the new repository may lose information about
 the connectivity of objects and produce multiple copies of an object where the
 original repository had only one.

 Finally, class Object includes two methods, writeTo: and loadFrom:, that
 convert an object to and from its passive form.  These methods can be
 reimplemented to tailor the form for any given class.  The first thing any
 writeTo: method must do is to identify the class of the passivated object.  It
 does so by sending the writeClass: message to the passive object that stores
 it.  The loadFrom: method must send the hasRead: message to the passive object
 that loads it.  It then must create a new instance of the class it finds and
 must read all information that was written by the writeTo: method.

 The following discussion describes some limitations of PassiveObject in
 detail.

 Although certain atomic objects have the same OOP in any GemStone repository,
 most objects do not.  The special case that relates some atomic objects to
 their OOPs will be ignored hereafter.

 Now, the identity of a GemStone object depends upon its OOP.  However, when you
 transfer an object from one GemStone repository to another, it is not possible
 to guarantee that it will have the same OOP; its OOP in the original repository
 may already be used by another object in the new repository.  In general, an
 object''s OOP is lost during transfer.

 But the interconnectivity of objects in GemStone depends upon their OOPs.
 Objects identify their relationships to each other by their OOP.  To preserve
 interconnectivity, when aPassiveObject passivates a GemStone object, it also
 passivates all the other objects to which it refers, and the ones to which they
 refer, and so on (the transitive closure of the object).  It also encodes the
 relationships among the objects in the transitive closure so that those
 relationships can be restored when the object is activated in the new
 repository.

 However, each PassiveObject can passivate (the transitive closure of) only one
 object at a time.  If two objects are passivated, and some objects in the
 transitive closure of one refer to objects in the transitive closure of the
 other, PassiveObject has no way to capture or encode those relationships.  Upon
 activation, the lost interrelations between the two objects may not be
 evident at first because duplicate objects are created in the new repository
 and the same values are present.  Only subsequent updates in the duplicated
 objects will reveal their new independence of each other.  Such independence
 may well be unintended, a semantic anomaly in the data.

 To avoid difficulties, gather all data to be transferred into one collection.
 Passivate the collection from the original repository, then activate it in the
 new repository.  Connect the data to the new repository as appropriate, then
 remove the collection used for passivation and commit.  If you must passivate
 two or more objects, passivate only one object in any file; two objects in a
 file virtually guarantee data transfer errors.

 The following Characters are reserved for special use within passive objects.
 The special meanings do not apply within the byte contents of Strings, 
 ByteArrays or DoubleByteStrings within a passive object:

    $*   denotes true
    $~   denotes false
    $$   next byte is an instance of Character with value 0..255
    $!   next two bytes are instance of Character with value 0..65535,
            most significant byte is first.
    $.   denotes  nil
    $#   denotes _remoteNil
    $/   end of named instance variables within a Bag 
    $"   prefix/suffix Character used to identify instance variable names
    $?   class prefix
    $:   object identifier prefix
    $@   global reference prefix
    $%   denotes Metaclass reference
    $    terminates a global name or string representation of an integer
    $(   terminates a class name
    $^   begins/ends the GemStone version header (not used prior to v5.0). When
          activating a PassiveObject, version 413 is assumed if no version
          header found.
    $&   reserved for future use by VMware Inc.
    $)   reserved for future use by VMware Inc.
    $=   reserved for future use by VMware Inc.
    $_   reserved for customer use
' .
doc documentClassWith: txt.

self description: doc.
%
!
! Not in GemStone 5.0.  Doesn't fit the one method in this category.
!
! txt := (GsDocText new) details:
! 'Methods in this category are obsolete and are provided only for compatibility
!  with earlier releases of GemStone.  They will be removed in a future release.'.
! doc documentClassCategory: #'Backward Compatibility' with: txt.

! ------------------- Class methods for PassiveObject
category: 'Backward Compatibility'
classmethod: PassiveObject
initialize41ClassNames

"For complete documentation you must browse this entire method.

 Initialize the dictionary used to resolve class names when activating
 a passive object written by GemStone 4.1 .  The key is a name that may be
 contained in a PassiveObject written by 4.1; the value is a class or
 object in 5.0 to be used to instantiate an object with a class name equal
 to that name."

ClassNames41dict := SymbolDictionary new.
ClassNames41dict
  "Keys that are in 4.1 Globals but not in 5.0 Globals, and for which
   the implementations are compatible."
  at: #EmptyArray put: #() ;
  at: #EmptyString put: '' ;
  at: #_incompletePathTraversal put: #_incompletePathTraversal ;
  at: #IdentityHashDictionary 	put: IdentityKeyValueDictionary ;
  at: #RcHashDictionary    	put: RcKeyValueDictionary ;
  at: #StringHashDictionary 	put: StringKeyValueDictionary ;
  at: #IntegerHashDictionary	put: IntegerKeyValueDictionary ;
  at: #AbstractBag		put: UnorderedCollection ;
  at: #HashDictionary		put: KeyValueDictionary ;
  at: #RcBag			put: RcIdentityBag ;

  "Classes in 4.1 whose names have changed but implementation is the same."
  at: #Bag put: IdentityBag ;
  at: #Set put: IdentitySet ;

  "Some classes that map to obsolete implementations."
  at: #ClampSpecification put: ObsoleteClampSpecification ;
  at: #GsFile put: ObsoleteGsFile ;
  at: #RcCollisionBucket put: ObsoleteRcCollisionBucket ;

  "Classes that are handled normally, or by version logic in loadFrom: methods:
      Symbol, SymbolAssociation, DateTime (converted to GMT).
   Remapping of these names is not needed because they are activated as
   instances of the new 5.0 class by the loadFrom: methods."

  "The following classes are reloaded as instances of the obsolete class
   and then remapped to an instances of the new class. loadFrom: methods 
   are reimplemented in the obsolete classes to handle this. 

   If the 4.1.3 passivation was from a user defined subclass of one of 
   these obsolete classes, then two situations are possible:

     If the 4.1.3 classes were transferred to a 5.0 GemStone repository by
     repository conversion, then a new subclass of the corresponding current
     5.0 class may need to be defined before activation can be accomplished.  

     If the 4.1 class definitions were filed out and filed-in to 5.0, 
     then a new subclass of one of the obsolete 5.0 classes may need to
     be defined.

  To implement activation of a user defined obsolete class, 

    1) In the obsolete class in 5.0, implement the class method loadFrom: 
    in terms of loadFrom:mappingToClass: .  If necessary, implement
    loadFrom:mappingToClass: (if it is not inherited from an existing
    class in GemStone 5.0 ).  
    See class ObsoleteDictionary for examples of these methods.

    2) If the obsolete class is not named in the symbol list in 5.0,
    access the mapping dictionary using the instance method oldClassMap and
    copy the dictionary.  Then add an entry to map the name of the obsolete
    class from 4.1 to the identity of the appropriate obsolete class in 5.0 .
    This obsolete class in 5.0 should contain an implementation of
    loadFrom:  which uses loadFrom:mappingTo: .
    Install the extended dictionary using the instance method oldClassMap: .
  "
  
  at: #Dictionary put: ObsoleteDictionary ; "remaps to Dictionary"
  at: #LanguageDictionary 
    put: ObsoleteLanguageDictionary ; "remaps to LanguageDictionary."

  at: #IdentityDictionary 
    put: ObsoleteIdentityDictionary ; "remaps to IdentityDictionary"

  at: #SymbolDictionary put: ObsoleteSymbolDictionary ;
    "remaps to SymbolDictionary"

  at: #SymbolHashDictionary 
    put: ObsoleteSymbolKeyValueDictionary ; "remaps to SymbolKeyValueDictionary"

  at: #SymbolListDictionary 
    put: ObsoleteSymbolListDictionary . "remaps to SymbolDictionary"

 "Handling constraints during activation of PassiveObjects written by 4.1 .

  Suppose the 4.1 repository contains classes that are obsolete classes in
  5.0, or subclasses of those obsolete classes.  The activation methods in
  5.0 will map instances of some obsolete classes to instances of other classes.
  This means that the class in 5.0 of the final activated instance should
  have constraints expressed in terms of non-obsolete classes.  Thus
  when migrating class definitions from the 4.1 to the 5.0 repository, 
  it may be necessary to modify the constraints in those class definitions.

  Assume that the 4.1 class definitions are initially transferred to 5.0
  by repository conversion. Then the following dictionary
    constrMap := IdentityDictionary new .
    constrMap at: Dictionarysub41 put: Dictionary ;
      at: LanguageDictionarysub41 put: LanguageDictionary ;
      at: IdentityDictionarysub41 put: IdentityDictionary ;
      at: SymbolDictionarysub41  put: SymbolDictionary ;
      at: SymbolHashDictionarysub41 put: SymbolKeyValueDictionary  ;
      at: SymbolListDictionarysub41 put: SymbolDictionarysub50 ;
      at: DateTimesub41 put: DateTime ;
      at: ObsoleteIdentityDictionary put: IdentityDictionary ;
      at: ObsoleteLanguageDictionary put: LanguageDictionary ;
      at: ObsoleteSymbolDictionary put: SymbolDictionary ;
      at: ObsoleteSymbolKeyValueDictionary put: SymbolKeyValueDictionary ;
      at: ObsoleteSymbolListDictionary put: SymbolDictionary ;
      at: ObsoleteSymbolSet put: SymbolSet ;
      at: ObsoleteIdentityCollisionBucket put: IdentityCollisionBucket ;
      at: ObsoleteSymbolAssociation put: SymbolAssociation ;
      at: ObsoleteDictionary put: Dictionary ;
      at: GsFile put: ObsoleteGsFile ;
      at: ObsoleteDateTime put: DateTime ;
      at: ObsoleteSymbol put: Symbol ;
      at: ObsoleteRcCollisionBucket put: RcCollisionBucket .

   may be referenced in code that automatically generates a 5.0 compatible 
   class definition from a 4.1 class definition. constrMap defines how
   a constraint in a 4.1 class definition should be mapped to a constraint
   in a 5.0 class definition. In the example, Dictionarysub41
   is a subclass of Dictionary in 4.1 . A corresponding Dictionarysub50
   class is generated, along with the method
     category: 'Storing and Loading'
     classmethod: Dictionarysub41
     loadFrom: passiveObj
     ^ self loadFrom: passiveObj mappingToClass: Dictionarysub50
     %
  "
        
^ ClassNames41dict immediateInvariant.
%

expectvalue 21
run
PassiveObject initialize41ClassNames size 
%

category: 'Instance Creation'
classmethod: PassiveObject
new

"Disallowed.  Use one of the other methods in category 'Instance Creation'
 to obtain a new PassiveObject."

self shouldNotImplement: #new
%

category: 'Instance Creation'
classmethod: PassiveObject
fromServerTextFile: fileName

"Creates a new instance of the receiver, and sets the instance's description
 string from the contents of the given text file."

^ super new fromServerTextFile: fileName
%

category: 'Instance Creation'
classmethod: PassiveObject
fromClientTextFile: fileName

"Creates a new instance of the receiver, and sets the instance's description
 string from the contents of the given client text file."

^ super new fromClientTextFile: fileName
%

category: 'Stream I/O'
classmethod: PassiveObject
newOnStream: aStream

"Creates a new instance of the receiver, and sets the instance's description
 from the text on the given stream."

^super new contents: aStream
%

category: 'Instance Creation'
classmethod: PassiveObject
newWithContents: passiveString

"Create a new PassiveObject for an existing description.  This is normally
 used to create an instance of PassiveObject for use in activating an object
 previously stored into a passive textual description.  The argument is the
 contents instance variable from a PassiveObject in which descriptions of other
 objects were written."

^super new contents: passiveString
%

category: 'Instance Creation'
classmethod: PassiveObject
passivate: anObject

"Writes the given file to a new instance of this class.  This method is normally
 invoked indirectly by sending the message 'passivate' to an object."

^super new passivate: anObject
%

category: 'Stream I/O'
classmethod: PassiveObject
passivate: anObject toStream: stream

"Writes the given object to the given stream, returning the stream."

^ (super new) passivate: anObject toStream: stream
%

! ------------------- Instance methods for PassiveObject
category: 'Accessing'
method: PassiveObject
oldClassMap

"Returns the value of the oldClassMap instance variable."

^ oldClassMap
%

category: 'Accessing'
method: PassiveObject
oldClassMap: aSymbolDictionary

"Updates the value of the oldClassMap instance variable."

oldClassMap := aSymbolDictionary
%

category: 'Accessing'
method: PassiveObject
version

"Returns the value of the version instance variable, which represents the
 version of GemStone that wrote the passivated object(s).  For example,
 version 5.0 of GemStone has the integer value 500."

^ version
%

category: 'Reading'
method: PassiveObject
activate

"Loads the object(s) whose representation is contained in the receiver's
 stream."

| object cancelBlock delim |

self initializeForActivation.
(contents class isBytes) ifTrue: [
  str := ReadStream on: contents
]
ifFalse: [
  (contents isKindOf: GsFile) ifTrue: [
    file := contents.
    file isOpen ifFalse:[ file open "reopen the file" ].
    str := ReadStream on: String new.
    epos := file position.
  ]
  ifFalse: [
    str := contents.
  ].
].
cancelBlock := [ objects := classes := str := exitBlock :=
  cancelBlock := exitBlock := nil ].
exitBlock  := [ cancelBlock value.  ^self].  "for error exits"
self peek == $^ ifTrue:[
  self next . "skip the $^ "
  version := self readInt .
  "skip the $^ that terminates the version header "
  (delim := self next) == $^ ifFalse:[
    self _halt: 'Version header trailing $^ not found.'
    ]. 
  ]
ifFalse:[
  version := 413 . "assume passivated from GemStone v4.1.3" 
  oldClassMap == nil ifTrue:[
    oldClassMap := ClassNames41dict .
    ]
  ].
object := self readObject.
cancelBlock value.
file ~~ nil ifTrue:[ file close ].  "reduce number of open files"
^object
%

category: 'Private - File Buffering'
method: PassiveObject
atEnd

"Private."

(file ~~ nil _and: [epos == nil _or: [str atEnd]]) ifTrue: [
  ^file atEnd
].
^str atEnd
%

category: 'Private - File Buffering'
method: PassiveObject
backupExternal

"Backup the file stream to current position."

epos ~~ nil ifTrue: [
  file position: epos + str position - 1.
  epos := nil.  "epos being nil shows that str is invalid"
].
%

category: 'Private'
method: PassiveObject
bagMark

"Returns the character that precedes the end of instance variables markers in
 Bag objects."

^ $/
%

category: 'Private'
method: PassiveObject
checkEBuf

"Loads the cached stream from the external stream if necessary."

(file ~~ nil _and: [ epos == nil _or: [ str atEnd ] ]) ifTrue: [
  self loadEBuf
].
%

category: 'Private'
method: PassiveObject
checkForBagMark

"Sees the comment in writeBagMark for an explanation of Bag markers.  Skips any
 white space and then returns whether the next token is a Bag marker."

self skipWhiteSpace.
self atEnd ifTrue: [ ^false ].
^(self next == self bagMark) ifTrue: [ true ] ifFalse: [ str skip: -1. false ]
%

category: 'Private'
method: PassiveObject
checkForInstVarMark

"Sees the comment in writeBagMark for an explanation of Bag markers.  Skips any
 white space and then returns whether the next token is a Bag marker."

| char |

self skipWhiteSpace.
self atEnd ifTrue: [ ^false ].
char := self next.
str skip: -1.
^char == self ivPrefix
%

category: 'Private'
method: PassiveObject
contents

"Returns the content string of the receiver."

^contents
%

category: 'Private'
method: PassiveObject
contents: aString

"Sets the content string of the receiver."

contents := aString
%

category: 'Private'
method: PassiveObject
cr

""

str lf
%

category: 'Private'
method: PassiveObject
endNamedInstVars

"An empty instance variable name identifies the end of named instance
 variables."

self putIvPrefix; putIvSuffix
%

category: 'File I/O'
method: PassiveObject
fromClientTextFile: fileName

"Sets the receiver's description string from the contents of the given text
 file."

contents := GsFile openRead: fileName .
contents == nil ifTrue:[ self _halt:'Unable to open file: ' , fileName ].
%

category: 'File I/O'
method: PassiveObject
fromServerTextFile: fileName

"Sets the receiver's description string from the contents of the given text
 file."

contents := GsFile openReadOnServer: fileName .
contents == nil ifTrue:[ self _halt:'Unable to open file: ' , fileName ].
%

category: 'Reading'
method: PassiveObject
hasRead: anObject

"The given object has been instantiated but not filled out with values yet:
 assign it an identifier.  All classes must send this message to their
 strObject before filling in a new instance's values."

objects add: anObject.
^anObject
%

category: 'Reading'
method: PassiveObject
hasRead: anObject marker: marker

"For objects whose values must be at least partially read before the object
 can be marked as read, the objectPositionMarker method can be used to
 reserve the correct object number for the as yet uninstantiated object.
 The marker token returned by objectPositionMarker can then later be used
 with this method to record the instantiated object.  For an example
 see ExecutableBlock class | loadFrom:."

objects at: marker put: anObject.
^anObject
%

! fix bug 18387
category: 'Private' 
method: PassiveObject 
hasWritten: anObject 
 
"Sees if the given object has been written already.  If so, writes out its 
 identifier and returns true.  Otherwise, returns false." 
 
| id | 
 
anObject containsIdentity ifTrue: [^false]. 
id := System _inMap: objects at: anObject putIfAbsent: nextObjectNo. 
^id == nextObjectNo ifTrue: [ 
  "a new entry" 
mapCache add: anObject. 
  nextObjectNo := nextObjectNo + 1. 
  false 
] 
ifFalse: [ 
  self putIdPrefix; writeInt: id. 
  true 
] 
% 

category: 'Private - Initialization'
method: PassiveObject
initializeForActivation

"Prepares the receiver to activate an object that is in its passive form."

classes := Array new.
objects := Array new.
ivNames := Array new.
nextClassNo  :=
nextObjectNo :=
nextIVNo     := 1.
epos := nil.
version := nil "the activate method will read the version header" . 
%

category: 'Private - Initialization'
method: PassiveObject
initializeForStore

"Prepares the receiver to passivate an object."
| systm |

classes := 1.
objects := 2.
systm := System .
systm _initMap: classes.
systm _initMap: objects.
ivStrings := Array new.
nextClassNo  :=
nextObjectNo :=
nextIVNo     := 1.
str := WriteStream on: (String new).
version := 510 .
%

category: 'Private - Initialization'
method: PassiveObject
nextPutVersion

"Writes the version header to the receiver's stream."

self nextPut: $^ ; nextPutAll: version asString; nextPut: $^
%

category: 'Private'
method: PassiveObject
ivName

"Returns the name of the last named instance variable read with readNamedIV.
 If no variable was found in readNamedIV, returns nil."

^ivName
%

category: 'Private'
method: PassiveObject
ivPrefix

"Returns the prefix character used to identify instance variable names."

^ $"
%

category: 'Private'
method: PassiveObject
ivSuffix

"Returns the suffix used to identify instance variable names."

^ $"
%

category: 'Private'
method: PassiveObject
ivSuffixStr

"Returns the suffix used to identify instance variable names."

^ '"'
%

category: 'Private'
method: PassiveObject
ivValue

"Returns the value of the last named instance variable read with readNamedIV.
 If no variable was found in readNamedIV, returns nil."

^ ivVal
%

category: 'Private'
method: PassiveObject
lf

""

str lf
%

category: 'Reading'
method: PassiveObject
load: amount byteStringsInto: byteObj

"Loads the given number of formatted byte-sized numbers into the given byte
 object."
  
| nextIdx |

file ~~ nil ifTrue: [
  self backupExternal.
  file next: amount byteStringsInto: byteObj
]
ifFalse: [
  nextIdx := System userAction: #GsfPassiveObjLoadByteStrings 
                with: byteObj with: amount
                with: str _collection with: str position.
  nextIdx ~~ nil ifTrue: [
    str position: nextIdx
  ].
].
%

category: 'Private'
method: PassiveObject
loadEBuf

"Load bytes into the cached input stream."

| c |

c := str _collection.
(epos ~~ nil _and: [str atEnd not]) ifTrue: [
  "loading while not at the end of the cache stream - append the next line
   to the string"
  file nextLineInto: c startingAt: c size.
  ^self
].
epos := file position.
c size: 0.
file nextLineInto: c startingAt: 1.
str _fastPosition: 1.
%

category: 'Private'
method: PassiveObject
next

"Inlined checkEBuf."

(file ~~ nil _and: [ epos == nil _or: [str atEnd]]) ifTrue: [ self loadEBuf ].

^ str _fastNext
%

category: 'Private'
method: PassiveObject
next: n bytesTo: aString

"Stores the next n input bytes into the given string."

epos ~~ nil ifTrue: [ self backupExternal ].
^ file ~~ nil ifTrue: [ file next: n into: aString ]
            ifFalse: [ str  nextElements: n into: aString ]
%

category: 'Private'
method: PassiveObject
next: n basicBytesTo: aString

"Private.  Stores the next n input bytes into aString."

"Used in loading JapaneseStrings"

epos ~~ nil ifTrue: [ self backupExternal ].
^ file ~~ nil ifTrue: [ file _next: n basicInto: aString ]
            ifFalse: [ str  _next: n basicInto: aString ]
%

category: 'Private'
method: PassiveObject
nextClassNumber

"Private."

| cur |

cur := nextClassNo.
nextClassNo := nextClassNo + 1.
^ cur
%

category: 'Private'
method: PassiveObject
nextPut: aCharacter

"Private."

str nextPut: aCharacter
%

category: 'Private'
method: PassiveObject
nextPutAll: aString

"Private."

str nextPutAll: aString
%

category: 'Private'
method: PassiveObject
nextPutAllBytes: aString

"Private."

str nextPutAllBytes: aString
%

category: 'Reading'
method: PassiveObject
objectPositionMarker

"Reserve a place for an object that's being read but has no ID yet.  The marker
 can be used with hasRead:marker: when the object has been created.  An example
 use is activation of ExecutableBlock objects, which must read a source code
 string and compile it to create the block object.  On writing the block, the
 block is assigned an object number before the string, so on reading the block
 back in this ordering must be maintained."

objects add: nil.
^ objects size   
%

! fix 18387
category: 'Private' 
method: PassiveObject 
passivate: anObject 
 
"" 
| systm |
 
mapCache := IdentitySet new. 
self initializeForStore. 
self nextPutVersion . 
self hasWritten: anObject.  "assigns an identifier for the object" 
anObject writeTo: self. 
contents := str _collection. 
systm := System .
systm _initMap: classes. 
systm _initMap: objects. 
classes := objects := str := nil. 
mapCache := nil. 
^ self 
% 

category: 'Stream I/O'
method: PassiveObject
passivate: anObject toStream: streamOrFile

"Passivates the given object, writing the description out to the given stream.
 This does not result in a state where the receiver can activate the object.

 It is intended that streamOrFile be an instance of GsFile opened
 for writing, and that a new instance of PassiveObject be used to read
 the file when re-activation is desired."

| systm |
mapCache := IdentitySet new. 
self initializeForStore.
str := streamOrFile.
self nextPutVersion .
self hasWritten: anObject.  "assigns an identifier for the object"
anObject writeTo: self.
systm := System .
systm _initMap: classes.
systm _initMap: objects.
classes := nil.
objects := nil.
str isExternal ifTrue:[ str close ] .
str := nil.
mapCache := nil. 
^ self
%

category: 'Private'
method: PassiveObject
putClassPrefix

"Private."

str nextPut: $?
%

category: 'Private'
method: PassiveObject
putIdPrefix

"Private."

str nextPut: $:
%

category: 'Private'
method: PassiveObject
putIvName: ivname

"Private."

| id s |

"classes dict is overloaded - no need to keep two dictionaries"
id := System _inMap: classes at: ivname putIfAbsent: nextIVNo.
id == nextIVNo ifTrue: [
  nextIVNo := nextIVNo + 1.
  s := String new.
  s add: $"; addAll: ivname; add: $".
  str nextPutAll: s.
  s size: 1; addAll: id asString; add: $".
  ivStrings add: s.
]
ifFalse: [
  str nextPutAll: (ivStrings at: id)
].
%

category: 'Private'
method: PassiveObject
putIvPrefix

"Writes the prefix used to identify instance variable names."

str nextPut: $"
%

category: 'Private'
method: PassiveObject
putIvSuffix

"Writes the suffix used to identify instance variable names."

str nextPut: $"
%

category: 'Private'
method: PassiveObject
resolveSymbol: aString

"Private.  Returns the SymbolAssociation found by searching the appropriate
 dictionaries and symbol list, or nil if not found."

| sym assoc |
sym := Symbol _existingWithAll: aString  .
sym == nil ifTrue:[ ^ nil ].
oldClassMap ~~ nil ifTrue:[
  "first check for mapping of a 4.1 class name to a 5.0 class."
  assoc := oldClassMap associationAt: sym otherwise: nil .
  assoc ~~ nil ifTrue:[ ^ assoc ].
  ].
^ GsSession currentSession resolveSymbol: sym 
%

category: 'Private'
method: PassiveObject
readClass

"Private.  Reads in a class name or ID and returns the corresponding class."

| id name class ch |

self skipWhiteSpace.
ch := self next.
ch == $? ifTrue: [
  id := self readInt.
  ^classes at: id
].
"get the class name and see if the class exists in this image"
name := String with: ch .
name addAll: (self upTo: $( ).

class := self resolveSymbol: name .
class == nil ifTrue: [
  self _halt: 'Your GemStone repository is missing class ' , name  .

  "if application proceeded from the notification error, try
  to fetch the object again.  Exit if not found"
  class := self resolveSymbol: name.
  "class is either nil (not found) or the Association for 'name'"
  class == nil ifTrue: [exitBlock value].
  class := class value.
  ]
ifFalse: [
  class := class value
  ].
classes add: class.
^ class
%

category: 'Private'
method: PassiveObject
readInt

"Reads an int from the input position"

| idx coll int c neg size |

(file ~~ nil _and: [epos == nil _or: [str atEnd]]) ifTrue: [
  self loadEBuf
].
"this code disrespects the privacy of the stream, but this
 method must be as fast as possible"
idx := str position.
coll := str _collection.
int := 0.
size := coll size.
neg := (coll at: idx) == $-.
neg ifTrue: [
  idx:=idx+1
].
idx to: size do:  [ :i |
  c := (coll at: i) asciiValue.
  ((48 <= c) _and: [ c <= 57 ]) ifTrue: [
    int := int * 10 + c - 48
  ]
  ifFalse: [
    "End of integer"
    idx := i.
    c == 32 ifTrue: [ idx := idx + 1 ].
    str _fastPosition: idx.
    ^neg ifTrue: [int * -1] ifFalse: [int].
  ].
].

"End of string"
idx := size + 1.
str _fastPosition: idx.
^ neg ifTrue: [int * -1] ifFalse: [int]
%

category: 'Private'
method: PassiveObject
readNamedIV

"Reads the next instance variable name and object and puts them into ivName and
 ivValue in the receiver.  Returns false if the next input item is not an
 instance variable name or the end-of-named-instance-variables mark, and true
 otherwise.  If a name and object are not both read, ivName and ivValue will be
 nil."

| char obj name globalName ascii ivSuffix int |

"Care must be taken in this method to not rely on the state of ivName
 and ivVal.  This method must be reentrant for recursive activations
 started within this method, and it must return the correct values in
 ivName/ivVal when completed"

ivName := ivVal := nil.

self skipWhiteSpace.
self atEnd ifTrue: [ ^false ].
self checkEBuf.
char := str _fastNext.
char == $/ ifTrue: [
  "end of Bag mark - precedes ivPrefix marks"
  str skip: -1.
  ^true
].

char == $" "self ivPrefix" ifFalse: [
  str skip: -1.
  ^false
].

"check for end of named instance variables"
char := str _fastNext.
ivSuffix := $".
char == ivSuffix ifTrue: [
  str skip: -2.
  ^true
].

ascii := char asciiValue.
(ascii <= 57 _and: [48 <= ascii]) ifTrue: [ 
  str skip: -1.
  int := self readInt.
  self next. "consume the quote char"
  int > ivNames size ifTrue: [
    self _halt:
'A forward instance variable name reference has been encountered 
during object activation.  Select "continue" to proceed and
skip activation of this object'.
    exitBlock value
  ].
  name := ivNames at: int.
]
ifFalse: [
  name := String with: char.
  [ str atEnd not _and: [
    char := str _fastNext.  char ~~ ivSuffix ] ] whileTrue: [
    name add: char
  ].
  ivNames add: name.
].

self skipWhiteSpace.
char := str peek.
char == $. ifTrue: [
  str next.
  ivName := name.
  ivVal := nil.
  ^true
].
char == $* ifTrue: [
  str next.
  ivName := name.
  ivVal := true.
  ^true
].
char == $~ ifTrue: [
  str next.
  ivName := name.
  ivVal := false.
  ^true
].
(char == $# _and:[ version >= 500]) ifTrue: [
  str next.
  ivName := name.
  ivVal := _remoteNil .
  ^true
].

ascii := char asciiValue.

((57 >= ascii _and: [ascii >= 48]) _or: [char == $-]) ifTrue: [
  obj := self readInt.
  obj _isSmallInteger ifFalse: [
    (version >= 500) ifTrue:[
      objects add: obj.  "identity of object was relevant at passivation"
    ].
  ].
  ivName := name.
  ivVal := obj.
  ^true
].

char == $: ifTrue: [
  "identifier of an object that's already been activated"
  str _fastNext.
  obj := self readInt.
  (objects size >= obj) ifTrue: [ obj := objects at: obj ]
  ifFalse: [
    self _halt: 'An object identifier was found in passive description
that has not yet been defined.' .
    exitBlock value
  ].
  ivName := name.
  ivVal  := obj.
  ^true
].

char == $$ ifTrue: [ "8-bit Character"
  str _fastNext.
  obj := str _fastNext.
  "chars contain their identity, so no identifier is needed"
  ivName := name.
  ivVal  := obj.
  ^true
].
(char == $! _and:[ version >= 500]) ifTrue: [ "16-bit Character"
  str _fastNext.
  obj := Character withValue:
    (( str _fastNext asciiValue * 256) + str _fastNext asciiValue) .
  ivName := name.
  ivVal  := obj.
  ^true
].
"check for a letter or a name token.  Character isLetter is "
(char == $? _or: [char isLetter]) ifTrue: [
  "a class ID or name"
  obj := (self readClass loadFrom: self).
  ivName := name.
  ivVal  := obj.
  ^true
].

(char == $@ _or: [char == $%]) ifFalse: [
  self _halt: 'Unknown token type encountered in passive object description.' .
  exitBlock value
].

"a global reference"
str _fastNext.
globalName := self upTo: $ .
obj := self resolveSymbol: globalName .
obj == nil ifFalse: [
  obj := obj value
]
ifTrue: [
  self _halt: 
     'A passive object is being activated that refers to an object named ' 
     , globalName , '. ' ,
     'However, your environment does not include an object by this name.' .
  ^exitBlock value
].

"check for Metaclass reference"
char = $% ifTrue: [
  obj := obj class
].

objects add: obj.
ivName := name.
ivVal  := obj.
^true
%

category: 'Reading'
method: PassiveObject
readObject

"Returns the next object from the stream."

| char obj ascii globalName |

self skipWhiteSpace.
self atEnd ifTrue: [ ^nil ].
self checkEBuf.
char := str peek.

char == $. ifTrue: [
  str next.
  ^nil
].
char == $# ifTrue: [
  str next.
  ^ _remoteNil
].

char == $* ifTrue: [
  str next.
  ^true
].

char == $~ ifTrue: [
  str next.
  ^false
].

ascii := char asciiValue.

((57 >= ascii _and: [ascii >= 48]) _or: [char == $-]) ifTrue: [
  obj := self readInt.
  obj _isSmallInteger ifFalse: [
    (version >= 500) ifTrue:[
      objects add: obj.  "identity of object was relevant at passivation"
    ]
  ].
  ^obj
].

char == $: ifTrue: [
  "identifier of an object that's already been activated"
  self next.
  obj := self readInt.
  (objects size >= obj) ifTrue: [ obj := objects at: obj ]
  ifFalse: [
    self _halt: 'An object identifier was found in passive description
that has not yet been defined.' .
    exitBlock value
  ].
  ^obj
].

char == $$ ifTrue: [ "8-bit Character"
  str _fastNext.
  obj := str _fastNext.
  "chars contain their identity, so no identifier is needed"
  ^obj
].
char == $! ifTrue: [ "16-bit Character"
  str _fastNext.
  obj := Character withValue:
    (( str _fastNext asciiValue * 256) + str _fastNext asciiValue) .
  "chars contain their identity, so no identifier is needed"
  ^obj
].

"check for a letter or a name token.  Character isLetter is "
(char isLetter _or: [char == $?]) ifTrue: [
  "a class ID or name"
  ^self readClass loadFrom: self
].

(char == $@ _or: [char == $%]) ifFalse: [
  self _halt:
'Unknown token type encountered in passive object description.' .
  exitBlock value
].

"a global reference"
self next.  "gobble the prefix"
globalName := self upTo: $ .
globalName := globalName asSymbol.
obj := self resolveSymbol: globalName .
obj == nil ifFalse: [
  obj := obj value
]
ifTrue: [
  self _halt: 
    'A passive object is being activated that refers to an object named ' 
       , globalName , '. ' , 
    'However, your environment does not include an object by this name.' .
  ^exitBlock value
].

"check for Metaclass reference"
char = $% ifTrue: [
  obj := obj class
].

objects add: obj.
^obj
%

category: 'Private'
method: PassiveObject
readSize

""

^self skipWhiteSpace; readInt
%

category: 'Private'
method: PassiveObject
skipNamedInstVars

"Read any remaining named instance variables - they are obsolete now."

| ivp ivs c bagMark |

ivp := self ivPrefix.
ivs := self ivSuffix.
bagMark := self bagMark.
self skipWhiteSpace.
[ ((c := self next) == ivp) & (self next == ivs) ] whileFalse: [
  (c == bagMark) ifTrue: [
    str skip: 1.
    ^self
  ]
  ifFalse: [
    str skip: -2.
  ].
  (self readNamedIV) ifFalse: [ ^self ].
  self skipWhiteSpace.
].
%

category: 'Private'
method: PassiveObject
skipWhiteSpace

""

| c |

[ self atEnd ] whileFalse: [
  c := (self next) asciiValue.  "read from self to make sure buffering is ok"
  (c < 33 _and: [c == 32 _or: [c == 10 _or: [c == 9 _or: [c == 13 _or: [c == 12]]]]])
  ifFalse: [
    str skip: -1.
    ^self.
  ].
].
%

category: 'Private'
method: PassiveObject
space

""

str nextPut: $ .
%

category: 'File I/O'
method: PassiveObject
toClientTextFile: fileName

"Writes the receiver's passive description to the given text file."

contents == nil ifTrue: [
   ''  toClientTextFile: fileName
]
ifFalse: [
  contents toClientTextFile: fileName
]
%

category: 'File I/O'
method: PassiveObject
toServerTextFile: fileName

"Writes the receiver's passive description to the given text file."

contents == nil ifTrue: [
   ''  toServerTextFile: fileName
]
ifFalse: [
  contents toServerTextFile: fileName
]
%

category: 'Private'
method: PassiveObject
upTo: aChar

""

^str upTo: aChar
%

category: 'Private'
method: PassiveObject
upToSeparator

""

| c result size |

result := String new.
self checkEBuf.
size := str size.
[str atEnd _or: [(c := str next) isSeparator]] whileFalse: [
  result add: c.
  c := nil
].
c ~~ nil ifTrue: [
  str skip: -1
].
^result
%

category: 'Private'
method: PassiveObject
writeBagMark

"Older versions of GemStone did not allow named instance variables in Bag and
 its subclasses so the passive descriptions of these objects did not include
 named instance variable sections.  These classes can now have named instance
 variables, so descriptions of their instances now have named instance variable
 sections.  The loading algorithms have difficulty in distinguishing a
 zero-length Bag from its surrounding objects without the help of a special
 token.  This method writes that token onto the output stream."
  
self nextPut: self bagMark
%

category: 'Private'
method: PassiveObject
writeBytes: byteObj

""

str isExternal ifTrue: [
  str printBytes: byteObj
]
ifFalse: [
  str nextPutAll: (System userAction: #GsfPassiveObjPrint with: byteObj)
]
%

category: 'Private'
method: PassiveObject
writeClass: aClass

"Sees if the given class has been written to str already.  If so, writes out its
 identifier and returns true.  Otherwise, writes out its name and returns
 false."

| id |

id := System _inMap: classes at: aClass putIfAbsent: nextClassNo.
id == nextClassNo ifTrue: [
  "a new class"
  nextClassNo := nextClassNo + 1.
  str nextPutAll: aClass name; nextPut: $(.
  ^false
]
ifFalse: [
  self putClassPrefix; writeInt: id.
  ^true
]
%

category: 'Private'
method: PassiveObject
writeGlobalRef: name

""

str nextPut: $@; nextPutAll: name; nextPut: $ .
%

category: 'Private'
method: PassiveObject
writeInt: anInteger

"Write a 4-byte small int to the output stream."
  
str nextPutAll: anInteger asString; nextPut: $ .
%

category: 'Writing'
method: PassiveObject
writeObject: anObject

"Use this method to write components of another object to the output stream."

"true, false and nil are handled internally since they make up a large
 part of many objects.  This lets activation and passivation avoid
 checking to see if these objects have been read/written each time
 they are encountered."

anObject == nil ifTrue:[
  str nextPut: $. .
  ^nil
  ].
anObject == _remoteNil ifTrue:[
  str nextPut: $# .
  ^_remoteNil
  ].
anObject == true ifTrue: [
  str nextPut: $* .
  ^true
  ].
anObject == false ifTrue: [
  str nextPut: $~ .
  ^false
  ].

(self hasWritten: anObject) ifTrue: [^anObject].

"at this point, a query to global directories could be made, and
  a 'Global' entry could be made in the stream, instead of passivating
  'anObject'.  This could be useful in clamping off objects that have
  their own version-control lists"

(anObject isBehavior) ifTrue: [
  anObject isMeta ifTrue: [
    self nextPut: $%; nextPutAll: anObject thisClass name
  ]
  ifFalse: [
    self nextPut: $@; nextPutAll: anObject name; nextPut: $ .
  ].
]
ifFalse: [
  anObject writeTo: self
].
^anObject
%

category: 'Writing'
method: PassiveObject
writeObject: anObject named: objName

"Use this method to write components of another object to the output stream with
 instance variable names included.  When read back in, the corresponding named
 instance variable reading method must be used."

(anObject isKindOf: Collection) ifTrue: [
  str lf
].
self putIvName: objName.
^self writeObject: anObject
%

category: 'Private'
method: PassiveObject
writeSize: anInteger

"Write a size to the string"

str nextPutAll: anInteger asString; nextPut: $ .
%

!  methods added to other classes; must add the methods here to avoid
!  forward references

category: 'Private'
method: PassiveObject
peek

"Inlined checkEBuf."

(file ~~ nil _and: [ epos == nil _or: [str atEnd]]) ifTrue: [ self loadEBuf ].

^str peek
%

