The Inbox: ImageFormat-kks.34.mcz

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.

!

I copied this to the VMMaker repository, and moved the inbox intry to treated.

Dave

On Wed, Apr 10, 2019 at 05:13:58PM +0000, [hidden email] wrote: