Strange Dictionary behavior

Hi OA team, all,

    I'm porting the Avi Bryant GOODS client for squeak to Dolphin ST.

    Right now I've made the easy part, so the connection and rootNode tests
are passing OK.

    The BIG thing is to make work the commit test.

    I had a question about the Dictionary object. When I look a normal new
Dictionary with the inspector, I it is empty and it has 3 nil objects under
the
tally (in the instance variables inspector's tab). I really wonder what are
those 3 nil objects and what's the relation between them and the >>basicSize
method.

    I wonder this because when you add some objects to a normal dictionary
with 'at:put:' if you track the implementation it uses finKeyOrNil: method
and when it calls the basicSize it gets 3 (for the normal empty dic).

    In the other hand, when I call the root dictionary stored in the
database, I get it, it's empty, it's tally is 0, and it looks ready for
action, but it hasn't those 3 nils and if you make a >>basicSize it answer
0, so it is an empty dictionary that can't make an at:put:, so it's
basically useless.

    What can I do to see what's going on?

    best regards,

--
Sebastián Sastre
[hidden email]
www.seaswork.com.ar

Sebastián,

>     In the other hand, when I call the root dictionary stored in the
> database, I get it, it's empty, it's tally is 0, and it looks ready
> for action, but it hasn't those 3 nils and if you make a >>basicSize
> it answer 0, so it is an empty dictionary that can't make an at:put:,
> so it's basically useless.
>
>     What can I do to see what's going on?

I think you're getting mixed up between the implementation and the
interface.

#basicSize (a private method) answers the size of the implementation, the
Object (or whatever) that actually stores the collection.  A lot of
Dolphin's collection classes (Set and it's subclasses for instance) have a
small initial size for efficiency and implementation reasons.

#size answers the size of the interface object, the number of objects that a
user has put in the visible collection.

You can see the same effect with OrderedCollection

x := OrdereredCollection new: 100

creates an OrderedCollection with space preallocated for 100 objects

x basicSize --> 100
x size --> 0
x inspect --> shows 100 nils in the collection
x asArray inspect --> shows an empty Array

--
Ian

Use the Reply-To address to contact me.
Mail sent to the From address is ignored.

Thanks Ian,

    I have to solve a situation in wich the dictionary cames up from the
goods server without that preallocated space. In other terms, the
"deserialized" dictionary answers>>basicSize 0

    Right now I don't know why this is happening or how to solve it.


--
Sebastián Sastre
[hidden email]
www.seaswork.com.ar

"Ian Bartholomew" <[hidden email]> escribió en el mensaje
news:c5iqvn$233e1$[hidden email]... a

Sebastián,

>     I have to solve a situation in wich the dictionary cames up from
> the goods server without that preallocated space. In other terms, the
> "deserialized" dictionary answers>>basicSize 0

That doesn't look right.  Dolphin collections that use a hash table need a
minimum size of 2 to work (see the inline comment in Set class>>sizeFor: for
example) so I'm not sure how you get that result.  How did you serialize the
Dictionary in the first place? Dolphin's STBFiler seems to work as expected
(as expected)...

d := Dictionary new.
d basicSize.

answers 3

d1 := Object fromBinaryStoreBytes: d binaryStoreBytes.
d1 basicSize

answers 2.  (The difference is because the STBFiler recreates the Dictionary
using "Dictionary new: 0" which is bumped up to the minimum size of 2
(nearest prime to 0 + 25%) whereas the original uses "Dictionary new: 2"
which is bumped to 3)..

I think we will need some code snippets to see what you are doing.

--
Ian

Use the Reply-To address to contact me.
Mail sent to the From address is ignored.

Dear Ian, all people interested,

    I've said "deserialize" because I'm not quite sure of the serializing
mechanism that this software uses. Certainly is not the STB way because this
engine is languaje independent (C++, java, our dear ST, ect).

    If you want to take a look, install this pre-pre-alpha package in a
fresh image. Start a goods server in some port (suggested 6100) as you can
see default in KKDBTest>>dbPort and KKDBTest>>dbHost.
    Hint: to start a goods database place the installation files, make a
folder for the database with a file yourdatabasename.cfg  containing the
following two lines:
1
0: localhost:6100
EOF

then call the server like this

goodsrv path\yourdatabasename

    in a workspace evaluate this:

db := KKDatabase onHost: 'localhost' port: 6100.

dict := Dictionary new.

dict inspect.

db root: dict; commit.

db := nil.

db := KKDatabase onHost: 'localhost' port: 6100.

db root inspect.

you will see the second "strange dictionary"

good luck !

--
Sebastián Sastre
[hidden email]
www.seaswork.com.ar

----------------------Below this line is the
.pac---------------------------------
| package |
package := Package name: 'GOODS Client'.
package paxVersion: 0;
 basicComment: ''.


package classNames
 add: #KKBooleanField;
 add: #KKCache;
 add: #KKClassCache;
 add: #KKClassDescriptor;
 add: #KKClassRecord;
 add: #KKCommitFailure;
 add: #KKConnection;
 add: #KKDatabase;
 add: #KKDBTest;
 add: #KKDoubleField;
 add: #KKFieldContainer;
 add: #KKFieldRecord;
 add: #KKFieldType;
 add: #KKFixedArrayContainer;
 add: #KKFloatField;
 add: #KKKeyCache;
 add: #KKObjectProxy;
 add: #KKObjectRecord;
 add: #KKRecordCache;
 add: #KKReferenceField;
 add: #KKRequestKey;
 add: #KKRequestObject;
 add: #KKSignedIntegerField;
 add: #KKSingleFieldContainer;
 add: #KKStringDescriptor;
 add: #KKStringField;
 add: #KKStructureContainer;
 add: #KKSymbolDescriptor;
 add: #KKUnsignedIntegerField;
 add: #KKVariableClassDescriptor;
 add: #KKVariableFieldContainer;
 add: #LookupKey;
 add: #WeakValueAssociation;
 yourself.

package methodNames
 add: #Behavior -> #allSubclassesDoGently:;
 add: #Boolean -> #goodsWriteTaggedOn:;
 add: #ByteArray -> #longAt:bigEndian:;
 add: #ByteArray -> #longAt:put:bigEndian:;
 add: #ByteArray -> #shortAt:bigEndian:;
 add: #ByteArray -> #shortAt:put:bigEndian:;
 add: #ByteArray -> #unsignedShortAt:bigEndian:;
 add: #ByteArray -> #unsignedShortAt:put:bigEndian:;
 add: #Class -> #subclassesDoGently:;
 add: #Collection -> #detectSum:;
 add: #Dictionary -> #like:;
 add: #Dictionary -> #scanFor:;
 add: #Float -> #asIEEE32BitWord;
 add: #Float -> #goodsWriteTaggedOn:;
 add: #Object -> #=;
 add: #Object -> #goodsUpdate;
 add: #Object -> #yourClass;
 add: #OrderedCollection -> #withIndexCollect:;
 add: #PositionableStream -> #nextInt32Put:;
 add: #PositionableStream -> #uint16;
 add: #PositionableStream -> #uint16:;
 add: #PositionableStream -> #uint32;
 add: #PositionableStream -> #uint32:;
 add: #ProtoObject -> #isInMemory;
 add: #SequenceableCollection -> #collectWithIndex:;
 add: #SequenceableCollection -> #withIndexCollect:;
 add: #Set -> #like:;
 add: #SmallInteger -> #digitAt:;
 add: #SmallInteger -> #goodsWriteTaggedOn:;
 add: #String -> #findDelimiters:startingAt:;
 add: #String -> #findTokens:;
 add: #String -> #skipDelimiters:startingAt:;
 add: 'Boolean class' -> #goodsDescriptor;
 add: 'Object class' -> #goodsClassName;
 add: 'Object class' -> #goodsDescriptor;
 add: 'Object class' -> #goodsDescriptorClass;
 add: 'Object class' -> #goodsFieldDescriptorNamed:;
 add: 'Object class' -> #goodsFieldDescriptors;
 add: 'Object class' -> #goodsVariableFieldDescriptor;
 add: 'Object class' -> #isInMemory;
 add: 'SmallInteger class' -> #goodsDescriptor;
 add: 'String class' -> #goodsDescriptorClass;
 add: 'Symbol class' -> #goodsDescriptorClass;
 yourself.

package binaryGlobalNames: (Set new
 yourself).

package globalAliases: (Set new
 yourself).

package allResourceNames: (Set new
 yourself).

package setPrerequisites: (IdentitySet new
 add: '..\Object Arts\Dolphin\Base\Dolphin';
 add: '..\Object Arts\Dolphin\Sockets\Sockets Connection';
 add: '..\Camp Smalltalk\SUnit\SUnit';
 yourself).

package!

"Class Definitions"!

Object subclass: #KKCache
 instanceVariableNames: 'connection'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
Object subclass: #KKClassDescriptor
 instanceVariableNames: 'class className fields id'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
Object subclass: #KKClassRecord
 instanceVariableNames: 'fixedSize varyingSize fixedRefs varyingRefs fields
name nameSize'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
Object subclass: #KKConnection
 instanceVariableNames: 'socket headerBuf invalids'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
Object subclass: #KKDatabase
 instanceVariableNames: 'connection keyCache'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
Object subclass: #KKFieldContainer
 instanceVariableNames: 'fieldType name parent'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
Object subclass: #KKFieldRecord
 instanceVariableNames: 'type size components index nextIndex name
nameOffset'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
Object subclass: #KKFieldType
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
Object subclass: #KKObjectRecord
 instanceVariableNames: 'txnFlags oid cpid storage data'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
Error subclass: #KKCommitFailure
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
Notification subclass: #KKRequestKey
 instanceVariableNames: 'object'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
Notification subclass: #KKRequestObject
 instanceVariableNames: 'key'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKCache subclass: #KKClassCache
 instanceVariableNames: 'cache keys classes'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKCache subclass: #KKKeyCache
 instanceVariableNames: 'cache keys recordCache'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKCache subclass: #KKRecordCache
 instanceVariableNames: 'objectRecords newObjects classCache'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKClassDescriptor subclass: #KKVariableClassDescriptor
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKFieldContainer subclass: #KKFixedArrayContainer
 instanceVariableNames: 'arraySize'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKFieldContainer subclass: #KKSingleFieldContainer
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKFieldContainer subclass: #KKStructureContainer
 instanceVariableNames: 'fieldCount size'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKFieldContainer subclass: #KKVariableFieldContainer
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKVariableFieldContainer subclass: #KKStringDescriptor
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKStringDescriptor subclass: #KKSymbolDescriptor
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKFieldType subclass: #KKBooleanField
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKFieldType subclass: #KKDoubleField
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKFieldType subclass: #KKFloatField
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKFieldType subclass: #KKReferenceField
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKFieldType subclass: #KKStringField
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKFieldType subclass: #KKUnsignedIntegerField
 instanceVariableNames: 'size'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
KKUnsignedIntegerField subclass: #KKSignedIntegerField
 instanceVariableNames: 'bitMask'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
Magnitude subclass: #LookupKey
 instanceVariableNames: 'key'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
LookupKey subclass: #WeakValueAssociation
 instanceVariableNames: ''
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
TestCase subclass: #KKDBTest
 instanceVariableNames: 'dbOne dbTwo connOne connTwo'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!
ProtoObject subclass: #KKObjectProxy
 instanceVariableNames: 'assoc database'
 classVariableNames: ''
 poolDictionaries: ''
 classInstanceVariableNames: ''!

"Global Aliases"!


"Loose Methods"!

!Behavior methodsFor!

allSubclassesDoGently: aBlock
 "Evaluate the argument, aBlock, for each of the receiver's subclasses."

 self subclassesDoGently:
  [:cl |
  cl isInMemory ifTrue: [
   aBlock value: cl.
   cl allSubclassesDoGently: aBlock]]! !
!Behavior categoriesFor: #allSubclassesDoGently:!public! !

!Boolean methodsFor!

goodsWriteTaggedOn: aStream
 aStream nextPut: 2; next: 3 put: 0; boolean: self! !
!Boolean categoriesFor: #goodsWriteTaggedOn:!public! !

!Boolean class methodsFor!

goodsDescriptor
 self error: 'Cannot store immediate values as references' ! !
!Boolean class categoriesFor: #goodsDescriptor!public! !

!ByteArray methodsFor!

longAt: index bigEndian: aBool
 "Return a 32bit integer quantity starting from the given byte index"
 | b0 b1 b2 w h |
 aBool ifTrue:[
  b0 := self at: index.
  b1 := self at: index+1.
  b2 := self at: index+2.
  w := self at: index+3.
 ] ifFalse:[
  w := self at: index.
  b2 := self at: index+1.
  b1 := self at: index+2.
  b0 := self at: index+3.
 ].
 "Minimize LargeInteger arithmetic"
 h := ((b0 bitAnd: 16r7F) - (b0 bitAnd: 16r80) bitShift: 8) + b1.
 b2 = 0 ifFalse:[w := (b2 bitShift: 8) + w].
 h = 0 ifFalse:[w := (h bitShift: 16) + w].
 ^w!

longAt: index put: value bigEndian: aBool
 "Return a 32bit integer quantity starting from the given byte index"
 | b0 b1 b2 b3 |
 b0 := value bitShift: -24.
 b0 := (b0 bitAnd: 16r7F) - (b0 bitAnd: 16r80).
 b0 < 0 ifTrue:[b0 := 256 + b0].
 b1 := (value bitShift: -16) bitAnd: 255.
 b2 := (value bitShift: -8) bitAnd: 255.
 b3 := value bitAnd: 255.
 aBool ifTrue:[
  self at: index put: b0.
  self at: index+1 put: b1.
  self at: index+2 put: b2.
  self at: index+3 put: b3.
 ] ifFalse:[
  self at: index put: b3.
  self at: index+1 put: b2.
  self at: index+2 put: b1.
  self at: index+3 put: b0.
 ].
 ^value!

shortAt: index bigEndian: aBool
 "Return a 16 bit integer quantity starting from the given byte index"
 | uShort |
 uShort := self unsignedShortAt: index bigEndian: aBool.
 ^(uShort bitAnd: 16r7FFF) - (uShort bitAnd: 16r8000)!

shortAt: index put: value bigEndian: aBool
 "Store a 16 bit integer quantity starting from the given byte index"

 self unsignedShortAt: index put: (value bitAnd: 16r7FFF) - (value
bitAnd: -16r8000) bigEndian: aBool.
 ^value!

unsignedShortAt: index bigEndian: aBool
 "Return a 16 bit unsigned integer quantity starting from the given byte
index"
 ^aBool
  ifTrue:[((self at: index) bitShift: 8) + (self at: index+1)]
  ifFalse:[((self at: index+1) bitShift: 8) + (self at: index)].!

unsignedShortAt: index put: value bigEndian: aBool
 "Store a 16 bit unsigned integer quantity starting from the given byte
index"
 aBool ifTrue:[
  self at: index put: (value bitShift: -8).
  self at: index+1 put: (value bitAnd: 255).
 ] ifFalse:[
  self at: index+1 put: (value bitShift: -8).
  self at: index put: (value bitAnd: 255).
 ].
 ^value! !
!ByteArray categoriesFor: #longAt:bigEndian:!public! !
!ByteArray categoriesFor: #longAt:put:bigEndian:!public! !
!ByteArray categoriesFor: #shortAt:bigEndian:!public! !
!ByteArray categoriesFor: #shortAt:put:bigEndian:!public! !
!ByteArray categoriesFor: #unsignedShortAt:bigEndian:!public! !
!ByteArray categoriesFor: #unsignedShortAt:put:bigEndian:!public! !

!Class methodsFor!

subclassesDoGently: aBlock
 "Evaluate the argument, aBlock, for each of the receiver's immediate
subclasses."
 subclasses == nil
  ifFalse: [subclasses do: aBlock]! !
!Class categoriesFor: #subclassesDoGently:!public! !

!Collection methodsFor!

detectSum: aBlock
 "Evaluate aBlock with each of the receiver's elements as the argument.
 Return the sum of the answers."
 | sum |
 sum := 0.
 self do: [:each |
  sum := (aBlock value: each) + sum].
 ^ sum! !
!Collection categoriesFor: #detectSum:!public! !

!Dictionary methodsFor!

like: anObject
 "Answer an object in the receiver that is equal to anObject,
 nil if no such object is found. Relies heavily on hash properties"

 | index |

 ^(index := self scanFor: anObject) = 0
  ifFalse: [self associations at: index].!

scanFor: anObject
 "Scan the key array for the first slot containing either a nil (indicating
an empty slot) or an element that matches anObject. Answer the index of that
slot or zero if no slot is found. This method will be overridden in various
subclasses that have different interpretations for matching elements."
 | element start finish |
" start := (anObject hash \\ self size) + 1.
 finish := self size."

 1 to: self keys size do:[:i| ( (self keys elements at:i) == nil or:[(self
keys elements at:i) = anObject] ) ifTrue:[ ^ i ]].

 "Search from (hash mod size) to the end."
" start to: finish do:
  [:index | ((element _ array at: index) == nil or: [element key =
anObject])
   ifTrue: [^ index ]]."

 "Search from 1 to where we started."
" 1 to: start-1 do:
  [:index | ((element := self at: index) == nil or: [element key =
anObject])
   ifTrue: [^ index ]]."

 ^ 0 "No match AND no empty slot"! !
!Dictionary categoriesFor: #like:!public! !
!Dictionary categoriesFor: #scanFor:!public! !

!Float methodsFor!

asIEEE32BitWord
 "Convert the receiver into a 32 bit Integer value representing the same
number in IEEE 32 bit format. Used for conversion in FloatArrays only."
 | word1 word2 sign mantissa exponent destWord |

 self = 0.0 ifTrue:[^0].
 word1 := self basicAt: 1.
 word2 := self basicAt: 2.
 mantissa := (word2 bitShift: -29) + ((word1 bitAnd:  16rFFFFF) bitShift:
3).
 exponent := ((word1 bitShift: -20) bitAnd: 16r7FF) - 1023 + 127.
 exponent < 0 ifTrue:[^0]. "Underflow"
 exponent > 254 ifTrue:["Overflow"
  exponent := 255.
  mantissa := 0].
 sign := word1 bitAnd: 16r80000000.
 destWord := (sign bitOr: (exponent bitShift: 23)) bitOr: mantissa.
 ^ destWord!

goodsWriteTaggedOn: aStream
 aStream nextPut: 3; uint32: self asIEEE32BitWord ! !
!Float categoriesFor: #asIEEE32BitWord!public! !
!Float categoriesFor: #goodsWriteTaggedOn:!public! !

!Object methodsFor!

= comparand

 "Answer whether the receiver and the argument represent the same
 object. If = is redefined in any subclass, consider also redefining the
 message hash."

 ^ self == comparand yourself!

goodsUpdate
 !

yourClass
 ^ self class! !
!Object categoriesFor: #=!comparing!public! !
!Object categoriesFor: #goodsUpdate!public! !
!Object categoriesFor: #yourClass!public! !

!Object class methodsFor!

goodsClassName
 ^ self name
!

goodsDescriptor
 |descriptor|
 descriptor := self goodsDescriptorClass new.
 descriptor class: self;
    className: self goodsClassName.
 self goodsFieldDescriptors do: [:field | descriptor addField: field].
 self isVariable ifTrue: [descriptor addField: self
goodsVariableFieldDescriptor].
 ^ descriptor!

goodsDescriptorClass
 ^ self isVariable
  ifTrue: [KKVariableClassDescriptor]
  ifFalse: [KKClassDescriptor]!

goodsFieldDescriptorNamed: aName
 |selector|
 selector := (aName, 'Descriptor') asSymbol.
 ^ ((self respondsTo: selector)
   ifTrue: [self perform: selector]
   ifFalse: [KKSingleFieldContainer referenceField])
  name: aName!

goodsFieldDescriptors
 |fields superFields|
 fields := self instVarNames collect: [:ivar | self
goodsFieldDescriptorNamed: ivar].
 ^ self superclass = Object
  ifTrue: [fields]
  ifFalse:
   [superFields := self superclass goodsFieldDescriptors.
   (Array with: (KKStructureContainer new
        name: self superclass goodsClassName;
        fieldCount: superFields size)),
   superFields,
   fields]!

goodsVariableFieldDescriptor
 | container field |
 container := KKVariableFieldContainer new name: 'array'.
 field := self isBits
    ifFalse: [KKReferenceField new]
    ifTrue:
     [self isBytes
      ifTrue: [KKUnsignedIntegerField new size: 2]
      ifFalse: [KKUnsignedIntegerField new size: 4]].
 container fieldType: field.
 ^ container
!

isInMemory

 ^ true! !
!Object class categoriesFor: #goodsClassName!public! !
!Object class categoriesFor: #goodsDescriptor!public! !
!Object class categoriesFor: #goodsDescriptorClass!public! !
!Object class categoriesFor: #goodsFieldDescriptorNamed:!public! !
!Object class categoriesFor: #goodsFieldDescriptors!public! !
!Object class categoriesFor: #goodsVariableFieldDescriptor!public! !
!Object class categoriesFor: #isInMemory!public! !

!OrderedCollection methodsFor!

withIndexCollect: elementAndIndexBlock
 "Just like with:collect: except that the iteration index supplies the
second argument to the block. Override superclass in order to use addLast:,
not at:put:."

 | newCollection |
 newCollection := self species new: self size.
 firstIndex to: lastIndex do:
  [:index |
  newCollection addLast: (elementAndIndexBlock
   value: (self at: index)
   value: index - firstIndex + 1)].
 ^ newCollection! !
!OrderedCollection categoriesFor: #withIndexCollect:!public! !

!PositionableStream methodsFor!

nextInt32Put: int32
 "Write a signed integer to the next 4 bytes"
 | pos |
 pos := int32 < 0
  ifTrue: [(0-int32) bitInvert32 + 1]
  ifFalse: [int32].
 1 to: 4 do: [:i | self nextPut: (pos digitAt: 5-i)].
 ^ int32!

uint16
 "Answer the next unsigned, 16-bit integer from this (binary) stream."

 | n |
 n := self next.
 n := (n bitShift: 8) + (self next).
 ^ n
!

uint16: anInteger
 "Store the given unsigned, 16-bit integer on this (binary) stream."

 (anInteger < 0) | (anInteger >= 16r10000)
  ifTrue: [self error: 'outside unsigned 16-bit integer range'].

 self nextPut: (anInteger digitAt: 2).
 self nextPut: (anInteger digitAt: 1).
!

uint32
 "Answer the next unsigned, 32-bit integer from this (binary) stream."

 | n |
 n := self next.
 n := (n bitShift: 8) + self next.
 n := (n bitShift: 8) + self next.
 n := (n bitShift: 8) + self next.
 ^ n
!

uint32: anInteger
 "Store the given unsigned, 32-bit integer on this (binary) stream."

 (anInteger < 0) | (anInteger >= 16r100000000)
  ifTrue: [self error: 'outside unsigned 32-bit integer range'].

 self nextPut: (anInteger digitAt: 4).
 self nextPut: (anInteger digitAt: 3).
 self nextPut: (anInteger digitAt: 2).
 self nextPut: (anInteger digitAt: 1).! !
!PositionableStream categoriesFor: #nextInt32Put:!public! !
!PositionableStream categoriesFor: #uint16!public! !
!PositionableStream categoriesFor: #uint16:!public! !
!PositionableStream categoriesFor: #uint32!public! !
!PositionableStream categoriesFor: #uint32:!public! !

!ProtoObject methodsFor!

isInMemory
 "All normal objects are."
 ^ true! !
!ProtoObject categoriesFor: #isInMemory!public! !

!SequenceableCollection methodsFor!

collectWithIndex: elementAndIndexBlock
 "Use the new version with consistent naming"
 ^ self withIndexCollect: elementAndIndexBlock!

withIndexCollect: elementAndIndexBlock
 "Just like with:collect: except that the iteration index supplies the
second argument to the block."
 | result |
 result := self species new: self size.
 1 to: self size do:
  [:index | result at: index put:
  (elementAndIndexBlock
   value: (self at: index)
   value: index)].
 ^ result! !
!SequenceableCollection categoriesFor: #collectWithIndex:!public! !
!SequenceableCollection categoriesFor: #withIndexCollect:!public! !

!Set methodsFor!

like: anObject
 "Answer an object in the receiver that is equal to anObject,
 nil if no such object is found. Relies heavily on hash properties"

 | index |

 ^(index := self scanFor: anObject) = 0
  ifFalse: [self at: index].! !
!Set categoriesFor: #like:!public! !

!SmallInteger methodsFor!

digitAt: n
 "Answer the value of an indexable field in the receiver.
LargePositiveInteger uses bytes of base two number, and each is a 'digit'
base 256.  Fail if the argument (the index) is not an Integer or is out of
bounds."
 n>4 ifTrue: [^ 0].
 self < 0
  ifTrue:
   [self = SmallInteger minVal ifTrue:
    ["Can't negate minVal -- treat specially"
    ^ #(0 0 0 64) at: n].
   ^ ((0-self) bitShift: (1-n)*8) bitAnd: 16rFF]
  ifFalse: [^ (self bitShift: (1-n)*8) bitAnd: 16rFF]!

goodsWriteTaggedOn: aStream
 aStream nextPut: 1; nextInt32Put: self.
 ! !
!SmallInteger categoriesFor: #digitAt:!public! !
!SmallInteger categoriesFor: #goodsWriteTaggedOn:!public! !

!SmallInteger class methodsFor!

goodsDescriptor
 self error: 'Cannot store immediate values as references' ! !
!SmallInteger class categoriesFor: #goodsDescriptor!public! !

!String methodsFor!

findDelimiters: delimiters startingAt: start
 "Answer the index of the character within the receiver, starting at start,
that matches one of the delimiters. If the receiver does not contain any of
the delimiters, answer size + 1."

 start to: self size do: [:i |
  delimiters do: [:delim | delim = (self at: i) ifTrue: [^ i]]].
 ^ self size + 1!

findTokens: delimiters
 "Answer the collection of tokens that result from parsing self.  Return
strings between the delimiters.  Any character in the Collection delimiters
marks a border.  Several delimiters in a row are considered as just one
separation.  Also, allow delimiters to be a single character."

 | tokens keyStart keyStop separators |

 tokens := OrderedCollection new.
 separators := delimiters class == Character
  ifTrue: [Array with: delimiters]
  ifFalse: [delimiters].
 keyStop := 1.
 [keyStop <= self size] whileTrue:
  [keyStart := self skipDelimiters: separators startingAt: keyStop.
  keyStop := self findDelimiters: separators startingAt: keyStart.
  keyStart < keyStop
   ifTrue: [tokens add: (self copyFrom: keyStart to: (keyStop - 1))]].
 ^tokens!

skipDelimiters: delimiters startingAt: start
 "Answer the index of the character within the receiver, starting at start,
that does NOT match one of the delimiters. If the receiver does not contain
any of the delimiters, answer size + 1.  Assumes the delimiters to be a
non-empty string."

 start to: self size do: [:i |
  delimiters detect: [:delim | delim = (self at: i)]
    ifNone: [^ i]].
 ^ self size + 1! !
!String categoriesFor: #findDelimiters:startingAt:!public! !
!String categoriesFor: #findTokens:!public! !
!String categoriesFor: #skipDelimiters:startingAt:!public! !

!String class methodsFor!

goodsDescriptorClass
 ^ KKStringDescriptor! !
!String class categoriesFor: #goodsDescriptorClass!public! !

!Symbol class methodsFor!

goodsDescriptorClass
 ^ KKSymbolDescriptor! !
!Symbol class categoriesFor: #goodsDescriptorClass!public! !

"End of package definition"!

"Source Globals"!

"Classes"!

KKCache guid: (GUID fromString: '{99A1C852-11A6-47DD-A36C-38FEB57B3AE7}')!
KKCache comment: ''!
!KKCache categoriesForClass!Kernel-Objects! !
!KKCache methodsFor!

initialize
!

initializeWithConnection: aConnection
 connection := aConnection.
 self initialize.! !
!KKCache categoriesFor: #initialize!public! !
!KKCache categoriesFor: #initializeWithConnection:!public! !

!KKCache class methodsFor!

connection: aConnection
 ^ self basicNew initializeWithConnection: aConnection! !
!KKCache class categoriesFor: #connection:!public! !

KKClassDescriptor guid: (GUID fromString:
'{98F2F6CC-7456-4429-91A4-7E958958C025}')!
KKClassDescriptor comment: ''!
!KKClassDescriptor categoriesForClass!Kernel-Objects! !
!KKClassDescriptor methodsFor!

= another
 ^ className = another className and: [fields = another fields]!

addField: aFieldContainer
 self fields add: aFieldContainer.
 aFieldContainer parent: self.!

class: aClass
 class := aClass.
!

className
 ^className!

className: anObject
 className := anObject!

estimatedSize
 ^ self fixedSize + (self varyingSize * 5)!

fields
 ^ fields ifNil: [fields := OrderedCollection new]!

fixedRefs
 ^ (fields select: [:f | f isVariable not and: [f isReference]]) size!

fixedSize
 ^ (fields reject: [:f | f isVariable]) detectSum: [:f | f totalSize]!

hash
 ^ className hash + fields hash!

id
 ^id!

id: anObject
 id := anObject!

instanceClass
 ^ class!

newInstanceFromStream: aStream
 ^ self instanceClass basicNew!

objectFromStream: aStream
 |obj|
 obj := self newInstanceFromStream: aStream.
 self referenceFieldsFirstDo: [:each | each refreshObject: obj fromStream:
aStream].
 ^ obj!

referenceFieldsFirst
 ^ (self fields select: [:f | f isReference]), (self fields reject: [:f | f
isReference])!

referenceFieldsFirstDo: aBlock
 self fields do: [:ea | ea isReference ifTrue: [aBlock value: ea]].
 self fields do: [:ea | ea isReference ifFalse: [aBlock value: ea]]!

streamForObject: anObject
 |stream|
 stream := WriteStream on: (ByteArray new: 16).
 self writeObject: anObject onStream: stream.
 ^ stream!

varyingRefs
 ^ (fields select: [:f | f isVariable and: [f isReference]]) size!

varyingSize
 ^ (fields select: [:f | f isVariable]) detectSum: [:f | f totalSize]!

writeObject: anObject onStream: aStream
 self referenceFieldsFirstDo: [:each | each writeObject: anObject onStream:
aStream]! !
!KKClassDescriptor categoriesFor: #=!public! !
!KKClassDescriptor categoriesFor: #addField:!public! !
!KKClassDescriptor categoriesFor: #class:!public! !
!KKClassDescriptor categoriesFor: #className!accessing!private! !
!KKClassDescriptor categoriesFor: #className:!accessing!private! !
!KKClassDescriptor categoriesFor: #estimatedSize!public! !
!KKClassDescriptor categoriesFor: #fields!public! !
!KKClassDescriptor categoriesFor: #fixedRefs!public! !
!KKClassDescriptor categoriesFor: #fixedSize!public! !
!KKClassDescriptor categoriesFor: #hash!public! !
!KKClassDescriptor categoriesFor: #id!accessing!private! !
!KKClassDescriptor categoriesFor: #id:!accessing!private! !
!KKClassDescriptor categoriesFor: #instanceClass!public! !
!KKClassDescriptor categoriesFor: #newInstanceFromStream:!public! !
!KKClassDescriptor categoriesFor: #objectFromStream:!public! !
!KKClassDescriptor categoriesFor: #referenceFieldsFirst!public! !
!KKClassDescriptor categoriesFor: #referenceFieldsFirstDo:!public! !
!KKClassDescriptor categoriesFor: #streamForObject:!public! !
!KKClassDescriptor categoriesFor: #varyingRefs!public! !
!KKClassDescriptor categoriesFor: #varyingSize!public! !
!KKClassDescriptor categoriesFor: #writeObject:onStream:!public! !

!KKClassDescriptor class methodsFor!

findClassForName: aClassName

 Object allSubclassesDoGently: [:class |
  ((class respondsTo: #goodsClassName) and: [class goodsClassName =
aClassName])
   ifTrue: [^ class]].

 ^ Smalltalk
  at: (aClassName findTokens: '.') last asSymbol
  ifAbsent: [self error: 'Could not find class for ', aClassName].!

forClassNamed: aClassName
 |class|
 class := self findClassForName: aClassName.
 ^ class goodsDescriptorClass new class: class; className: aClassName! !
!KKClassDescriptor class categoriesFor: #findClassForName:!public! !
!KKClassDescriptor class categoriesFor: #forClassNamed:!public! !

KKClassRecord guid: (GUID fromString:
'{BBF1E456-5733-4530-A5BC-95EBB3E97753}')!
KKClassRecord comment: ''!
!KKClassRecord categoriesForClass!Kernel-Objects! !
!KKClassRecord methodsFor!

calculateNameOffsets
 |base i|
 base := fields size * 16.
 i := name size + 1.
 fields do:
  [:each |
  each nameOffset: base + i.
  i := i + each name size + 1].
 nameSize := i.
 !

descriptor
 |descr|
 descr := KKClassDescriptor forClassNamed: name.
 fields do: [:each | descr addField: each descriptor].
 ^ descr!

fixIndices
 |indicesSeen|
 indicesSeen := Set new.
 fields do:
  [:each | |index|
  index := each nextIndex.
  ((indicesSeen includes: index) or: [index >= fields size])
   ifTrue: [each nextIndex: 0].
  indicesSeen add: index].!

initializeFromDescriptor: aDescriptor
 fields := aDescriptor fields collectWithIndex:
  [:each :i | (KKFieldRecord fromDescriptor: each atIndex: i - 1)].

 fixedSize := aDescriptor fixedSize.
 varyingSize := aDescriptor varyingSize.
 fixedRefs := aDescriptor fixedRefs.
 varyingRefs := aDescriptor varyingRefs.
 name := aDescriptor className.

 self fixIndices.
 self calculateNameOffsets.!

initializeFromStream: aStream
 | fieldCount |
 fixedSize := aStream uint32.
 varyingSize := aStream uint32.
 fixedRefs := aStream uint32.
 varyingRefs := aStream uint32.

 fieldCount := aStream uint32.
 nameSize :=  aStream uint32.

 fields := Array new: fieldCount.
 1 to: fieldCount do: [:i |
  fields at: i put: (KKFieldRecord fromStream: aStream atIndex: i - 1)].

 name := (aStream upTo: 0) asString.
 fields do: [:field | field name: (aStream upTo: 0) asString].!

writeOn: aStream
 aStream uint32: fixedSize.
 aStream uint32: varyingSize.
 aStream uint32: fixedRefs.
 aStream uint32: varyingRefs.

 aStream uint32: fields size.
 aStream uint32: nameSize.
 fields do: [:each | each writeOn: aStream].
 aStream nextPutAll: name asByteArray; nextPut: 0.
 fields do: [:each | aStream nextPutAll: each name asByteArray; nextPut:
0].! !
!KKClassRecord categoriesFor: #calculateNameOffsets!public! !
!KKClassRecord categoriesFor: #descriptor!public! !
!KKClassRecord categoriesFor: #fixIndices!public! !
!KKClassRecord categoriesFor: #initializeFromDescriptor:!public! !
!KKClassRecord categoriesFor: #initializeFromStream:!public! !
!KKClassRecord categoriesFor: #writeOn:!public! !

!KKClassRecord class methodsFor!

fromDescriptor: aDescriptor
 ^ self new initializeFromDescriptor: aDescriptor!

fromStream: aStream
 ^ self new initializeFromStream: aStream! !
!KKClassRecord class categoriesFor: #fromDescriptor:!public! !
!KKClassRecord class categoriesFor: #fromStream:!public! !

KKConnection guid: (GUID fromString:
'{82CF4E80-5F99-4320-8475-8F3B05148A06}')!
KKConnection comment: ''!
!KKConnection categoriesForClass!Kernel-Objects! !
!KKConnection methodsFor!

allocateObjectOfClass: aCPID size: aSize
 self sendCommand: 23
  withShort: aCPID
  withLong: aSize.
 ^ self receiveLocation!

bye
 socket closeAndDestroy.
 self notify: 'GOODS server disconnected'.
 !

classAt: anID
 self sendCommand: 5 withShort: anID.
 ^ self receiveClassDescriptor!

commitRecords: objectRecords
 |stream buffer|
 objectRecords isEmpty ifTrue: [^ true].
 stream := WriteStream on: (ByteArray new: 500).
 objectRecords do: [:each | each writeOn: stream].
 buffer := stream contents.

 self sendCommand: 13
  withShort: 1
  withLong: buffer size.
 socket sendByteArray: buffer.

 ^ self receiveTransactionResult!

forgetObjects: aCollection
 self forgetOrThrowObjects: aCollection withCommand: 2!

forgetOrThrowObjects: aCollection withCommand: aCommand
 aCollection isEmpty ifTrue: [^ self].

 self sendCommand: aCommand
  withLong: aCollection first
  withLong: aCollection size - 1.

 aCollection allButFirst do:
  [:oid |
  self sendCommand: aCommand
   withLong: oid]!

freeObject: oid
 self sendCommand: 25 withLong: oid!

headerByte
 ^ headerBuf at: 2 !

headerCommand
 ^ headerBuf at: 1!

headerLong
 ^ headerBuf longAt: 5 bigEndian: true!

headerLong2
 ^ headerBuf longAt: 9 bigEndian: true!

headerShort
 ^ headerBuf shortAt: 3 bigEndian: true!

initializeWithSocket: aSocket
 headerBuf := ByteArray new: 16.
 socket := aSocket.
!

invalids
 socket hasInput ifTrue:
  [self receiveIntoHeaderBuffer.
  self headerCommand = 4 ifFalse: [self error: 'Expecting invalidate'].
  self receiveInvalids].

 ^ invalids ifNotNil: [:result | invalids := nil. result]
!

isConnected
 ^ socket isOpen!

lockObject: anID shared: sharedFlag wait: waitFlag
 self sendCommand: 10
  withByte: (sharedFlag ifTrue: [1] ifFalse: [2])
  withShort: (waitFlag ifTrue: [0] ifFalse: [1])
  withLong: anID
  withLong: 0.

 ^ self receiveLockResult!

loginWithName: aName
 self sendCommand: 17
  withLong: aName size.
 socket sendByteArray: aName.

 ^ self receiveOkOrRefused!

logout
 self sendCommand: 18.
 [self receiveHeader] on: Notification do: [^ true]!

objectsAt: oid copy: copyFlag cluster: clusterFlag
 self sendCommand: 0
  withShort: (copyFlag ifTrue: [1] ifFalse: [0]) + (clusterFlag ifTrue: [2]
ifFalse: [0])
  withLong: oid.

 ^ self receiveObjects!

putClass: aClassDescriptor
 |stream buffer|
 stream := WriteStream on: (ByteArray new: 100).
 (KKClassRecord fromDescriptor: aClassDescriptor) writeOn: stream.
 buffer := stream contents.

 self sendCommand: 7 withLong: buffer size.
 socket sendByteArray: buffer.

 ^ self receiveClassID!

receiveClassDescriptor
 |buffer|
 self receiveHeader.
 self headerCommand = 6 ifFalse: [self error: 'Expected class descriptor'].
 buffer := ByteArray new: self headerLong.
 self receiveFullyInto: buffer.
 ^ (KKClassRecord fromStream: (ReadStream on: buffer)) descriptor.!

receiveClassID
 self receiveHeader.
 self headerCommand = 8 ifFalse: [self error: 'Expected class id'].
 ^ self headerShort!

receiveFullyInto: aBuffer
 |i size received |

 i := 1.
 size := aBuffer size.

 received := socket receiveByteArray: size.

 aBuffer replaceFrom: 1 to: size with: received startingAt: 1.

" [i > size] whileFalse: [i := i + (socket receiveDataInto: aBuffer
startingAt: i)]."!

receiveHeader
 self receiveIntoHeaderBuffer.
 self headerCommand = 4 ifTrue:
  [self receiveInvalids.
   self receiveHeader]!

receiveIntoHeaderBuffer
 self receiveFullyInto: headerBuf.
 self headerCommand = 20 ifTrue: [self bye].
!

receiveInvalids
 invalids ifNil: [invalids _ Set new].
 invalids add: self headerLong.
 self headerLong2 timesRepeat: [
  self receiveFullyInto: headerBuf.
  invalids add: self headerLong]
!

receiveLocation
 self receiveHeader.
 self headerCommand = 24 ifFalse: [self error: 'Expecting object location'].
 ^ self headerLong!

receiveLockResult
 self receiveHeader.
 self headerCommand = 11 ifFalse: [self error: 'Expecting lock result'].
 ^ self headerByte = 1!

receiveObjects
 |buffer|
 self receiveHeader.
 self headerCommand = 1 ifFalse: [self error: 'Expecting object packet'].
 buffer := ByteArray new: self headerLong.
 self receiveFullyInto: buffer.
 ^ self receiveObjectsFromStream: (ReadStream on: buffer).
!

receiveObjectsFromStream: aStream
 |records|
 records := OrderedCollection new.
 [aStream atEnd] whileFalse:
  [records add: (KKObjectRecord fromStream: aStream)].
 ^ records!

receiveOkOrRefused

 self receiveHeader.

 self headerCommand = 21 ifTrue:[^true].
 self headerCommand = 22 ifTrue:[^false].

 self error: 'Expected ok or refuse'.!

receiveTransactionResult
 self receiveHeader.
 self headerCommand = 15 ifFalse: [self error: 'Expecting transaction
result'].
 ^ self headerByte = 1!

sendCommand: aCommand
 self sendCommand: aCommand
  withByte: 0
  withShort: 0
  withLong: 0
  withLong: 0!

sendCommand: aCommand withByte: aByte withShort: aShort withLong: aLong
withLong: anotherLong
 headerBuf at: 1 put: aCommand.
 headerBuf at: 2 put: aByte.
 headerBuf shortAt: 3 put: aShort bigEndian: true.
 headerBuf longAt: 5 put: aLong bigEndian: true.
 headerBuf longAt: 9 put: anotherLong bigEndian: true.
 socket sendByteArray: headerBuf.!

sendCommand: aByte withLong: aLong
 self sendCommand: aByte
   withByte: 0
   withShort: 0
   withLong: aLong
   withLong: 0!

sendCommand: aByte withLong: aLong withLong: anotherLong
 self sendCommand: aByte
   withByte: 0
   withShort: 0
   withLong: aLong
   withLong: anotherLong!

sendCommand: aByte withShort: aShort
 self sendCommand: aByte
   withByte: 0
   withShort: aShort
   withLong: 0
   withLong: 0!

sendCommand: aByte withShort: aShort withLong: aLong
 self sendCommand: aByte
   withByte: 0
   withShort: aShort
   withLong: aLong
   withLong: 0!

throwObjects: aCollection
 self forgetOrThrowObjects: aCollection withCommand: 3!

unlockObject: anID completely: aBoolean
 self sendCommand: 12
  withByte: (aBoolean ifTrue: [0] ifFalse: [1])
  withShort: 0
  withLong: anID
  withLong: 0! !
!KKConnection categoriesFor: #allocateObjectOfClass:size:!public! !
!KKConnection categoriesFor: #bye!public! !
!KKConnection categoriesFor: #classAt:!public! !
!KKConnection categoriesFor: #commitRecords:!public! !
!KKConnection categoriesFor: #forgetObjects:!public! !
!KKConnection categoriesFor: #forgetOrThrowObjects:withCommand:!public! !
!KKConnection categoriesFor: #freeObject:!public! !
!KKConnection categoriesFor: #headerByte!public! !
!KKConnection categoriesFor: #headerCommand!public! !
!KKConnection categoriesFor: #headerLong!public! !
!KKConnection categoriesFor: #headerLong2!public! !
!KKConnection categoriesFor: #headerShort!public! !
!KKConnection categoriesFor: #initializeWithSocket:!public! !
!KKConnection categoriesFor: #invalids!public! !
!KKConnection categoriesFor: #isConnected!public! !
!KKConnection categoriesFor: #lockObject:shared:wait:!public! !
!KKConnection categoriesFor: #loginWithName:!public! !
!KKConnection categoriesFor: #logout!public! !
!KKConnection categoriesFor: #objectsAt:copy:cluster:!public! !
!KKConnection categoriesFor: #putClass:!public! !
!KKConnection categoriesFor: #receiveClassDescriptor!public! !
!KKConnection categoriesFor: #receiveClassID!public! !
!KKConnection categoriesFor: #receiveFullyInto:!public! !
!KKConnection categoriesFor: #receiveHeader!public! !
!KKConnection categoriesFor: #receiveIntoHeaderBuffer!public! !
!KKConnection categoriesFor: #receiveInvalids!public! !
!KKConnection categoriesFor: #receiveLocation!public! !
!KKConnection categoriesFor: #receiveLockResult!public! !
!KKConnection categoriesFor: #receiveObjects!public! !
!KKConnection categoriesFor: #receiveObjectsFromStream:!public! !
!KKConnection categoriesFor: #receiveOkOrRefused!public! !
!KKConnection categoriesFor: #receiveTransactionResult!public! !
!KKConnection categoriesFor: #sendCommand:!public! !
!KKConnection categoriesFor:
#sendCommand:withByte:withShort:withLong:withLong:!public! !
!KKConnection categoriesFor: #sendCommand:withLong:!public! !
!KKConnection categoriesFor: #sendCommand:withLong:withLong:!public! !
!KKConnection categoriesFor: #sendCommand:withShort:!public! !
!KKConnection categoriesFor: #sendCommand:withShort:withLong:!public! !
!KKConnection categoriesFor: #throwObjects:!public! !
!KKConnection categoriesFor: #unlockObject:completely:!public! !

!KKConnection class methodsFor!

defaultLogin
 ^ 'dolphin', (Time millisecondClockValue hex allButFirst: 3)!

hostname: hostname port: portNumber
 | socket |
" Socket initializeNetwork."
 socket := (Socket port: portNumber host: hostname) connect.
 (Delay forMilliseconds: 10) wait.
 ^ (self socket: socket) loginWithName: self defaultLogin; yourself!

socket: aSocket
 ^ self basicNew initializeWithSocket: aSocket! !
!KKConnection class categoriesFor: #defaultLogin!public! !
!KKConnection class categoriesFor: #hostname:port:!public! !
!KKConnection class categoriesFor: #socket:!public! !

KKDatabase guid: (GUID fromString:
'{31791031-75DB-45CB-A0D6-824C5B2A918F}')!
KKDatabase comment: ''!
!KKDatabase categoriesForClass!Kernel-Objects! !
!KKDatabase methodsFor!

at: key
 ^ self withReadHandler: [keyCache at: key]!

cacheSize
 ^ keyCache size!

commit
 ^ self commitOnFailure: [KKCommitFailure signal]!

commitOnFailure: aBlock
 ^ (self withWriteHandler: [keyCache commit])
  ifTrue: [self refresh]
  ifFalse: [ aBlock value ]!

commitWithRetry: aBlock
 aBlock value.
 self commitOnFailure: [self rollback. self commitWithRetry: aBlock]!

downgradeLock: anObject
 connection unlockObject: (self keyForObject: anObject) completely: false!

flush
 keyCache flushWithFullGC: false!

flushAll
 keyCache flushWithFullGC: true!

initializeWithConnection: aConnection
 connection := aConnection.
 keyCache := KKKeyCache connection: aConnection.!

keyForObject: anObject
 ^ anObject class == KKObjectProxy
  ifTrue: [anObject xxxKey]
  ifFalse: [keyCache keyForObject: anObject]!

logout
 connection logout.!

objectForKey: key
 ^ keyCache at: key ifAbsent: [KKObjectProxy database: self key: key]!

readLock: anObject
 connection lockObject: (self keyForObject: anObject) shared: true wait:
true!

readLock: anObject do: aBlock
 self readLock: anObject.
 ^ aBlock ensure: [self unlock: anObject]!

refresh
 self withReadHandler: [keyCache refresh]!

rollback
 self withReadHandler: [keyCache rollback].
 self refresh.!

root
 ^ self withReadHandler: [keyCache root]!

root: anObject
 self root.
 ^ self withWriteHandler: [keyCache root: anObject]!

tryReadLock: anObject
 ^ connection lockObject: (self keyForObject: anObject) shared: true wait:
false!

tryWriteLock: anObject
 ^ connection lockObject: (self keyForObject: anObject) shared: false wait:
false!

unlock: anObject
 connection unlockObject: (self keyForObject: anObject) completely: true!

withReadHandler: aBlock
 ^ aBlock
  on: KKRequestObject
  do: [:n | n resume: (self objectForKey: n key)]!

withWriteHandler: aBlock
 ^ aBlock
  on: KKRequestKey
  do: [:n | n resume: (self keyForObject: n object)]!

writeLock: anObject
 connection lockObject: (self keyForObject: anObject) shared: false wait:
true!

writeLock: anObject do: aBlock
 self writeLock: anObject.
 ^ aBlock ensure: [self unlock: anObject]! !
!KKDatabase categoriesFor: #at:!public! !
!KKDatabase categoriesFor: #cacheSize!public! !
!KKDatabase categoriesFor: #commit!public! !
!KKDatabase categoriesFor: #commitOnFailure:!public! !
!KKDatabase categoriesFor: #commitWithRetry:!public! !
!KKDatabase categoriesFor: #downgradeLock:!public! !
!KKDatabase categoriesFor: #flush!public! !
!KKDatabase categoriesFor: #flushAll!public! !
!KKDatabase categoriesFor: #initializeWithConnection:!public! !
!KKDatabase categoriesFor: #keyForObject:!public! !
!KKDatabase categoriesFor: #logout!public! !
!KKDatabase categoriesFor: #objectForKey:!public! !
!KKDatabase categoriesFor: #readLock:!public! !
!KKDatabase categoriesFor: #readLock:do:!public! !
!KKDatabase categoriesFor: #refresh!public! !
!KKDatabase categoriesFor: #rollback!public! !
!KKDatabase categoriesFor: #root!public! !
!KKDatabase categoriesFor: #root:!public! !
!KKDatabase categoriesFor: #tryReadLock:!public! !
!KKDatabase categoriesFor: #tryWriteLock:!public! !
!KKDatabase categoriesFor: #unlock:!public! !
!KKDatabase categoriesFor: #withReadHandler:!public! !
!KKDatabase categoriesFor: #withWriteHandler:!public! !
!KKDatabase categoriesFor: #writeLock:!public! !
!KKDatabase categoriesFor: #writeLock:do:!public! !

!KKDatabase class methodsFor!

connection: aConnection
 ^ self basicNew initializeWithConnection: aConnection!

onHost: hostname port: aNumber
 ^ self connection: (KKConnection hostname: hostname port: aNumber)! !
!KKDatabase class categoriesFor: #connection:!public! !
!KKDatabase class categoriesFor: #onHost:port:!public! !

KKFieldContainer guid: (GUID fromString:
'{87C5B1A2-8CDB-45F0-B426-2124282C6205}')!
KKFieldContainer comment: ''!
!KKFieldContainer categoriesForClass!Kernel-Objects! !
!KKFieldContainer methodsFor!

= other
 ^ (((name = other name
  and: [self fieldSize = other fieldSize])
  and: [self components = other components])
  and: [self type = other type])!

components
 self subclassResponsiblity !

fieldInObject: anObject
 |i|
 i := anObject class allInstVarNames indexOf: name.
 ^ i > 0 ifTrue: [anObject instVarAt: i]!

fieldSize
 ^ fieldType size!

fieldType
 ^fieldType!

fieldType: anObject
 fieldType := anObject!

hash
 ^ name hash + self fieldSize + self components + self type!

isReference
 ^ fieldType isReference!

isVariable
 ^ false!

name
 ^name!

name: anObject
 name := anObject!

offsetToNextField
 ^ 1!

parent: aClassDescriptor
 parent := aClassDescriptor!

refreshObject: anObject fromStream: aStream
 self subclassResponsiblity !

storeField: aField inObject: anObject
 |i|
 i := anObject class allInstVarNames indexOf: name.
 i > 0 ifTrue: [anObject instVarAt: i put: aField]!

totalSize
 self subclassResponsibility!

type
 ^ fieldType type!

writeObject: anObject onStream: aStream
 self subclassResponsiblity ! !
!KKFieldContainer categoriesFor: #=!public! !
!KKFieldContainer categoriesFor: #components!public! !
!KKFieldContainer categoriesFor: #fieldInObject:!public! !
!KKFieldContainer categoriesFor: #fieldSize!public! !
!KKFieldContainer categoriesFor: #fieldType!accessing!private! !
!KKFieldContainer categoriesFor: #fieldType:!accessing!private! !
!KKFieldContainer categoriesFor: #hash!public! !
!KKFieldContainer categoriesFor: #isReference!public! !
!KKFieldContainer categoriesFor: #isVariable!public! !
!KKFieldContainer categoriesFor: #name!accessing!private! !
!KKFieldContainer categoriesFor: #name:!accessing!private! !
!KKFieldContainer categoriesFor: #offsetToNextField!public! !
!KKFieldContainer categoriesFor: #parent:!public! !
!KKFieldContainer categoriesFor: #refreshObject:fromStream:!public! !
!KKFieldContainer categoriesFor: #storeField:inObject:!public! !
!KKFieldContainer categoriesFor: #totalSize!public! !
!KKFieldContainer categoriesFor: #type!public! !
!KKFieldContainer categoriesFor: #writeObject:onStream:!public! !

!KKFieldContainer class methodsFor!

booleanField
 ^ self new fieldType: KKBooleanField new!

byteField
 ^ self new fieldType: (KKSignedIntegerField new size: 1)!

charField
 ^ self new fieldType: (KKUnsignedIntegerField new size: 2)!

doubleField
 ^ self new fieldType: KKDoubleField new!

floatField
 ^ self new fieldType: KKFloatField new!

intField
 ^ self new fieldType: (KKSignedIntegerField new size: 4)!

longField
 ^ self new fieldType: (KKSignedIntegerField new size: 8)!

referenceField
 ^ self new fieldType: KKReferenceField new!

shortField
 ^ self new fieldType: (KKSignedIntegerField new size: 2)! !
!KKFieldContainer class categoriesFor: #booleanField!public! !
!KKFieldContainer class categoriesFor: #byteField!public! !
!KKFieldContainer class categoriesFor: #charField!public! !
!KKFieldContainer class categoriesFor: #doubleField!public! !
!KKFieldContainer class categoriesFor: #floatField!public! !
!KKFieldContainer class categoriesFor: #intField!public! !
!KKFieldContainer class categoriesFor: #longField!public! !
!KKFieldContainer class categoriesFor: #referenceField!public! !
!KKFieldContainer class categoriesFor: #shortField!public! !

KKFieldRecord guid: (GUID fromString:
'{01368048-40BA-4A87-B9DA-886A8514C23D}')!
KKFieldRecord comment: ''!
!KKFieldRecord categoriesForClass!Kernel-Objects! !
!KKFieldRecord methodsFor!

descriptor
 |fieldType container desconocido |

 type = 0 ifTrue:[^ KKStructureContainer new
       name: name;
       fieldCount: (nextIndex - index) - 1;
       fieldSize: size].
 type = 1 ifTrue:[fieldType := KKReferenceField new].
 type = 2 ifTrue:[fieldType := KKSignedIntegerField new size: size].
 type = 3 ifTrue:[fieldType := size = 1
       ifTrue: [KKBooleanField new]
       ifFalse: [KKUnsignedIntegerField new size: size]].
 type = 4 ifTrue:[ (fieldType := size) = 4
     ifTrue: [KKFloatField new]
     ifFalse: [KKDoubleField new]].
 type = 5 ifTrue:[fieldType := KKStringField new].
 desconocido := false.
 (Interval from:0 to:5) do:[:e| desconocido := desconocido or:[ e =
type ] ].
 desconocido ifFalse: [self error: 'unknown field type'].

 components = 0 ifTrue:[ container := KKVariableFieldContainer new].
 components = 1 ifTrue:[ container := KKSingleFieldContainer new].
 desconocido := false.
 (Interval from:0 to:1) do:[:e| desconocido := desconocido or:[ e =
components ] ].
 desconocido ifFalse: [container  := KKFixedArrayContainer new arraySize:
components].

 container
  name: name;
  fieldType: fieldType.
 ^ container !

initializeFromDescriptor: aDescriptor atIndex: anIndex
 type := aDescriptor type.
 size := aDescriptor fieldSize.
 components := aDescriptor components.
 name := aDescriptor name.
 index := anIndex.
 nextIndex := anIndex + aDescriptor offsetToNextField !

initializeFromStream: aStream atIndex: anIndex
 type := aStream uint16.
 nameOffset := aStream uint16.
 size := aStream uint32.
 components := aStream uint32.
 nextIndex := aStream uint32.
 index := anIndex.!

name
 ^name!

name: anObject
 name := anObject!

nameOffset: aNumber
 nameOffset := aNumber!

nextIndex
 ^ nextIndex!

nextIndex: anIndex
 nextIndex := anIndex!

writeOn: aStream
 aStream
  uint16: type;
  uint16: nameOffset;
  uint32: size;
  uint32: components;
  uint32: nextIndex.
! !
!KKFieldRecord categoriesFor: #descriptor!public! !
!KKFieldRecord categoriesFor: #initializeFromDescriptor:atIndex:!public! !
!KKFieldRecord categoriesFor: #initializeFromStream:atIndex:!public! !
!KKFieldRecord categoriesFor: #name!accessing!private! !
!KKFieldRecord categoriesFor: #name:!accessing!private! !
!KKFieldRecord categoriesFor: #nameOffset:!public! !
!KKFieldRecord categoriesFor: #nextIndex!public! !
!KKFieldRecord categoriesFor: #nextIndex:!public! !
!KKFieldRecord categoriesFor: #writeOn:!public! !

!KKFieldRecord class methodsFor!

fromDescriptor: aDescriptor atIndex: anIndex
 ^ self new initializeFromDescriptor: aDescriptor atIndex: anIndex!

fromStream: aStream atIndex: anIndex
 ^ self new initializeFromStream: aStream atIndex: anIndex! !
!KKFieldRecord class categoriesFor: #fromDescriptor:atIndex:!public! !
!KKFieldRecord class categoriesFor: #fromStream:atIndex:!public! !

KKFieldType guid: (GUID fromString:
'{556F9086-ACEC-4A57-B760-E6A8D674EE91}')!
KKFieldType comment: ''!
!KKFieldType categoriesForClass!Kernel-Objects! !
!KKFieldType methodsFor!

fieldFromStream: aStream
 self subclassResponsiblity !

isReference
 ^ false!

offsetToNextField
 ^ 1!

type
 self subclassResponsiblity !

writeField: aField onStream: aStream
 self subclassResponsibility! !
!KKFieldType categoriesFor: #fieldFromStream:!public! !
!KKFieldType categoriesFor: #isReference!public! !
!KKFieldType categoriesFor: #offsetToNextField!public! !
!KKFieldType categoriesFor: #type!public! !
!KKFieldType categoriesFor: #writeField:onStream:!public! !

KKObjectRecord guid: (GUID fromString:
'{2539B151-3C6E-4800-B079-3396A4C11DB0}')!
KKObjectRecord comment: ''!
!KKObjectRecord categoriesForClass!Kernel-Objects! !
!KKObjectRecord methodsFor!

= other
 ^ (other key = oid)
  and: [other classKey = cpid
  and: [other data = data]]!

classKey
 ^ cpid!

data
 ^ data!

initializeFromStream: aStream
 |size|
 txnFlags := aStream uint32.
 oid := aStream uint32.
 cpid := aStream uint16.
 storage := aStream uint16.
 size := aStream uint32.

 data := aStream next: size!

initializeWithKey: aKey classKey: aClassKey data: aByteArray txnFlags:
aNumber
 oid := aKey.
 cpid := aClassKey.
 data := aByteArray.
 txnFlags := aNumber.
 storage := 0.
!

key
 ^ oid!

writeOn: aStream
 aStream uint32: txnFlags.
 aStream uint32: oid.
 aStream uint16: cpid.
 aStream uint16: storage.
 aStream uint32: data size.
 aStream nextPutAll: data.! !
!KKObjectRecord categoriesFor: #=!public! !
!KKObjectRecord categoriesFor: #classKey!public! !
!KKObjectRecord categoriesFor: #data!public! !
!KKObjectRecord categoriesFor: #initializeFromStream:!public! !
!KKObjectRecord categoriesFor:
#initializeWithKey:classKey:data:txnFlags:!public! !
!KKObjectRecord categoriesFor: #key!public! !
!KKObjectRecord categoriesFor: #writeOn:!public! !

!KKObjectRecord class methodsFor!

fromStream: aStream
 ^ self new initializeFromStream: aStream!

updateObjectAt: aKey classKey: aClassKey data: aByteArray unlock: aBoolean
 |flags|
 flags := aBoolean ifTrue: [7] ifFalse: [3].
 ^ self new initializeWithKey: aKey classKey: aClassKey data: aByteArray
txnFlags: flags!

validateObjectAt: aKey classKey: aClassKey unlock: aBoolean
 |flags|
 flags _ aBoolean ifTrue: [6] ifFalse: [2].
 ^ self new initializeWithKey: aKey classKey: aClassKey data: #() txnFlags:
flags! !
!KKObjectRecord class categoriesFor: #fromStream:!public! !
!KKObjectRecord class categoriesFor:
#updateObjectAt:classKey:data:unlock:!public! !
!KKObjectRecord class categoriesFor:
#validateObjectAt:classKey:unlock:!public! !

KKCommitFailure guid: (GUID fromString:
'{41C955CE-1524-44B7-9C10-50A2521D1561}')!
KKCommitFailure comment: ''!
!KKCommitFailure categoriesForClass!Kernel-Exception Handling! !
KKRequestKey guid: (GUID fromString:
'{7338E150-8297-493F-A3F5-73AC246069C2}')!
KKRequestKey comment: ''!
!KKRequestKey categoriesForClass!Kernel-Exception Handling! !
!KKRequestKey methodsFor!

defaultAction
 self error: 'No write handler'!

object
 ^object!

object: anObject
 object := anObject! !
!KKRequestKey categoriesFor: #defaultAction!public! !
!KKRequestKey categoriesFor: #object!accessing!private! !
!KKRequestKey categoriesFor: #object:!accessing!private! !

KKRequestObject guid: (GUID fromString:
'{E9E316A9-143B-482F-B28A-680880352C1C}')!
KKRequestObject comment: ''!
!KKRequestObject categoriesForClass!Kernel-Exception Handling! !
!KKRequestObject methodsFor!

defaultAction
 self error: 'No read handler'!

key
 ^key!

key: anObject
 key := anObject! !
!KKRequestObject categoriesFor: #defaultAction!public! !
!KKRequestObject categoriesFor: #key!accessing!private! !
!KKRequestObject categoriesFor: #key:!accessing!private! !

KKClassCache guid: (GUID fromString:
'{00891827-23B9-4BCD-A114-205B622936EF}')!
KKClassCache comment: ''!
!KKClassCache categoriesForClass!Kernel-Objects! !
!KKClassCache methodsFor!

at: aKey
 ^ cache at: aKey ifAbsent: [self loadDescriptorAt: aKey]!

at: aKey put: aClassDescriptor
 cache at: aKey put: aClassDescriptor.
 keys at: aClassDescriptor put: aKey.
 ^ aClassDescriptor!

cacheClassesDuring: aBlock
 classes := Dictionary new.
 ^ aBlock ensure: [classes := nil]!

classForObject: anObject
 ^ classes isNil
  ifTrue: [self findClassForObject: anObject]
  ifFalse: [classes at: anObject class ifAbsentPut: [self
findClassForObject: anObject]]!

findClassForObject: anObject

 |descr storedDescr |

 descr := anObject class goodsDescriptor.
 storedDescr := (keys like: descr) ifNotNil: [:assoc | assoc key].
 ^ storedDescr ifNil: [self storeDescriptor: descr]!

initialize
 cache := Dictionary new.
 keys := Dictionary new!

loadDescriptorAt: aKey
 |descr|
 descr := connection classAt: aKey.
 descr id: aKey.
 self at: aKey put: descr.
 ^ descr!

storeDescriptor: aClassDescriptor
 | id |
 id := connection putClass: aClassDescriptor.
 aClassDescriptor id: id.
 self at: id put: aClassDescriptor.
 ^ aClassDescriptor! !
!KKClassCache categoriesFor: #at:!public! !
!KKClassCache categoriesFor: #at:put:!public! !
!KKClassCache categoriesFor: #cacheClassesDuring:!public! !
!KKClassCache categoriesFor: #classForObject:!public! !
!KKClassCache categoriesFor: #findClassForObject:!public! !
!KKClassCache categoriesFor: #initialize!public! !
!KKClassCache categoriesFor: #loadDescriptorAt:!public! !
!KKClassCache categoriesFor: #storeDescriptor:!public! !

KKKeyCache guid: (GUID fromString:
'{6392C94E-0D67-4EF4-AF79-D20FC6E86573}')!
KKKeyCache comment: ''!
!KKKeyCache categoriesForClass!Kernel-Objects! !
!KKKeyCache methodsFor!

at: key
 ^ self at: key ifAbsent: [self loadObjectAt: key]!

at: key ifAbsent: aBlock
 ^ cache at: key ifAbsent: aBlock!

at: key put: anObject
 cache at: key put: anObject.
 keys at: anObject put: key.!

commit
 ^ recordCache commit!

flushWithFullGC: aBoolean
 | finalized |
 cache := Dictionary new.
 aBoolean
  ifTrue: [Smalltalk garbageCollect]
  ifFalse: [Smalltalk garbageCollectMost].
 finalized := OrderedCollection new.
 keys keysAndValuesDo:
  [:object :key |
  object isNil
   ifTrue: [finalized add: key]
   ifFalse: [cache at: key put: object]].
 keys finalizeValues.
 connection forgetObjects: finalized.!

initialize

 recordCache := KKRecordCache connection: connection.
 cache := Dictionary new.
 keys := WeakIdentityDictionary new.


"Originalmente

 recordCache := KKRecordCache connection: connection.
 cache := Dictionary new.
 keys := WeakIdentityKeyDictionary new."!

keyForObject: anObject
 | key |
 ^ keys
  at: anObject
  ifAbsent:
   [key _ recordCache allocateObject: anObject.
   self at: key put: anObject.
   key]!

loadObjectAt: key
 ^ recordCache
  loadObjectsStartingAt: key
  do: [:k :object | self refreshObjectAt: k from: object]
  ifAbsent: [nil]!

refresh
 connection invalids ifNotNil:
  [:invalids |
  invalids do: [:key | self loadObjectAt: key]] !

refreshObjectAt: key from: anObject
 (cache includesKey: key)
  ifFalse: [self at: key put: anObject]
  ifTrue: [(cache at: key) copyFrom: anObject; goodsUpdate]!

rollback
 recordCache rollback!

root
 ^ self at: self rootKey!

root: anObject
 self at: self rootKey put: anObject.
 recordCache addObject: anObject.
!

rootKey
 ^ 16r10000!

size
 ^ cache size! !
!KKKeyCache categoriesFor: #at:!public! !
!KKKeyCache categoriesFor: #at:ifAbsent:!public! !
!KKKeyCache categoriesFor: #at:put:!public! !
!KKKeyCache categoriesFor: #commit!public! !
!KKKeyCache categoriesFor: #flushWithFullGC:!public! !
!KKKeyCache categoriesFor: #initialize!public! !
!KKKeyCache categoriesFor: #keyForObject:!public! !
!KKKeyCache categoriesFor: #loadObjectAt:!public! !
!KKKeyCache categoriesFor: #refresh!public! !
!KKKeyCache categoriesFor: #refreshObjectAt:from:!public! !
!KKKeyCache categoriesFor: #rollback!public! !
!KKKeyCache categoriesFor: #root!public! !
!KKKeyCache categoriesFor: #root:!public! !
!KKKeyCache categoriesFor: #rootKey!public! !
!KKKeyCache categoriesFor: #size!public! !

KKRecordCache guid: (GUID fromString:
'{6851011D-1790-45D9-9C2D-DF2681062285}')!
KKRecordCache comment: ''!
!KKRecordCache categoriesForClass!Kernel-Objects! !
!KKRecordCache methodsFor!

addDirtyObjectsToRecords: aDictionary
 | newRec |
 self objectsAndRecordsDo:
  [:object :oldRec |
  newRec := self updateRecordForObject: object.
  newRec = oldRec ifFalse: [aDictionary at: object put: newRec]].
!

addNewObjectsToRecords: aDictionary
 | new |
 new := newObjects.
 newObjects := IdentitySet new.
 new do: [:ea | aDictionary at: ea put: (self updateRecordForObject: ea)]!

addObject: anObject
 newObjects add: anObject!

allocateObject: anObject
 | descriptor |
 self addObject: anObject.
 descriptor := classCache classForObject: anObject.
 ^ connection allocateObjectOfClass: descriptor id size: descriptor
estimatedSize!

commit
 | dirtyRecords |

 classCache cacheClassesDuring:
  [dirtyRecords := IdentityDictionary new.
  self addDirtyObjectsToRecords: dirtyRecords.
  [newObjects isEmpty] whileFalse:
   [self addNewObjectsToRecords: dirtyRecords].
  (connection commitRecords: dirtyRecords)
   ifTrue: [self updateCacheFromRecords: dirtyRecords. ^ true]
   ifFalse: [^ false]]!

initialize
 classCache := KKClassCache connection: connection.
 objectRecords := WeakIdentityDictionary new.
 WeakArray addDependent: objectRecords.
 newObjects := IdentitySet new.!

keyForObject: anObject
 ^ (KKRequestKey new object: anObject) signal!

loadObjectRecord: aRecord
 ^ (classCache at: aRecord classKey)
  objectFromStream: (ReadStream on: aRecord data)!

loadObjectsStartingAt: aKey do: keyAndValueBlock ifAbsent: aBlock
 |records obj|
 records := connection objectsAt: aKey copy: false cluster: true.
 records first classKey < 2 ifTrue: [^ aBlock value].

 records reverseDo:
  [:record |
  obj := self loadObjectRecord: record.
  objectRecords at: obj put: record.
  keyAndValueBlock value: record key value: obj].
 ^ obj!

objectsAndRecordsDo: aBlock
 objectRecords keysAndValuesDo:
  [:object :record |
  object ifNotNil: [:o| aBlock value: o value: record]]!

rollback
 self objectsAndRecordsDo:
  [:object :record |
  object copyFrom: (self loadObjectRecord: record)]!

updateCacheFromRecords: aDictionary
 aDictionary keysAndValuesDo: [:object :rec | objectRecords at: object put:
rec].
!

updateRecordForObject: anObject
 | descriptor stream|
 descriptor := classCache classForObject: anObject.
 stream := descriptor streamForObject: anObject.

 ^ KKObjectRecord
   updateObjectAt: (self keyForObject: anObject)
   classKey: descriptor id
   data: stream contents
   unlock: true! !
!KKRecordCache categoriesFor: #addDirtyObjectsToRecords:!public! !
!KKRecordCache categoriesFor: #addNewObjectsToRecords:!public! !
!KKRecordCache categoriesFor: #addObject:!public! !
!KKRecordCache categoriesFor: #allocateObject:!public! !
!KKRecordCache categoriesFor: #commit!public! !
!KKRecordCache categoriesFor: #initialize!public! !
!KKRecordCache categoriesFor: #keyForObject:!public! !
!KKRecordCache categoriesFor: #loadObjectRecord:!public! !
!KKRecordCache categoriesFor: #loadObjectsStartingAt:do:ifAbsent:!public! !
!KKRecordCache categoriesFor: #objectsAndRecordsDo:!public! !
!KKRecordCache categoriesFor: #rollback!public! !
!KKRecordCache categoriesFor: #updateCacheFromRecords:!public! !
!KKRecordCache categoriesFor: #updateRecordForObject:!public! !

KKVariableClassDescriptor guid: (GUID fromString:
'{DF34C2D5-2E6D-4300-AF8A-70ADC23D2A48}')!
KKVariableClassDescriptor comment: ''!
!KKVariableClassDescriptor categoriesForClass!Kernel-Objects! !
!KKVariableClassDescriptor methodsFor!

newInstanceFromStream: aStream
 ^ self instanceClass basicNew: (aStream contents size - (self fixedSize)) /
self varyingSize.! !
!KKVariableClassDescriptor categoriesFor: #newInstanceFromStream:!public! !

KKFixedArrayContainer guid: (GUID fromString:
'{CDB05897-C512-4896-A3F5-3E44B4061BE3}')!
KKFixedArrayContainer comment: ''!
!KKFixedArrayContainer categoriesForClass!Kernel-Objects! !
!KKFixedArrayContainer methodsFor!

arraySize: aNumber
 arraySize := aNumber!

components
 ^ arraySize!

refreshObject: anObject fromStream: aStream
 |array|
 array := Array new: arraySize.
 1 to: arraySize do:
  [:i | array at: i put:
   (fieldType fieldFromStream: aStream)].
 anObject instVarNamed: name put: array.!

totalSize
 ^ arraySize * fieldType size!

writeObject: anObject onStream: aStream
 |array|
 array := anObject instVarNamed: name.
 1 to: (array size min: arraySize) do:
  [:i | fieldType writeField: (array at: i) onStream: aStream].
 array size < arraySize
  ifTrue: [aStream next: (arraySize - array size) * fieldType size put: 0]
! !
!KKFixedArrayContainer categoriesFor: #arraySize:!public! !
!KKFixedArrayContainer categoriesFor: #components!public! !
!KKFixedArrayContainer categoriesFor: #refreshObject:fromStream:!public! !
!KKFixedArrayContainer categoriesFor: #totalSize!public! !
!KKFixedArrayContainer categoriesFor: #writeObject:onStream:!public! !

KKSingleFieldContainer guid: (GUID fromString:
'{85702AB8-C05C-469C-A900-2532455A8401}')!
KKSingleFieldContainer comment: ''!
!KKSingleFieldContainer categoriesForClass!Kernel-Objects! !
!KKSingleFieldContainer methodsFor!

components
 ^ 1!

refreshObject: anObject fromStream: aStream
 self storeField: (fieldType fieldFromStream: aStream) inObject: anObject!

totalSize
 ^ fieldType size!

writeObject: anObject onStream: aStream
 fieldType writeField: (self fieldInObject: anObject) onStream: aStream
    ! !
!KKSingleFieldContainer categoriesFor: #components!public! !
!KKSingleFieldContainer categoriesFor: #refreshObject:fromStream:!public! !
!KKSingleFieldContainer categoriesFor: #totalSize!public! !
!KKSingleFieldContainer categoriesFor: #writeObject:onStream:!public! !

!KKSingleFieldContainer class methodsFor!

stringField
 ^ self new fieldType: KKStringField new! !
!KKSingleFieldContainer class categoriesFor: #stringField!public! !

KKStructureContainer guid: (GUID fromString:
'{15D18841-2F36-4797-8BCE-315122C773C0}')!
KKStructureContainer comment: ''!
!KKStructureContainer categoriesForClass!Kernel-Objects! !
!KKStructureContainer methodsFor!

calculateSize
 |startIndex|
 startIndex := parent fields identityIndexOf: self.
 ^(parent fields copyFrom: startIndex to: startIndex + fieldCount)
  detectSum: [:each | each totalSize]!

components
 ^ 1!

description
 ^ Array with: (Array with: name with: #structure with: fieldCount)!

fieldCount: aNumber
 fieldCount := aNumber!

fieldSize
 ^ size ifNil: [size := self calculateSize]
  !

fieldSize: aNumber
 size := aNumber!

isReference
 ^ false!

offsetToNextField
 ^ fieldCount + 1!

refreshObject: anObject fromStream: aStream
!

totalSize
 ^ 0!

type
 ^ 0!

writeObject: anObject onStream: aStream
! !
!KKStructureContainer categoriesFor: #calculateSize!public! !
!KKStructureContainer categoriesFor: #components!public! !
!KKStructureContainer categoriesFor: #description!public! !
!KKStructureContainer categoriesFor: #fieldCount:!public! !
!KKStructureContainer categoriesFor: #fieldSize!public! !
!KKStructureContainer categoriesFor: #fieldSize:!public! !
!KKStructureContainer categoriesFor: #isReference!public! !
!KKStructureContainer categoriesFor: #offsetToNextField!public! !
!KKStructureContainer categoriesFor: #refreshObject:fromStream:!public! !
!KKStructureContainer categoriesFor: #totalSize!public! !
!KKStructureContainer categoriesFor: #type!public! !
!KKStructureContainer categoriesFor: #writeObject:onStream:!public! !

KKVariableFieldContainer guid: (GUID fromString:
'{5951D86A-CEA8-4F56-874C-B8134F12B246}')!
KKVariableFieldContainer comment: ''!
!KKVariableFieldContainer categoriesForClass!Kernel-Objects! !
!KKVariableFieldContainer methodsFor!

components
 ^ 0!

isVariable
 ^ true!

refreshObject: anObject fromStream: aStream
 anObject class isVariable
  ifTrue: [self refreshVariablePartOfObject: anObject fromStream: aStream]
  ifFalse: [self refreshVariableArrayInObject: anObject fromStream:
aStream].
!

refreshVariableArrayInObject: anObject fromStream: aStream
 |size array |
 size := ((aStream size - parent fixedSize) / fieldType size).
 array := Array new: size.
 1 to: size do: [:i | array at: i put: (fieldType fieldFromStream:
aStream)].
 self storeField: array inObject: anObject.!

refreshVariablePartOfObject: anObject fromStream: aStream
 1 to: anObject size do:
  [:i | anObject at: i put: (fieldType fieldFromStream: aStream)]!

totalSize
 ^ fieldType size!

writeObject: anObject onStream: aStream
 anObject class isVariable
  ifTrue: [self writeVariablePartOfObject: anObject onStream: aStream]
  ifFalse: [self writeVariableArrayFrom: anObject onStream: aStream]
!

writeVariableArrayFrom: anObject onStream: aStream
 |array|
 array := self fieldInObject: anObject.
 array do: [:each | fieldType writeField: each onStream: aStream].!

writeVariablePartOfObject: anObject onStream: aStream
 1 to: anObject size do: [:i | fieldType writeField: (anObject at: i)
onStream: aStream]
! !
!KKVariableFieldContainer categoriesFor: #components!public! !
!KKVariableFieldContainer categoriesFor: #isVariable!public! !
!KKVariableFieldContainer categoriesFor: #refreshObject:fromStream:!public!
!
!KKVariableFieldContainer categoriesFor:
#refreshVariableArrayInObject:fromStream:!public! !
!KKVariableFieldContainer categoriesFor:
#refreshVariablePartOfObject:fromStream:!public! !
!KKVariableFieldContainer categoriesFor: #totalSize!public! !
!KKVariableFieldContainer categoriesFor: #writeObject:onStream:!public! !
!KKVariableFieldContainer categoriesFor:
#writeVariableArrayFrom:onStream:!public! !
!KKVariableFieldContainer categoriesFor:
#writeVariablePartOfObject:onStream:!public! !

KKStringDescriptor guid: (GUID fromString:
'{BE897A07-227F-45E5-BD1C-6874B48F0F7D}')!
KKStringDescriptor comment: ''!
!KKStringDescriptor categoriesForClass!Kernel-Objects! !
!KKStringDescriptor methodsFor!

instanceClass
 ^ ByteArray!

objectFromStream: aStream
 ^ (super objectFromStream: aStream) asString!

writeObject: anObject onStream: aStream
 super writeObject: anObject asByteArray onStream: aStream! !
!KKStringDescriptor categoriesFor: #instanceClass!public! !
!KKStringDescriptor categoriesFor: #objectFromStream:!public! !
!KKStringDescriptor categoriesFor: #writeObject:onStream:!public! !

KKSymbolDescriptor guid: (GUID fromString:
'{D5F2E6DE-A3E4-4139-B499-158A43DFCC1A}')!
KKSymbolDescriptor comment: ''!
!KKSymbolDescriptor categoriesForClass!Kernel-Objects! !
!KKSymbolDescriptor methodsFor!

objectFromStream: aStream
 ^ (super objectFromStream: aStream) asSymbol! !
!KKSymbolDescriptor categoriesFor: #objectFromStream:!public! !

KKBooleanField guid: (GUID fromString:
'{FF213AC6-0809-4FEB-8106-6E06077D7C25}')!
KKBooleanField comment: ''!
!KKBooleanField categoriesForClass!Kernel-Objects! !
!KKBooleanField methodsFor!

fieldFromStream: aStream
 ^ aStream boolean!

size
 ^ 1!

type
 ^ 3!

writeField: aField onStream: aStream
 aStream boolean: aField! !
!KKBooleanField categoriesFor: #fieldFromStream:!public! !
!KKBooleanField categoriesFor: #size!public! !
!KKBooleanField categoriesFor: #type!public! !
!KKBooleanField categoriesFor: #writeField:onStream:!public! !

KKDoubleField guid: (GUID fromString:
'{5CB59C64-02BC-4F65-947F-5AA2CD3EAB5A}')!
KKDoubleField comment: ''!
!KKDoubleField categoriesForClass!Kernel-Objects! !
!KKDoubleField methodsFor!

fieldFromStream: aStream
 |float|
 float := Float new: 2.
 float at: 1 put: aStream uint32.
 float at: 2 put: aStream uint32.
 ^ float
!

size
 ^ 8!

type
 ^ 4!

writeField: aField onStream: aStream
 aStream uint32: (aField at: 1).
 aStream uint32: (aField at: 2).
! !
!KKDoubleField categoriesFor: #fieldFromStream:!public! !
!KKDoubleField categoriesFor: #size!public! !
!KKDoubleField categoriesFor: #type!public! !
!KKDoubleField categoriesFor: #writeField:onStream:!public! !

KKFloatField guid: (GUID fromString:
'{27A69BB9-0D6A-4797-9F85-602B2A81EBAB}')!
KKFloatField comment: ''!
!KKFloatField categoriesForClass!Kernel-Objects! !
!KKFloatField methodsFor!

fieldFromStream: aStream
 ^ Float fromIEEE32Bit: aStream uint32!

size
 ^ 4!

type
 ^ 4!

writeField: aField onStream: aStream
 aStream uint32: aField asIEEE32BitWord ! !
!KKFloatField categoriesFor: #fieldFromStream:!public! !
!KKFloatField categoriesFor: #size!public! !
!KKFloatField categoriesFor: #type!public! !
!KKFloatField categoriesFor: #writeField:onStream:!public! !

KKReferenceField guid: (GUID fromString:
'{BF4DE0B4-0B44-435D-859C-5FFD5AB00512}')!
KKReferenceField comment: ''!
!KKReferenceField categoriesForClass!Kernel-Objects! !
!KKReferenceField methodsFor!

decodeUnsignedInteger: anInteger
 ^ anInteger >= 16r80000000
  ifTrue: [-16r1000000 + anInteger]
  ifFalse: [anInteger]!

fieldFromStream: aStream
 |sid oid|
 sid := aStream uint16.
 oid := aStream uint32.

 ^ (oid = 0 or: [(sid >> 15) = 1])
   ifTrue: [self fieldFromTag: sid value: oid]
   ifFalse: [self referenceAt: oid]!

fieldFromTag: sid value: oid

 | value |

  sid = 0
  ifTrue: [^ nil]
  ifFalse: [value := sid bitAnd: 16r00FF.
   value = 1 ifTrue:[ ^ self decodeUnsignedInteger: oid].
   value = 2 ifTrue:[ ^ oid = 1 ].
   value = 3 ifTrue:[ ^ Float fromIEEE32Bit: oid]]!

isImmediateValue: anObject
 ^ #(True False SmallInteger UndefinedObject Float) includes: anObject class
name!

isReference
 ^ true!

keyForReference: anObject
 ^ (KKRequestKey new object: anObject) signal!

referenceAt: aKey
 ^ (KKRequestObject new key: aKey) signal!

size
 ^ 6!

type
 ^ 1!

writeField: anObject onStream: aStream
 (self isImmediateValue: anObject)
  ifTrue: [self writeTaggedField: anObject onStream: aStream]
  ifFalse:
   [aStream
    uint16: 0;
    uint32: (self keyForReference: anObject)]!

writeTaggedField: anObject onStream: aStream
 anObject isNil
  ifTrue: [aStream nextNumber: 6 put: 0]
  ifFalse:[aStream nextPut: 255.
    anObject goodsWriteTaggedOn: aStream].
! !
!KKReferenceField categoriesFor: #decodeUnsignedInteger:!public! !
!KKReferenceField categoriesFor: #fieldFromStream:!public! !
!KKReferenceField categoriesFor: #fieldFromTag:value:!public! !
!KKReferenceField categoriesFor: #isImmediateValue:!public! !
!KKReferenceField categoriesFor: #isReference!public! !
!KKReferenceField categoriesFor: #keyForReference:!public! !
!KKReferenceField categoriesFor: #referenceAt:!public! !
!KKReferenceField categoriesFor: #size!public! !
!KKReferenceField categoriesFor: #type!public! !
!KKReferenceField categoriesFor: #writeField:onStream:!public! !
!KKReferenceField categoriesFor: #writeTaggedField:onStream:!public! !

KKStringField guid: (GUID fromString:
'{9F9E2357-18F3-4FFB-958B-3E881E4B3525}')!
KKStringField comment: ''!
!KKStringField categoriesForClass!Kernel-Objects! !
!KKStringField methodsFor!

fieldFromStream: aStream
 |length string|
 length := aStream uint16.
 string := String new: length.

 1 to: length do: [:i | string at: i put: (Character value: aStream
uint16)].
 ^ string!

isReference
 ^ false!

size
 ^ 2!

type
 ^ 5!

writeField: anObject onStream: aStream
 aStream uint16: anObject size.
 anObject do: [:char | aStream uint16: char asciiValue].! !
!KKStringField categoriesFor: #fieldFromStream:!public! !
!KKStringField categoriesFor: #isReference!public! !
!KKStringField categoriesFor: #size!public! !
!KKStringField categoriesFor: #type!public! !
!KKStringField categoriesFor: #writeField:onStream:!public! !

KKUnsignedIntegerField guid: (GUID fromString:
'{FB6AA25C-F1AD-4A85-9D4D-2DDA85194EBB}')!
KKUnsignedIntegerField comment: ''!
!KKUnsignedIntegerField categoriesForClass!Kernel-Objects! !
!KKUnsignedIntegerField methodsFor!

fieldFromStream: aStream
 ^ aStream nextNumber: size!

size
 ^ size !

size: anObject
 size := anObject!

type
 ^ 3!

writeField: aField onStream: aStream
 aStream nextNumber: size put: aField! !
!KKUnsignedIntegerField categoriesFor: #fieldFromStream:!public! !
!KKUnsignedIntegerField categoriesFor: #size!accessing!private! !
!KKUnsignedIntegerField categoriesFor: #size:!accessing!private! !
!KKUnsignedIntegerField categoriesFor: #type!public! !
!KKUnsignedIntegerField categoriesFor: #writeField:onStream:!public! !

KKSignedIntegerField guid: (GUID fromString:
'{3C19E9BD-5FC5-4AFA-A606-A6C4D3EE09A8}')!
KKSignedIntegerField comment: ''!
!KKSignedIntegerField categoriesForClass!Kernel-Objects! !
!KKSignedIntegerField methodsFor!

decodeSignedInteger: aNumber
 ^ aNumber highBit = (size * 8)
  ifTrue: [((aNumber bitXor: bitMask) + 1) negated]
  ifFalse: [aNumber]!

encodeSignedInteger: aNumber
 ^ aNumber < 0
  ifTrue: [(aNumber bitXor: bitMask) + 1]
  ifFalse: [aNumber]!

fieldFromStream: aStream
 ^ self decodeSignedInteger: (super fieldFromStream: aStream)!

size: aNumber
 size := aNumber.
 bitMask := (2 raisedTo: size * 8) - 1.!

type
 ^ 2!

writeField: aField onStream: aStream
 super writeField: (self encodeSignedInteger: aField) onStream: aStream! !
!KKSignedIntegerField categoriesFor: #decodeSignedInteger:!public! !
!KKSignedIntegerField categoriesFor: #encodeSignedInteger:!public! !
!KKSignedIntegerField categoriesFor: #fieldFromStream:!public! !
!KKSignedIntegerField categoriesFor: #size:!public! !
!KKSignedIntegerField categoriesFor: #type!public! !
!KKSignedIntegerField categoriesFor: #writeField:onStream:!public! !

LookupKey guid: (GUID fromString: '{AC375917-0BF4-4AA4-8082-DDCF0625805F}')!
LookupKey comment: ''!
!LookupKey categoriesForClass!Magnitude-General! !
!LookupKey methodsFor!

< aLookupKey
 "Refer to the comment in Magnitude|<."

 ^key < aLookupKey key!

= aLookupKey

 self species = aLookupKey species
  ifTrue: [^key = aLookupKey key]
  ifFalse: [^false]! !
!LookupKey categoriesFor: #<!public! !
!LookupKey categoriesFor: #=!public! !

!LookupKey class methodsFor!

key: aKey
 "Answer an instance of me with the argument as the lookup up."

 ^self new key: aKey! !
!LookupKey class categoriesFor: #key:!public! !

WeakValueAssociation guid: (GUID fromString:
'{8E78E772-0A82-412A-99F9-D5261C74FD3B}')!
WeakValueAssociation comment: 'I represent a key for looking up entries in a
data structure. Subclasses of me, such as Association, typically represent
dictionary entries.'!
!WeakValueAssociation categoriesForClass!Magnitude-General! !
!WeakValueAssociation methodsFor!

key: aKey value: anObject
 "Store the arguments as the variables of the receiver."

 key := aKey.
 self value: anObject!

value
 ^self at: 1!

value: anObject
 "Store the argument, anObject, as the value of the receiver."

 self at: 1 put: anObject! !
!WeakValueAssociation categoriesFor: #key:value:!public! !
!WeakValueAssociation categoriesFor: #value!public! !
!WeakValueAssociation categoriesFor: #value:!public! !

!WeakValueAssociation class methodsFor!

key: anObject value: bObject
 ^ self new key: anObject value: bObject!

new
 ^ self new: 1! !
!WeakValueAssociation class categoriesFor: #key:value:!public! !
!WeakValueAssociation class categoriesFor: #new!public! !

KKDBTest guid: (GUID fromString: '{DC397937-1B60-4B0E-8A58-84A83CEDFE0A}')!
KKDBTest comment: ''!
!KKDBTest categoriesForClass!Unclassified! !
!KKDBTest methodsFor!

dbHost
 ^ 'localhost'!

dbPort
 ^ 6101!

setUp
 connOne := KKConnection hostname: (self dbHost) port: (self dbPort).
 connTwo := KKConnection hostname: (self dbHost) port: (self dbPort).
 dbOne := KKDatabase connection: connOne.
 dbOne root: Dictionary new; commit.
 dbTwo := KKDatabase connection: connTwo.!

tearDown
 !

testConnection
 self assert: connOne isConnected.
 self assert: connTwo isConnected!

testRefreshRoot
 dbOne root at: 'x' put: 1.

 dbOne commit.
 dbTwo refresh.
 self assert: (dbTwo root at: 'x') = 1.
 dbTwo root at: 'y' put: 3.
 dbTwo commit.
 self assert: dbOne root size = 1.
 dbOne refresh.
 self assert: dbOne root size = 2.!

testRootNode
" self assert: dbOne root = Dictionary new."
 dbOne root: #(23).
 dbOne commit.
 dbTwo refresh.
 self assert: dbTwo root = #(23).!

testTransactions
 " testNode1 should be an OrderedCollection"
 | dbOneNode1 dbTwoNode1 |
 dbOneNode1 := dbOne root at: 'TestNode1' ifAbsentPut: [OrderedCollection
new].
 dbOne commit.
 dbTwo refresh.
 dbTwoNode1 := dbTwo root at: 'TestNode1'.

 dbOneNode1 reset.
 self assert: dbOneNode1 isEmpty.
 (1 to: 10) do: [:i | dbOneNode1 add: i].
 dbOne commit.
 dbTwo refresh.
 self assert: dbTwoNode1 asArray = #(1 2 3 4 5 6 7 8 9 10).

 dbOneNode1 reset.
 (11 to: 20) do: [:i | dbOneNode1 add: i].
 dbOne rollback.
 dbTwo refresh.
 self deny: dbTwoNode1 asArray =  #(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
17 18 19 20).
 ! !
!KKDBTest categoriesFor: #dbHost!public! !
!KKDBTest categoriesFor: #dbPort!public! !
!KKDBTest categoriesFor: #setUp!public! !
!KKDBTest categoriesFor: #tearDown!public! !
!KKDBTest categoriesFor: #testConnection!public! !
!KKDBTest categoriesFor: #testRefreshRoot!public! !
!KKDBTest categoriesFor: #testRootNode!public! !
!KKDBTest categoriesFor: #testTransactions!public! !

KKObjectProxy guid: (GUID fromString:
'{142879C5-2CBD-4DCE-AF3D-31367F717924}')!
KKObjectProxy comment: ''!
!KKObjectProxy categoriesForClass!System-Support! !
!KKObjectProxy methodsFor!

doesNotUnderstand: aMessage
 ^ self xxxObject perform: aMessage selector withArguments: aMessage
arguments!

isInMemory
 ^ assoc value notNil!

xxxDatabase: aDatabase
 database := aDatabase!

xxxKey
 ^ assoc key!

xxxKey: oid

 assoc := Association key: oid value: nil.!

xxxObject
 assoc value ifNil: [assoc value: (database at: assoc key)].
 ^ assoc value! !
!KKObjectProxy categoriesFor: #doesNotUnderstand:!public! !
!KKObjectProxy categoriesFor: #isInMemory!public! !
!KKObjectProxy categoriesFor: #xxxDatabase:!public! !
!KKObjectProxy categoriesFor: #xxxKey!public! !
!KKObjectProxy categoriesFor: #xxxKey:!public! !
!KKObjectProxy categoriesFor: #xxxObject!public! !

!KKObjectProxy class methodsFor!

database: aDatabase key: key
 ^ self basicNew
  xxxDatabase: aDatabase;
  xxxKey: key! !
!KKObjectProxy class categoriesFor: #database:key:!public! !

"Binary Globals"!

"Resources"!

Sebastián,

> you will see the second "strange dictionary"

That particular problem is cause by
KKVariableClassDescription>>newInstanceFromStream: which uses #basicNew:
when it should use #new:.  Using #basicNew: means that the code in Set>>new:
that sets up the Dictionary is ignored.

I'm not sure what changing that method will do to the recreation of any
other classes...

One other thing I noticed in passing is that you've overridden Object>>=.  I
don't _think_ your implementation is different to that of the primitive it
replaces but I would have thought it slowed things down somewhat.

--
Ian

Use the Reply-To address to contact me.
Mail sent to the From address is ignored.

Dear Ian,

    I had some progress here but I've found another problem due to a
difference of behavior between squeak and dolphin.

    OrderedCollection isVariable
    Dictionary isVariable

    in dolphin ST evaluates to true while for some reason (that I don't
undestand) in squeak they answers false.

    This is bringing a lot of different consequences that makes unable to
store and retrieve objects as it's suposed to.


--
Sebastián Sastre
[hidden email]
www.seaswork.com.ar


"Ian Bartholomew" <[hidden email]> escribió en el mensaje
news:c5mbjq$37ard$[hidden email]...
> Sebastián,
>
> > you will see the second "strange dictionary"
>
> That particular problem is cause by
> KKVariableClassDescription>>newInstanceFromStream: which uses #basicNew:
> when it should use #new:.  Using #basicNew: means that the code in
Set>>new:
> that sets up the Dictionary is ignored.
>
> I'm not sure what changing that method will do to the recreation of any
> other classes...
>
> One other thing I noticed in passing is that you've overridden Object>>=.
I

Sebastián,

>     OrderedCollection isVariable
>     Dictionary isVariable
>
>     in dolphin ST evaluates to true while for some reason (that I
> don't undestand) in squeak they answers false.

That's to do with the way that a class maintains it's variables.  Classes
created using either of the variable class types have indexable variables,
normal classes do not.  I'll leave it to someone more knowledable on the
subject to explain it properly though :-)

I assume that squeak (which I've never seen) implements these classes in a
different way.

>     This is bringing a lot of different consequences that makes
> unable to store and retrieve objects as it's suposed to.

I only had a quick look, while I was investigating your Dictionary problem,
but it seemed to me that a lot, if not most, of the code you ported is
concerned with the serialising/unserialising of objects into ByteArrays.  I
assume, since it works with a lot of different languages, the database just
stores objects using these ByteArrays.  If that is the case why not use
Dolphins STB to do the serialisation work for you and just look at creating
the keys and interfacing with the database.

I may be missing something though....

--
Ian

Use the Reply-To address to contact me.
Mail sent to the From address is ignored.

> I only had a quick look, while I was investigating your Dictionary
problem,
> but it seemed to me that a lot, if not most, of the code you ported is
> concerned with the serialising/unserialising of objects into ByteArrays.
I
> assume, since it works with a lot of different languages, the database
just
> stores objects using these ByteArrays.  If that is the case why not use
> Dolphins STB to do the serialisation work for you and just look at
creating
> the keys and interfacing with the database.
>
> I may be missing something though....

You're right about ByteArrays. But... this server is an object database, so
it is able to store objects individually as it needs (it works with
metadata, has it's own GarbageCollector, etc.) and I've read that it has a
lot of optimizations caching the objects that you are using. This is the
difference between using it and a MySQL with one table and one column of one
big bytearray. Or a simple file with a STB stored object on your disk.

In fact I was able to use this server in a very inefficient way. To make a
test I've stored one BIG serialized dictionary in the rootNode and then
deserialized it from another connection. But the idea of this client is to
make use of the optimizations. Think about having a repository of 48000
articles of complex objects and you want to make an update in one of them,
you'll have to serialize the whole dictionary (serveral seconds) again and
write into disk THAT bytearray (some seconds). In the other hand you have
(when this client works :P) that the object is updated by the server in
milliseconds. Then everything makes sense don't you think?

regards,

--
Sebastián Sastre
[hidden email]
www.seaswork.com.ar

"Ian Bartholomew" <[hidden email]> wrote in message news:<c5mbjq$37ard$[hidden email]>...
> That particular problem is cause by
> KKVariableClassDescription>>newInstanceFromStream: which uses #basicNew:
> when it should use #new:.  Using #basicNew: means that the code in Set>>new:
> that sets up the Dictionary is ignored.

I would say, rather, that the problem is in
KKVariableFieldContainer>>writeVariablePartOfObject:onStream: and
#refreshVariablePartOfObject:fromStream:, which should be using
#basicSize and #basicAt: rather than #size and #at:.  This hasn't been
a problem in Squeak because Set is not a variably sized object itself,
but holds onto an Array.

> One other thing I noticed in passing is that you've overridden Object>>=.  I
> don't _think_ your implementation is different to that of the primitive it
> replaces but I would have thought it slowed things down somewhat.

This is necessary when the object you're comparing with is a proxy -
the #yourself will trigger a DNU and cause the real object to be
brought in from the DB for the #== test, whereas the proxy itself
wouldn't be #==.  At least, it's necessary in Squeak; I don't know
what the original implementation is in Dolphin, but I suspect it has
the same issue.

Avi

"Avi Bryant" <[hidden email]> wrote in message
news:[hidden email]...
> "Ian Bartholomew" <[hidden email]> wrote in message
news:<c5mbjq$37ard$[hidden email]>...
> > ...One other thing I noticed in passing is that you've overridden
Object>>=.  I
> > don't _think_ your implementation is different to that of the primitive
it
> > replaces but I would have thought it slowed things down somewhat.
>
> This is necessary when the object you're comparing with is a proxy -
> the #yourself will trigger a DNU and cause the real object to be
> brought in from the DB for the #== test, whereas the proxy itself
> wouldn't be #==.  At least, it's necessary in Squeak; I don't know
> what the original implementation is in Dolphin, but I suspect it has
> the same issue.

#yourself won't cause a DNU in Dolphin, because it is normally optimized
away by the compiler (although this is can be changed by passing a different
flag to the compiler), so I'd guess that trick won't work anyway. I think
VisualAge Smalltalk has a similar optimisation.

Regards

Blair

Blair McGlashan wrote:
> #yourself won't cause a DNU in Dolphin, because it is normally optimized
> away by the compiler (although this is can be changed by passing a different
> flag to the compiler), so I'd guess that trick won't work anyway. I think
> VisualAge Smalltalk has a similar optimisation.

This same issue came up for OmniBase and hence the Source Tracking
System when this optimization got added last year. I took Chris Uppal's
suggestion and added #resolve to Object and the proxy class to do what
#yourself used to do before it became optimized away.

I was just wondering if #resolve should be added to the base as some
sore of "standard"?
Now that #yourself is usually optimized, there needs to be something
that does the full message send, which could be used to ensure that a
proxy gets de-referenced.

-Bill

-------------------------------------------
Bill Dargel            [hidden email]
Shoshana Technologies
100 West Joy Road, Ann Arbor, MI 48105  USA

"Ian Bartholomew" <[hidden email]> wrote in message news:
> I only had a quick look, while I was investigating your Dictionary problem,
> but it seemed to me that a lot, if not most, of the code you ported is
> concerned with the serialising/unserialising of objects into ByteArrays.  I
> assume, since it works with a lot of different languages, the database just
> stores objects using these ByteArrays.  If that is the case why not use
> Dolphins STB to do the serialisation work for you and just look at creating
> the keys and interfacing with the database.

No, GOODS isn't just dealing with the data as opaque ByteArrays - it's
aware of which fields are references to other objects, which are
immediate data, etc.  Think of it like a large, transactional
Smalltalk image, but with behaviorless objects - for example, it does
GC based on following references from a root object.  So you certainly
have to use its serialization scheme (ie, format your objects the way
its object memory expects them).

If you do things right (use compatible class schemas) you can actually
share object data across languages.  I was recently commissioned to
write a Python client to the same database, and with care this allows
transparent data sharing between Smalltalk and Python apps, which is
pretty cool.

Anyway, I would expect that using #basicSize and #basicAt: as I
suggested earlier would have made these #isVariable issues go away -
did it not?

Avi

Avi et al,

> No, GOODS isn't just dealing with the data as opaque ByteArrays - it's
> aware of which fields are references to other objects, which are
> immediate data, etc.

Ok, apologies to all (including KK, whose name I won't even try to spell) if
I've maligned GOODS in any way.  I only looked at it deeply enough to try to
work out why Sebastián was having his Dictionary problems and obviously
didn't look as deeply as I should have.

--
Ian

Use the Reply-To address to contact me.
Mail sent to the From address is ignored.

>
> This same issue came up for OmniBase and hence the Source Tracking
> System when this optimization got added last year. I took Chris Uppal's
> suggestion and added #resolve to Object and the proxy class to do what
> #yourself used to do before it became optimized away.

Bill, can you post an example?

> I was just wondering if #resolve should be added to the base as some
> sore of "standard"?
> Now that #yourself is usually optimized, there needs to be something
> that does the full message send, which could be used to ensure that a
> proxy gets de-referenced.

I agree,


best regards,

--
Sebastián Sastre
[hidden email]
www.seaswork.com.ar

"Avi Bryant" <[hidden email]> escribió en el mensaje
news:[hidden email]...
> "Ian Bartholomew" <[hidden email]> wrote in message
news:<c5mbjq$37ard$[hidden email]>...
> > That particular problem is cause by
> > KKVariableClassDescription>>newInstanceFromStream: which uses #basicNew:
> > when it should use #new:.  Using #basicNew: means that the code in
Set>>new:
> > that sets up the Dictionary is ignored.
>
> I would say, rather, that the problem is in
> KKVariableFieldContainer>>writeVariablePartOfObject:onStream: and
> #refreshVariablePartOfObject:fromStream:, which should be using
> #basicSize and #basicAt: rather than #size and #at:.  This hasn't been
> a problem in Squeak because Set is not a variably sized object itself,
> but holds onto an Array.

If I get your point the code should be like this
KKVariableFieldContainer>>refreshVariablePartOfObject: anObject fromStream:
aStream

1 to: anObject basicSize do:

[:i | anObject basicAt: i put: (fieldType fieldFromStream: aStream)]

I've stored a dictionary like that but when is restored it has the problem
of it basicSize
that is zero (and it won't make at:put:)

Anyway, as the behavior of isVariable is diferent between dolphin and
squeak, I saw some diferences on the descriptor when a commit is send. I
think this also is a problem.

Do you have any suggestion to have the same behavior, or to normalize the
descriptor so the dictionary (and perhaps may others) can serialize ok into
the serevr?

Seb

Sebastián Sastre wrote:
>Bill dargel wrote:
> > This same issue came up for OmniBase and hence the Source Tracking
> > System when this optimization got added last year. I took Chris Uppal's
> > suggestion and added #resolve to Object and the proxy class to do what
> > #yourself used to do before it became optimized away.
>
> Bill, can you post an example?

I'll try. This is from David Gorisek's OmniBase (a commercial object
database) and Source Tracking System (STS). See http://www.gorisek.com.
I ended up making some changes to my copy of the product in order to
make it work with the new version of Dolphin that had started to
optimize away the actual message send for #yourself. Credit goes to
Chris Uppal for showing what needed to be done.

Added the #resolve method to Object --

!Object methodsFor!
resolve
        ^self! !

And added it to the proxy to do the reconstitution of the object from
the byteArray (which is what StsStbProxy>>yourself used to be doing) --

!StsStbProxy methodsFor!
resolve
        ^(STBInFiler on: (ReadStream on: bytes)) next! !

Then there were about a dozen places where STS had been using #yourself
to force a possible proxy into the actual object. These uses of
#yourself got replaced by #resolve. For example --

!StsMethodEdition methodsFor!
source
                "Sending #resolve insures that object is already fetched from the
database
                (will never answer an instance of ODBReference)."
        ^source resolve! !

And another example from the beginning of another method --

!StsClassEdition methodsFor!
compareWith: classEdition on: aTreeModel
        | changes root def1 def2 |
        classEdition resolve == self ifTrue: [^self].
    <snip>

Hope this is of some help.
-Bill

-------------------------------------------
Bill Dargel            [hidden email]
Shoshana Technologies
100 West Joy Road, Ann Arbor, MI 48105  USA

"Sebastián Sastre" <[hidden email]> wrote in message news:<c5p2lf$433pg$[hidden email]>...
 
Did you also make the change to #writeVariablePartOfObject:onStream:?

KKVariableFieldContainer>>writeVariablePartOfObject: anObject
onStream: aStream
  1 to: anObject basicSize do: [:i | fieldType writeField: (anObject
basicAt: i) onStream: aStream]

If you do that, and reading in still produces a Dictionary of
basicSize 0, I would be very surprised.

Note that Dictionary, and the fact that it's #isVariable in Dolphin
but not in Squeak, is a red herring here - there's no reason to need
any special case logic for Dictionary.  The issue is that there was a
bug in KKVariableFieldContainer (fixed by the above changes), that was
getting exposed by Dolphin's Dictionary class.  But it would be
possible to write other classes, in Squeak or Dolphin, that would
trigger the same bug and require the same fix.

Avi

Sebastián Sastre wrote:

> I've stored a dictionary like that but when is restored it has the problem
> of it basicSize
> that is zero (and it won't make at:put:)

Sounds as if something is using #basicNew when it should be using #basicNew:.

For instance, to create an empty Set (with #basicSize = 3) "by hand" you'd need
to do:

    (Set basicNew: 3)
        instVarAt: 1 "tally" put: 0;
        yourself.

    -- chris

Avi,

> If you do that, and reading in still produces a Dictionary of
> basicSize 0, I would be very surprised.

    I've added the the change you suggest and the empty dictionary is
serializing and deserializing ok from the database.

    If I put some object into it, and commit the changes, when I call back
it from the DB the dic is unable to find the key (inspecting it you can see
it have it but is not able to recover it I'm looking why).


> Note that Dictionary, and the fact that it's #isVariable in Dolphin
> but not in Squeak, is a red herring here - there's no reason to need
> any special case logic for Dictionary.  The issue is that there was a
> bug in KKVariableFieldContainer (fixed by the above changes), that was
> getting exposed by Dolphin's Dictionary class.  But it would be
> possible to write other classes, in Squeak or Dolphin, that would
> trigger the same bug and require the same fix.

    so... this does mean #isVariable is not a problem anymore?

regards,

Seb