VM Maker: ImageFormat-dtl.17.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: ImageFormat-dtl.17.mcz

commits-2
 
David T. Lewis uploaded a new version of ImageFormat to project VM Maker:
http://source.squeak.org/VMMaker/ImageFormat-dtl.17.mcz

==================== Summary ====================

Name: ImageFormat-dtl.17
Author: dtl
Time: 9 October 2013, 10:36:05.224 pm
UUID: c0eac484-fb27-48d6-8c7a-69c1b95f52bc
Ancestors: ImageFormat-dtl.16

Assign image format numbers 6521 and 68019 to the Spur object format. Assume that Spur extends existing Cog requirements, and that bit 5 of the format number identifies an image that requires Spur support from the VM. Update unit tests to document the new format numbers.

The assigned image format numbers are:

a 64-bit image with no closure support and no native platform float word order requirement (68000)
a 64-bit image with closure support and no native platform float word order requirement (68002)
a 64-bit image with closure support and float words stored in native platform order (68003)
a 64-bit image with closure support and float words stored in native platform order using Spur object format (68019)
a 32-bit image with no closure support and no native platform float word order requirement (6502)
a 32-bit image with closure support and no native platform float word order requirement (6504)
a 32-bit image with closure support and float words stored in native platform order (6505)
a 32-bit image with closure support and float words stored in native platform order using Spur object format (6521)

=============== Diff against ImageFormat-dtl.16 ===============

Item was changed:
  Object subclass: #ImageFormat
+ instanceVariableNames: 'wordSize requiresClosureSupport requiresNativeFloatWordOrder requiresSpurSupport'
+ classVariableNames: 'BaseVersionMask BaseVersionNumbers CapabilitiesBitsMask KnownVersionNumbers PlatformByteOrderBit ReservedBitsMask SpurObjectBit'
- instanceVariableNames: 'wordSize requiresClosureSupport requiresNativeFloatWordOrder'
- classVariableNames: 'BaseVersionMask BaseVersionNumbers CapabilitiesBitsMask KnownVersionNumbers PlatformByteOrderBit ReservedBitsMask'
  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"
  !

Item was changed:
+ ----- Method: ImageFormat class>>availableBits (in category 'initialize-release') -----
- ----- Method: ImageFormat class>>availableBits (in category 'image formats') -----
  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
  !

Item was changed:
  ----- 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: 5 put: nil. "unassigned bit available for future image formats"
  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
  !

Item was changed:
  ----- 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
- ^PlatformByteOrderBit "only one so far"
  !

Item was changed:
  ----- 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
  !

Item was changed:
  ----- 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 four 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"
- 68003 "Cog and StackVM running 64-bit image"
  " ... add others here as bits are allocated to represent requirements of other image formats"
  }
  !

Item was added:
+ ----- 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"
+
+ ^(self wordSize: bytesPerWord)
+ setClosureSupportRequirement: true;
+ setCogSupportRequirement: true;
+ setSpurSupportRequirement: spurRequired
+ !

Item was changed:
  ----- 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].
  ^val
  !

Item was changed:
  ----- 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])
  ifTrue: [requiresClosureSupport := true].
  (baseVersion = 6502 or: [baseVersion = 6504])
  ifTrue: [wordSize := 4]
  ifFalse: [(baseVersion = 68000 or: [baseVersion = 68002])
  ifTrue: [wordSize := 8]
  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]
 
  !

Item was changed:
  ----- Method: ImageFormat>>initialize (in category 'initialize-release') -----
  initialize
  requiresClosureSupport := false.
+ requiresNativeFloatWordOrder := false.
+ requiresSpurSupport := false!
- requiresNativeFloatWordOrder := false!

Item was changed:
  ----- Method: ImageFormat>>printDescriptionOn: (in category 'printing') -----
  printDescriptionOn: stream
 
  stream nextPutAll: 'a ';
  nextPutAll: (wordSize * 8) asString;
  nextPutAll: '-bit 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'].
  stream nextPutAll: ' (';
  nextPutAll: self asInteger asString;
  nextPut: $).
  ^ stream
  !

Item was added:
+ ----- Method: ImageFormat>>requiresSpurSupport (in category 'testing') -----
+ requiresSpurSupport
+ "True if this image uses the Spur object format."
+ ^requiresSpurSupport!

Item was added:
+ ----- 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
+ !

Item was changed:
  ----- 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.
  !

Item was added:
+ ----- 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!

Item was added:
+ ----- Method: ImageFormatTest>>testFormat68019 (in category 'testing') -----
+ testFormat68019
+
+ | spur |
+ spur := ImageFormat fromInteger: 68019.
+ self assert: spur asInteger = 68019.
+ self assert: (ImageFormat wordSize: 8 spur: true) 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!

Item was changed:
  ----- 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 deny: (ImageFormat new fromInteger: 68002) is32Bit.!

Item was changed:
  ----- 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: 68002) is64Bit.!

Item was changed:
  ----- 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: 68019) isValidVersionNumber.
 
  !

Item was changed:
  ----- 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.
  !