[Vm-dev] Setting the Cog bit

David T. Lewis lewis at mail.msen.com
Wed Jun 23 01:52:31 UTC 2010


Does the Cog VM update to a new image format version number when
snapshotting? If not, then I have the following proposal:

An image that is snapshotted by a Cog VM is going to expect Cog
support when next loaded. It would be good if the image snapshot
declares this explicitly so the VM can exit in a controlled manner
if unable to provide the required support.

I propose that we add a Cog bit to the image format version number,
as illustrated in the attached change set. This can be extended in
the future such that an image that requires "foo" support from a VM
will set the "foo bit".

The original Squeak images had image format number 6502. With closure
support, this became 6504. Requiring Cog implies a requirement for
closure support, so an image that requires Cog support would be 6505.
For 64-bit images, the corresponding image format numbers are 68000,
68002, and 68003. Note that bit 0 was previously unused, which means
that Cog would become the recipient of the highly-coveted bit zero
position ;)

There are plenty of free bits available to be allocated for future
capabilities, and the high order bit would be reserved for expansion
if the need ever arises.

Dave

-------------- next part --------------
'From Squeak3.11alpha of 12 June 2010 [latest update: #10207] on 22 June 2010 at 9:10:45 pm'!
"Change Set:		ImageFormatVersion-dtl
Date:			22 June 2010
Author:			David T. Lewis

Class ImageFormatVersion implements, for purposes of documentation, the image version number that is stored in the image file header. It is implemented in terms of capabilities that the image expects of the virtual machine. It is backward compatible with existing Squeak image format version numbers, and proposes to use bit assignments to represent addition capabilities that the image expects of the virtual machine. For purposes of illustration, bit zero is allocated as the Cog bit, such that a 32-bit image that expects Cog support in the VM has image format number 6505.

Class ImageFormatVersionTest contains unit tests to validate the implementation.

In this proposed format, we currently would have:
  ImageFormatVersion default ==> 6502
  ImageFormatVersion wordSize: 4 ==> 6502
  ImageFormatVersion wordSize: 4 closures: false => 6502
  ImageFormatVersion wordSize: 4 closures: true ==> 6504
  ImageFormatVersion wordSize: 4 cog: false ==> 6502
  ImageFormatVersion wordSize: 4 cog: true ==> 6505
  ImageFormatVersion wordSize: 8 ==> 68000
  ImageFormatVersion wordSize: 8 closures: false ==> 68000
  ImageFormatVersion wordSize: 8 closures: true ==> 68002
  ImageFormatVersion wordSize: 8 cog: false ==> 68000
  ImageFormatVersion wordSize: 8 cog: true ==> 68003
"!


!ImageFormatVersion commentStamp: 'dtl 6/22/2010 20:50' prior: 0!
ImageFormatVersion represents the requirements of the image in terms of capabilities that should 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, e.g. if image sets bit 15 to indicate "needs object header inversion", then VM can check bit 15 and decide whether it can support this (whimsical) requirement.

Given current usage (6502, 6504, 68000, and 68002) we have 10 bits currently in use, and 22 available for future use. Reserve the high order bit for future extention in case 32 bits is not enough. This leaves 21 bits for future image format changes.

Suggested change: The imageFormatVersion number for a 64-bit image with closure bytecode support should be changed from 68002 to 68008. This means that bit number 4 (one-base indexing) means "image requires closure bytecode support" for both 32-bit and 64-bit image formats. The change only effects people running 64-bit images with closures (I am quite
confident that this is a small number of people).

Policy: Anyone making a significant image format change that they wish to be supported by standard VMs can register a bit in the imageFormatVersion bit map. When we run out of bits, allocate a second 32 bit value, set the extension bit, and carry on. If that's not enough, burn the disk packs ;)

How the imageFormatVersion value is used and modified:

Image responsibilities:
  - Image is responsible for knowing its imageFormatVersion.
  - Image is responsible for modifying its imageVersionNumber if new capabilities
    are required
  - Image is responsible for informing the VM of any change (note: An image
    with closure bytecodes does this indirectly).

VM responsibilities:
  - VM is responsible for reading imageFormatVersion from image header on image load
  - VM is responsible for determining if it can support the image format and for
    deciding what to do if it cannot support the image format
  - VM is responsible for saving the (possibly updated) imageFormatVersion
    on image save

Bit 0 ==> 0     Cog support required
Bit 1 ==> 1
Bit 2 ==> 1
Bit 3 ==> 1     (proposed "closure bytecodes required" bit)
Bit 4 ==> 0
Bit 5 ==> 1
Bit 6 ==> 1
Bit 7 ==> 1
Bit 8 ==> 1
Bit 9 ==> 0
Bit 10 ==> 0
Bit 11 ==> 1
Bit 12 ==> 1
Bit 13 ==> 0
Bit 14 ==> 0
Bit 15 ==> 0
Bit 16 ==> 1
Bit 17 ==> 0
Bit 18 ==> 0
Bit 19 ==> 0
Bit 20 ==> 0
Bit 21 ==> 0
Bit 22 ==> 0
Bit 23 ==> 0
Bit 24 ==> 0
Bit 25 ==> 0
Bit 26 ==> 0
Bit 27 ==> 0
Bit 28 ==> 0
Bit 29 ==> 0
Bit 30 ==> 0
Bit 31 ==> 0    (reserve as extension bit)
!


!ImageFormatVersionTest commentStamp: 'dtl 6/9/2010 20:11' prior: 0!
Verify and document the values of image format version. The image format version is an integer value that identifies the format of an image snapshot and the capabilities that the image expects of the virtual machine.!


!ImageFormatVersion methodsFor: 'initialize-release' stamp: 'dtl 6/9/2010 21:22'!
fromInteger: anInteger
	"Initialize a new instance from anInteger obtained from an image file header."

	| baseVersion |
	(anInteger bitAnd: self 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]]! !

!ImageFormatVersion methodsFor: 'initialize-release' stamp: 'dtl 6/22/2010 20:30'!
initialize
	requiresClosureSupport := false.
	requiresCogSupport := false! !

!ImageFormatVersion methodsFor: 'initialize-release' stamp: 'dtl 6/9/2010 21:20'!
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
! !

!ImageFormatVersion methodsFor: 'initialize-release' stamp: 'dtl 6/22/2010 20:59'!
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"
	requiresCogSupport := aBoolean
! !

!ImageFormatVersion methodsFor: 'testing' stamp: 'dtl 6/9/2010 21:45'!
is32Bit
	"True if the image uses 4 byte object memory words and 4 byte object pointers."
	^wordSize = 4! !

!ImageFormatVersion methodsFor: 'testing' stamp: 'dtl 6/9/2010 21:45'!
is64Bit
	"True if the image uses 8 byte object memory words and 8 byte object pointers."
	^wordSize = 8! !

!ImageFormatVersion methodsFor: 'testing' stamp: 'dtl 6/10/2010 07:05'!
requiresClosureSupport
	"True if this image contains closure bytecodes that must be supported by
	the virtual machine."
	^requiresClosureSupport! !

!ImageFormatVersion methodsFor: 'testing' stamp: 'dtl 6/22/2010 20:31'!
requiresCogSupport
	"True if this image requires a Cog VM (stack VM possibly including a Cog jitter)"
	^requiresCogSupport! !

!ImageFormatVersion methodsFor: 'accessing' stamp: 'dtl 6/9/2010 21:39'!
wordSize
	^ wordSize! !

!ImageFormatVersion methodsFor: 'converting' stamp: 'dtl 6/22/2010 20:31'!
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 requiresCogSupport ifTrue: [val := val + 1].
	^val
! !

!ImageFormatVersion methodsFor: 'printing' stamp: 'dtl 6/9/2010 21:47'!
printOn: aStream
	aStream nextPutAll: self asInteger asString! !

!ImageFormatVersion methodsFor: 'private' stamp: 'dtl 6/9/2010 20:07'!
baseVersionBits
	"Answer the bits associated with base format number exclusive of capability bits"

	^self baseVersionBitsOf: self asInteger
! !

!ImageFormatVersion methodsFor: 'private' stamp: 'dtl 6/9/2010 20:07'!
baseVersionBitsOf: anInteger
	"Answer the bits of anInteger associated with base format number exclusive
	of capability bits"

	^ anInteger bitAnd: self baseVersionMask! !

!ImageFormatVersion methodsFor: 'private' stamp: 'dtl 6/9/2010 19:07'!
baseVersionMask
	"Mask the bits associated with base format number exclusive of capability bits"

	^self baseVersionNumbers
		inject: 0
		into: [:accum :e | accum bitOr: e]
! !

!ImageFormatVersion methodsFor: 'private' stamp: 'dtl 6/9/2010 21:50'!
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)
! !

!ImageFormatVersion methodsFor: 'private' stamp: 'dtl 6/9/2010 21:25'!
isValidVersionNumber
	"True if the version number uses a known base version number and does not
	use any reserved bits"

	^(self baseVersionNumbers includes: self baseVersionBits)
		and: [(self asInteger bitAnd: self reservedBitsMask) = 0]! !

!ImageFormatVersion methodsFor: 'private' stamp: 'dtl 6/9/2010 20:03'!
reservedBitsMask
	"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."
	
	"ImageFormatVersion new reservedBitsMask printStringBase: 2"

	^16rFFFFFFFF bitXor: self baseVersionMask! !


!ImageFormatVersion class methodsFor: 'instance creation' stamp: 'dtl 6/8/2010 21:24'!
default
	"The original Squeak image format number"

	^ self wordSize: 4! !

!ImageFormatVersion class methodsFor: 'instance creation' stamp: 'dtl 6/10/2010 07:02'!
fromInteger: anInteger
	"Answer a new instance from an integer, typically obtained from an
	image file header."

	^ self new fromInteger: anInteger! !

!ImageFormatVersion class methodsFor: 'instance creation' stamp: 'dtl 6/9/2010 19:52'!
wordSize: bytesPerWord
	bytesPerWord = 4
		ifTrue: [^self new fromInteger: 6502].
	bytesPerWord = 8
		ifTrue: [^self new fromInteger: 68000].
	self error: 'unsupported word size ', bytesPerWord! !

!ImageFormatVersion class methodsFor: 'instance creation' stamp: 'dtl 6/9/2010 21:18'!
wordSize: bytesPerWord closures: aBoolean

	^(self wordSize: bytesPerWord) setClosureSupportRequirement: aBoolean
! !

!ImageFormatVersion class methodsFor: 'instance creation' stamp: 'dtl 6/22/2010 20:48'!
wordSize: bytesPerWord cog: cogRequired

	^(self wordSize: bytesPerWord)
		setClosureSupportRequirement: cogRequired;
		setCogSupportRequirement: cogRequired
! !


!ImageFormatVersionTest methodsFor: 'testing' stamp: 'dtl 6/8/2010 22:31'!
testAsInteger

	self assert: (ImageFormatVersion fromInteger: 6502) asInteger = 6502.
	self assert: (ImageFormatVersion fromInteger: 6504) asInteger = 6504.
	self assert: (ImageFormatVersion fromInteger: 68000) asInteger = 68000.
	self assert: (ImageFormatVersion fromInteger: 68002) asInteger = 68002.
	! !

!ImageFormatVersionTest methodsFor: 'testing' stamp: 'dtl 6/9/2010 19:52'!
testBaseVersionBits

	self assert: ImageFormatVersion new baseVersionMask = 16r119EE.
	self assert: (ImageFormatVersion wordSize: 4) baseVersionBits = 6502.
	self assert: (ImageFormatVersion new fromInteger: 6504) baseVersionBits = 6504.
	self assert: (ImageFormatVersion wordSize: 8) baseVersionBits = 68000.
	self assert: (ImageFormatVersion new fromInteger: 68002) baseVersionBits = 68002.
! !

!ImageFormatVersionTest methodsFor: 'testing' stamp: 'dtl 6/9/2010 19:42'!
testDefaultImageFormats
	"Original 32-bit image format, and the original 64-bit image format, prior to
	introduction of block closure support."

	self assert: (6502 = (ImageFormatVersion wordSize: 4) asInteger).
	self assert: (68000 = (ImageFormatVersion wordSize: 8) asInteger).
	self should: [ImageFormatVersion wordSize: 0] raise: Error.
	self should: [ImageFormatVersion wordSize: 12] raise: Error! !

!ImageFormatVersionTest methodsFor: 'testing' stamp: 'dtl 6/9/2010 21:37'!
testFormat6502

	self assert: ImageFormatVersion default asInteger = 6502.
	self assert: (ImageFormatVersion wordSize: 4) asInteger = 6502.
	self assert: (ImageFormatVersion wordSize: 4 closures: false) asInteger = 6502.
	self assert: (ImageFormatVersion fromInteger: 6502) asInteger = 6502.
	self assert: ImageFormatVersion default wordSize = 4.
	self deny: ImageFormatVersion default requiresClosureSupport.
	self assert: ImageFormatVersion default is32Bit.
	self deny: ImageFormatVersion default is64Bit! !

!ImageFormatVersionTest methodsFor: 'testing' stamp: 'dtl 6/9/2010 21:44'!
testFormat6504

	| defaultWithClosures |
	defaultWithClosures := ImageFormatVersion default setClosureSupportRequirement: true.
	self assert: defaultWithClosures asInteger = 6504.
	self assert: (ImageFormatVersion wordSize: 4 closures: true) asInteger = 6504.
	self assert: (ImageFormatVersion fromInteger: 6504) asInteger = 6504.
	self assert: defaultWithClosures wordSize = 4.
	self assert: defaultWithClosures requiresClosureSupport.
	self assert: defaultWithClosures is32Bit.
	self deny: defaultWithClosures is64Bit! !

!ImageFormatVersionTest methodsFor: 'testing' stamp: 'dtl 6/9/2010 19:53'!
testIs32Bit

	self assert: (ImageFormatVersion wordSize: 4) is32Bit.
	self assert: (ImageFormatVersion new fromInteger: 6504) is32Bit.
	self deny: (ImageFormatVersion wordSize: 8) is32Bit.
	self deny: (ImageFormatVersion new fromInteger: 68002) is32Bit.! !

!ImageFormatVersionTest methodsFor: 'testing' stamp: 'dtl 6/9/2010 19:53'!
testIs64Bit

	self deny: (ImageFormatVersion wordSize: 4) is64Bit.
	self deny: (ImageFormatVersion new fromInteger: 6504) is64Bit.
	self assert: (ImageFormatVersion wordSize: 8) is64Bit.
	self assert: (ImageFormatVersion new fromInteger: 68002) is64Bit.! !

!ImageFormatVersionTest methodsFor: 'testing' stamp: 'dtl 6/9/2010 19:52'!
testIsValidVersionNumber

	self should: [ImageFormatVersion fromInteger: 0] raise: Error.
	self should: [ImageFormatVersion fromInteger: (6502 bitAnd: 16r80000000)] raise: Error.
	self should: [ImageFormatVersion fromInteger: (6502 bitAt: 31 put: 1)] raise: Error.
	self should: [ImageFormatVersion fromInteger: 6500] raise: Error.
	self should: [ImageFormatVersion fromInteger: 6501] raise: Error.
	self should: [ImageFormatVersion fromInteger: 6505] raise: Error.
	self should: [ImageFormatVersion fromInteger: 68001] raise: Error.

	self assert: ImageFormatVersion default isValidVersionNumber.
	self assert: (ImageFormatVersion wordSize: 4 closures: false) isValidVersionNumber.
	self assert: (ImageFormatVersion wordSize: 4 closures: true) isValidVersionNumber.
	self assert: (ImageFormatVersion wordSize: 8 closures: false) isValidVersionNumber.
	self assert: (ImageFormatVersion wordSize: 8 closures: true) isValidVersionNumber.
	self assert: (ImageFormatVersion fromInteger: 6502) isValidVersionNumber.
	self assert: (ImageFormatVersion fromInteger: (6502 bitAt: 31 put: 0)) isValidVersionNumber.

! !

!ImageFormatVersionTest methodsFor: 'testing' stamp: 'dtl 6/9/2010 21:19'!
testRequiresClosureSupport

	| v |
	v := ImageFormatVersion 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 := ImageFormatVersion 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: (ImageFormatVersion wordSize: 4 closures: false) requiresClosureSupport.
	self assert: (ImageFormatVersion wordSize: 4 closures: true) requiresClosureSupport.
	self deny: (ImageFormatVersion wordSize: 8 closures: false) requiresClosureSupport.
	self assert: (ImageFormatVersion wordSize: 8 closures: true) requiresClosureSupport.
! !

!ImageFormatVersionTest methodsFor: 'testing' stamp: 'dtl 6/22/2010 20:54'!
testRequiresCogSupport

	| v |
	v := ImageFormatVersion wordSize: 4.
	self deny: v requiresCogSupport.
	v setCogSupportRequirement: false.
	self assert: v asInteger = 6502.
	self deny: v requiresCogSupport.
	v setCogSupportRequirement: true.
	self assert: v asInteger = 6505.
	self assert: v requiresCogSupport.

	v := ImageFormatVersion wordSize: 8.
	self deny: v requiresCogSupport.
	v setCogSupportRequirement: false.
	self assert: v asInteger = 68000.
	self deny: v requiresCogSupport.
	v setCogSupportRequirement: true.
	self assert: v asInteger = 68003.
	self assert: v requiresCogSupport.
	
	self deny: (ImageFormatVersion wordSize: 4 cog: false) requiresCogSupport.
	self deny: (ImageFormatVersion wordSize: 4 cog: false) requiresClosureSupport.
	self deny: (ImageFormatVersion wordSize: 8 cog: false) requiresCogSupport.
	self deny: (ImageFormatVersion wordSize: 8 cog: false) requiresClosureSupport.
	self assert: (ImageFormatVersion wordSize: 4 cog: true) requiresCogSupport.
	self assert: (ImageFormatVersion wordSize: 4 cog: true) requiresClosureSupport.
	self assert: (ImageFormatVersion wordSize: 8 cog: true) requiresCogSupport.
	self assert: (ImageFormatVersion wordSize: 8 cog: true) requiresClosureSupport.
! !



More information about the Vm-dev mailing list