--- a/Class.st Tue Jan 16 03:28:46 1996 +0100
+++ b/Class.st Tue Jan 16 20:11:19 1996 +0100
@@ -909,10 +909,15 @@
!
storeBinaryDefinitionOn: stream manager: manager
- "classes will store the name, signature and instvar names.
+ "classes only store the name, signature and instvar names.
They restore by looking for that name in the Smalltalk dictionary.
However, using the signature, a check for being valid is made at
- restore time."
+ restore time.
+ This avoids a full recursive store of a class in the normal binary
+ storage - however, it also means that a classes semantics cannot
+ be stored with the basic storeBinary operation
+ (we depend on the class being present at binaryLoad time.
+ To store classes, use #storeBinaryClassOn:manager: or BOSS>>nextPutClasses:."
|varnames n sz|
@@ -954,6 +959,200 @@
Rectangle storeBinaryOn:s.
Object readBinaryFrom:(ReadStream on:s contents)
"
+!
+
+storeBinaryClassOn:stream manager:manager
+ "store a classes complete description (i.e. including methods).
+ However, the superclass chain is not stored - at load time, that must
+ be either present or autoloadable."
+
+ |nSel s|
+
+ stream nextPut: manager codeForClass.
+
+ "/ the following order must correlate to
+ "/ the storing in #binaryDefinitionFrom:manager:
+
+ "/ store
+ "/ superclasses name,
+ "/ name,
+ "/ typeSymbol,
+ "/ instVarNames
+ "/ classVarNames
+ "/ category
+ "/ classInstVarNames
+
+ superclass name storeBinaryOn:stream manager:manager.
+ name storeBinaryOn:stream manager:manager.
+ flags storeBinaryOn:stream manager:manager.
+ (instvars notNil and:[instvars isEmpty]) ifTrue:[
+ nil storeBinaryOn:stream manager:manager.
+ ] ifFalse:[
+ instvars storeBinaryOn:stream manager:manager.
+ ].
+ (classvars notNil and:[classvars isEmpty]) ifTrue:[
+ nil storeBinaryOn:stream manager:manager.
+ ] ifFalse:[
+ classvars storeBinaryOn:stream manager:manager.
+ ].
+ category storeBinaryOn:stream manager:manager.
+ s := self class instanceVariableString.
+ (s notNil and:[s isEmpty]) ifTrue:[
+ nil storeBinaryOn:stream manager:manager.
+ ] ifFalse:[
+ s storeBinaryOn:stream manager:manager.
+ ].
+
+ "/ store
+ "/ number of class methods
+ (nSel := self class selectorArray size) storeBinaryOn:stream manager:manager.
+
+ "/ store
+ "/ class methods
+ 1 to:nSel do:[:i |
+ |sel m|
+
+ sel := self class selectorArray at:i.
+ m := self class methodArray at:i.
+
+ sel storeBinaryOn:stream manager:manager.
+ m storeFullBinaryDefinitionOn:stream manager:manager
+ ].
+
+ "/ store
+ "/ number of inst methods
+ (nSel := selectorArray size) storeBinaryOn:stream manager:manager.
+
+ "/ store
+ "/ inst methods
+ 1 to:nSel do:[:i |
+ |sel m|
+
+ sel := selectorArray at:i.
+ m := methodArray at:i.
+
+ sel storeBinaryOn:stream manager:manager.
+ m storeFullBinaryDefinitionOn:stream manager:manager
+ ].
+
+ "
+ |bos|
+
+ bos := BinaryObjectStorage onNew: (Filename named: 'FBrowser.cls') writeStream.
+ bos nextPutClasses:(Array with:FileBrowser).
+ bos close.
+ "
+ "
+ |bos cls|
+
+ bos := BinaryObjectStorage onOld: (Filename named: 'FBrowser.cls') readStream.
+ cls := bos next.
+ bos close.
+ cls open.
+ "
+
+ "Modified: 16.1.1996 / 17:01:05 / cg"
+!
+
+binaryClassDefinitionFrom:stream manager:manager
+ "retrieve a class as stored previously with
+ #storeBinaryClassOn:manager:"
+
+ |superclassName name flags instvars classvars category classInstVars
+ nSel sel lastCategory
+ newClass superClass selectors methods cselectors cmethods|
+
+ "/ the following order must correlate to
+ "/ the storing in #storeBinaryClassOn:manager:
+
+ "/ retrieve
+ "/ superclasses name,
+ "/ name,
+ "/ typeSymbol,
+ "/ instVarNames
+ "/ classVarNames
+ "/ category
+ "/ classInstVarNames
+
+ superclassName := manager nextObject.
+ name := manager nextObject.
+ flags := manager nextObject.
+ instvars := manager nextObject.
+ instvars isNil ifTrue:[instvars := ''].
+ classvars := manager nextObject.
+ classvars isNil ifTrue:[classvars := ''].
+ category := manager nextObject.
+ classInstVars := manager nextObject.
+ classInstVars isNil ifTrue:[classInstVars := ''].
+
+ superClass := Smalltalk at:superclassName ifAbsent:nil.
+ superClass notNil ifTrue:[
+ superClass autoload.
+ ].
+
+
+"/ 'got superName:' print. superclassName printNL.
+"/ 'got name:' print. name printNL.
+"/ 'got flags: ' print. flags printNL.
+"/ 'got instvars: ' print. instvars printNL.
+"/ 'got classvars: ' print. classvars printNL.
+"/ 'got category: ' print. category printNL.
+"/ 'got classInstvars: ' print. classInstVars printNL.
+
+ "/ retrieve
+ "/ number of class methods
+
+ nSel := manager nextObject.
+ cselectors := Array new:nSel.
+ cmethods := Array new:nSel.
+
+ "/ retrieve
+ "/ class methods
+ 1 to:nSel do:[:i |
+ |m|
+
+ sel := manager nextObject.
+ m := Method binaryFullDefinitionFrom:stream manager:manager.
+ cmethods at:i put:m.
+ cselectors at:i put:sel.
+ ].
+
+ "/ retrieve
+ "/ number of inst methods
+
+ nSel := manager nextObject.
+ selectors := Array new:nSel.
+ methods := Array new:nSel.
+
+ "/ retrieve
+ "/ inst methods
+ 1 to:nSel do:[:i |
+ |m|
+
+ sel := manager nextObject.
+ m := Method binaryFullDefinitionFrom:stream manager:manager.
+ methods at:i put:m.
+ selectors at:i put:sel.
+ ].
+
+ superClass isNil ifTrue:[^ nil].
+
+ newClass := superClass
+ subclass:name asSymbol
+ instanceVariableNames:instvars
+ classVariableNames:classvars
+ poolDictionaries:''
+ category:category.
+ newClass isNil ifTrue:[
+ ^ nil
+ ].
+ newClass class instanceVariableNames:classInstVars.
+
+ newClass selectors:selectors methods:methods.
+ newClass class selectors:cselectors methods:cmethods.
+ ^ newClass
+
+ "Modified: 16.1.1996 / 17:03:21 / cg"
! !
!Class methodsFor:'c function interfacing'!
@@ -3416,6 +3615,6 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.115 1996-01-15 21:43:31 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.116 1996-01-16 19:11:04 cg Exp $'
! !
Class initialize!