"{ Package: 'stx:goodies/xtreams/transforms' }"

"{ NameSpace: Xtreams }"

Object subclass:#ObjectMarshaler
	instanceVariableNames:'classes read write version rehash analyse immediate classesMutex'
	classVariableNames:''
	poolDictionaries:'Xtreams::XtreamsPool'
	category:'Xtreams-Transforms'
!

ObjectMarshaler comment:'Marshaler defines the binary format for various object types it is meant to support. This one defines generic marshaling format for arbitrary Smaltalk objects, named STST 2.0. It is used as the default marshaler for marshaling streams. It is designed to be reasonably compact and fast to marshal / unmarshal. Objects have no persistent identity between transactions, but do within a transaction to allow for recursion.

Record Format:
	<class record> <object record>

Class Format:
	Class name is only included if this is the first reference to a class id that isn''t known by the terminals.
	<class id : integer> (<class absoluteName : string> <class isMeta : 0 = false, 1 = true>)?

Object Format:
	Object id is not included if the object is an immediate, in which case the object body is always included.
	Object body is not included if the object is has previously been shared between the terminals in this transaction.
	<object id : integer>? <object body>?		

Object Body Formats:
	integers:
		0 .. 252											one byte
		-2147483647 .. 2147483648						four bytes
		-9223372036854775807 .. 9223372036854775808	eight bytes
		larger integers									a stringified base 36 number
		float												four bytes
		double											eight bytes

	true / false / nil:
		No space beyond the record entry

	class:
		A repeat of the Class Format

	characters:
		<character : integer>

	strings:
		<string size : integer> <characters : character>*

	bytes:
		<byte array size: integer> <bytes : one byte>*

	collection:
		<collection size : integer> <elements : record>*

	dictionary / keyed collection:
		<dictionary size : integer> (<key : record> <value : record>)*

	object:
		The basicSize is only included if the object class isVariable
		<basicSize : integer>? <instance variables : record)* (basic variables : record)*

Example Records:
	true:		21 (true)
	128:		19 (SmallInteger) 128
	''test'':		4 (ByteString) 1 (object id) 4 (string length) 116 $t 101 $e 115 $s 116 $t
	5 asValue:
		23 (ValueHolder) 29 (class name length) ...29.. (''Root.Smalltalk.UI.ValueHolder'') 0 (not meta) 1 (object id)
			22 (nil)
			19 (SmallInteger) 5
	(5 @ 6):
		18 (Point) 1 (object id)
			19 (SmallInteger) 5
			19 (SmallInteger) 6
	(Array with: 5 asValue with: 5 asValue):
		1 (Array) 1 (object id) 2 (array length)
			23 (ValueHolder) 29 (class name length) ...29.. (''Root.Smalltalk.UI.ValueHolder'') 0 (not meta) 2 (object id)
				22 (nil)
				19 (SmallInteger) 5
			23 (ValueHolder) 3 (object id)
				22 (nil)
				19 (SmallInteger) 5

Instance Variables
	classes	<Array of: Class> maps class IDs to classes
	read	<Dictionary key: Class value: Symbol> maps classes to methods to use to unmarshal
	write	<Dictionary key: Class value: Symbol> maps classes to methods to use to marshal
	version	<ByteArray> version id, e.g. (STST 2.0)
	rehash	<Array of: Class> list of classes that need to be rehashed after unmarshaling
	analyse	<Array of: Symbol> maps class IDs to corresponding analysing method selector
	immediate	<Array of: Boolean> maps class IDs to value of #hasImmediateInstances for that class

'
!


!ObjectMarshaler class methodsFor:'instance creation'!

new
	^super new initialize
! !

!ObjectMarshaler class methodsFor:'pragmas'!

pragmas
	<pragmas: #instance>
	^#( #reads: #analyse: #writes: )
! !

!ObjectMarshaler methodsFor:'analyse - complex'!

analyse: reading binding: aClass
	<analyse: 'Core.VariableBinding'>

	| binding isInStandardEnvironment |
	reading
		log: ['binding: ', binding]
		do: [isInStandardEnvironment := self unmarshal: reading.
			binding := self get: reading string: String.
			isInStandardEnvironment ifFalse:
				[reading log: 'value' do: [self analyse: reading].
				reading log: 'environment' do: [self analyse: reading]]]
!

analyse: reading bytes: aClass
	<analyse: 'Core.ByteArray'>

	| bytes |
	reading log: ['bytes: ', bytes printString] do: [bytes := self get: reading bytes: aClass]
!

analyse: reading class: aClass
	<analyse: 'Core.Behavior'>

	| classId class  |
	reading
		log:	['class: ', class absoluteName]
		do:	[classId := self analyse: reading class_id: [:id :behavior | classId := id. class := behavior]]
!

analyse: reading class_id: aBlock
	| id class className classIsMeta classFormat classInstVarSize classInstVarNames |
	id := -1.
	reading log: ['class id: ', id printString] do: [id := self get: reading integer: nil].
	id > classes size ifFalse: [^aBlock value: id value: (classes at: id)].
	class := nil.
	reading log: ['class description: ', class fullName] do:
		[className := self get: reading string: String.
		classIsMeta := self unmarshal: reading.
		classFormat := self get: reading integer: Integer.
		classInstVarSize := self get: reading integer: Integer.
		classInstVarNames := (1 to: classInstVarSize) collect: [:i | self get: reading string: String].
		classesMutex critical: [
			class := self resolveClass: className isMeta: classIsMeta format: classFormat instVarNames: classInstVarNames.
			self includeClass: class]].
	^aBlock value: id value: class
!

analyse: reading collection: aClass
	<analyse: 'Core.Collection'>
	<analyse: 'Core.OrderedCollection'>
	<analyse: 'Core.Array'>
	<analyse: 'Core.Set'>

	| size |
	reading log: ['collection: ', aClass fullName, ' size: ', size printString] do: [
		size := self get: reading integer: nil.
		size timesRepeat: [self analyse: reading]]
!

analyse: reading compiledcode: aClass
	<analyse: 'Kernel.CompiledCode'>

	reading log: 'compiled code: ', aClass fullName do: [
		| variableSize allInstVarNames |
		variableSize := aClass isVariable
			ifTrue:	[self get: reading integer: nil]
			ifFalse:	[0].

		allInstVarNames := aClass allInstVarNames.
		1 to: aClass instSize do: [:index | reading log: (allInstVarNames at: index) do: [self analyse: reading]].
		1 to: variableSize do: [:index | reading log: index printString do: [self analyse: reading]]]
!

analyse: reading dictionary: aClass
	<analyse: 'Core.Dictionary'>
	<analyse: 'Core.KeyedCollection'>

	| size |
	reading log: ['dictionary: ', aClass fullName, ' size: ', size printString] do: [
		size := self get: reading integer: nil.
		size timesRepeat:
			[self analyse: reading.
			self analyse: reading]]
!

analyse: reading interval: aClass
	<analyse: 'Core.Interval'>

	reading log: ['interval: ', aClass fullName] do: [
		self analyse: reading.
		self analyse: reading.
		self analyse: reading]
!

analyse: reading linkedlist: aClass
	<analyse: 'Core.LinkedList'>

	| size |
	reading log: ['linkedlist: ', aClass fullName, ' size: ', size printString] do: [
		size := self get: reading integer: nil.
		size timesRepeat: [self analyse: reading]]
!

analyse: reading namespace: aClass
	<analyse: 'Kernel.NameSpace'>

	| namespace |
	^reading log: ['namespace: ', namespace absoluteName] do: [namespace := (self get: reading string: String) asStrictReference value]
!

analyse: reading object: aClass
	<analyse: 'Core.Object'>

	reading log: 'object: ', aClass fullName do: [
		| variableSize allInstVarNames |
		variableSize := aClass isVariable
			ifTrue:	[self get: reading integer: nil]
			ifFalse:	[0].

		allInstVarNames := aClass allInstVarNames.
		1 to: aClass instSize do: [:index | reading log: (allInstVarNames at: index) do: [self analyse: reading]].
		1 to: variableSize do: [:index | reading log: index printString do: [self analyse: reading]]]
!

analyse: reading point: aClass
	<analyse: 'Core.Point'>

	reading log: 'point' do:
		[reading log: 'x:' do: [self analyse: reading].
		reading log: 'y:' do: [self analyse: reading]]
!

analyse: reading sortedCollection: aClass
	<analyse: 'Core.SortedCollection'>

	| size |
	size := 0.
	reading log: ['sorted collection: ', aClass fullName, ' size: ', size printString] do: [
		size := self get: reading integer: nil.
		reading log: ['sort block'] do: [self analyse: reading].
		size timesRepeat: [self analyse: reading]]
!

analyse: reading string: aClass
	<analyse: 'Core.String'>
	<analyse: 'Core.ByteString'>
	<analyse: 'Core.TwoByteString'>
	<analyse: 'Core.FourByteString'>

	| string |
	reading log: ['string: ', string printString] do: [string := self get: reading string: aClass]
!

analyse: reading symbol: aClass
	<analyse: 'Core.Symbol'>
	<analyse: 'Core.ByteSymbol'>
	<analyse: 'Core.TwoByteSymbol'>
	<analyse: 'Core.FourByteSymbol'>

	| symbol |
	reading log: ['symbol: ', symbol printString] do: [symbol := self get: reading symbol: aClass]
!

analyse: reading variablePool: aClass
	<analyse: 'Tools.WorkspaceVariablePool'>

	reading log: ['variable pool'] do:
		[reading log: 'import' do: [self get: reading string: String].
		reading log: 'bindings' do: [self analyse: reading]].
! !

!ObjectMarshaler methodsFor:'analyse - core'!

analyse: reading character: aClass
	<analyse: 'Core.Character'>

	| character |
	reading log: ['character: ', character printString] do: [character := self get: reading character: aClass]
!

analyse: reading false: boolean
	<analyse: 'Core.False'>

	reading log: 'false' do: [self get: reading false: boolean]
!

analyse: reading nil: undefined
	<analyse: 'Core.UndefinedObject'>

	reading log: 'nil' do: [self get: reading nil: undefined]
!

analyse: reading true: boolean
	<analyse: 'Core.True'>

	reading log: 'true' do: [self get: reading true: boolean]
! !

!ObjectMarshaler methodsFor:'analyse - numbers'!

analyse: reading double: aClass
	<analyse: 'Core.Double'>

	| double |
	reading log: ['double: ', double printString] do: [double := self get: reading double: aClass]
!

analyse: reading float: aClass
	<analyse: 'Core.Float'>

	| float |
	reading log: ['float: ', float printString] do: [float := self get: reading float: aClass]
!

analyse: reading integer: aClass
	<analyse: 'Core.Integer'>
	<analyse: 'Core.SmallInteger'>
	<analyse: 'Core.LargePositiveInteger'>
	<analyse: 'Core.LargeNegativeInteger'>

	| indicator integer |
	integer := nil.
	reading log: [integer ifNil: ['integer'] ifNotNil: ['byte integer: ', integer printString]] do: [
		indicator := self get: reading byte: nil.
		indicator < 252 ifTrue: [integer := indicator. ^indicator].
		indicator = 255 ifTrue: [^self analyse: reading integerNegativeLarge: aClass].
		indicator = 254 ifTrue: [^self analyse: reading integerPositiveLarge: aClass].
		indicator = 253 ifTrue: [^self analyse: reading integerMedium: aClass].
		indicator = 252 ifTrue: [^self analyse: reading integerSmall: aClass]]
!

analyse: reading integerMedium: aClass
	| integer |
	reading log: ['medium integer: ', integer printString] do: [integer := self get: reading integerMedium: aClass]
!

analyse: reading integerNegativeLarge: integer
	reading log: 'large negative integer' do: [self get: reading integerLarge: integer]
!

analyse: reading integerPositiveLarge: integer
	reading log: 'large positive integer' do: [self get: reading integerLarge: integer]
!

analyse: reading integerSmall: aClass
	| integer |
	reading log: ['small integer: ', integer printString] do: [integer := self get: reading integerSmall: aClass]
! !

!ObjectMarshaler methodsFor:'api'!

analyse: reading
	| description |
	description := '<error>'.
	reading
		log:
			[description]
		do:
			[ | classId class objectId |
			self analyse: reading class_id: [:id :behavior |
				description := 'class id: ', id printString, ' class: ', behavior fullName, ' '.
				classId := id.
				class := behavior].
			(immediate at: classId) ifTrue:
				[description := description, 'immediate'.
				self perform: (analyse at: classId) with: reading with: class.
				^self].
			objectId := -1.
			reading log: ['object id: ', objectId printString] do: [objectId := self get: reading integer: nil].
			(reading objects includes: objectId) ifTrue:
				[description := description, 'reference: ', objectId printString.
				^self].
			description := description, 'object id: ', objectId printString.
			reading objects add: objectId.
			self perform: (analyse at: classId) with: reading with: class.
			(rehash at: classId) ifTrue: [description := description, ' rehash']]
!

marshal: writing object: object
	| class classId objectId |
	class := object class.
	classId := self put: writing class: class.

	(immediate at: classId) ifTrue: [^self perform: (write at: classId) with: writing with: object].
	(objectId := writing objects identityIndexOf: object) isZero ifTrue:
		[(objectId := writing objects identityIndexOf: writing nothing) isZero ifTrue:
			[writing grow.
			objectId := writing objects size].
		writing objects at: objectId put: object.
		self put: writing integer: objectId.
		^self perform: (write at: classId) with: writing with: object].
	self put: writing integer: objectId
!

unmarshal: reading
	| object reference classId class objectIndex referenceIndex |
	self get: reading class_id: [:id :behavior | classId := id. class := behavior].
	(immediate at: classId) ifTrue: [^self perform: (read at: classId) with: reading with: class].
	objectIndex := (self get: reading integer: nil) * 2.
	referenceIndex := objectIndex - 1.
	objectIndex > reading objects size ifTrue: [reading grow: objectIndex].
	(object := reading objects at: objectIndex) ~~ reading nothing ifTrue:
		[reading objects at: referenceIndex put: true.
		^object].
	reading objects at: objectIndex put: (reference := Object new).
	object := self perform: (read at: classId) with: reading with: class.
	(rehash at: classId) ifTrue: [object rehash].
	^(reading objects at: referenceIndex)
		ifTrue:	[reference become: object. reference]
		ifFalse:	[reading objects at: objectIndex put: object. object]
! !

!ObjectMarshaler methodsFor:'configuration'!

configureAnalyse: reading
	"Negotiate this marshaler on the reading stream and return true if the stream should be big-endian."

	(reading read: version size) = version ifFalse: [self error: 'incompatible marshalers'].
	^reading get = true coerceToCInteger
!

configureMarshal: writing
	"Negotiate this marshaler on the writing stream and return true if the stream should be big-endian."

	writing
		write: version;
		put: InterpretedBytes isBigEndian coerceToCInteger;
		flush.
	^InterpretedBytes isBigEndian
!

configureUnmarshal: reading
	"Negotiate this marshaler on the reading stream and return true if the stream should be big-endian."

	(reading read: version size) = version ifFalse: [self error: 'incompatible marshalers'].
	^reading get = true coerceToCInteger
! !

!ObjectMarshaler methodsFor:'initialize-release'!

includeClass: aClass
	| class classId |
	class := aClass.
	[(classId := classes indexOf: class) isZero] whileTrue: [class := class superclass].
	classes := classes copyWith: aClass.
	read := read copyWith: (read at: classId).
	write := write copyWith: (write at: classId).
	analyse := analyse copyWith: (analyse at: classId).
	rehash := rehash copyWith: (rehash at: classId).
	immediate := immediate copyWith: aClass hasImmediateInstances.
	^classes size
!

initialize
	self initializeVersion.
	classesMutex := Semaphore forMutualExclusion.
	classes := Array new.

	read := Array new.
	(Pragma allNamed: #reads: from: self class to: ObjectMarshaler sortedByArgument: 1) do: [:pragma |
		classes := classes copyWith: pragma arguments first asStrictReference value.
		read := read copyWith: pragma selector].

	analyse := Array new: classes size.
	(Pragma allNamed: #analyse: from: self class to: ObjectMarshaler sortedByArgument: 1) do: [:pragma |
		| class id |
		class := pragma arguments first asStrictReference value.
		(id := classes indexOf: class) isZero
			ifTrue:
				[classes := classes copyWith: class.
				read := read copyWith: nil.
				analyse := analyse copyWith: pragma selector]
			ifFalse:
				[analyse at: id put: pragma selector]].

	write := Array new: classes size.
	(Pragma allNamed: #writes: from: self class to: ObjectMarshaler sortedByArgument: 1) do: [:pragma |
		| class id |
		class := pragma arguments first asStrictReference value.
		(id := classes indexOf: class) isZero
			ifTrue:
				[classes := classes copyWith: class.
				read := read copyWith: nil.
				analyse := analyse copyWith: nil.
				write := write copyWith: pragma selector]
			ifFalse:
				[write at: id put: pragma selector]].

	rehash := Array new: classes size.
	classes keysAndValuesDo: [:index :class | rehash at: index put: (class canUnderstand: #rehash)].

	immediate := Array new: classes size.
	classes keysAndValuesDo: [:index :class | immediate at: index put: class hasImmediateInstances].

	"true, false and nil are not immediate in the #isImmediate sense, but they are in the bytes sense"
	immediate
		at: (classes indexOf: UndefinedObject) put: true;
		at: (classes indexOf: True) put: true;
		at: (classes indexOf: False) put: true
!

initializeVersion
        | hash versionWriting |
        version := #[83 84 83 84 20]. "STST 2.0"
        hash := self class absoluteName hash.
        (self class methodDictionary keys asSortedCollection: [:a :b | (a compareCollatingWith: b) <= 0]) do: [:key |
                hash := (hash bitXor: key hash) bitXor: (self class methodDictionary at: key) byteCode hash].

        versionWriting := ByteArray new writing.
        versionWriting write: version.
        versionWriting write: hash digitLength.
        [hash > 0] whileTrue: [versionWriting write: (hash bitAnd: 255). hash := hash bitShift: -8].
        version := versionWriting conclusion
!

resolveClass: className isMeta: classIsMeta format: classFormat instVarNames: classInstVarNames
	"If a class by the absolute name of className exists, and its shape and format match what was expected, re-use it, otherwise create a shadow-class."

	| class newMetaclass |
	class := className asStrictReference valueOrDo: [nil].
	(class ~~ nil and: [classIsMeta]) ifTrue: [class := class class].

	(class == nil or: [class format ~= classFormat or: [class allInstVarNames asSet ~= classInstVarNames asSet]]) ifTrue: [
		newMetaclass := Metaclass new.
		newMetaclass hash.
		newMetaclass setSuperclass: Object class.
		newMetaclass setInstanceFormat: (classIsMeta ifTrue: [classFormat] ifFalse: [Object class format]).
		newMetaclass instanceVariables: (classIsMeta ifTrue: [(classInstVarNames asSet - Object class instVarNames asSet) asArray] ifFalse: [#()]).
		newMetaclass methodDictionary: Kernel.MethodDictionary new.

		class := newMetaclass new.
		class hash.
		class setName: className.
		class setSuperclass: Object.
		class setInstanceFormat: (classIsMeta ifTrue: [Object format] ifFalse: [classFormat]).
		class instanceVariables: (classIsMeta ifTrue: [#()] ifFalse: [classInstVarNames]).
		class methodDictionary: Kernel.MethodDictionary new.

		classIsMeta ifFalse: [
			classInstVarNames do: [:instVarName |  | methodNode |
				methodNode := class compilerClass new compile: instVarName, ' ^', instVarName in: class notifying: nil ifFail: [].
				class methodDictionary at: methodNode selector put: methodNode generate.
				methodNode := class compilerClass new compile: instVarName, ': anObject ', instVarName, ' := anObject' in: class notifying: nil ifFail: [].
				class methodDictionary at: methodNode selector put: methodNode generate].
			class flushVMmethodCache].
		classIsMeta ifTrue: [class := newMetaclass]].
	^class
!

version
	^version
! !

!ObjectMarshaler methodsFor:'reading - complex'!

get: reading binding: aClass
	<reads: 'Core.VariableBinding'>

	| isInStandardEnvironment |

	isInStandardEnvironment := self unmarshal: reading.
	isInStandardEnvironment
		ifTrue: [^(self get: reading string: String) asStrictReference binding].

	^(aClass
		key: (self get: reading symbol: Symbol)
		value: (self unmarshal: reading))
			environment: (self unmarshal: reading);
			yourself
!

get: reading bytes: aClass
	<reads: 'Core.ByteArray'>

	| size bytearray |
	size := self get: reading integer: nil.
	bytearray := ByteArray new: size.
	1 to: size do: [:each | bytearray at: each put: (self get: reading byte: nil)].
	^bytearray
!

get: reading class: aClass
	<reads: 'Core.Behavior'>

	| class |
	self get: reading class_id: [:id :behavior | class := behavior].
	^class
!

get: reading class_id: aBlock
	| id class className classIsMeta classFormat classInstVarSize classInstVarNames |
	id := self get: reading integer: nil.
	id > classes size ifFalse: [^aBlock value: id value: (classes at: id)].
	className := self get: reading string: String "asStrictReference value".
	classIsMeta := self unmarshal: reading.
	classFormat := self get: reading integer: Integer.
	classInstVarSize := self get: reading integer: Integer.
	classInstVarNames := (1 to: classInstVarSize) collect: [:each | self get: reading string: String].
	classesMutex critical: [
		class := self resolveClass: className isMeta: classIsMeta format: classFormat instVarNames: classInstVarNames.
		self includeClass: class].
	^aBlock value: id value: class
!

get: reading collection: aClass
	<reads: 'Core.Collection'>
	<reads: 'Core.OrderedCollection'>
	<reads: 'Core.Array'>

	| collection size |
	size := self get: reading integer: nil.
	collection := aClass withSize: size.
	1 to: size do: [:index | collection at: index put: (self unmarshal: reading)].
	^collection
!

get: reading compiledcode: aClass
	<reads: 'Kernel.CompiledCode'>

	| object variableSize |
	aClass isVariable
		ifTrue:
			[variableSize := self get: reading integer: nil.
			object := aClass basicNew: variableSize]
		ifFalse:
			[variableSize := 0.
			object := aClass basicNew].

	1 to: aClass instSize do: [:index | object instVarAt: index put: (self unmarshal: reading)].
	1 to: variableSize do: [:index | object basicAt: index put: (self unmarshal: reading)].
	^object
!

get: reading dictionary: aClass
	<reads: 'Core.Dictionary'>
	<reads: 'Core.KeyedCollection'>

	| size dictionary |
	size := self get: reading integer: nil.
	dictionary := aClass new.
	size timesRepeat: [dictionary at: (self unmarshal: reading) put: (self unmarshal: reading)].
	^dictionary
!

get: reading interval: aClass
	<reads: 'Core.Interval'>

	| start stop step |
	start := self unmarshal: reading.
	stop := self unmarshal: reading.
	step := self unmarshal: reading.
	^Interval from: start to: stop by: step
!

get: reading linkedlist: aClass
	<reads: 'Core.LinkedList'>

	| collection size |
	size := self get: reading integer: nil.
	collection := aClass new.
	1 to: size do: [:index | collection add: (self unmarshal: reading)].
	^collection
!

get: reading namespace: aClass
	<reads: 'Kernel.NameSpace'>

	^(self get: reading string: String) asStrictReference value
!

get: reading object: aClass
	<reads: 'Core.Object'>

	| object variableSize |
	aClass isVariable
		ifTrue:
			[variableSize := self get: reading integer: nil.
			object := aClass withSize: variableSize]
		ifFalse:
			[variableSize := 0.
			object := aClass basicNew].

	1 to: aClass instSize do: [:index | object instVarAt: index put: (self unmarshal: reading)].
	1 to: variableSize do: [:index | object basicAt: index put: (self unmarshal: reading)].
	^object
!

get: reading point: aClass
	<reads: 'Core.Point'>

	^Point
		x: (self unmarshal: reading) 
		y: (self unmarshal: reading)
!

get: reading set: aClass
	<reads: 'Core.Set'>

	| set size |
	size := self get: reading integer: nil.
	set := aClass new: size.
	size timesRepeat: [set add: (self unmarshal: reading)].
	^set
!

get: reading sortedCollection: aClass
	<reads: 'Core.SortedCollection'>

	| collection size sortBlock |
	size := self get: reading integer: nil.
	sortBlock := self unmarshal: reading.
	collection := Array new: size.
	1 to: size do: [:index | collection at: index put: (self unmarshal: reading)].
	^SortedCollection withAll: collection sortBlock: sortBlock
!

get: reading string: aClass
	<reads: 'Core.String'>
	<reads: 'Core.ByteString'>
	<reads: 'Core.TwoByteString'>
	<reads: 'Core.FourByteString'>

	| size string |
	size := self get: reading integer: nil.
	string := aClass new: size.
	1 to: size do: [:each | string at: each put: (self get: reading character: nil)].
	^string
!

get: reading symbol: aClass
	<reads: 'Core.Symbol'>
	<reads: 'Core.ByteSymbol'>
	<reads: 'Core.TwoByteSymbol'>
	<reads: 'Core.FourByteSymbol'>

	^(self get: reading string: String) asSymbol
!

get: reading variablePool: aClass
	<reads: 'Tools.WorkspaceVariablePool'>

	^aClass new
		imports: (self get: reading string: String);
		instVarNamed: 'bindings' put: (self unmarshal: reading);
		yourself
! !

!ObjectMarshaler methodsFor:'reading - core'!

get: reading byte: aClass
	^reading uint8 get
!

get: reading character: aClass
	<reads: 'Core.Character'>

	^Character codePoint: (self get: reading integer: nil)
!

get: writing false: boolean
	<reads: 'Core.False'>

	^false
!

get: writing nil: undefined
	<reads: 'Core.UndefinedObject'>

	^nil
!

get: writing true: boolean
	<reads: 'Core.True'>

	^true
! !

!ObjectMarshaler methodsFor:'reading - numbers'!

get: reading double: aClass
	<reads: 'Core.Double'>

	^reading double get
!

get: reading float: aClass
	<reads: 'Core.Float'>

	^reading float get
!

get: reading integer: aClass
	<reads: 'Core.Integer'>
	<reads: 'Core.SmallInteger'>
	<reads: 'Core.LargePositiveInteger'>
	<reads: 'Core.LargeNegativeInteger'>

	| indicator |
	indicator := self get: reading byte: nil.
	indicator < 252 ifTrue: [^indicator].
	indicator = 252 ifTrue: [^self get: reading integerSmall: aClass].
	indicator = 253 ifTrue: [^self get: reading integerMedium: aClass].
	indicator = 254 ifTrue: [^self get: reading integerLarge: aClass].
	indicator = 255 ifTrue: [^(self get: reading integerLarge: aClass) negated]
!

get: reading integerLarge: integer
	| printed |
	printed := self get: reading string: String.
	^Number readIntegerFrom: printed readStream radix: 36
!

get: reading integerMedium: aClass
	^reading int64 get
!

get: reading integerSmall: aClass
	^reading int32 get
! !

!ObjectMarshaler methodsFor:'writing - complex'!

put: writing binding: aBinding
	<writes: 'Core.VariableBinding'>

	self marshal: writing object: aBinding environment isInStandardEnvironment.
	aBinding environment isInStandardEnvironment
		ifTrue: [^self put: writing string: aBinding absoluteName].

	self put: writing string: aBinding key.
	self marshal: writing object: aBinding value.
	self marshal: writing object: aBinding environment.
!

put: writing bytes: bytearray
	<writes: 'Core.ByteArray'>

	self put: writing integer: bytearray size.
	bytearray do: [:byte | self put: writing byte: byte]
!

put: writing class: class
	<writes: 'Core.Behavior'>

	| id behavior |
	classesMutex critical: [
		(id := classes indexOf: class) isZero ifFalse: [self put: writing integer: id. ^id].
		id := self includeClass: class].
	self put: writing integer: id.
	behavior := class.
	class isMeta ifTrue: [behavior := behavior soleInstance].
	self put: writing string: behavior absoluteName.
	self marshal: writing object: class isMeta.
	self put: writing integer: class format.
	self put: writing integer: class instSize.
	class allInstVarNames do: [:each | self put: writing string: each].
	^id
!

put: writing collection: collection
	<writes: 'Core.Collection'>
	<writes: 'Core.OrderedCollection'>
	<writes: 'Core.Array'>

	self put: writing integer: collection size.
	collection do: [:object | self marshal: writing object: object]
!

put: writing compiledcode: aCompiledCode
	<writes: 'Kernel.CompiledCode'>

	self put: writing object: aCompiledCode
!

put: writing dictionary: dictionary
	<writes: 'Core.Dictionary'>
	<writes: 'Core.KeyedCollection'>

	self put: writing integer: dictionary size.
	dictionary keysAndValuesDo: [:key :value |
		self marshal: writing object: key.
		self marshal: writing object: value]
!

put: writing interval: interval
	<writes: 'Core.Interval'>

	self marshal: writing object: interval first.
	self marshal: writing object: interval last.
	self marshal: writing object: interval increment
!

put: writing linkedlist: aLinkedList
	<writes: 'Core.LinkedList'>

	self put: writing integer: aLinkedList size.
	aLinkedList do: [:object | self marshal: writing object: object]
!

put: writing namespace: aNamespace
	<writes: 'Kernel.NameSpace'>

	self put: writing string: aNamespace absoluteName
!

put: writing object: object
	<writes: 'Core.Object'>

	object class isVariable ifTrue: [self put: writing integer: object basicSize].
	1 to: object class instSize do: [:index | self marshal: writing object: (object instVarAt: index)].
	1 to: object basicSize do: [:index | self marshal: writing object: (object basicAt: index)]
!

put: writing point: point
	<writes: 'Core.Point'>

	self marshal: writing object: point x.
	self marshal: writing object: point y
!

put: writing set: set
	<writes: 'Core.Set'>

	self put: writing integer: set size.
	set do: [:object | self marshal: writing object: object]
!

put: writing sortedCollection: collection
	<writes: 'Core.SortedCollection'>

	self put: writing integer: collection size.
	self marshal: writing object: collection sortBlock.
	collection do: [:object | self marshal: writing object: object]
!

put: writing string: string
	<writes: 'Core.String'>
	<writes: 'Core.ByteString'>
	<writes: 'Core.TwoByteString'>
	<writes: 'Core.FourByteString'>
	<writes: 'Core.ByteSymbol'>
	<writes: 'Core.TwoByteSymbol'>
	<writes: 'Core.FourByteSymbol'>


	self put: writing integer: string size.
	string do: [:character | self put: writing character: character]
!

put: writing variablePool: aPool
	<writes: 'Tools.WorkspaceVariablePool'>

	self put: writing string: aPool importString.
	self marshal: writing object: aPool localBindings
! !

!ObjectMarshaler methodsFor:'writing - core'!

put: writing builtins: builtin
	<writes: 'Core.True'>
	<writes: 'Core.False'>
	<writes: 'Core.UndefinedObject'>
!

put: writing byte: byte
	writing uint8 put: byte
!

put: writing character: character
	<writes: 'Core.Character'>

	self put: writing integer: character codePoint
! !

!ObjectMarshaler methodsFor:'writing - numbers'!

put: writing double: double
	<writes: 'Core.Double'>

	writing double put: double
!

put: writing float: float
	<writes: 'Core.Float'>

	writing float put: float
!

put: writing integer: integer
	<writes: 'Core.Integer'>
	<writes: 'Core.SmallInteger'>
	<writes: 'Core.LargePositiveInteger'>
	<writes: 'Core.LargeNegativeInteger'>

	(integer between: 0 and: 251) ifTrue: [^self put: writing byte: integer].
	(integer between: -2147483647 and: 2147483648) ifTrue: [^self put: writing integerSmall: integer].
	(integer between: -9223372036854775807 and: 9223372036854775808) ifTrue: [^self put: writing integerMedium: integer].
	integer positive
		ifTrue:	[self put: writing integerPositiveLarge: integer]
		ifFalse:	[self put: writing integerNegativeLarge: integer]
!

put: writing integerLarge: integer
	| printed |
	printed := String new writeStream.
	integer printOn: printed base: 36.
	printed := printed contents.
	printed size > 9223372036854775808 ifTrue: [self error: 'this number is too big for me, try again in a thousand years.'].
	self put: writing string: printed
!

put: writing integerMedium: integer
	self put: writing byte: 253.
	writing int64 put: integer
!

put: writing integerNegativeLarge: integer
	self put: writing byte: 255.
	self put: writing integerLarge: integer negated
!

put: writing integerPositiveLarge: integer
	self put: writing byte: 254.
	self put: writing integerLarge: integer
!

put: writing integerSmall: integer
	self put: writing byte: 252.
	writing int32 put: integer
! !

!ObjectMarshaler class methodsFor:'documentation'!

version_SVN
    ^ '$Id$'
! !