[Vm-dev] VM Maker: ImageFormat-dtl.20.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Mar 12 05:02:45 UTC 2016


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

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

Name: ImageFormat-dtl.20
Author: dtl
Time: 12 March 2016, 12:02:40.549 am
UUID: 62b8d3f2-7457-4176-898f-66631d97ccc1
Ancestors: ImageFormat-dtl.19

Spur:
Resolve the conflict between 32-bit and 64-bit tag assignments.  In 32-bits we
have 1=even SmallIntegers, 2=Characters, 3=odd SmallIntegers, and in 64-bits we
had 1=SmallIntegers, 2=Characters, 3=SmallFloats.  Hence we would want
SmallFloat64's identityHash to be 3, which conflicts with 32 bits' odd
SmallIntegers.  Change is for 64-bits to use 1=SmallIntegers, 2=Characters,
4=SmallFloats.  This also means single-bit tests in the Cogit, which produces
better code, and no scratch registers to hold masked tags.

Hence roll the 64-bit Spur image format version number from 68019 to 68021.

=============== Diff against ImageFormat-dtl.19 ===============

Item was changed:
  Object subclass: #ImageFormat
+ 	instanceVariableNames: 'wordSize requiresClosureSupport requiresNativeFloatWordOrder requiresSpurSupport requiresNewSpur64TagAssignment'
- 	instanceVariableNames: 'wordSize requiresClosureSupport requiresNativeFloatWordOrder requiresSpurSupport'
  	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"
  !

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.
- 	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 (early)"
+ 			68021 .	"Spur 64 bit object memory"
- 			68019 .	"Spur 64 bit object memory"
  				" ... add others here as bits are allocated to represent requirements of other image formats"
  		}
  !

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

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

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].
+ 	self requiresNewSpur64TagAssignment ifTrue: [val := val + 2].
  	^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]) or: [baseVersion = 68004])
- 	(baseVersion = 6504 or: [baseVersion = 68002])
  		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: [(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.
+ 	requiresNewSpur64TagAssignment := false.!
- 	requiresSpurSupport := 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'.
+ 				(self is64Bit and: [self requiresNewSpur64TagAssignment not])
+ 					ifTrue: [stream nextPutAll: ' (obsolete)']].
- 			ifTrue: [stream nextPutAll: ' using Spur object format'].
  		stream nextPutAll: ' (';
  			nextPutAll: self asInteger asString;
  			nextPut: $).
  		^ stream
  !

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

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

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



More information about the Vm-dev mailing list