[Vm-dev] Fwd: [squeak-dev] The Inbox: ImageFormat-kks.34.mcz
K K Subbu
kksubbu.ml at gmail.com
Wed Apr 10 18:10:53 UTC 2019
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