diff --git a/src/BaselineOfMorphic/BaselineOfMorphic.class.st b/src/BaselineOfMorphic/BaselineOfMorphic.class.st index cdde41e2da2..806df168795 100644 --- a/src/BaselineOfMorphic/BaselineOfMorphic.class.st +++ b/src/BaselineOfMorphic/BaselineOfMorphic.class.st @@ -108,7 +108,6 @@ BaselineOfMorphic >> baseline: spec [ { #category : 'actions' } BaselineOfMorphic >> cleanUpAfterMorphicInitialization [ - MCDataStream initialize. FreeTypeCache clearCurrent. World cleanseOtherworldlySteppers. MCFileBasedRepository flushAllCaches diff --git a/src/Graphics-Files/BMPReadWriter.class.st b/src/Graphics-Files/BMPReadWriter.class.st index 7318974a0b6..efc8c22d14e 100644 --- a/src/Graphics-Files/BMPReadWriter.class.st +++ b/src/Graphics-Files/BMPReadWriter.class.st @@ -37,19 +37,6 @@ Class { #package : 'Graphics-Files' } -{ #category : 'testing' } -BMPReadWriter class >> readAllFrom: fd [ - "MessageTally spyOn:[BMPReadWriter readAllFrom: FileDirectory default]" - fd fileNames do:[:fName| - (fName endsWith: '.bmp') ifTrue:[ - [Form fromBinaryStream: (fd readOnlyFileNamed: fName)] on: Error do:[:nix]. - ]. - ]. - fd directoryNames do:[:fdName| - self readAllFrom: (fd / fdName) - ] -] - { #category : 'image reading/writing' } BMPReadWriter class >> typicalFileExtensions [ "Answer a collection of file extensions (lowercase) which files that I can read might commonly have" diff --git a/src/Monticello-BackwardCompatibility/MCClassTraitDefinition.class.st b/src/Monticello-BackwardCompatibility/MCClassTraitDefinition.class.st index c4740a99241..9af1bcd83ff 100644 --- a/src/Monticello-BackwardCompatibility/MCClassTraitDefinition.class.st +++ b/src/Monticello-BackwardCompatibility/MCClassTraitDefinition.class.st @@ -144,9 +144,9 @@ MCClassTraitDefinition >> packageName [ ] { #category : 'accessing' } -MCClassTraitDefinition >> packageName: anObject [ +MCClassTraitDefinition >> packageName: anString [ - packageName := anObject + packageName := anString ifNotNil: [ :package | package asSymbol ] ] { #category : 'printing' } @@ -192,5 +192,5 @@ MCClassTraitDefinition >> tagName: aString [ tagName := aString = Package rootTagName ifTrue: [ nil ] - ifFalse: [ aString asSymbol ] + ifFalse: [ aString ifNotNil: [ aString asSymbol ] ] ] diff --git a/src/Monticello-BackwardCompatibility/MCDataStream.extension.st b/src/Monticello-BackwardCompatibility/MCDataStream.extension.st deleted file mode 100644 index a82742016eb..00000000000 --- a/src/Monticello-BackwardCompatibility/MCDataStream.extension.st +++ /dev/null @@ -1,228 +0,0 @@ -Extension { #name : 'MCDataStream' } - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> readBitmap [ - "PRIVATE -- Read the contents of a Bitmap." - ^ Bitmap newFromStream: byteStream - "Note that the reader knows that the size is in long words, but the data is in bytes." -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> readByteArray [ - "PRIVATE -- Read the contents of a ByteArray." - - | count | - count := byteStream nextNumber: 4. - ^ byteStream next: count "assume stream is in binary mode" - -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> readClass [ - ^ self error: 'Classes cannot be materialized with DataStream' -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> readFloat [ - "PRIVATE -- Read the contents of a Float. - This is the fast way to read a Float. - We support 8-byte Floats here. Non-IEEE" - - | new | - new := Float new: 2. "To get an instance" - new at: 1 put: (byteStream nextNumber: 4). - new at: 2 put: (byteStream nextNumber: 4). - ^ new -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> readMethod [ - "PRIVATE -- Read the contents of an arbitrary instance. - ASSUMES: readDataFrom:size: sends me beginReference: after it - instantiates the new object but before reading nested objects. - NOTE: We must restore the current reference position after - recursive calls to next. - Let the instance, not the class read the data. " - - | instSize newClass className xxHeader nLits byteCodeSizePlusTrailer newMethod lits | - instSize := (byteStream nextNumber: 4) - 1. - className := self next. - newClass := Smalltalk globals at: className asSymbol. - xxHeader := self next. "nArgs := (xxHeader >> 24) bitAnd: 16rF." "nTemps := (xxHeader >> 18) bitAnd: 16r3F." "largeBit := (xxHeader >> 17) bitAnd: 1." - nLits := xxHeader >> 9 bitAnd: 16rFF. "primBits := ((xxHeader >> 19) bitAnd: 16r600) + (xxHeader bitAnd: 16r1FF)." - byteCodeSizePlusTrailer := instSize - newClass instSize - ((nLits + 1) * 4). "0" - newMethod := newClass basicNew: byteCodeSizePlusTrailer header: xxHeader. - lits := newMethod numLiterals + 1. "counting header" - 2 to: lits do: [ :ii | newMethod objectAt: ii put: self next ]. - lits * 4 + 1 to: newMethod basicSize do: [ :ii | newMethod basicAt: ii put: byteStream next ]. "Get raw bytes directly from the file" - ^ newMethod -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> readRectangle [ - "Read a compact Rectangle. Rectangles with values outside +/- 2047 were stored as normal objects (type=9). They will not come here. 17:22 tk" - - "Encoding is four 12-bit signed numbers. 48 bits in next 6 bytes. 17:24 tk" - | acc left top right bottom | - acc := byteStream nextNumber: 3. - left := acc bitShift: -12. - (left bitAnd: 16r800) ~= 0 ifTrue: [left := left - 16r1000]. "sign" - top := acc bitAnd: 16rFFF. - (top bitAnd: 16r800) ~= 0 ifTrue: [top := top - 16r1000]. "sign" - - acc := byteStream nextNumber: 3. - right := acc bitShift: -12. - (right bitAnd: 16r800) ~= 0 ifTrue: [right := right - 16r1000]. "sign" - bottom := acc bitAnd: 16rFFF. - (bottom bitAnd: 16r800) ~= 0 ifTrue: [bottom := bottom - 16r1000]. "sign" - - ^ Rectangle left: left right: right top: top bottom: bottom - -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> readReference [ - "Read the contents of an object reference. (Cf. outputReference:) File is not now positioned at this object." - | referencePosition | - ^ (referencePosition := (byteStream nextNumber: 4)) = self vacantRef "relative" - ifTrue: [nil] - ifFalse: [self objectAt: referencePosition] "relative pos" -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> readShortInst [ - "Read the contents of an arbitrary instance that has a short header. - ASSUMES: readDataFrom:size: sends me beginReference: after it - instantiates the new object but before reading nested objects. - NOTE: We must restore the current reference position after - recursive calls to next. - Let the instance, not the class read the data. " - - | instSize aSymbol anObject newClass | - instSize := byteStream next - 1. "one byte of size" - aSymbol := self readShortRef. "class symbol in two bytes of file pos" - newClass := Smalltalk globals at: aSymbol asSymbol. - anObject := newClass isVariable - ifFalse: [ newClass basicNew ] - ifTrue: [ newClass basicNew: instSize - newClass instSize ]. "Create object here" - anObject := anObject readDataFrom: self size: instSize. - ^ anObject -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> readShortRef [ - "Read an object reference from two bytes only. Original object must be in first 65536 bytes of the file. Relative to start of data. vacantRef not a possibility." - - ^ self objectAt: (byteStream nextNumber: 2) -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> readStringOld [ - - ^ byteStream nextStringOld -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> readUser [ - "Reconstruct both the private class and the instance. Still used??" - ^ self readInstance. "Will create new unique class" - -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> readWordArray [ - "PRIVATE -- Read the contents of a WordArray." - ^ WordArray newFromStream: byteStream - "Size is number of long words." -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> writeBitmap: aBitmap [ - "PRIVATE -- Write the contents of a Bitmap." - - aBitmap writeOn: byteStream - "Note that this calls (byteStream nextPutAll: aBitmap) which knows enough to put 4-byte quantities on the stream! Reader must know that size is in long words." -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> writeByteArray: aByteArray [ - "PRIVATE -- Write the contents of a ByteArray." - - byteStream nextNumber: 4 put: aByteArray size. - "May have to convert types here..." - byteStream nextPutAll: aByteArray. -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> writeClass: aClass [ - ^ self error: 'Classes cannot be serialized with DataStream' -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> writeFloat: aFloat [ - "PRIVATE -- Write the contents of a Float. - We support 8-byte Floats here." - - byteStream nextNumber: 4 put: (aFloat at: 1). - byteStream nextNumber: 4 put: (aFloat at: 2). - -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> writeRectangle: anObject [ - "Write the contents of a Rectangle. See if it can be a compact Rectangle (type=15). Rectangles with values outside +/- 2047 were stored as normal objects (type=9). 17:22 tk" - - | ok right bottom top left acc | - ok := true. - (right := anObject right) > 2047 ifTrue: [ok := false]. - right < -2048 ifTrue: [ok := false]. - (bottom := anObject bottom) > 2047 ifTrue: [ok := false]. - bottom < -2048 ifTrue: [ok := false]. - (top := anObject top) > 2047 ifTrue: [ok := false]. - top < -2048 ifTrue: [ok := false]. - (left := anObject left) > 2047 ifTrue: [ok := false]. - left < -2048 ifTrue: [ok := false]. - ok := ok & left isInteger & right isInteger & top isInteger & bottom isInteger. - - ok ifFalse: [ - byteStream skip: -1; nextPut: 9; skip: 0. "rewrite type to be normal instance" - ^ anObject storeDataOn: self]. - - acc := ((left bitAnd: 16rFFF) bitShift: 12) + (top bitAnd: 16rFFF). - byteStream nextNumber: 3 put: acc. - acc := ((right bitAnd: 16rFFF) bitShift: 12) + (bottom bitAnd: 16rFFF). - byteStream nextNumber: 3 put: acc. -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> writeStringOld: aString [ - "PRIVATE -- Write the contents of a String." - - | length | - aString size < 16384 - ifTrue: [ - (length := aString size) < 192 - ifTrue: [byteStream nextPut: length] - ifFalse: - [byteStream nextPut: (length // 256 + 192). - byteStream nextPut: (length \\ 256)]. - aString do: [:char | byteStream nextPut: char asciiValue]] - ifFalse: [self writeByteArray: aString]. "takes more space" -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> writeUser: anObject [ - "Write the contents of an arbitrary User instance (and its devoted class)." - - "If anObject is an instance of a unique user class, will lie and say it has a generic class" - ^ anObject storeDataOn: self -] - -{ #category : '*Monticello-BackwardCompatibility' } -MCDataStream >> writeWordLike: aWordArray [ - "Note that we put the class name before the size." - - self nextPut: aWordArray class name. - aWordArray writeOn: byteStream - "Note that this calls (byteStream nextPutAll: aBitmap) which knows enough to put 4-byte quantities on the stream! Reader must know that size is in long words or double-bytes." -] diff --git a/src/Monticello-BackwardCompatibility/MCOldDataStreamExtensions.class.st b/src/Monticello-BackwardCompatibility/MCOldDataStreamExtensions.class.st deleted file mode 100644 index 4c496876314..00000000000 --- a/src/Monticello-BackwardCompatibility/MCOldDataStreamExtensions.class.st +++ /dev/null @@ -1,28 +0,0 @@ -" -This is an extension class for the MCDataStream, it should only used if you need backward compatibility. But we have tested that is only needed because is ""copy-pasted"" code. MC is not using at all the defined types id. - -This package is unloadeable. -" -Class { - #name : 'MCOldDataStreamExtensions', - #superclass : 'Object', - #category : 'Monticello-BackwardCompatibility', - #package : 'Monticello-BackwardCompatibility' -} - -{ #category : 'class initialization' } -MCOldDataStreamExtensions class >> initialize [ - MCDataStream registerReaderSelector: #readStringOld atIndex: 5. - MCDataStream registerClass: ByteArray atIndex: 7 usingReadSelector: #readByteArray usingWriteSelector: #writeByteArray:. - MCDataStream registerReaderSelector: #readReference atIndex: 10. - MCDataStream registerClass: Bitmap atIndex: 11 usingReadSelector: #readBitmap usingWriteSelector: #writeBitmap:. - " 12 is for Classes but never worked". - MCDataStream registerReaderSelector: #readInstace atIndex: 13. - MCDataStream registerClass: Float atIndex: 14 usingReadSelector: #readFloat usingWriteSelector: #writeFloat:. - MCDataStream registerClass: Rectangle atIndex: 15 usingReadSelector: #readRectangle usingWriteSelector: #writeRectangle:. - MCDataStream registerReaderSelector: #readShortInst atIndex: 16. - MCDataStream registerClass: WordArray atIndex: 18 usingReadSelector: #readWordArray usingWriteSelector: #writeBitmap:. - MCDataStream registerReaderSelector: #readMethod atIndex: 21. - - -] diff --git a/src/Monticello-Tests/MCDataStreamTest.class.st b/src/Monticello-Tests/MCDataStreamTest.class.st deleted file mode 100644 index 6b6a93c2b2e..00000000000 --- a/src/Monticello-Tests/MCDataStreamTest.class.st +++ /dev/null @@ -1,40 +0,0 @@ -Class { - #name : 'MCDataStreamTest', - #superclass : 'TestCase', - #category : 'Monticello-Tests-IO', - #package : 'Monticello-Tests', - #tag : 'IO' -} - -{ #category : 'accessing' } -MCDataStreamTest >> testFileName [ - ^ self class name,'_', testSelector , '_test' -] - -{ #category : 'testing' } -MCDataStreamTest >> testFileNamed [ - | testString fileName | - "Given" - fileName := self testFileName. - testString := 'testString'. - "When" - [ MCDataStream fileNamed: fileName do: [ :streamType | streamType nextPut: testString ]. - "Then" - MCDataStream readOnlyFileNamed: fileName do: [ :streamType | self assert: streamType next equals: testString ] ] - ensure: [ (FileSystem disk workingDirectory / fileName) ensureDelete ] -] - -{ #category : 'testing' } -MCDataStreamTest >> testReadOnlyFileNamed [ - | testString fileName file | - "Given" - fileName := self testFileName. - testString := 'testString'. - "When" - [ MCDataStream fileNamed: fileName do: [ :streamType | streamType nextPut: testString ]. - "Then" - file := MCDataStream readOnlyFileNamed: fileName. - self assert: file next equals: testString. - file close ] - ensure: [ fileName asFileReference delete ] -] diff --git a/src/Monticello-Tests/MCFileInTest.class.st b/src/Monticello-Tests/MCFileInTest.class.st index fc1e2d31457..3d4d2496bae 100644 --- a/src/Monticello-Tests/MCFileInTest.class.st +++ b/src/Monticello-Tests/MCFileInTest.class.st @@ -66,9 +66,10 @@ MCFileInTest >> setUp [ { #category : 'running' } MCFileInTest >> tearDown [ + (diff isNil or: [diff isEmpty not]) ifTrue: [expected updatePackage: self mockPackage]. - MCDataStream initialize. + super tearDown ] diff --git a/src/Monticello-Tests/MCPackageTest.class.st b/src/Monticello-Tests/MCPackageTest.class.st index 569420f9297..919469aab9c 100644 --- a/src/Monticello-Tests/MCPackageTest.class.st +++ b/src/Monticello-Tests/MCPackageTest.class.st @@ -16,8 +16,8 @@ MCPackageTest >> aMethodRemoved: anEvent [ { #category : 'running' } MCPackageTest >> tearDown [ + self mockSnapshot install. - MCDataStream initialize. "MCMockClassG ends up in the DataStream TypeMap -- we need to reset" super tearDown ] diff --git a/src/Monticello/MCClassDefinition.extension.st b/src/Monticello/MCClassDefinition.extension.st index 31ecfe93316..a0420b626f5 100644 --- a/src/Monticello/MCClassDefinition.extension.st +++ b/src/Monticello/MCClassDefinition.extension.st @@ -7,16 +7,3 @@ MCClassDefinition >> accept: aVisitor [ ifTrue: [aVisitor visitMetaclassDefinition: self]. ] - -{ #category : '*Monticello' } -MCClassDefinition >> storeDataOn: aDataStream [ - | instVarSize | - instVarSize := (self hasTraitComposition or: [ self hasClassTraitComposition ]) - ifTrue: [ self class instSize ] - ifFalse: [ self class instSize - 2 ]. - aDataStream - beginInstance: self class - size: instVarSize. - 1 to: instVarSize do: [ :index | - aDataStream nextPut: (self instVarAt: index) ]. -] diff --git a/src/Monticello/MCDataStream.class.st b/src/Monticello/MCDataStream.class.st deleted file mode 100644 index e4aac60c666..00000000000 --- a/src/Monticello/MCDataStream.class.st +++ /dev/null @@ -1,604 +0,0 @@ -" -This is the save-to-disk facility. A DataStream can store one or more objects in a persistent form. - -To handle objects with sharing and cycles, you must use a -ReferenceStream instead of a DataStream. (Or SmartRefStream.) ReferenceStream is typically -faster and produces smaller files because it doesn't repeatedly write the same Symbols. - -Here is the way to use DataStream and ReferenceStream: - rr := ReferenceStream fileNamed: 'test.obj'. - rr nextPut: . - rr close. - -To get it back: - rr := ReferenceStream fileNamed: 'test.obj'. - := rr next. - rr close. - -Each object to be stored has two opportunities to control what gets stored. On the high level, objectToStoreOnDataStream allows you to substitute another object on the way out. The low level hook is storeDataOn:. The read-in counterparts to these messages are comeFullyUpOnReload and (class) readDataFrom:size:. See these methods for more information about externalizing and internalizing. - -NOTE: A DataStream should be treated as a write-stream for writing. It is a read-stream for reading. It is not a ReadWriteStream. - -" -Class { - #name : 'MCDataStream', - #superclass : 'Stream', - #instVars : [ - 'byteStream', - 'topCall', - 'basePos' - ], - #classVars : [ - 'ReadSelectors', - 'TypeMap', - 'WriteSelectors' - ], - #category : 'Monticello-Storing', - #package : 'Monticello', - #tag : 'Storing' -} - -{ #category : 'cleanup' } -MCDataStream class >> cleanUp [ - "Re-initialize DataStream to avoid hanging onto obsolete classes" - - self initialize -] - -{ #category : 'instance creation' } -MCDataStream class >> detectFile: aBlock do: anotherBlock [ - ^ aBlock value - ifNotNil: [ :file | - [ anotherBlock value: file ] - ensure: [ file close ] ] -] - -{ #category : 'instance creation' } -MCDataStream class >> fileNamed: aString [ - "Here is the way to use DataStream and ReferenceStream: - -| rr | -rr := ReferenceStream fileNamed: 'test.obj'. -rr nextPut: 'Zork'. -rr close. -" - - ^ self on: aString asFileReference binaryWriteStream -] - -{ #category : 'instance creation' } -MCDataStream class >> fileNamed: fileName do: aBlock [ - "Returns the result of aBlock." - - ^ self detectFile: [ self fileNamed: fileName ] do: aBlock -] - -{ #category : 'class initialization' } -MCDataStream class >> initialize [ - self initializeTypeMap -] - -{ #category : 'class initialization' } -MCDataStream class >> initializeTypeMap [ - "TypeMap maps Smalltalk classes to type ID numbers which identify the data stream primitive formats. nextPut: writes these IDs to the data stream. NOTE: Changing these type ID numbers will invalidate all extant data stream files. Adding new ones is OK. - Classes named here have special formats in the file. If such a class has a subclass, it will use type 9 and write correctly. It will just be slow. (Later write the class name in the special format, then subclasses can use the type also.) - See nextPut:, next, typeIDFor:, & ReferenceStream>>isAReferenceType:" - - "MCDataStream initialize" - - TypeMap := WeakKeyDictionary new: 80. "sparse for fast hashing" - ReadSelectors := WeakValueDictionary new: 80. - WriteSelectors := WeakValueDictionary new: 80. - - "These are all the type ids used in serialization and deserealization. The Missing types id are optional for Monticello, see package - Monticello-OldDataStreamCompatibility for the registering of the older types ids." - self - registerClass: UndefinedObject - atIndex: 1 - usingReadSelector: #readNil - usingWriteSelector: #writeNil:. - self - registerClass: True - atIndex: 2 - usingReadSelector: #readTrue - usingWriteSelector: #writeTrue:. - self - registerClass: False - atIndex: 3 - usingReadSelector: #readFalse - usingWriteSelector: #writeFalse:. - self - registerClass: SmallInteger - atIndex: 4 - usingReadSelector: #readInteger - usingWriteSelector: #writeInteger:. - self - registerClass: ByteSymbol - atIndex: 6 - usingReadSelector: #readSymbol - usingWriteSelector: #writeSymbol:. - self - registerClass: Array - atIndex: 8 - usingReadSelector: #readArray - usingWriteSelector: #writeArray:. - "Type id 9 is special." - self registerReaderSelector: #readInstance atIndex: 9. - self registerWriterSelector: #writeInstance: atIndex: 9. - - self - registerClass: ByteString - atIndex: 17 - usingReadSelector: #readString - usingWriteSelector: #writeString:. - - self registerClass: WideString - atIndex: 20 - usingReadSelector: #readWordLike - usingWriteSelector: #writeWordLike: -] - -{ #category : 'instance creation' } -MCDataStream class >> new [ - ^ self basicNew -] - -{ #category : 'instance creation' } -MCDataStream class >> newFileNamed: aString [ - "Here is the way to use DataStream and ReferenceStream: - |rr| - rr := ReferenceStream fileNamed: 'test.obj'. - rr nextPut: 'Zork'. - rr close. -" - | fileReference | - fileReference := aString asFileReference. - fileReference exists ifTrue: [ FileExists signalWith: fileReference ]. - ^ self on: fileReference binaryWriteStream -] - -{ #category : 'instance creation' } -MCDataStream class >> oldFileNamed: aString [ - "Here is the way to use DataStream and ReferenceStream: - - |rr | - rr := ReferenceStream oldFileNamed: 'test.obj'. - ^ rr nextAndClose. -" - - | strm fileReference | - fileReference := aString asFileReference. - fileReference exists ifFalse: [ ^ nil ]. - strm := self on: fileReference binaryWriteStream. - ^ strm -] - -{ #category : 'instance creation' } -MCDataStream class >> on: aStream [ - "Open a new DataStream onto a low-level I/O stream." - - ^ self basicNew setStream: aStream - -] - -{ #category : 'instance creation' } -MCDataStream class >> readOnlyFileNamed: aString [ - "Here is the way to use DataStream and ReferenceStream: - - |rr| - rr := ReferenceStream fileNamed: 'test.obj'. - rr nextPut: 'Zork'. - rr close. -" - - ^ self on: aString asFileReference binaryReadStream -] - -{ #category : 'instance creation' } -MCDataStream class >> readOnlyFileNamed: fileName do: aBlock [ - "Returns the result of aBlock." - - ^ self detectFile: [ self readOnlyFileNamed: fileName ] do: aBlock -] - -{ #category : 'class initialization' } -MCDataStream class >> readSelectors [ - ReadSelectors ifNil: [ self initializeTypeMap ]. - ^ReadSelectors -] - -{ #category : 'class initialization' } -MCDataStream class >> registerClass: aClass atIndex: anIndex usingReadSelector: readSelector usingWriteSelector: writeSelector [ - self typeMap at: aClass put: anIndex. - self readSelectors at: anIndex put: readSelector. - self writeSelectors at: anIndex put: writeSelector -] - -{ #category : 'class initialization' } -MCDataStream class >> registerReaderSelector: aSelector atIndex: index [ - self readSelectors at: index put: aSelector -] - -{ #category : 'class initialization' } -MCDataStream class >> registerWriterSelector: aSelector atIndex: anIndex [ - self writeSelectors at: anIndex put: aSelector -] - -{ #category : 'instance creation' } -MCDataStream class >> streamedRepresentationOf: anObject [ - - | file | - file := (ByteArray new: 5000) writeStream. - (self on: file) nextPut: anObject. - ^file contents -] - -{ #category : 'class initialization' } -MCDataStream class >> typeMap [ - TypeMap ifNil: [ self initializeTypeMap ]. - ^ TypeMap -] - -{ #category : 'class initialization' } -MCDataStream class >> writeSelectors [ - WriteSelectors ifNil: [ self initializeTypeMap ]. - ^ WriteSelectors -] - -{ #category : 'other' } -MCDataStream >> atEnd [ - "Answer true if the stream is at the end." - - ^ byteStream atEnd -] - -{ #category : 'write and read' } -MCDataStream >> beginInstance: aClass size: anInteger [ - "This is for use by storeDataOn: methods. - Cf. Object>>storeDataOn:." - - "Addition of 1 seems to make extra work, since readInstance - has to compensate. Here for historical reasons dating back - to Kent Beck's original implementation in late 1988. - - In ReferenceStream, class is just 5 bytes for shared symbol. - - SmartRefStream puts out the names and number of class's instances variables for checking." - - byteStream nextNumber: 4 put: anInteger + 1. - - self nextPut: aClass name -] - -{ #category : 'other' } -MCDataStream >> byteStream [ - ^ byteStream -] - -{ #category : 'other' } -MCDataStream >> close [ - "Close the stream." - - | bytes | - byteStream closed - ifFalse: [ - bytes := byteStream position. - byteStream close] - ifTrue: [bytes := 'unknown']. - ^ bytes -] - -{ #category : 'other' } -MCDataStream >> contents [ - ^byteStream contents -] - -{ #category : 'other' } -MCDataStream >> flush [ - "Guarantee that any writes to me are actually recorded on disk." - - ^ byteStream flush -] - -{ #category : 'write and read' } -MCDataStream >> next [ - "Answer the next object in the stream." - | type selector anObject internalObject | - - type := byteStream next. - type ifNil: [ - byteStream close. "clean up" - byteStream position = 0 - ifTrue: [self error: 'The file did not exist in this directory'] - ifFalse: [self error: 'Unexpected end of object file']. - ^ nil]. - type = 0 ifTrue: [ - byteStream close. "clean up" - self error: 'Expected start of object, but found 0'. - ^ nil]. - - selector := self class readSelectors at: type - ifAbsent:[ - byteStream close. - self error: 'Unrecognised type id. You should load the Monticello-OldDataStreamCompatibility package' - ]. - - anObject := self perform: selector. "A method that recursively - calls next (readArray, readInstance, objectAt:) must save & - restore the current reference position." - - "After reading the externalObject, internalize it. - #readReference is a special case. Either: - (1) We actually have to read the object, recursively calling - next, which internalizes the object. - (2) We just read a reference to an object already read and - thus already interalized. - Either way, we must not re-internalize the object here." - selector == #readReference ifTrue: [^ anObject]. - internalObject := anObject comeFullyUpOnReload: self. - ^ internalObject -] - -{ #category : 'other' } -MCDataStream >> next: anInteger [ - "Answer an Array of the next anInteger objects in the stream." - | array | - - array := Array new: anInteger. - 1 to: anInteger do: [:i | - array at: i put: self next]. - ^ array -] - -{ #category : 'write and read' } -MCDataStream >> nextPut: anObject [ - "Write anObject to the receiver stream. Answer anObject." - | typeID selector objectToStore | - - typeID := self typeIDFor: anObject. - - objectToStore := anObject. - - byteStream nextPut: typeID. - selector := self class writeSelectors at: typeID. - self perform: selector with: objectToStore. - - ^ anObject -] - -{ #category : 'write and read' } -MCDataStream >> nextPutAll: aCollection [ - "Write each of the objects in aCollection to the - receiver stream. Answer aCollection." - - ^ aCollection do: [ :each | self nextPut: each ] -] - -{ #category : 'write and read' } -MCDataStream >> objectAt: anInteger [ - "PRIVATE -- Read & return the object at a given stream position. 08:18 tk anInteger is a relative file position. " - | savedPosn anObject | - - savedPosn := byteStream position. "absolute" - - byteStream position: anInteger + basePos. "was relative" - anObject := self next. - - byteStream position: savedPosn. "absolute" - ^ anObject -] - -{ #category : 'write and read' } -MCDataStream >> readArray [ - "PRIVATE -- Read the contents of an Array. - We must do beginReference: here after instantiating the Array - but before reading its contents, in case the contents reference - the Array. beginReference: will be sent again when we return to - next, but that's ok as long as we save and restore the current - reference position over recursive calls to next." - - | count array | - count := byteStream nextNumber: 4. - - array := Array new: count. "relative pos" - 1 to: count do: [ :i | array at: i put: self next ]. - ^ array -] - -{ #category : 'write and read' } -MCDataStream >> readFalse [ - "PRIVATE -- Read the contents of a False." - - ^ false -] - -{ #category : 'write and read' } -MCDataStream >> readInstance [ - "PRIVATE -- Read the contents of an arbitrary instance. - ASSUMES: readDataFrom:size: sends me beginReference: after it - instantiates the new object but before reading nested objects. - NOTE: We must restore the current reference position after - recursive calls to next. - Let the instance, not the class read the data. " - - | instSize aSymbol anObject newClass | - instSize := (byteStream nextNumber: 4) - 1. - aSymbol := self next. - newClass := Smalltalk globals at: aSymbol asSymbol. - anObject := newClass isVariable - ifFalse: [ newClass basicNew ] - ifTrue: [ newClass basicNew: instSize - newClass instSize ]. "Create object here" - anObject := anObject readDataFrom: self size: instSize. - ^ anObject -] - -{ #category : 'write and read' } -MCDataStream >> readInteger [ - "PRIVATE -- Read the contents of a SmallInteger." - - ^ byteStream nextInt32 "signed!!!" -] - -{ #category : 'write and read' } -MCDataStream >> readNil [ - "PRIVATE -- Read the contents of an UndefinedObject." - - ^ nil -] - -{ #category : 'write and read' } -MCDataStream >> readString [ - - | length aByteArray | - length := byteStream next. "first byte." - length >= 192 ifTrue: [length := length - 192. - 1 to: 3 do: [:ii | length := length * 256 + byteStream next]]. - aByteArray := ByteArray new: length. - - byteStream nextInto: aByteArray. - - "An ascii string..." - ^ aByteArray asString. -] - -{ #category : 'write and read' } -MCDataStream >> readSymbol [ - "PRIVATE -- Read the contents of a Symbol." - ^ self readString asSymbol -] - -{ #category : 'write and read' } -MCDataStream >> readTrue [ - "PRIVATE -- Read the contents of a True." - - ^ true -] - -{ #category : 'write and read' } -MCDataStream >> readWordLike [ - | aSymbol newClass anObject | - "Can be used by any class that is bits and not bytes (WordArray, Bitmap, SoundBuffer, etc)." - aSymbol := self next. - newClass := Smalltalk globals at: aSymbol asSymbol. - anObject := newClass newFromStream: byteStream. "Size is number of long words." - ^ anObject -] - -{ #category : 'initialization' } -MCDataStream >> reset [ - "Reset the stream." - - byteStream reset -] - -{ #category : 'other' } -MCDataStream >> rootObject [ - "Return the object at the root of the tree we are filing out. " - - ^ topCall -] - -{ #category : 'other' } -MCDataStream >> rootObject: anObject [ - "Return the object at the root of the tree we are filing out. " - - topCall := anObject -] - -{ #category : 'other' } -MCDataStream >> setStream: aStream [ - "PRIVATE -- Initialization method." - - basePos := aStream position. "Remember where we start. Earlier part of file contains a class or method file-in. Allow that to be edited. We don't deal in absolute file locations." - byteStream := aStream. -] - -{ #category : 'other' } -MCDataStream >> size [ - "Answer the stream's size." - - ^ byteStream size -] - -{ #category : 'write and read' } -MCDataStream >> typeIDFor: anObject [ - "Return the typeID for anObject's class. This is where the tangle of objects is clipped to stop everything from going out. - Classes can control their instance variables by defining objectToStoreOnDataStream. - Any object in blockers is not written out. See ReferenceStream.objectIfBlocked: and DataStream nextPut:. - Morphs do not write their owners. See Morph.storeDataOn: Each morph tells itself to 'prepareToBeSaved' before writing out." - - ^ self class typeMap at: anObject class ifAbsent: [9 "instance of any normal class"] -"See DataStream initialize. nil=1. true=2. false=3. a SmallInteger=4. (a String was 5). a Symbol=6. a ByteArray=7. an Array=8. other = 9. a Bitmap=11. a Metaclass=12. a Float=14. a Rectangle=15. any instance that can have a short header=16. a String=17 (new format). a WordArray=18." -] - -{ #category : 'other' } -MCDataStream >> vacantRef [ - "Answer the magic 32-bit constant we use ***ON DISK*** as a stream 'reference - position' to identify a reference that's not yet filled in. This must be a - value that won't be used as an ordinary reference. Cf. outputReference: and - readReference. -- - NOTE: We could use a different type ID for vacant-refs rather than writing - object-references with a magic value. (The type ID and value are - overwritten by ordinary object-references when weak refs are fullfilled.)" - - ^ SmallInteger maxVal -] - -{ #category : 'write and read' } -MCDataStream >> writeArray: anArray [ - "PRIVATE -- Write the contents of an Array." - - byteStream nextNumber: 4 put: anArray size. - self nextPutAll: anArray. -] - -{ #category : 'write and read' } -MCDataStream >> writeFalse: aFalse [ - "PRIVATE -- Write the contents of a False." -] - -{ #category : 'write and read' } -MCDataStream >> writeInstance: anObject [ - "PRIVATE -- Write the contents of an arbitrary instance." - - ^ anObject storeDataOn: self -] - -{ #category : 'write and read' } -MCDataStream >> writeInteger: anInteger [ - "PRIVATE -- Write the contents of a SmallInteger." - - byteStream nextInt32Put: anInteger "signed!!!!!" -] - -{ #category : 'write and read' } -MCDataStream >> writeNil: anUndefinedObject [ - "PRIVATE -- Write the contents of an UndefinedObject." -] - -{ #category : 'write and read' } -MCDataStream >> writeString: aString [ - "PRIVATE -- Write the contents of a String." - - | length | - (length := aString size) < 192 - ifTrue: [byteStream nextPut: length] - ifFalse: - [byteStream nextPut: (length byteAt: 4)+192. - byteStream nextPut: (length byteAt: 3). - byteStream nextPut: (length byteAt: 2). - byteStream nextPut: (length byteAt: 1)]. - byteStream nextPutAll: aString asByteArray. -] - -{ #category : 'write and read' } -MCDataStream >> writeSymbol: aSymbol [ - "PRIVATE -- Write the contents of a Symbol." - - self writeString: aSymbol -] - -{ #category : 'write and read' } -MCDataStream >> writeTrue: aTrue [ - "PRIVATE -- Write the contents of a True." -] diff --git a/src/Monticello/MCMczReader.class.st b/src/Monticello/MCMczReader.class.st index fd3d8bf8a44..36a0a49d56c 100644 --- a/src/Monticello/MCMczReader.class.st +++ b/src/Monticello/MCMczReader.class.st @@ -134,15 +134,6 @@ MCMczReader >> infoCache [ MCMczReader >> loadDefinitions [ definitions := OrderedCollection new. - (self zip memberNamed: 'snapshot.bin') ifNotNil: [ :m | - [ - definitions := (MCDataStream on: m contents readStream) next definitions. - self adaptDefinitions. - ^ definitions ] - on: Error - do: [ :fallThrough | - ('An error happened while reading MCZ. We will fallback to another format. Short error stack: ' , fallThrough signalerContext shortStack) traceCr ] ]. - "otherwise" (self zip membersMatching: 'snapshot/*') do: [ :m | self extractDefinitionsFrom: m ] ] diff --git a/src/Monticello/MCMczWriter.class.st b/src/Monticello/MCMczWriter.class.st index cf25a00b8fe..3ddc62b5a94 100644 --- a/src/Monticello/MCMczWriter.class.st +++ b/src/Monticello/MCMczWriter.class.st @@ -69,14 +69,6 @@ MCMczWriter >> serializeDefinitions: aCollection [ writer writeDefinitions: aCollection] ] -{ #category : 'serializing' } -MCMczWriter >> serializeInBinary: aSnapshot [ - - ^ ByteArray streamContents: [ :str | | writer | - writer := MCDataStream on: str. - writer nextPut: aSnapshot ] -] - { #category : 'serializing' } MCMczWriter >> serializePackage: aPackage [ ^ '(name ''', aPackage name, ''')' @@ -113,8 +105,10 @@ MCMczWriter >> writePackage: aPackage [ { #category : 'visiting' } MCMczWriter >> writeSnapshot: aSnapshot [ - self addString: (self serializeDefinitions: aSnapshot definitions) at: 'snapshot/source.' , self snapshotWriterClass extension encodedTo: 'utf8'. - self addString: (self serializeInBinary: aSnapshot) at: 'snapshot.bin' + self + addString: (self serializeDefinitions: aSnapshot definitions) + at: 'snapshot/source.' , self snapshotWriterClass extension + encodedTo: 'utf8' ] { #category : 'visiting' } diff --git a/src/Monticello/Object.extension.st b/src/Monticello/Object.extension.st index 831215d4f68..e51c69b30e2 100644 --- a/src/Monticello/Object.extension.st +++ b/src/Monticello/Object.extension.st @@ -31,23 +31,3 @@ Object >> readDataFrom: aDataStream size: varsOnDisk [ ^ self "If we ever return something other than self, fix calls on (super readDataFrom: aDataStream size: anInteger)" ] - -{ #category : '*Monticello-Storing' } -Object >> storeDataOn: aDataStream [ - "Store myself on a DataStream. Answer self. This is a low-level DataStream/ReferenceStream method. See also objectToStoreOnDataStream. NOTE: This method must send 'aDataStream beginInstance:size:' and then (nextPut:/nextPutWeak:) its subobjects. readDataFrom:size: reads back what we write here." - | cntInstVars cntIndexedVars | - - cntInstVars := self class instSize. - cntIndexedVars := self basicSize. - aDataStream - beginInstance: self class - size: cntInstVars + cntIndexedVars. - 1 to: cntInstVars do: - [:i | aDataStream nextPut: (self instVarAt: i)]. - - "Write fields of a variable length object. " - (self class isBits) ifFalse: [ - 1 to: cntIndexedVars do: - [:i | aDataStream nextPut: (self basicAt: i)]]. - -] diff --git a/src/PharoBootstrap/PBBootstrap.class.st b/src/PharoBootstrap/PBBootstrap.class.st index ffdfc318d08..5c1baded076 100644 --- a/src/PharoBootstrap/PBBootstrap.class.st +++ b/src/PharoBootstrap/PBBootstrap.class.st @@ -189,7 +189,6 @@ PBBootstrap >> exportMonticelloInStFile [ MCWorkingCopy initialize. MCLazyVersionInfo initialize. MCMethodDefinition initialize. - MCDataStream initialize. UUIDGenerator initialize.' intoFile: 'Monticello.st'