[Vm-dev] Fwd: [squeak-dev] The Inbox: ImageFormat-kks.34.mcz
David T. Lewis
lewis at mail.msen.com
Wed Apr 10 18:20:28 UTC 2019
Hi Subbu,
There is now an inbox for VMMaker that you can use for this:
MCHttpRepository
location: 'http://source.squeak.org/VMMakerInbox'
user: ''
password: ''
Dave
> Hi,
>
> How do I submit fixes to VMMaker? Is there a separate Inbox?
>
> I just uploaded *-34.mcz nad *-35.mcz to Inbox. I hope I didn't annoy
> squeak-dev readers with VMMaker patches.
>
> Thanks and Regards .. Subbu
>
> -------- Forwarded Message --------
> Subject: [squeak-dev] The Inbox: ImageFormat-kks.34.mcz
> Date: Wed, 10 Apr 2019 17:13:58 0000
> From: commits at source.squeak.org
> Reply-To: squeak-dev at lists.squeakfoundation.org
> To: squeak-dev at lists.squeakfoundation.org
>
> A new version of ImageFormat was added to project The Inbox:
> http://source.squeak.org/inbox/ImageFormat-kks.34.mcz
>
> ==================== Summary ====================
>
> Name: ImageFormat-kks.34
> Author: kks
> Time: 10 April 2019, 10:43:56.983339 pm
> UUID: b6d8d060-b305-437e-93b7-68e5427a76e0
> Ancestors: ImageFormat-dtl.33
>
> Added support for images whose header begins 512 bytes into the file.
> Expanded comments to explain magic file use.
>
> ==================== Snapshot ====================
>
> SystemOrganization addCategory: #'ImageFormat-Header'!
> SystemOrganization addCategory: #'ImageFormat-Tests'!
>
> Object subclass: #ImageFileHeader
> instanceVariableNames: 'imageFormat headerSize imageBytes startOfMemory
> specialObjectsOop lastHash screenSize imageHeaderFlags extraVMMemory'
> classVariableNames: ''
> poolDictionaries: ''
> category: 'ImageFormat-Header'!
>
> !ImageFileHeader commentStamp: 'dtl 11/1/2012 07:46' prior: 0!
> An ImageFileHeader represents the information in the header block of an
> image file, used by an interpreter VM. Subclasses may implement
> extensions for Cog or other header extensions.
>
> Instance variables correspond to the fields in an image file header. An
> instance of ImageFileHeader may be created by reading from an image
> file, and an ImageFileHeader may be written to a file.
>
> When stored to a file, the file header fields may be 32 or 64 bits in
> size, depending on the image format. The byte ordering of each field
> will be little endian or big endian, depending on the convention of the
> host platform. When reading from disk, endianness is inferred from the
> contents of the first data field.
>
> To explore the file header of an image file:
>
> | fs |
> fs := (FileStream readOnlyFileNamed: Smalltalk imageName) binary.
> ([ImageFileHeader readFrom: fs] ensure: [fs close]) explore
> !
>
> ImageFileHeader subclass: #CogImageFileHeader
> instanceVariableNames: 'desiredNumStackPages unknownShortOrCodeSizeInKs
> desiredEdenBytes maxExtSemTabSizeSet'
> classVariableNames: ''
> poolDictionaries: ''
> category: 'ImageFormat-Header'!
>
> !CogImageFileHeader commentStamp: 'dtl 10/31/2012 20:23' prior: 0!
> CogImageFileHeader is an extension of ImageFileHeader with additional
> fields that are used by Cog and Stack VMs. Some of the additional fields
> are encoded as short short integers, which are 16 bits when the header
> word size is 32, and 32 bits when the header word size is 64. All
> current Cog VMs use 32 bit word size with 16 bit short integer fields.!
>
> ----- Method: CogImageFileHeader>>desiredEdenBytes (in category
> 'accessing') -----
> desiredEdenBytes
>
> ^ desiredEdenBytes!
>
> ----- Method: CogImageFileHeader>>desiredEdenBytes: (in category
> 'accessing') -----
> desiredEdenBytes: anInteger
>
> desiredEdenBytes := anInteger!
>
> ----- Method: CogImageFileHeader>>desiredNumStackPages (in category
> 'accessing') -----
> desiredNumStackPages
>
> ^ desiredNumStackPages!
>
> ----- Method: CogImageFileHeader>>desiredNumStackPages: (in category
> 'accessing') -----
> desiredNumStackPages: anInteger
>
> desiredNumStackPages := anInteger!
>
> ----- Method: CogImageFileHeader>>fromEntryStream: (in category
> 'reading') -----
> fromEntryStream: streamOfHeaderStateObjects
>
> super fromEntryStream: streamOfHeaderStateObjects.
> desiredNumStackPages := streamOfHeaderStateObjects next.
> unknownShortOrCodeSizeInKs := streamOfHeaderStateObjects next.
> desiredEdenBytes := streamOfHeaderStateObjects next.
> maxExtSemTabSizeSet := streamOfHeaderStateObjects next.
> !
>
> ----- Method: CogImageFileHeader>>maxExtSemTabSizeSet (in category
> 'accessing') -----
> maxExtSemTabSizeSet
>
> ^ maxExtSemTabSizeSet!
>
> ----- Method: CogImageFileHeader>>maxExtSemTabSizeSet: (in category
> 'accessing') -----
> maxExtSemTabSizeSet: anInteger
>
> maxExtSemTabSizeSet := anInteger!
>
> ----- Method:
> CogImageFileHeader>>readFieldsFrom:startingAt:headerWordSize:littleEndian:into:
> (in category 'reading') -----
> readFieldsFrom: aStream startingAt: imageOffset headerWordSize:
> headerWordSize littleEndian: littleEndian into: aCollection
> "Read data fields and answer number of bytes read"
>
> | remainder bytesRead |
> bytesRead := super readFieldsFrom: aStream startingAt: imageOffset
> headerWordSize: headerWordSize littleEndian: littleEndian into:
> aCollection.
> aCollection add: (self nextNumber: headerWordSize / 2 from: aStream
> littleEndian: littleEndian). "desiredNumStackPages"
> aCollection add: (self nextNumber: headerWordSize / 2 from: aStream
> littleEndian: littleEndian). "unknownShortOrCodeSizeInKs"
> aCollection add: (self nextNumber: headerWordSize from: aStream
> littleEndian: littleEndian). "desiredEdenBytes"
> aCollection add: (self nextNumber: headerWordSize / 2 from: aStream
> littleEndian: littleEndian). "maxExtSemTabSizeSet"
> self nextNumber: headerWordSize / 2 from: aStream littleEndian:
> littleEndian.
> remainder := headerSize - (12 * imageFormat wordSize).
> self assert: remainder >= 0. "n.b. Mantis 7455 bug in original 64 bit
> image due to VMM error"
> ^3 * imageFormat wordSize + bytesRead.
> !
>
> ----- Method: CogImageFileHeader>>storeOn: (in category 'printing') -----
> storeOn: aStream "Append to the argument aStream a sequence of
> characters that is an expression whose evaluation creates an object
> similar to the receiver."
>
> super storeOn: aStream.
>
> aStream nextPutAll: '; desiredNumStackPages: '.
> desiredNumStackPages storeOn: aStream.
>
> aStream nextPutAll: '; unknownShortOrCodeSizeInKs: '.
> unknownShortOrCodeSizeInKs storeOn: aStream.
>
> aStream nextPutAll: '; desiredEdenBytes: '.
> desiredEdenBytes storeOn: aStream.
>
> aStream nextPutAll: '; maxExtSemTabSizeSet: '.
> maxExtSemTabSizeSet storeOn: aStream.
> !
>
> ----- Method: CogImageFileHeader>>unknownShortOrCodeSizeInKs (in
> category 'accessing') -----
> unknownShortOrCodeSizeInKs
>
> ^ unknownShortOrCodeSizeInKs!
>
> ----- Method: CogImageFileHeader>>unknownShortOrCodeSizeInKs: (in
> category 'accessing') -----
> unknownShortOrCodeSizeInKs: anInteger
>
> unknownShortOrCodeSizeInKs := anInteger!
>
> ----- Method:
> CogImageFileHeader>>writeFieldsTo:littleEndian:headerWordSize: (in
> category 'writing') -----
> writeFieldsTo: aStream littleEndian: littleEnder headerWordSize:
> headerWordSize
> "Write data fields and answer number of bytes written"
>
> | bytesWritten |
> bytesWritten := super writeFieldsTo: aStream littleEndian: littleEnder
> headerWordSize: headerWordSize.
> self nextNumber: headerWordSize / 2 put: desiredNumStackPages to:
> aStream littleEndian: littleEnder.
> self nextNumber: headerWordSize / 2 put: unknownShortOrCodeSizeInKs to:
> aStream littleEndian: littleEnder.
> self nextNumber: headerWordSize put: desiredEdenBytes to: aStream
> littleEndian: littleEnder.
> self nextNumber: headerWordSize / 2 put: maxExtSemTabSizeSet to:
> aStream littleEndian: littleEnder.
> self nextNumber: headerWordSize / 2 put: 0 to: aStream littleEndian:
> littleEnder.
> ^3 * imageFormat wordSize + bytesWritten.
> !
>
> ----- Method: ImageFileHeader class>>fromValues: (in category 'instance
> creation') -----
> fromValues: headerValues
> "Answer an new instance initialized from an array of values
> corresponding to
> fields in an image file header on disk. The values may have been read
> from a
> file, or they may have been created by querying the running VM."
>
> "self fromValues:self primInterpreterStateSnapshot"
>
> ^self basicNew fromEntryStream: headerValues readStream
> !
>
> ----- Method: ImageFileHeader class>>primInterpreterStateSnapshot (in
> category 'primitive access') -----
> primInterpreterStateSnapshot
> "Answer an array of values suitable for creating an image file header"
>
> "ImageFileHeader primInterpreterStateSnapshot"
>
> "ImageFileHeader fromValues: ImageFileHeader
> primInterpreterStateSnapshot"
>
> <primitive: 'primitiveInterpreterStateSnapshot'>
> self primitiveFailed!
>
> ----- Method: ImageFileHeader class>>primMemoryCopy (in category
> 'primitive access') -----
> primMemoryCopy
> "Answer an exact copy of the current object memory"
>
> "ImageFileHeader primMemoryCopy"
>
> <primitive: 'primitiveMemoryCopy'>
> self primitiveFailed!
>
> ----- Method: ImageFileHeader class>>primMemorySnapshotWithHeader (in
> category 'primitive access') -----
> primMemorySnapshotWithHeader
> "Answer an array with a snapshot of the object memory, and with an
> interpreter
> state array of values suitable for creating an image file header. This
> is an atomic
> request for primitiveMemorySnapshot and
> primitiveInterpreterStateSnapshot."
>
> "ImageFileHeader primMemorySnapshotWithHeader"
>
> " | result |
> result := ImageFileHeader primMemorySnapshotWithHeader.
> { result first . ImageFileHeader fromValues: result second } "
>
> <primitive: 'primitiveMemorySnapshotWithHeader'>
> self primitiveFailed!
>
> ----- Method: ImageFileHeader class>>readFrom: (in category 'instance
> creation') -----
> readFrom: aStream
>
> ^self readFrom: aStream startingAt: 0!
>
> ----- Method: ImageFileHeader class>>readFrom:startingAt: (in category
> 'instance creation') -----
> readFrom: aStream startingAt: imageOffset
>
> ^self basicNew readFrom: aStream startingAt: imageOffset into:
> OrderedCollection new!
>
> ----- Method: ImageFileHeader>>= (in category 'comparing') -----
> = other
>
> self species == other species ifFalse: [^ false].
> 1 to: self class instSize do:
> [:i | (self instVarAt: i) = (other instVarAt: i) ifFalse: [^ false]].
> ^ true!
>
> ----- Method: ImageFileHeader>>asByteArray (in category 'converting')
> -----
> asByteArray
> ^ ByteArray
> streamContents: [:strm | self writeTo: strm littleEndian: Smalltalk
> isLittleEndian]!
>
> ----- Method: ImageFileHeader>>asValues (in category 'converting') -----
> asValues
> "Answer an array of values from which a copy of this instance could be
> created with #fromValues:"
>
> "self fromValues: (self fromValues:self primInterpreterStateSnapshot)
> asValues"
>
> ^Array new writeStream
> nextPut: imageFormat asInteger;
> nextPut: headerSize;
> nextPut: imageBytes;
> nextPut: startOfMemory;
> nextPut: specialObjectsOop;
> nextPut: lastHash;
> nextPut: screenSize;
> nextPut: imageHeaderFlags;
> nextPut: extraVMMemory;
> contents
> !
>
> ----- Method: ImageFileHeader>>extraVMMemory (in category 'accessing')
> -----
> extraVMMemory
>
> ^ extraVMMemory!
>
> ----- Method: ImageFileHeader>>extraVMMemory: (in category 'accessing')
> -----
> extraVMMemory: anInteger
>
> extraVMMemory := anInteger!
>
> ----- Method: ImageFileHeader>>fromEntryStream: (in category 'reading')
> -----
> fromEntryStream: streamOfHeaderStateObjects
>
> imageFormat := ImageFormat fromInteger: streamOfHeaderStateObjects next.
> headerSize := streamOfHeaderStateObjects next.
> imageBytes := streamOfHeaderStateObjects next.
> startOfMemory := streamOfHeaderStateObjects next.
> specialObjectsOop := streamOfHeaderStateObjects next.
> lastHash := streamOfHeaderStateObjects next.
> screenSize := streamOfHeaderStateObjects next. "a Point with two
> integer values for X and Y extent"
> imageHeaderFlags := streamOfHeaderStateObjects next.
> extraVMMemory := streamOfHeaderStateObjects next.
>
> !
>
> ----- Method: ImageFileHeader>>hash (in category 'comparing') -----
> hash
> ^imageBytes hash xor: lastHash!
>
> ----- Method: ImageFileHeader>>headerSize (in category 'accessing') -----
> headerSize
>
> ^ headerSize!
>
> ----- Method: ImageFileHeader>>headerSize: (in category 'accessing') -----
> headerSize: anInteger
>
> headerSize := anInteger!
>
> ----- Method: ImageFileHeader>>imageBytes (in category 'accessing') -----
> imageBytes
>
> ^ imageBytes!
>
> ----- Method: ImageFileHeader>>imageBytes: (in category 'accessing') -----
> imageBytes: anInteger
>
> imageBytes := anInteger!
>
> ----- Method: ImageFileHeader>>imageFormat (in category 'accessing') -----
> imageFormat
>
> ^ imageFormat!
>
> ----- Method: ImageFileHeader>>imageFormat: (in category 'accessing')
> -----
> imageFormat: anImageFormat
>
> imageFormat := anImageFormat!
>
> ----- Method: ImageFileHeader>>imageHeaderFlags (in category
> 'accessing') -----
> imageHeaderFlags
>
> ^ imageHeaderFlags!
>
> ----- Method: ImageFileHeader>>imageHeaderFlags: (in category
> 'accessing') -----
> imageHeaderFlags: anInteger
>
> imageHeaderFlags := anInteger!
>
> ----- Method: ImageFileHeader>>lastHash (in category 'accessing') -----
> lastHash
>
> ^ lastHash!
>
> ----- Method: ImageFileHeader>>lastHash: (in category 'accessing') -----
> lastHash: anInteger
>
> lastHash := anInteger!
>
> ----- Method: ImageFileHeader>>nextNumber:from:littleEndian: (in
> category 'reading') -----
> nextNumber: length from: aStream littleEndian: littleEnder
>
> littleEnder
> ifTrue: [^aStream nextLittleEndianNumber: length]
> ifFalse: [^aStream nextNumber: length]!
>
> ----- Method: ImageFileHeader>>nextNumber:put:to:littleEndian: (in
> category 'writing') -----
> nextNumber: n put: v to: aStream littleEndian: littleEnder
>
> littleEnder
> ifTrue: [^aStream nextLittleEndianNumber: n put: v]
> ifFalse: [^aStream nextNumber: n put: v]!
>
> ----- Method: ImageFileHeader>>printOn: (in category 'printing') -----
> printOn: aStream
>
> super printOn: aStream.
> imageFormat ifNotNil: [
> aStream nextPutAll: ' for '.
> imageFormat printDescriptionOn: aStream]!
>
> ----- Method:
> ImageFileHeader>>readFieldsFrom:startingAt:headerWordSize:littleEndian:into:
> (in category 'reading') -----
> readFieldsFrom: aStream startingAt: imageOffset headerWordSize:
> headerWordSize littleEndian: littleEndian into: aCollection
> "Read data fields and answer number of bytes read"
>
> | remainder screenSizeWord |
> headerSize := self nextNumber: headerWordSize from: aStream
> littleEndian: littleEndian.
> aCollection add: headerSize.
> aCollection add: ( self nextNumber: headerWordSize from: aStream
> littleEndian: littleEndian). "imageBytes"
> aCollection add: (self nextNumber: headerWordSize from: aStream
> littleEndian: littleEndian). "startOfMemory"
> aCollection add: (self nextNumber: headerWordSize from: aStream
> littleEndian: littleEndian). "specialObjectsOop"
> aCollection add: (self nextNumber: headerWordSize from: aStream
> littleEndian: littleEndian). "lastHash"
> screenSizeWord := self nextNumber: headerWordSize from: aStream
> littleEndian: littleEndian.
> aCollection add: ((screenSizeWord >> 16) @ (screenSizeWord bitAnd:
> 16rFFFF)).
> aCollection add: (self nextNumber: headerWordSize from: aStream
> littleEndian: littleEndian). "imageHeaderFlags"
> aCollection add: (self nextNumber: headerWordSize from: aStream
> littleEndian: littleEndian). "extraVMMemory"
> remainder := headerSize - (9 * imageFormat wordSize).
> self assert: remainder >= 0. "n.b. Mantis 7455 bug in original 64 bit
> image due to VMM error"
> ^9 * imageFormat wordSize.
> !
>
> ----- Method: ImageFileHeader>>readFrom:startingAt:into: (in category
> 'reading') -----
> readFrom: aStream startingAt: imageOffset into: aCollection
>
> | remainder bytesRead headerWordSize littleEndian |
> littleEndian := self readImageVersionFrom: aStream startingAt:
> imageOffset.
> headerWordSize := aStream position - imageOffset.
> aCollection add: imageFormat asInteger.
> bytesRead := self readFieldsFrom: aStream startingAt: imageOffset
> headerWordSize: headerWordSize littleEndian: littleEndian into:
> aCollection.
> remainder := headerSize - bytesRead.
> self assert: remainder >= 0. "n.b. Mantis 7455 bug in original 64 bit
> image due to VMM error"
> aStream next: (headerSize - bytesRead).
>
> self fromEntryStream: aCollection readStream.
> !
>
> ----- Method: ImageFileHeader>>readImageVersionFrom:startingAt: (in
> category 'reading') -----
> readImageVersionFrom: aStream startingAt: imageOffset
> "Look for image format in the next 4 or 8 bytes and set imageFormat.
> Answer true
> if the header is written in little endian format."
>
> (aStream nextNumber: 4) caseOf:
> {
> [ 16r00001966 "6502" ] -> [ imageFormat := ImageFormat fromInteger:
> 6502. ^false ] .
> [ 16r66190000 "6502" ] -> [ imageFormat := ImageFormat fromInteger:
> 6502. ^true ] .
> [ 16r00001968 "6504" ] -> [ imageFormat := ImageFormat fromInteger:
> 6504. ^false ] .
> [ 16r68190000 "6504" ] -> [ imageFormat := ImageFormat fromInteger:
> 6504. ^true ] .
> [ 16r00001969 "6505" ] -> [ imageFormat := ImageFormat fromInteger:
> 6505. ^false ] .
> [ 16r69190000 "6505" ] -> [ imageFormat := ImageFormat fromInteger:
> 6505. ^true ] .
> [ 16r00001979 "6521" ] -> [ imageFormat := ImageFormat fromInteger:
> 6521. ^false ] .
> [ 16r79190000 "6521" ] -> [ imageFormat := ImageFormat fromInteger:
> 6521. ^true ] .
> [ 16rA0090100 "68000" ] -> [ imageFormat := ImageFormat fromInteger:
> 68000. aStream next: 4. ^true ] .
> [ 16rA2090100 "68002" ] -> [ imageFormat := ImageFormat fromInteger:
> 68002. aStream next: 4. ^true ] .
> [ 16rA3090100 "68003" ] -> [ imageFormat := ImageFormat fromInteger:
> 68003. aStream next: 4. ^true ] .
> [ 16rB3090100 "68019" ] -> [ imageFormat := ImageFormat fromInteger:
> 68019. aStream next: 4. ^true ] .
> [ 16r000109B3 "68019" ] -> [ imageFormat := ImageFormat fromInteger:
> 68019. aStream next: 4. ^false ] .
> [ 16rB5090100 "68021" ] -> [ imageFormat := ImageFormat fromInteger:
> 68021. aStream next: 4. ^true ] .
> [ 16r000109B5 "68021" ] -> [ imageFormat := ImageFormat fromInteger:
> 68021. aStream next: 4. ^false ] .
> [ 16r00000000 ] -> [
> "Standard interpreter VM puts the format number in the first 64 bits
> for a 64 bit image, so
> the leading 4 bytes are zero in this case. Cog/Spur VMs put the
> format number in the first
> 32 bits for both 32 and 64 bit images."
> (aStream nextNumber: 4) caseOf: {
> [ 16r000109A0 "68000" ] -> [ imageFormat := ImageFormat
> fromInteger: 68000. ^false ] .
> [ 16r000109A2 "68002" ] -> [ imageFormat := ImageFormat
> fromInteger: 68002. ^false ] .
> [ 16r000109A3 "68003" ] -> [ imageFormat := ImageFormat
> fromInteger: 68003. ^false ] .
> [ 16r000109B3 "68019" ] -> [ imageFormat := ImageFormat
> fromInteger: 68019. ^false ] .
> } otherwise: [self error: self asString , ' unrecognized format
> number']
> ]
> } otherwise: [self error: self asString , ' unrecognized format number']
>
> "ImageFormat versionNumberByteArrays do: [:e |
> Transcript cr; show: e printString , ': ', (ImageFormat fromBytes: e)
> description]
>
> #[0 0 25 102]: a 32-bit image with no closure support and no native
> platform float word order requirement (6502)
> #[102 25 0 0]: a 32-bit image with no closure support and no native
> platform float word order requirement (6502)
> #[0 0 25 104]: a 32-bit image with closure support and no native
> platform float word order requirement (6504)
> #[104 25 0 0]: a 32-bit image with closure support and no native
> platform float word order requirement (6504)
> #[0 0 0 0 0 1 9 160]: a 64-bit image with no closure support and no
> native platform float word order requirement (68000)
> #[160 9 1 0 0 0 0 0]: a 64-bit image with no closure support and no
> native platform float word order requirement (68000)
> #[0 0 0 0 0 1 9 162]: a 64-bit image with closure support and no native
> platform float word order requirement (68002)
> #[162 9 1 0 0 0 0 0]: a 64-bit image with closure support and no native
> platform float word order requirement (68002)
> #[0 0 25 105]: a 32-bit image with closure support and float words
> stored in native platform order (6505)
> #[105 25 0 0]: a 32-bit image with closure support and float words
> stored in native platform order (6505)
> #[0 0 0 0 0 1 9 163]: a 64-bit image with closure support and float
> words stored in native platform order (68003)
> #[163 9 1 0 0 0 0 0]: a 64-bit image with closure support and float
> words stored in native platform order (68003)
> #[0 0 25 121]: a 32-bit image with closure support and float words
> stored in native platform order using Spur object format (6521)
> #[121 25 0 0]: a 32-bit image with closure support and float words
> stored in native platform order using Spur object format (6521)
> #[0 0 0 0 0 1 9 179]: a 64-bit image with closure support and float
> words stored in native platform order using Spur object format
> (obsolete) (68019)
> #[179 9 1 0 0 0 0 0]: a 64-bit image with closure support and float
> words stored in native platform order using Spur object format
> (obsolete) (68019)
> #[0 0 0 0 0 1 9 181]: a 64-bit image with closure support and float
> words stored in native platform order using Spur object format (68021)
> #[181 9 1 0 0 0 0 0]: a 64-bit image with closure support and float
> words stored in native platform order using Spur object format (68021)
> "
> !
>
> ----- Method: ImageFileHeader>>screenSize (in category 'accessing') -----
> screenSize
> "World extent at the time of image save, packed into 32 bit integer when
> saved to file header."
>
> "right= windowBounds.x + ((unsigned)savedWindowSize >> 16);
> bottom= windowBounds.y + (savedWindowSize & 0xFFFF);"
>
> ^ screenSize!
>
> ----- Method: ImageFileHeader>>screenSize: (in category 'accessing') -----
> screenSize: aPoint
> "World extent at the time of image save, packed into 32 bit integer when
> saved to file header."
>
> "right= windowBounds.x + ((unsigned)savedWindowSize >> 16);
> bottom= windowBounds.y + (savedWindowSize & 0xFFFF);"
>
> screenSize := aPoint
> !
>
> ----- Method: ImageFileHeader>>specialObjectsOop (in category
> 'accessing') -----
> specialObjectsOop
>
> ^ specialObjectsOop!
>
> ----- Method: ImageFileHeader>>specialObjectsOop: (in category
> 'accessing') -----
> specialObjectsOop: anInteger
>
> specialObjectsOop := anInteger!
>
> ----- Method: ImageFileHeader>>startOfMemory (in category 'accessing')
> -----
> startOfMemory
>
> ^ startOfMemory!
>
> ----- Method: ImageFileHeader>>startOfMemory: (in category 'accessing')
> -----
> startOfMemory: anInteger
>
> startOfMemory := anInteger!
>
> ----- Method: ImageFileHeader>>storeOn: (in category 'printing') -----
> storeOn: aStream "Append to the argument aStream a sequence of
> characters that is an expression whose evaluation creates an object
> similar to the receiver."
>
> aStream nextPutAll: self class name;
> nextPutAll: ' new imageFormat: ('.
> imageFormat storeOn: aStream.
>
> aStream nextPutAll: '); headerSize: '.
> headerSize storeOn: aStream.
>
> aStream nextPutAll: '; imageBytes: '.
> imageBytes storeOn: aStream.
>
> aStream nextPutAll: '; startOfMemory: '.
> startOfMemory storeOn: aStream.
>
> aStream nextPutAll: '; specialObjectsOop: '.
> specialObjectsOop storeOn: aStream.
>
> aStream nextPutAll: '; lastHash: '.
> lastHash storeOn: aStream.
>
> aStream nextPutAll: '; screenSize: '.
> screenSize storeOn: aStream.
>
> aStream nextPutAll: '; imageHeaderFlags: '.
> imageHeaderFlags storeOn: aStream.
>
> aStream nextPutAll: '; extraVMMemory: '.
> extraVMMemory storeOn: aStream.
>
> !
>
> ----- Method:
> ImageFileHeader>>writeFieldsTo:littleEndian:headerWordSize: (in category
> 'writing') -----
> writeFieldsTo: aStream littleEndian: littleEnder headerWordSize:
> headerWordSize
> "Write data fields and answer number of bytes written"
>
> self nextNumber: headerWordSize put: imageFormat asInteger to: aStream
> littleEndian: littleEnder.
> self nextNumber: headerWordSize put: headerSize to: aStream
> littleEndian: littleEnder.
> self nextNumber: headerWordSize put: imageBytes to: aStream
> littleEndian: littleEnder.
> self nextNumber: headerWordSize put: startOfMemory to: aStream
> littleEndian: littleEnder.
> self nextNumber: headerWordSize put: specialObjectsOop to: aStream
> littleEndian: littleEnder.
> self nextNumber: headerWordSize put: lastHash to: aStream littleEndian:
> littleEnder.
> self nextNumber: headerWordSize put: ((screenSize x) << 16 +
> (screenSize y)) to: aStream littleEndian: littleEnder.
> self nextNumber: headerWordSize put: imageHeaderFlags to: aStream
> littleEndian: littleEnder.
> self nextNumber: headerWordSize put: extraVMMemory to: aStream
> littleEndian: littleEnder.
> ^9 * imageFormat wordSize.
> !
>
> ----- Method: ImageFileHeader>>writeTo:littleEndian: (in category
> 'writing') -----
> writeTo: aStream littleEndian: littleEnder
>
> | headerWordSize remainder bytesWritten |
> headerWordSize := imageFormat wordSize.
> bytesWritten := self writeFieldsTo: aStream littleEndian: littleEnder
> headerWordSize: headerWordSize.
> remainder := headerSize - bytesWritten.
> self assert: remainder >= 0. "n.b. Mantis 7455 bug in original 64 bit
> image due to VMM error"
> remainder timesRepeat: [aStream nextPut: 0].
> !
>
> Object subclass: #ImageFormat
> instanceVariableNames: 'wordSize requiresClosureSupport
> requiresNativeFloatWordOrder requiresSpurSupport
> requiresNewSpur64TagAssignment'
> classVariableNames: 'BaseVersionMask BaseVersionNumbers
> CapabilitiesBitsMask KnownVersionNumbers PlatformByteOrderBit
> ReservedBitsMask SpurObjectBit'
> poolDictionaries: ''
> category: 'ImageFormat-Header'!
>
> !ImageFormat commentStamp: 'dtl 11/7/2010 22:13' prior: 0!
> ImageFormat represents the requirements of the image in terms of
> capabilities that must be supported by the virtual machine. The image
> format version is saved as an integer value in the header of an image
> file. When an image is loaded, the virtual machine checks the image
> format version to determine whether it is capable of supporting the
> requirements of that image.
>
> The image format version value is treated as a bit map of size 32,
> derived from the 32-bit integer value saved in the image header. Bits in
> the bit map represent image format requirements. For example, if the
> image sets bit 15 to indicate that it requires some capability from the
> VM, then the VM can check bit 15 and decide whether it is able to
> satisfy that requirement.
>
> The base image format numbers (6502, 6504, 68000, and 68002) utiliize 10
> of the 32 available bits. The high order bit is reserved as an extension
> bit for future use. The remaining 21 bits are used to represent
> additional image format requirements. For example, the low order bit is
> used to indication that the image uses (and requires support for) the
> platform byte ordering implemented in the StackInterpreter (Cog) VM.
>
> "(ImageFormat fromFile: Smalltalk imageName) description"
> !
>
> ----- Method: ImageFormat class>>allVersionNumberByteArrays (in category
> 'utility') -----
> allVersionNumberByteArrays
> "All known version numbers expressed as byte arrays of size 4 and 8 in
> little
> endian and big endian byte ordering."
>
> "ImageFormat allVersionNumberByteArrays"
>
> | byteArrays |
> byteArrays := OrderedCollection new.
> KnownVersionNumbers do: [:version |
> byteArrays add: ((WriteStream on: (ByteArray new: 4)) nextNumber: 4
> put: version; yourself) contents.
> byteArrays add: ((WriteStream on: (ByteArray new: 8)) nextNumber: 8
> put: version; yourself) contents.
> byteArrays add: ((WriteStream on: (ByteArray new: 4))
> nextLittleEndianNumber: 4 put: version; yourself) contents.
> byteArrays add: ((WriteStream on: (ByteArray new: 8))
> nextLittleEndianNumber: 8 put: version; yourself) contents].
> ^byteArrays!
>
> ----- Method: ImageFormat class>>availableBits (in category
> 'initialize-release') -----
> availableBits
> "Bits available for use as capability bits. Reserve high order bit as the
> extension bit, to be set true if additional bits are required in the
> future."
>
> "ImageFormat availableBits printStringBase: 2"
>
> | mask |
> mask := 0.
> self bitAssignments doWithIndex: [ :e :i |
> mask := mask bitAt: i put: (e isNil ifTrue: [ 1 ] ifFalse: [ 0 ])].
> ^ mask
> !
>
> ----- Method: ImageFormat class>>baseVersionMask (in category 'image
> formats') -----
> baseVersionMask
> "Mask the bits associated with base format number exclusive of
> capability bits"
>
> "ImageFormat baseVersionMask printStringBase: 2"
>
> ^ BaseVersionNumbers
> inject: 0
> into: [:accum :e | accum bitOr: e]
> !
>
> ----- Method: ImageFormat class>>baseVersionNumbers (in category 'image
> formats') -----
> baseVersionNumbers
> "The well-known image format versions for basic 32 and 64 bit images,
> including images that require closure bytecode support. These base
> format numbers my be modified by application of various capability bits
> representing additional requirements that the image expects to be
> supported by the virtual machine."
>
> ^#(6502 6504 68000 68002)
> !
>
> ----- Method: ImageFormat class>>bitAssignments (in category
> 'initialize-release') -----
> bitAssignments
>
> "ImageFormat bitAssignments
> doWithIndex: [ :e :i | Transcript cr; show: 'bit ', i asString, ' is
> ', (e ifNil: ['unused'])]"
>
> | bits |
> bits := Array new: 32.
> "If bit 1 is set, the high and low order 32-bit words of a Float are
> stored in
> platform word order. If bit 1 is not set, big-endian word order is
> used for Float
> regardless of the platform." bits at: 1 put: 'the use platform float
> word order bit (Cog and StackInterpreter)'.
> bits at: 2 put: 'used in base version numbers'.
> bits at: 3 put: 'used in base version numbers'.
> bits at: 4 put: 'used in base version numbers'.
> bits at: 5 put: 'the Spur object format bit'.
> bits at: 6 put: 'used in base version numbers'.
> bits at: 7 put: 'used in base version numbers'.
> bits at: 8 put: 'used in base version numbers'.
> bits at: 9 put: 'used in base version numbers'.
> bits at: 10 put: nil. "unassigned bit available for future image formats"
> bits at: 11 put: nil. "unassigned bit available for future image formats"
> bits at: 12 put: 'used in base version numbers'.
> bits at: 13 put: 'used in base version numbers'.
> bits at: 14 put: nil. "unassigned bit available for future image formats"
> bits at: 15 put: nil. "unassigned bit available for future image formats"
> bits at: 16 put: nil. "unassigned bit available for future image formats"
> bits at: 17 put: 'used in base version numbers'.
> bits at: 18 put: nil. "unassigned bit available for future image formats"
> bits at: 19 put: nil. "unassigned bit available for future image formats"
> bits at: 20 put: nil. "unassigned bit available for future image formats"
> bits at: 21 put: nil. "unassigned bit available for future image formats"
> bits at: 22 put: nil. "unassigned bit available for future image formats"
> bits at: 23 put: nil. "unassigned bit available for future image formats"
> bits at: 24 put: nil. "unassigned bit available for future image formats"
> bits at: 25 put: nil. "unassigned bit available for future image formats"
> bits at: 26 put: nil. "unassigned bit available for future image formats"
> bits at: 27 put: nil. "unassigned bit available for future image formats"
> bits at: 28 put: nil. "unassigned bit available for future image formats"
> bits at: 29 put: nil. "unassigned bit available for future image formats"
> bits at: 30 put: nil. "unassigned bit available for future image formats"
> bits at: 31 put: nil. "unassigned bit available for future image formats"
> "If bit 32 is set, additional image format information will be stored
> in one or
> more additional words. Currently this is unused, and bit 32 is always
> zero."
> bits at: 32 put: 'the extension bit (reserved for future use)'.
> ^bits
> !
>
> ----- Method: ImageFormat class>>bitsInUse (in category 'image formats')
> -----
> bitsInUse
> "Answer a mask of the bits used by all known version format numbers"
>
> "Transcript cr; show: (ImageFormat bitsInUse printStringBase: 2)"
>
> | mask |
> mask := 0.
> self bitAssignments doWithIndex: [ :e :i |
> mask := mask bitAt: i put: (e notNil ifTrue: [ 1 ] ifFalse: [ 0 ])].
> ^ mask
> !
>
> ----- Method: ImageFormat class>>capabilitiesBitsMask (in category
> 'image formats') -----
> capabilitiesBitsMask
> "Bits currently used as capability bits."
>
> "ImageFormat capabilitiesBitsMask printStringBase: 2"
>
> ^ (0 bitAt: PlatformByteOrderBit put: 1)
> bitAt: SpurObjectBit put: 1
> !
>
> ----- Method: ImageFormat class>>createCkFormatProgram (in category
> 'ckformat') -----
> createCkFormatProgram
> "Create ckformat source file in the default directory"
>
> "ImageFormat createCkFormatProgram"
>
> ^self storeCkFormatOnFile: 'ckformat.c' !
>
> ----- Method: ImageFormat class>>default (in category 'instance
> creation') -----
> default
> "The original Squeak image format number"
>
> ^ self wordSize: 4!
>
> ----- Method: ImageFormat class>>fromBytes: (in category 'instance
> creation') -----
> fromBytes: bytes
> ^ self fromStream: (ReadStream on: bytes)
> !
>
> ----- Method: ImageFormat class>>fromFile: (in category 'instance
> creation') -----
> fromFile: imageFile
> "Answer a new instance from a saved image file. The image format number
> is saved in the first 4 or 8 bytes of the file. Word size and byte
> ordering are
> dependent on the image and platform that saved the file, and must be
> decoded
> to obtain the image format."
>
> "ImageFormat fromFile: Smalltalk imageName"
>
> | f |
> f := (FileStream oldFileNamed: imageFile) ifNil: [FileStream
> readOnlyFileNamed: imageFile].
> f ifNotNil: [ | imageFormat |
> [f binary.
> imageFormat := self fromStream: f]
> ensure: [f close].
> ^imageFormat].
> ^self error: 'could not open ', imageFile
> !
>
> ----- Method: ImageFormat class>>fromInteger: (in category 'instance
> creation') -----
> fromInteger: anInteger
> "Answer a new instance from an integer, typically obtained from an
> image file header."
>
> ^ self new fromInteger: anInteger!
>
> ----- Method: ImageFormat class>>fromStream: (in category 'instance
> creation') -----
> fromStream: stream
> "Answer a new instance from a saved image file stream. Word size and
> byte ordering
> are dependent on the image and platform that saved the file, and must
> be decoded
> to obtain the image format. There may be a 512 byte offset, also."
>
> { 0 . 512 } do: [:offset | | num |
> [stream position: offset.
> num := stream nextNumber: 4. "try 32 bit big endian format"
> ^ self fromInteger: num]
> on: Error
> do: [[stream position: offset.
> num := stream nextLittleEndianNumber: 4. "try 32 bit little endian
> format"
> ^ self fromInteger: num]
> on: Error
> do: [[stream position: offset.
> num := stream nextNumber: 8. "try 64 bit big endian format"
> ^ self fromInteger: num]
> on: Error
> do: [[stream position: offset.
> num := stream nextLittleEndianNumber: 8. "try 64 bit little endian
> format"
> ^ self fromInteger: num]
> on: Error
> do: ["nothing. fall through for possible second round."]]]]].
> self error: 'unrecognized image format'!
>
> ----- Method: ImageFormat class>>generateCkFormatProgram:on: (in
> category 'ckformat') -----
> generateCkFormatProgram: programName on: stream
> "Generate source code for an image format version reader. The program
> is intended for testing image file format from a unix shell script such
> that
> the shell script can decide what VM to run based on image requirements."
>
> | formatNumber |
> stream nextPutAll: '/* ', programName, ': Print the image format number
> on standard output */'; cr;
> nextPutAll: '/* for use in a shell script to test image format
> requirements. */'; cr;
> nextPutAll: '/* A non-zero return status code indicates failure. */';
> cr; cr;
> nextPutAll: '/* Usage: ', programName, ' imageFileName */'; cr; cr;
> nextPutAll: '/* --- DO NOT EDIT THIS FILE --- */'; cr;
> nextPutAll: '/* --- Automatically generated from class ', self name,
> ' ', DateAndTime now asString, '--- */'; cr;
> nextPutAll: '/* --- Source code is in package ImageFormat in the
> VMMaker repository --- */'; cr;
> nextPutAll: '/* --- DO NOT EDIT THIS FILE --- */'; cr; cr;
> nextPutAll: '#include <stdio.h>'; cr;
> nextPutAll: '#include <stdlib.h>'; cr;
> nextPutAll: '#include <string.h>'; cr; cr;
> nextPutAll: 'int main(int argc, char **argv) {'; cr;
> tab; nextPutAll: 'FILE *f;'; cr;
> tab; nextPutAll: 'unsigned char buf[8];'; cr;
> tab; nextPutAll: 'int formatNumber;'; cr;
> tab; nextPutAll: 'unsigned char c;'; cr;
> tab; nextPutAll: 'int match;'; cr;
> tab; nextPutAll: 'if (argc !!= 2) {'; cr;
> tab; tab; nextPutAll: 'printf("usage: ', programName, '
> imageFileName\n");'; cr;
> tab; tab; nextPutAll: 'exit(1);'; cr;
> tab; nextPutAll: '}'; cr;
> tab; nextPutAll: 'f = fopen(argv[1], "r");'; cr;
> tab; nextPutAll: 'if (f == NULL) {'; cr;
> tab; tab; nextPutAll: 'perror(argv[1]);'; cr;
> tab; tab; nextPutAll: 'exit(2);'; cr;
> tab; nextPutAll: '}'; cr.
> { 0. 512 } do: [:offset |
> stream
> tab; nextPutAll: 'if(fseek(f, '; nextPutAll: offset asString;
> nextPutAll: 'L, SEEK_SET) !!= 0) {';cr;
> tab; tab; nextPutAll: 'fprintf(stderr, "cannot go to pos %d in %s\n",
> '; nextPutAll: offset asString; nextPutAll: ', argv[1]);'; cr;
> tab; tab; nextPutAll: 'exit(3);'; cr;
> tab; nextPutAll: '}'; cr;
> tab; nextPutAll: 'if (fread(buf, 1, 8, f) < 8) {'; cr;
> tab; tab; nextPutAll: 'fprintf(stderr, "cannot read %s\n",
> argv[1]);'; cr;
> tab; tab; nextPutAll: 'exit(3);'; cr;
> tab; nextPutAll: '}'; cr.
> self versionNumberByteArrays withIndexDo: [ :v :tag | | b |
> formatNumber := (self fromBytes: v) asInteger.
> b := 'b_', formatNumber asString, '_', tag asString.
> stream tab; nextPutAll: '{'; cr; tab; nextPutAll: 'unsigned char ',
> b, '[', v size asString, ']= { '.
> v inject: true into: [:first : elem |
> first ifFalse: [stream nextPutAll: ', '].
> stream nextPutAll: elem asString.
> false].
> stream nextPutAll: '};'; cr;
> tab; nextPutAll: 'if (memcmp(buf, ', b, ', ', v size asString, ')
> == 0) {'; cr;
> tab; tab; nextPutAll: 'printf("%d\n", ', formatNumber, ');'; cr;
> tab; tab; nextPutAll: 'exit(0);'; cr;
> tab; nextPutAll: '}'; cr; tab; nextPutAll: '}'; cr]].
> stream tab; nextPutAll: 'printf("0\n"); /* print an invalid format
> number */';cr;
> tab; nextPutAll: 'exit (-1); /* not found, exit with error code */';
> cr;
> nextPutAll: '}'; cr
> !
>
> ----- Method: ImageFormat class>>initialize (in category
> 'initialize-release') -----
> initialize
> "ImageFormat initialize"
>
> PlatformByteOrderBit := 1.
> SpurObjectBit := 5.
> BaseVersionNumbers := self baseVersionNumbers.
> BaseVersionMask := self baseVersionMask.
> CapabilitiesBitsMask := self capabilitiesBitsMask.
> ReservedBitsMask := self availableBits.
> KnownVersionNumbers := self knownVersionNumbers.
> !
>
> ----- Method: ImageFormat class>>knownVersionNumbers (in category
> 'initialize-release') -----
> knownVersionNumbers
> "Version numbers currently in use or likely to be used (e.g. 64-bit Cog
> formats)"
>
> "ImageFormat knownVersionNumbers collect: [:e | (ImageFormat
> fromInteger: e) description]"
>
> ^ ( self baseVersionNumbers, "the original format number variants"
> {
> 6505 . "Cog and StackVM"
> 68003 . "Cog and StackVM running 64-bit image"
> 6521 . "Spur 32 bit object memory"
> 68019 . "Spur 64 bit object memory (early)"
> 68021 . "Spur 64 bit object memory"
> " ... add others here as bits are allocated to represent
> requirements of other image formats"
> } ) sort.
> !
>
> ----- Method: ImageFormat class>>storeCkFormatOnFile: (in category
> 'ckformat') -----
> storeCkFormatOnFile: fileName
> "Store source code for an image format version reader in a file. The
> program
> is intended for testing image file format from a unix shell script such
> that
> the shell script can decide what VM to run based on image requirements."
>
> | f |
> f := CrLfFileStream newFileNamed: fileName.
> [self generateCkFormatProgram: 'ckformat' on: f]
> ensure: [f ifNotNil: [f close]].
> ^fileName!
>
> ----- Method: ImageFormat class>>storeCkstatusOnFile: (in category
> 'ckformat') -----
> storeCkstatusOnFile: fileName
> "Deprecated 07-Dec-2012, use storeCkFormatOnFile:"
> ^self storeCkFormatOnFile: fileName
> !
>
> ----- Method: ImageFormat class>>thisImageFileFormat (in category
> 'instance creation') -----
> thisImageFileFormat
> "The image format read from the header of the file from which the current
> image was loaded. This may be different from the current format if the VM
> has modified the image at load time or in the course of running the
> image."
>
> "ImageFormat thisImageFileFormat description"
>
> ^self fromFile: Smalltalk imageName
> !
>
> ----- Method: ImageFormat class>>unixMagicFileEntries (in category 'unix
> magic file entries') -----
> unixMagicFileEntries
> "Answer a string that can be appended to /etc/magic on a Unix system to
> support the file(1) utility.
> For example, the file magic produced by
> (FileStream newFileNamed: 'magic') in: [:fs |
> [fs nextPutAll: ImageFormat unixMagicFileEntries ] ensure: [ fs close
> ]]
> can be appended to $HOME/.magic and then
> $ file squeak.image pharo.image ...
> will describe the given image files precisely"
>
> ^String streamContents: [:s |
> s nextPutAll: '# Smalltalk image file formats'; lf.
> KnownVersionNumbers do: [ :num | | fmt |
> #( 'le' 'be' ) do: [ :endian |
> #(0 512) do: [ :offset |
> fmt := self fromInteger: num.
> (fmt is64Bit and: [ endian = 'be' ])
> ifTrue: [ s nextPutAll: (offset+4) asString ]
> ifFalse: [ s nextPutAll: offset asString ].
> s tab;
> nextPutAll: endian;
> nextPutAll: 'long';
> tab;
> nextPutAll: num asString;
> tab;
> nextPutAll: 'Smalltalk '.
> fmt printTerseDescriptionOn: s.
> s lf.
> s nextPutAll: '!!:mime application/';
> nextPutAll: fmt simpleName;
> nextPutAll: '-image';
> lf
> ]
> ]
> ].
> s lf.
> ]!
>
> ----- Method: ImageFormat class>>versionDescriptions (in category
> 'utility') -----
> versionDescriptions
>
> "ImageFormat versionDescriptions do: [:e | Transcript cr; show: e]"
>
> "| d | d := ImageFormat versionDescriptions.
> KnownVersionNumbers do: [ :v | Transcript cr; show: v asString, '- ',
> (d at: v)]"
>
> ^ Dictionary
> withAll: (KnownVersionNumbers
> collect: [:e | e -> (self fromInteger: e) description])!
>
> ----- Method: ImageFormat class>>versionNumberByteArrays (in category
> 'utility') -----
> versionNumberByteArrays
> "All byte array expressions of known version numbers. These are the
> possible values
> that may appear in the first 4 or 8 bytes of a saved image file. All 32
> bit images have
> this number in the first 4 bytes of the image file header. A 64 bit V3
> image has this
> number saved in the first 8 bytes of the header (only 4 bytes of which
> are significant).
> For a 64 bit Spur image, the number is saved in the first 4 bytes. In
> all cases, the value
> may be stored in little endian or big endian byte ordering depending on
> the host
> platform (although all currently supported VMs are for little endian
> host platforms)."
>
> "ImageFormat versionNumberByteArrays do: [:e |
> Transcript cr; show: e printString , ': ', (ImageFormat fromBytes: e)
> description]"
>
> ^self allVersionNumberByteArrays select: [:e |
> e size = 4
> or: [ (self fromBytes: e) requiresSpurSupport not ]].
> !
>
> ----- Method: ImageFormat class>>wordSize: (in category 'instance
> creation') -----
> wordSize: bytesPerWord
> bytesPerWord = 4
> ifTrue: [^self new fromInteger: 6502].
> bytesPerWord = 8
> ifTrue: [^self new fromInteger: 68000].
> self error: 'unsupported word size ', bytesPerWord!
>
> ----- Method: ImageFormat class>>wordSize:closures: (in category
> 'instance creation') -----
> wordSize: bytesPerWord closures: aBoolean
>
> ^(self wordSize: bytesPerWord) setClosureSupportRequirement: aBoolean
> !
>
> ----- Method: ImageFormat class>>wordSize:cog: (in category 'instance
> creation') -----
> wordSize: bytesPerWord cog: cogRequired
>
> ^(self wordSize: bytesPerWord)
> setClosureSupportRequirement: cogRequired;
> setCogSupportRequirement: cogRequired
> !
>
> ----- Method: ImageFormat class>>wordSize:spur: (in category 'instance
> creation') -----
> wordSize: bytesPerWord spur: spurRequired
> "Answer a Spur image format, or default to Cog if Spur is not specified"
>
> | update64 |
> update64 := bytesPerWord == 8. "The 64 bit Spur image has an updated
> version"
> ^self wordSize: bytesPerWord spur: spurRequired
> requiresNewSpur64TagAssignment: update64!
>
> ----- Method: ImageFormat
> class>>wordSize:spur:requiresNewSpur64TagAssignment: (in category
> 'instance creation') -----
> wordSize: bytesPerWord spur: spurRequired
> requiresNewSpur64TagAssignment: newSpur64
> "Answer a Spur image format, or default to Cog if Spur is not specified"
>
> ^(self wordSize: bytesPerWord)
> setClosureSupportRequirement: true;
> setCogSupportRequirement: true;
> setSpurSupportRequirement: spurRequired;
> setRequiresNewSpur64TagAssignmentRequirement: newSpur64
> !
>
> ----- Method: ImageFormat>>= (in category 'comparing') -----
> = anImageFormat
> ^self class == anImageFormat class
> and: [self asInteger = anImageFormat asInteger].
> !
>
> ----- Method: ImageFormat>>asInteger (in category 'converting') -----
> asInteger
> "Answer an integer representation of this image format suitable for
> storage
> in an image file header. The stored value in the file header will be
> used when
> loading the image from the snapshot file."
>
> | val |
> val := wordSize = 4
> ifTrue: [6502]
> ifFalse: [68000].
> self requiresClosureSupport ifTrue: [val := val + 2].
> self requiresNativeFloatWordOrder ifTrue: [val := val + 1].
> self requiresSpurSupport ifTrue: [val := val + 2r10000].
> self requiresNewSpur64TagAssignment ifTrue: [val := val + 2].
> ^val
> !
>
> ----- Method: ImageFormat>>baseVersionBits (in category 'private') -----
> baseVersionBits
> "Answer the bits associated with base format number exclusive of
> capability bits"
>
> ^self baseVersionBitsOf: self asInteger
> !
>
> ----- Method: ImageFormat>>baseVersionBitsOf: (in category 'private')
> -----
> baseVersionBitsOf: anInteger
> "Answer the bits of anInteger associated with base format number
> exclusive
> of capability bits"
>
> ^ anInteger bitAnd: BaseVersionMask!
>
> ----- Method: ImageFormat>>description (in category 'printing') -----
> description
>
> "(ImageFormat fromInteger: 6502) description"
>
> ^String streamContents: [:s | self printDescriptionOn: s]
> !
>
> ----- Method: ImageFormat>>fromInteger: (in category
> 'initialize-release') -----
> fromInteger: anInteger
> "Initialize a new instance from anInteger obtained from an image file
> header."
>
> | baseVersion capabilitiesBits |
> (anInteger bitAnd: ReservedBitsMask) ~= 0
> ifTrue: [self error: 'invalid format number ', anInteger printString].
> baseVersion := self baseVersionBitsOf: anInteger.
> ((baseVersion = 6504 or: [baseVersion = 68002]) or: [baseVersion =
> 68004])
> ifTrue: [requiresClosureSupport := true].
> (baseVersion = 6502 or: [baseVersion = 6504])
> ifTrue: [wordSize := 4]
> ifFalse: [((baseVersion = 68000 or: [baseVersion = 68002]) or:
> [baseVersion = 68004])
> ifTrue: [wordSize := 8.
> baseVersion = 68004
> ifTrue: [self setRequiresNewSpur64TagAssignmentRequirement: true]]
> ifFalse: [self error: 'invalid format number ', anInteger
> printString]].
> capabilitiesBits := anInteger bitAnd: CapabilitiesBitsMask.
> (capabilitiesBits bitAt: PlatformByteOrderBit) = 1
> ifTrue: [requiresNativeFloatWordOrder := true.
> requiresClosureSupport
> ifFalse: [self error: 'Images requiring platform byte order also
> require closure support (Cog)'].
> capabilitiesBits := capabilitiesBits bitAt: PlatformByteOrderBit put:
> 0].
> (capabilitiesBits bitAt: SpurObjectBit) = 1
> ifTrue: [requiresSpurSupport := true.
> requiresClosureSupport
> ifFalse: [self error: 'Images requiring Spur also require closure
> support'].
> requiresNativeFloatWordOrder
> ifFalse: [self error: 'Images requiring Spur also require native
> float word order support'].
> capabilitiesBits := capabilitiesBits bitAt: SpurObjectBit put: 0].
> "add additional capability bit handling here"
> capabilitiesBits == 0
> ifFalse: [self error: 'invalid format number ', anInteger printString]
>
> !
>
> ----- Method: ImageFormat>>hash (in category 'comparing') -----
> hash
> ^self asInteger hash!
>
> ----- Method: ImageFormat>>initialize (in category 'initialize-release')
> -----
> initialize
> requiresClosureSupport := false.
> requiresNativeFloatWordOrder := false.
> requiresSpurSupport := false.
> requiresNewSpur64TagAssignment := false.!
>
> ----- Method: ImageFormat>>is32Bit (in category 'testing') -----
> is32Bit
> "True if the image uses 4 byte object memory words and 4 byte object
> pointers."
> ^wordSize = 4!
>
> ----- Method: ImageFormat>>is64Bit (in category 'testing') -----
> is64Bit
> "True if the image uses 8 byte object memory words and 8 byte object
> pointers."
> ^wordSize = 8!
>
> ----- Method: ImageFormat>>isValidVersionNumber (in category 'private')
> -----
> isValidVersionNumber
> "True if the version number uses a known base version number and does not
> use any reserved bits. Used only for unit tests, by definition this
> must always
> be true."
>
> ^(BaseVersionNumbers includes: self baseVersionBits)
> and: [(self asInteger bitAnd: ReservedBitsMask) = 0]!
>
> ----- Method: ImageFormat>>printDescriptionOn: (in category 'printing')
> -----
> printDescriptionOn: stream
> "
> The classic squeak image, aka V3, is 32-bit with magic 6502. The first
> 64-bit
> Squeak image was generated from V3 image made by Dan Ingalls and Ian
> Piumarta
> in 2005. Later, the magic code was changed to 68000.
>
> After full closure support came to Squeak, the magic code changed to
> 6504 for
> 32-bit and 68002 for 64-bit images by setting a capability bit.
>
> Cog VM introduced a native order for floats under 6505 magic code. Its
> corresponding 64b code would have been 68003 but no such image was
> produced.
> Older Interpreter VMs would simply load 6505 by flipping word order back.
>
> Cog VM also introduced a new object layout for 64-bit images called Spur
> layout
> under a new magic code - 68021. A few images were also generated with
> 68019,
> but this magic is now considered obsolete and deprecated.
> "
> stream nextPutAll: 'a ';
> nextPutAll: (wordSize * 8) asString;
> nextPutAll: '-bit ';
> nextPutAll: (self requiresSpurSupport
> ifTrue: [ 'Spur' ]
> ifFalse: [ 'V3' ]);
> nextPutAll: ' image with '.
> self requiresClosureSupport ifFalse: [stream nextPutAll: 'no '].
> stream nextPutAll: 'closure support and '.
> self requiresNativeFloatWordOrder
> ifTrue: [stream nextPutAll: 'float words stored in native platform
> order']
> ifFalse: [stream nextPutAll: 'no native platform float word order
> requirement'].
> self requiresSpurSupport
> ifTrue: [stream nextPutAll: ' using Spur object format'.
> (self is64Bit and: [self requiresNewSpur64TagAssignment not])
> ifTrue: [stream nextPutAll: ' (obsolete)']].
> stream nextPutAll: ' (';
> nextPutAll: self asInteger asString;
> nextPut: $).
> ^ stream
> !
>
> ----- Method: ImageFormat>>printOn: (in category 'printing') -----
> printOn: aStream
>
> aStream nextPutAll: 'ImageFormat fromInteger: ', self asInteger asString
> !
>
> ----- Method: ImageFormat>>printTerseDescriptionOn: (in category
> 'printing') -----
> printTerseDescriptionOn: stream
> "Shortened description as may be required for unix magic file entries"
>
> stream
> nextPutAll: self simpleName;
> nextPutAll: ' image '.
> self requiresClosureSupport ifTrue: [stream nextPutAll: '+C'].
> self requiresNativeFloatWordOrder ifTrue: [stream nextPutAll: '+NF'].
> self requiresNewSpur64TagAssignment ifTrue: [stream nextPutAll: '+Tag' ].
> stream nextPutAll: ' (%d)'.
> ^ stream
> !
>
> ----- Method: ImageFormat>>requiresClosureSupport (in category
> 'testing') -----
> requiresClosureSupport
> "True if this image contains closure bytecodes that must be supported by
> the virtual machine."
> ^requiresClosureSupport!
>
> ----- Method: ImageFormat>>requiresNativeFloatWordOrder (in category
> 'testing') -----
> requiresNativeFloatWordOrder
> "True if this image requires a Cog VM (stack VM possibly including a
> Cog jitter)"
> ^requiresNativeFloatWordOrder!
>
> ----- Method: ImageFormat>>requiresNewSpur64TagAssignment (in category
> 'testing') -----
> requiresNewSpur64TagAssignment
> "True if this is a 64 bit Spur image with immediate tag assigments
> redefined as of
> VMMaker.oscog-eem.1722"
> ^requiresNewSpur64TagAssignment!
>
> ----- Method: ImageFormat>>requiresSpurSupport (in category 'testing')
> -----
> requiresSpurSupport
> "True if this image uses the Spur object format."
> ^requiresSpurSupport!
>
> ----- Method: ImageFormat>>setClosureSupportRequirement: (in category
> 'initialize-release') -----
> setClosureSupportRequirement: aBoolean
> "If true, the image expects the virtual machine to be able to provide
> support
> for closure bytecodes that are present in the image. If false, the
> image does
> not require this support, although the virtual machine is free to
> provide it."
>
> requiresClosureSupport := aBoolean
> !
>
> ----- Method: ImageFormat>>setCogSupportRequirement: (in category
> 'initialize-release') -----
> setCogSupportRequirement: aBoolean
> "If true, the image expects the virtual machine to be able to provide Cog
> support, either in the form of a Stack VM or a Cog VM. If false, the
> image does
> not require this support, although the virtual machine is free to
> provide it."
>
> aBoolean ifTrue: [requiresClosureSupport := true]. "required in all Cog
> images"
> self setNativeFloatWordOrderRequirement: aBoolean
> !
>
> ----- Method: ImageFormat>>setNativeFloatWordOrderRequirement: (in
> category 'initialize-release') -----
> setNativeFloatWordOrderRequirement: aBoolean
> "If true, certain objects are implemented in native platform word order.
> On
> a little endian platform, access to the two words of a 64 bit float
> object is
> more efficient if the words are stored in native word order. On a big
> endian
> platform, platform word order is the same as object memory word order and
> this setting has no effect.
>
> The StackInterpreter and Cog make use of this for performance reasons."
>
> requiresNativeFloatWordOrder := aBoolean
> !
>
> ----- Method: ImageFormat>>setRequiresNewSpur64TagAssignmentRequirement:
> (in category 'initialize-release') -----
> setRequiresNewSpur64TagAssignmentRequirement: aBoolean
> "Applicable only to 64-bit Spur images. If true, the updated tag
> assignment
> definitions are required. Earlier Spur 64 bit images use tag assignment
> for
> immediates that conflict with the Spur 32 bit image definition. "
>
> requiresNewSpur64TagAssignment := aBoolean
> !
>
> ----- Method: ImageFormat>>setSpurSupportRequirement: (in category
> 'initialize-release') -----
> setSpurSupportRequirement: aBoolean
> "If true, the image expects the virtual machine to be able to provide
> support
> for the Spur object format. If false, the image does not require this
> support,
> although the virtual machine is free to provide it."
>
> requiresSpurSupport := aBoolean
> !
>
> ----- Method: ImageFormat>>simpleName (in category 'printing') -----
> simpleName
>
> "Return a simple name for the format, suitable for use as filename or
> mimetype.
> (ImageFormat fromInteger: 6505) simpleName."
>
> ^String streamContents: [:s |
> self requiresSpurSupport
> ifTrue: [ s nextPutAll: 'spur']
> ifFalse: [s nextPutAll: 'squeak'].
> self is64Bit ifTrue: [ s nextPutAll: '64']]!
>
> ----- Method: ImageFormat>>storeOn: (in category 'printing') -----
> storeOn: aStream "Append to the argument aStream a sequence of
> characters that is an expression whose evaluation creates an object
> similar to the receiver."
>
> aStream nextPutAll: self class name;
> nextPutAll: ' fromInteger: ';
> nextPutAll: self asInteger asString!
>
> ----- Method: ImageFormat>>wordSize (in category 'accessing') -----
> wordSize
> ^ wordSize!
>
> TestCase subclass: #ImageFileHeaderTest
> instanceVariableNames: ''
> classVariableNames: ''
> poolDictionaries: ''
> category: 'ImageFormat-Tests'!
>
> !ImageFileHeaderTest commentStamp: 'dtl 10/31/2012 20:26' prior: 0!
> ImageFileHeaderTest provides unit tests for ImageFileHeader and
> CogImageFileHeader. These tests verify conversion to and from disk file
> format for various word sizes, platform endianness, and image formats.!
>
> ----- Method: ImageFileHeaderTest>>sample6504HeaderData (in category
> 'running') -----
> sample6504HeaderData
> "First 200 bytes of an image file saved by an interpreter VM, an
> ImageFileHeader
> for a 32-bit image with closure support and no native platform float
> word order
> requirement (6504)"
>
> ^#[104 25 0 0 64 0 0 0 4 127 88 8 16 0 0 0 196 175 67 5 175 67 0 0 151
> 3 160 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
> 0 0 0 0 209 143 131 0 5 0 0 30 89 145 131 0 5 0 160 24 149 144 131 0 5 0
> 12 23 15 129 56 0 140 122 24 0 12 22 0 0 4 1 0 0 36 49 132 0 0 50 188 26
> 88 198 24 0 3 0 0 0 8 197 24 0 3 0 0 0 64 188 24 0 3 0 0 0 88 188 24 0 3
> 0 0 0 76 188 24 0 3 0 0 0 52 188 24 0 3 0 0 0 72 124 24 0 3 0 0 0 112
> 129 24 0 3 0 0 0 36 199 24 0 3 0 0 0 100 199 24 0 3 0 0 0 132 197 24 0 3
> 0 0 0]!
>
> ----- Method: ImageFileHeaderTest>>sample6505HeaderData (in category
> 'running') -----
> sample6505HeaderData
> "First 200 bytes of an image file saved by a Cog VM, an ImageFileHeader
> for
> a 32-bit image with closure support and float words stored in native
> platform
> order (6505)"
>
> ^#[105 25 0 0 64 0 0 0 28 181 88 8 0 224 70 183 180 143 138 188 71 229
> 231 47 151 3 160 4 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
> 0 0 0 0 0 0 0 0 0 193 111 202 183 5 0 0 30 73 113 202 183 5 0 160 24 133
> 112 202 183 5 0 12 23 15 129 56 0 124 90 95 183 252 245 70 183 4 1 0 0
> 20 17 203 183 0 50 188 26 72 166 95 183 3 0 0 0 248 164 95 183 3 0 0 0
> 48 156 95 183 3 0 0 0 72 156 95 183 3 0 0 0 60 156 95 183 3 0 0 0 36 156
> 95 183 3 0 0 0 56 92 95 183 3 0 0 0 96 97 95 183 3 0 0 0 20 167 95 183 3
> 0 0 0 84 167 95 183 3 0 0 0 116 165 95 183 3 0 0 0]!
>
> ----- Method: ImageFileHeaderTest>>sample68002HeaderData (in category
> 'running') -----
> sample68002HeaderData
> "First 200 bytes of a 64-bit image file saved by an interpreter VM, an
> ImageFileHeader for a 64-bit image with closure support and no native
> platform float word order requirement (68002)"
>
> ^#[162 9 1 0 0 0 0 0 128 0 0 0 0 0 0 0 200 95 202 11 0 0 0 0 0 160 102
> 243 128 127 0 0 168 160 102 243 128 127 0 0 76 217 0 0 0 0 0 0 148 3 192
> 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
> 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
> 0 0 0 0 0 73 187 102 243 128 127 0 0 9 0 12 23 0 0 0 0 177 187 102 243
> 128 127 0 0 9 0 160 24 0 0 0 0 57 160 102 243 128 127 0 0 9 0 0 30 0 0 0
> 0 25 188 102 243 128 127 0 0 97 1 12 30 0 0 0 0 88 188 102 243 128 127 0
> 0]!
>
> ----- Method: ImageFileHeaderTest>>testAsByteArray (in category
> 'testing') -----
> testAsByteArray
> "Read and write with data in all byte positions"
>
> | hdr ws b1 b2 |
> b1 := self sample6505HeaderData.
> hdr := ImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ByteArray new.
> hdr writeTo: ws littleEndian: true.
> b2 := ws contents.
> self assert: hdr asByteArray = b2.!
>
> ----- Method: ImageFileHeaderTest>>testCogStoreOn (in category
> 'testing') -----
> testCogStoreOn
> "Read and write with data in all byte positions"
>
> | hdr ws b1 b2 hdr2 |
> b1 := ByteArray new: 64.
> b1 at: 1 put: 104; at: 2 put: 25; at: 3 put: 0; at: 4 put: 0. "a valid
> image format number"
> b1 at: 5 put: 64; at: 6 put: 0; at: 7 put: 0; at: 8 put: 0. "header
> size 64"
> 9 to: 64 do: [ :i | b1 at: i put: i ].
> hdr := CogImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ''.
> hdr storeOn: ws.
> hdr2 := Compiler evaluate: ws contents.
> ws := WriteStream on: ByteArray new.
> hdr2 writeTo: ws littleEndian: true.
> b2 := ws contents.
> self assert: (b2 first: 46) = (b1 first: 46).
> self assert: (b2 last: (64 - 46)) asSet size = 1. "all zeros"!
>
> ----- Method: ImageFileHeaderTest>>testReadWrite64BitBigEndian (in
> category 'testing') -----
> testReadWrite64BitBigEndian
> "Read and write with data in all byte positions"
>
> | hdr ws b1 b2 |
> b1 := ByteArray new: 128.
> #[0 0 0 0 0 1 9 162 0 0 0 0 0 0 0 128] withIndexDo: [ :e :i | b1 at: i
> put: e].
> 17 to: 128 do: [ :i | b1 at: i put: i ].
> hdr := ImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ByteArray new.
> hdr writeTo: ws littleEndian: false.
> b2 := ws contents.
> self assert: (b2 first: 72) = (b1 first: 72).
> self assert: (b2 last: (128 - 72)) asSet size = 1. "all zeros"!
>
> ----- Method: ImageFileHeaderTest>>testReadWrite64BitCogBigEndian (in
> category 'testing') -----
> testReadWrite64BitCogBigEndian
> "Read and write with data in all byte positions"
>
> | hdr ws b1 b2 |
> b1 := ByteArray new: 128.
> #[0 0 0 0 0 1 9 162 0 0 0 0 0 0 0 128] withIndexDo: [ :e :i | b1 at: i
> put: e].
> 17 to: 128 do: [ :i | b1 at: i put: i ].
> hdr := CogImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ByteArray new.
> hdr writeTo: ws littleEndian: false.
> b2 := ws contents.
> self assert: (b2 first: 92) = (b1 first: 92).
> self assert: (b2 last: (128 - 92)) asSet size = 1. "all zeros"!
>
> ----- Method: ImageFileHeaderTest>>testReadWrite64BitCogLittleEndian (in
> category 'testing') -----
> testReadWrite64BitCogLittleEndian
> "Read and write with data in all byte positions"
>
> | hdr ws b1 b2 |
> b1 := ByteArray new: 128.
> #[162 9 1 0 0 0 0 0 128 0 0 0 0 0 0 0] withIndexDo: [ :e :i | b1 at: i
> put: e].
> 17 to: 128 do: [ :i | b1 at: i put: i ].
> hdr := CogImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ByteArray new.
> hdr writeTo: ws littleEndian: true.
> b2 := ws contents.
> self assert: (b2 first: 92) = (b1 first: 92).
> self assert: (b2 last: (128 - 92)) asSet size = 1. "all zeros"!
>
> ----- Method: ImageFileHeaderTest>>testReadWrite64BitLittleEndian (in
> category 'testing') -----
> testReadWrite64BitLittleEndian
> "Read and write with data in all byte positions"
>
> | hdr ws b1 b2 |
> b1 := ByteArray new: 128.
> #[162 9 1 0 0 0 0 0 128 0 0 0 0 0 0 0] withIndexDo: [ :e :i | b1 at: i
> put: e].
> 17 to: 128 do: [ :i | b1 at: i put: i ].
> hdr := ImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ByteArray new.
> hdr writeTo: ws littleEndian: true.
> b2 := ws contents.
> self assert: (b2 first: 72) = (b1 first: 72).
> self assert: (b2 last: (128 - 72)) asSet size = 1. "all zeros"!
>
> ----- Method: ImageFileHeaderTest>>testReadWriteBigEndian (in category
> 'testing') -----
> testReadWriteBigEndian
> "Read and write with data in all byte positions"
>
> | hdr ws b1 b2 |
> b1 := ByteArray new: 64.
> b1 at: 4 put: 104; at: 3 put: 25; at: 2 put: 0; at: 1 put: 0. "a valid
> image format number"
> b1 at: 8 put: 64; at: 7 put: 0; at: 6 put: 0; at: 5 put: 0. "header
> size 64"
> 9 to: 64 do: [ :i | b1 at: i put: i ].
> hdr := ImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ByteArray new.
> hdr writeTo: ws littleEndian: false.
> b2 := ws contents.
> self assert: (b2 first: 36) = (b1 first: 36).
> self assert: (b2 last: (64 - 36)) asSet size = 1. "all zeros"!
>
> ----- Method: ImageFileHeaderTest>>testReadWriteCogBigEndian (in
> category 'testing') -----
> testReadWriteCogBigEndian
> "Read and write with data in all byte positions"
>
> | hdr ws b1 b2 |
> b1 := ByteArray new: 64.
> b1 at: 4 put: 104; at: 3 put: 25; at: 2 put: 0; at: 1 put: 0. "a valid
> image format number"
> b1 at: 8 put: 64; at: 7 put: 0; at: 6 put: 0; at: 5 put: 0. "header
> size 64"
> 9 to: 64 do: [ :i | b1 at: i put: i ].
> hdr := CogImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ByteArray new.
> hdr writeTo: ws littleEndian: false.
> b2 := ws contents.
> self assert: (b2 first: 46) = (b1 first: 46).
> self assert: (b2 last: (64 - 46)) asSet size = 1. "all zeros"!
>
> ----- Method: ImageFileHeaderTest>>testReadWriteCogLittleEndian (in
> category 'testing') -----
> testReadWriteCogLittleEndian
> "Read and write with data in all byte positions"
>
> | hdr ws b1 b2 |
> b1 := ByteArray new: 64.
> b1 at: 1 put: 104; at: 2 put: 25; at: 3 put: 0; at: 4 put: 0. "a valid
> image format number"
> b1 at: 5 put: 64; at: 6 put: 0; at: 7 put: 0; at: 8 put: 0. "header
> size 64"
> 9 to: 64 do: [ :i | b1 at: i put: i ].
> hdr := CogImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ByteArray new.
> hdr writeTo: ws littleEndian: true.
> b2 := ws contents.
> self assert: (b2 first: 46) = (b1 first: 46).
> self assert: (b2 last: (64 - 46)) asSet size = 1. "all zeros"!
>
> ----- Method: ImageFileHeaderTest>>testReadWriteLittleEndian (in
> category 'testing') -----
> testReadWriteLittleEndian
> "Read and write with data in all byte positions"
>
> | hdr ws b1 b2 |
> b1 := ByteArray new: 64.
> b1 at: 1 put: 104; at: 2 put: 25; at: 3 put: 0; at: 4 put: 0. "a valid
> image format number"
> b1 at: 5 put: 64; at: 6 put: 0; at: 7 put: 0; at: 8 put: 0. "header
> size 64"
> 9 to: 64 do: [ :i | b1 at: i put: i ].
> hdr := ImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ByteArray new.
> hdr writeTo: ws littleEndian: true.
> b2 := ws contents.
> self assert: (b2 first: 36) = (b1 first: 36).
> self assert: (b2 last: (64 - 36)) asSet size = 1. "all zeros"!
>
> ----- Method: ImageFileHeaderTest>>testSample6504Header (in category
> 'testing') -----
> testSample6504Header
> "Using data from a real file header, verify conversions"
>
> | hdr ws b1 b2 |
> b1 := self sample6504HeaderData.
> hdr := ImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ByteArray new.
> hdr writeTo: ws littleEndian: true.
> b2 := ws contents.
> self assert: b2 = (b1 first: 64).!
>
> ----- Method: ImageFileHeaderTest>>testSample6505Header (in category
> 'testing') -----
> testSample6505Header
> "Using data from a real file header, verify conversions"
>
> | hdr ws b1 b2 |
> b1 := self sample6505HeaderData.
> hdr := ImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ByteArray new.
> hdr writeTo: ws littleEndian: true.
> b2 := ws contents.
> self assert: b2 = (b1 first: 64).!
>
> ----- Method: ImageFileHeaderTest>>testSample68002Header (in category
> 'testing') -----
> testSample68002Header
> "Using data from a real file header, verify conversions"
>
> | hdr ws b1 b2 |
> b1 := self sample68002HeaderData.
> hdr := ImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ByteArray new.
> hdr writeTo: ws littleEndian: true.
> b2 := ws contents.
> self assert: b2 = (b1 first: 128).!
>
> ----- Method: ImageFileHeaderTest>>testStoreOn (in category 'testing')
> -----
> testStoreOn
> "Read and write with data in all byte positions"
>
> | hdr ws b1 b2 hdr2 |
> b1 := ByteArray new: 64.
> b1 at: 1 put: 104; at: 2 put: 25; at: 3 put: 0; at: 4 put: 0. "a valid
> image format number"
> b1 at: 5 put: 64; at: 6 put: 0; at: 7 put: 0; at: 8 put: 0. "header
> size 64"
> 9 to: 64 do: [ :i | b1 at: i put: i ].
> hdr := ImageFileHeader readFrom: (ReadStream on: b1).
> ws := WriteStream on: ''.
> hdr storeOn: ws.
> hdr2 := Compiler evaluate: ws contents.
> ws := WriteStream on: ByteArray new.
> hdr2 writeTo: ws littleEndian: true.
> b2 := ws contents.
> self assert: (b2 first: 36) = (b1 first: 36).
> self assert: (b2 last: (64 - 36)) asSet size = 1. "all zeros"!
>
> TestCase subclass: #ImageFormatTest
> instanceVariableNames: ''
> classVariableNames: ''
> poolDictionaries: ''
> category: 'ImageFormat-Tests'!
>
> !ImageFormatTest commentStamp: 'dtl 9/5/2010 13:41' prior: 0!
> Verify and document the values of ImageFormat. The image format is an
> integer value that identifies the format of an image snapshot and the
> capabilities that the image expects of the virtual machine.!
>
> ----- Method: ImageFormatTest>>testAsInteger (in category 'testing') -----
> testAsInteger
>
> self assert: (ImageFormat fromInteger: 6502) asInteger = 6502.
> self assert: (ImageFormat fromInteger: 6504) asInteger = 6504.
> self assert: (ImageFormat fromInteger: 68000) asInteger = 68000.
> self assert: (ImageFormat fromInteger: 68002) asInteger = 68002.
> self assert: (ImageFormat fromInteger: 6521) asInteger = 6521.
> self assert: (ImageFormat fromInteger: 68019) asInteger = 68019.
> self assert: (ImageFormat fromInteger: 68021) asInteger = 68021.
> !
>
> ----- Method: ImageFormatTest>>testBaseVersionBits (in category
> 'testing') -----
> testBaseVersionBits
>
> self assert: ImageFormat baseVersionMask = 16r119EE.
> self assert: (ImageFormat wordSize: 4) baseVersionBits = 6502.
> self assert: (ImageFormat new fromInteger: 6504) baseVersionBits = 6504.
> self assert: (ImageFormat wordSize: 8) baseVersionBits = 68000.
> self assert: (ImageFormat new fromInteger: 68002) baseVersionBits =
> 68002.
> !
>
> ----- Method: ImageFormatTest>>testBit17AsTestFor64BitImages (in
> category 'testing') -----
> testBit17AsTestFor64BitImages
> "If bit 17 of the version number is 1, then the image is a 64-bit image."
>
> ImageFormat knownVersionNumbers do: [ :versionNumber | | is64 bit17 |
> is64 := (ImageFormat fromInteger: versionNumber) is64Bit.
> bit17 := versionNumber bitAt: 17.
> self assert: bit17 = 1 equals:is64
> ].
> !
>
> ----- Method: ImageFormatTest>>testBitsInUse (in category 'testing') -----
> testBitsInUse
> "Ensure that the list of known version numbers is kept up to date with
> the bit allocation"
>
> | allocatedBitsInUse calculatedBitsInUse |
> calculatedBitsInUse := ImageFormat knownVersionNumbers
> inject: 0
> into: [ :e :a | a bitOr: e] .
> allocatedBitsInUse := ImageFormat baseVersionMask bitOr: ImageFormat
> capabilitiesBitsMask.
> self assert: calculatedBitsInUse = allocatedBitsInUse
> !
>
> ----- Method: ImageFormatTest>>testDefaultImageFormats (in category
> 'testing') -----
> testDefaultImageFormats
> "Original 32-bit image format, and the original 64-bit image format,
> prior to
> introduction of block closure support."
>
> self assert: (6502 = (ImageFormat wordSize: 4) asInteger).
> self assert: (68000 = (ImageFormat wordSize: 8) asInteger).
> self should: [ImageFormat wordSize: 0] raise: Error.
> self should: [ImageFormat wordSize: 12] raise: Error!
>
> ----- Method: ImageFormatTest>>testFormat6502 (in category 'testing')
> -----
> testFormat6502
>
> self assert: ImageFormat default asInteger = 6502.
> self assert: (ImageFormat wordSize: 4) asInteger = 6502.
> self assert: (ImageFormat wordSize: 4 closures: false) asInteger = 6502.
> self assert: (ImageFormat fromInteger: 6502) asInteger = 6502.
> self assert: ImageFormat default wordSize = 4.
> self deny: ImageFormat default requiresClosureSupport.
> self deny: ImageFormat default requiresNativeFloatWordOrder.
> self assert: ImageFormat default is32Bit.
> self deny: ImageFormat default is64Bit.
> self assert: (ImageFormat fromInteger: 6502) asInteger = 6502
> !
>
> ----- Method: ImageFormatTest>>testFormat6504 (in category 'testing')
> -----
> testFormat6504
>
> | defaultWithClosures |
> defaultWithClosures := ImageFormat default
> setClosureSupportRequirement: true.
> self assert: defaultWithClosures asInteger = 6504.
> self assert: (ImageFormat wordSize: 4 closures: true) asInteger = 6504.
> self assert: (ImageFormat fromInteger: 6504) asInteger = 6504.
> self assert: defaultWithClosures wordSize = 4.
> self assert: defaultWithClosures requiresClosureSupport.
> self deny: defaultWithClosures requiresNativeFloatWordOrder.
> self assert: defaultWithClosures is32Bit.
> self deny: defaultWithClosures is64Bit.
> self assert: (ImageFormat fromInteger: 6504) asInteger = 6504
> !
>
> ----- Method: ImageFormatTest>>testFormat6505 (in category 'testing')
> -----
> testFormat6505
>
> | cog32 |
> cog32 := ImageFormat default
> setCogSupportRequirement: true;
> setClosureSupportRequirement: true.
> self assert: cog32 asInteger = 6505.
> self assert: (ImageFormat wordSize: 4 cog: true) asInteger = 6505.
> self assert: (ImageFormat fromInteger: 6505) asInteger = 6505.
> self assert: cog32 wordSize = 4.
> self assert: cog32 requiresClosureSupport.
> self assert: cog32 requiresNativeFloatWordOrder.
> self assert: cog32 is32Bit.
> self deny: cog32 is64Bit.
> self assert: (ImageFormat fromInteger: 6505) asInteger = 6505!
>
> ----- Method: ImageFormatTest>>testFormat6521 (in category 'testing')
> -----
> testFormat6521
>
> | spur |
> spur := ImageFormat fromInteger: 6521.
> self assert: spur asInteger = 6521.
> self assert: (ImageFormat wordSize: 4 spur: true) asInteger = 6521.
> self assert: (ImageFormat fromInteger: 6521) asInteger = 6521.
> self assert: spur wordSize = 4.
> self assert: spur requiresClosureSupport.
> self assert: spur requiresNativeFloatWordOrder.
> self assert: spur is32Bit.
> self deny: spur is64Bit.
> self assert: spur requiresSpurSupport.
> self assert: (ImageFormat fromInteger: 6521) asInteger = 6521!
>
> ----- Method: ImageFormatTest>>testFormat68000 (in category 'testing')
> -----
> testFormat68000
>
> | closures64 |
> closures64 := ImageFormat wordSize: 8.
> self assert: closures64 asInteger = 68000.
> self assert: (ImageFormat wordSize: 8 closures: false) asInteger = 68000.
> self assert: (ImageFormat fromInteger: 68000) asInteger = 68000.
> self assert: closures64 wordSize = 8.
> self deny: closures64 requiresClosureSupport.
> self deny: closures64 requiresNativeFloatWordOrder.
> self deny: closures64 is32Bit.
> self assert: closures64 is64Bit.
> self assert: (ImageFormat fromInteger: 68000) asInteger = 68000
> !
>
> ----- Method: ImageFormatTest>>testFormat68002 (in category 'testing')
> -----
> testFormat68002
>
> | closures64 |
> closures64 := (ImageFormat wordSize: 8) setClosureSupportRequirement:
> true.
> self assert: closures64 asInteger = 68002.
> self assert: (ImageFormat wordSize: 8 closures: true) asInteger = 68002.
> self assert: (ImageFormat fromInteger: 68002) asInteger = 68002.
> self assert: closures64 wordSize = 8.
> self assert: closures64 requiresClosureSupport.
> self deny: closures64 requiresNativeFloatWordOrder.
> self deny: closures64 is32Bit.
> self assert: closures64 is64Bit.
> self assert: (ImageFormat fromInteger: 68002) asInteger = 68002!
>
> ----- Method: ImageFormatTest>>testFormat68003 (in category 'testing')
> -----
> testFormat68003
>
> | cog64 |
> cog64 := (ImageFormat wordSize: 8) setCogSupportRequirement: true.
> self assert: cog64 asInteger = 68003.
> self assert: (ImageFormat wordSize: 8 cog: true) asInteger = 68003.
> self assert: (ImageFormat fromInteger: 68003) asInteger = 68003.
> self assert: cog64 wordSize = 8.
> self assert: cog64 requiresClosureSupport.
> self assert: cog64 requiresNativeFloatWordOrder.
> self deny: cog64 is32Bit.
> self assert: cog64 is64Bit.
> self assert: (ImageFormat fromInteger: 68003) asInteger = 68003!
>
> ----- Method: ImageFormatTest>>testFormat68019 (in category 'testing')
> -----
> testFormat68019
>
> | spur |
> spur := ImageFormat fromInteger: 68019.
> self assert: spur asInteger = 68019.
> self assert: (ImageFormat wordSize: 8 spur: true
> requiresNewSpur64TagAssignment: false) asInteger = 68019.
> self assert: (ImageFormat fromInteger: 68019) asInteger = 68019.
> self assert: spur wordSize = 8.
> self assert: spur requiresClosureSupport.
> self assert: spur requiresNativeFloatWordOrder.
> self deny: spur is32Bit.
> self assert: spur is64Bit.
> self assert: spur requiresSpurSupport.
> self assert: (ImageFormat fromInteger: 68019) asInteger = 68019!
>
> ----- Method: ImageFormatTest>>testFormat68021 (in category 'testing')
> -----
> testFormat68021
>
> | spur |
> spur := ImageFormat fromInteger: 68021.
> self assert: spur asInteger = 68021.
> self assert: (ImageFormat wordSize: 8 spur: true) asInteger = 68021.
> self assert: (ImageFormat fromInteger: 68021) asInteger = 68021.
> self assert: spur wordSize = 8.
> self assert: spur requiresClosureSupport.
> self assert: spur requiresNativeFloatWordOrder.
> self deny: spur is32Bit.
> self assert: spur is64Bit.
> self assert: spur requiresSpurSupport.
> self assert: (ImageFormat fromInteger: 68021) asInteger = 68021!
>
> ----- Method: ImageFormatTest>>testIs32Bit (in category 'testing') -----
> testIs32Bit
>
> self assert: (ImageFormat wordSize: 4) is32Bit.
> self assert: (ImageFormat new fromInteger: 6504) is32Bit.
> self deny: (ImageFormat wordSize: 8) is32Bit.
> self deny: (ImageFormat new fromInteger: 68002) is32Bit.
> self deny: (ImageFormat fromInteger: 6521) is64Bit.
> self assert: (ImageFormat new fromInteger: 68019) is64Bit.
> self assert: (ImageFormat new fromInteger: 68021) is64Bit.
> !
>
> ----- Method: ImageFormatTest>>testIs64Bit (in category 'testing') -----
> testIs64Bit
>
> self deny: (ImageFormat wordSize: 4) is64Bit.
> self deny: (ImageFormat new fromInteger: 6504) is64Bit.
> self assert: (ImageFormat wordSize: 8) is64Bit.
> self assert: (ImageFormat new fromInteger: 68002) is64Bit.
> self deny: (ImageFormat fromInteger: 6521) is64Bit.
> self assert: (ImageFormat new fromInteger: 68019) is64Bit.
> self assert: (ImageFormat new fromInteger: 68021) is64Bit.
> !
>
> ----- Method: ImageFormatTest>>testIsValidVersionNumber (in category
> 'testing') -----
> testIsValidVersionNumber
>
> self should: [ImageFormat fromInteger: 0] raise: Error.
> self should: [ImageFormat fromInteger: (6502 bitAnd: 16r80000000)]
> raise: Error.
> self should: [ImageFormat fromInteger: (6502 bitAt: 31 put: 1)] raise:
> Error.
> self should: [ImageFormat fromInteger: 6500] raise: Error.
> self should: [ImageFormat fromInteger: 6501] raise: Error.
> self should: [ImageFormat fromInteger: 6503] raise: Error. "Cog
> requires both capabilities"
> self should: [ImageFormat fromInteger: 68001] raise: Error. "Cog
> requires both capabilities"
>
> self assert: ImageFormat default isValidVersionNumber.
> self assert: (ImageFormat wordSize: 4 closures: false)
> isValidVersionNumber.
> self assert: (ImageFormat wordSize: 4 closures: true)
> isValidVersionNumber.
> self assert: (ImageFormat wordSize: 8 closures: false)
> isValidVersionNumber.
> self assert: (ImageFormat wordSize: 8 closures: true)
> isValidVersionNumber.
> self assert: (ImageFormat fromInteger: 6502) isValidVersionNumber.
> self assert: (ImageFormat fromInteger: (6502 bitAt: 31 put: 0))
> isValidVersionNumber.
> self assert: (ImageFormat fromInteger: 6521) isValidVersionNumber.
> self assert: (ImageFormat fromInteger:68000) isValidVersionNumber.
> self assert: (ImageFormat fromInteger:68002) isValidVersionNumber.
> self assert: (ImageFormat fromInteger:68004) isValidVersionNumber.
> self assert: (ImageFormat fromInteger:68003) isValidVersionNumber.
> "valid but unused, as with 68019"
> self assert: (ImageFormat fromInteger: 68019) isValidVersionNumber.
> self assert: (ImageFormat fromInteger: 68021) isValidVersionNumber.
>
> !
>
> ----- Method: ImageFormatTest>>testRequiresClosureSupport (in category
> 'testing') -----
> testRequiresClosureSupport
>
> | v |
> v := ImageFormat wordSize: 4.
> self deny: v requiresClosureSupport.
> v setClosureSupportRequirement: false.
> self assert: v asInteger = 6502.
> self deny: v requiresClosureSupport.
> v setClosureSupportRequirement: true.
> self assert: v asInteger = 6504.
> self assert: v requiresClosureSupport.
>
> v := ImageFormat wordSize: 8.
> self deny: v requiresClosureSupport.
> v setClosureSupportRequirement: false.
> self assert: v asInteger = 68000.
> self deny: v requiresClosureSupport.
> v setClosureSupportRequirement: true.
> self assert: v asInteger = 68002.
> self assert: v requiresClosureSupport.
>
> self deny: (ImageFormat wordSize: 4 closures: false)
> requiresClosureSupport.
> self assert: (ImageFormat wordSize: 4 closures: true)
> requiresClosureSupport.
> self deny: (ImageFormat wordSize: 8 closures: false)
> requiresClosureSupport.
> self assert: (ImageFormat wordSize: 8 closures: true)
> requiresClosureSupport.
> !
>
> ----- Method: ImageFormatTest>>testRequiresNativeFloatWordOrder (in
> category 'testing') -----
> testRequiresNativeFloatWordOrder
> "Required for Cog and StackInterpreter"
>
> | v |
> v := ImageFormat wordSize: 4.
> self deny: v requiresNativeFloatWordOrder.
> v setCogSupportRequirement: false.
> self assert: v asInteger = 6502.
> self deny: v requiresNativeFloatWordOrder.
> v setCogSupportRequirement: true.
> self assert: v asInteger = 6505.
> self assert: v requiresNativeFloatWordOrder.
> v setSpurSupportRequirement: true.
> self assert: v asInteger = 6521.
>
> v := ImageFormat wordSize: 8.
> self deny: v requiresNativeFloatWordOrder.
> v setCogSupportRequirement: false.
> self assert: v asInteger = 68000.
> self deny: v requiresNativeFloatWordOrder.
> v setCogSupportRequirement: true.
> self assert: v asInteger = 68003.
> self assert: v requiresNativeFloatWordOrder.
> v setSpurSupportRequirement: true.
> self assert: v asInteger = 68019.
>
> self deny: (ImageFormat wordSize: 4 cog: false)
> requiresNativeFloatWordOrder.
> self deny: (ImageFormat wordSize: 4 cog: false) requiresClosureSupport.
> self deny: (ImageFormat wordSize: 8 cog: false)
> requiresNativeFloatWordOrder.
> self deny: (ImageFormat wordSize: 8 cog: false) requiresClosureSupport.
> self assert: (ImageFormat wordSize: 4 cog: true)
> requiresNativeFloatWordOrder.
> self assert: (ImageFormat wordSize: 4 cog: true) requiresClosureSupport.
> self assert: (ImageFormat wordSize: 8 cog: true)
> requiresNativeFloatWordOrder.
> self assert: (ImageFormat wordSize: 8 cog: true) requiresClosureSupport.
> self assert: (ImageFormat fromInteger: 6521)
> requiresNativeFloatWordOrder.
> self assert: (ImageFormat fromInteger: 6521) requiresClosureSupport.
> self assert: (ImageFormat fromInteger: 68019)
> requiresNativeFloatWordOrder.
> self assert: (ImageFormat fromInteger: 68019) requiresClosureSupport.
> self assert: (ImageFormat fromInteger: 68021)
> requiresNativeFloatWordOrder.
> self assert: (ImageFormat fromInteger: 68021) requiresClosureSupport.
>
> !
>
>
More information about the Vm-dev
mailing list