[Vm-dev] VM Maker: VMMaker.oscog-nice.1757.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Apr 2 22:49:30 UTC 2016


Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1757.mcz

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

Name: VMMaker.oscog-nice.1757
Author: nice
Time: 3 April 2016, 12:47:06.347 am
UUID: a8652aa5-b750-4c29-bb85-283dc8201c29
Ancestors: VMMaker.oscog-eem.1756

Use the byte swap macros as provided by sqMemoryAccess.h since svn 3667

Eliminate the now un-necessary related VMBasicConstants.

Fx a snafu in StackInterpreter>>getWord32FromFile:swap: and CogVMSimulator>>openOn:extraMemory:  that would have swapped64 a long32 on 64bits VM...
Well, there is no bigEndian 64bits STACK/COG image, so this was only a theoretical bug.
Note: classical interpreter reads a long for image version, not a word32.

Fix same snafu in StackInterpreter>>getShortFromFile:swap:  alas, I didn't provide a SQ_SWAP_2_BYTES macro, so open code it for now....

=============== Diff against VMMaker.oscog-eem.1756 ===============

Item was added:
+ ----- Method: CCodeGenerator>>generateByteSwap32:on:indent: (in category 'C translation') -----
+ generateByteSwap32: msgNode on: aStream indent: level
+ 	"Generate the C code for this message onto the given stream."
+ 
+ 	aStream nextPutAll: #'SQ_SWAP_4_BYTES'.
+ 	aStream nextPut: $(.
+ 	self emitCExpression: msgNode receiver on: aStream.
+ 	aStream nextPut: $)!

Item was added:
+ ----- Method: CCodeGenerator>>generateByteSwap64:on:indent: (in category 'C translation') -----
+ generateByteSwap64: msgNode on: aStream indent: level
+ 	"Generate the C code for this message onto the given stream."
+ 
+ 	aStream nextPutAll: #'SQ_SWAP_8_BYTES'.
+ 	aStream nextPut: $(.
+ 	self emitCExpression: msgNode receiver on: aStream.
+ 	aStream nextPut: $)!

Item was changed:
  ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation support') -----
  initializeCTranslationDictionary 
  	"Initialize the dictionary mapping message names to actions for C code generation."
  
  	| pairs |
  	
  	translationDict := Dictionary new: 200.
  	pairs := #(
  	#&				#generateAnd:on:indent:
  	#|				#generateOr:on:indent:
  	#abs			#generateAbs:on:indent:
  	#and:			#generateSequentialAnd:on:indent:
  	#or:			#generateSequentialOr:on:indent:
  	#not			#generateNot:on:indent:
  
  	#+				#generatePlus:on:indent:
  	#-				#generateMinus:on:indent:
  	#negated		#generateNegated:on:indent:
  	#*				#generateTimes:on:indent:
  	#/				#generateDivide:on:indent:
  	#//				#generateDivide:on:indent:
  	#\\				#generateModulo:on:indent:
  	#<<			#generateShiftLeft:on:indent:
  	#>>			#generateShiftRight:on:indent:
  	#>>>			#generateSignedShiftRight:on:indent:
  	#min:			#generateMin:on:indent:
  	#max:			#generateMax:on:indent:
  	#between:and:	#generateBetweenAnd:on:indent:
  
  	#bitAnd:			#generateBitAnd:on:indent:
  	#bitOr:				#generateBitOr:on:indent:
  	#bitXor:			#generateBitXor:on:indent:
  	#bitShift:			#generateBitShift:on:indent:
  	#signedBitShift:	#generateSignedBitShift:on:indent:
  	#bitInvert32		#generateBitInvert:on:indent:
  	#bitInvert64		#generateBitInvert:on:indent:
  	#bitClear:			#generateBitClear:on:indent:
  	#truncateTo:		#generateTruncateTo:on:indent:
  	#rounded			#generateRounded:on:indent:
  
+ 	#byteSwap32		#generateByteSwap32:on:indent:
+ 	#byteSwap64		#generateByteSwap64:on:indent:
+ 	
  	#<				#generateLessThan:on:indent:
  	#<=			#generateLessThanOrEqual:on:indent:
  	#=				#generateEqual:on:indent:
  	#>				#generateGreaterThan:on:indent:
  	#>=			#generateGreaterThanOrEqual:on:indent:
  	#~=			#generateNotEqual:on:indent:
  	#==			#generateEqual:on:indent:
  	#~~			#generateNotEqual:on:indent:
  	#isNil			#generateIsNil:on:indent:
  	#notNil			#generateNotNil:on:indent:
  
  	#whileTrue: 	#generateWhileTrue:on:indent:
  	#whileFalse:	#generateWhileFalse:on:indent:
  	#whileTrue 	#generateDoWhileTrue:on:indent:
  	#whileFalse		#generateDoWhileFalse:on:indent:
  	#to:do:			#generateToDo:on:indent:
  	#to:by:do:		#generateToByDo:on:indent:
  	#repeat 		#generateRepeat:on:indent:
  	#timesRepeat:	#generateTimesRepeat:on:indent:
  
  	#ifTrue:			#generateIfTrue:on:indent:
  	#ifFalse:		#generateIfFalse:on:indent:
  	#ifTrue:ifFalse:	#generateIfTrueIfFalse:on:indent:
  	#ifFalse:ifTrue:	#generateIfFalseIfTrue:on:indent:
  
  	#ifNotNil:		#generateIfNotNil:on:indent:
  	#ifNil:			#generateIfNil:on:indent:
  	#ifNotNil:ifNil:	#generateIfNotNilIfNil:on:indent:
  	#ifNil:ifNotNil:	#generateIfNilIfNotNil:on:indent:
  
  	#at:				#generateAt:on:indent:
  	#at:put:			#generateAtPut:on:indent:
  	#basicAt:		#generateAt:on:indent:
  	#basicAt:put:	#generateAtPut:on:indent:
  
  	#integerValueOf:			#generateIntegerValueOf:on:indent:
  	#integerObjectOf:			#generateIntegerObjectOf:on:indent:
  	#isIntegerObject: 			#generateIsIntegerObject:on:indent:
  	#cCode:					#generateInlineCCode:on:indent:
  	#cCode:inSmalltalk:			#generateInlineCCode:on:indent:
  	#cPreprocessorDirective:	#generateInlineCPreprocessorDirective:on:indent:
  	#cppIf:ifTrue:ifFalse:		#generateInlineCppIfElse:on:indent:
  	#cppIf:ifTrue:				#generateInlineCppIfElse:on:indent:
  	#cCoerce:to:				#generateCCoercion:on:indent:
  	#cCoerceSimple:to:			#generateCCoercion:on:indent:
  	#addressOf:				#generateAddressOf:on:indent:
  	#addressOf:put:			#generateAddressOf:on:indent:
  	#asAddress:put:			#generateAsAddress:on:indent:
  	#signedIntFromLong64		#generateSignedIntFromLong64:on:indent:
  	#signedIntFromLong		#generateSignedIntFromLong:on:indent:
  	#signedIntFromShort		#generateSignedIntFromShort:on:indent:
  	#signedIntToLong64		#generateSignedIntToLong64:on:indent:
  	#signedIntToLong			#generateSignedIntToLong:on:indent:
  	#signedIntToShort			#generateSignedIntToShort:on:indent:
  	#preIncrement				#generatePreIncrement:on:indent:
  	#preDecrement			#generatePreDecrement:on:indent:
  	#inline:						#generateInlineDirective:on:indent:
  	#asFloat					#generateAsFloat:on:indent:
  	#asInteger					#generateAsInteger:on:indent:
  	#asUnsignedInteger		#generateAsUnsignedInteger:on:indent:
  	#asLong					#generateAsLong:on:indent:
  	#asUnsignedLong			#generateAsUnsignedLong:on:indent:
  	#asUnsignedLongLong		#generateAsUnsignedLongLong:on:indent:
  	#asVoidPointer				#generateAsVoidPointer:on:indent:
  	#asSymbol					#generateAsSymbol:on:indent:
  	#flag:						#generateFlag:on:indent:
  	#anyMask:					#generateBitAnd:on:indent:
  	#allMask:					#generateAllMask:on:indent:
  	#noMask:					#generateNoMask:on:indent:
  	#raisedTo:					#generateRaisedTo:on:indent:
  	#touch:						#generateTouch:on:indent:
  
  	#bytesPerOop 				#generateBytesPerOop:on:indent:
  	#bytesPerWord 			#generateBytesPerWord:on:indent:
  	#wordSize		 			#generateBytesPerWord:on:indent:
  	#baseHeaderSize			#generateBaseHeaderSize:on:indent:
  	#minSmallInteger			#generateSmallIntegerConstant:on:indent:
  	#maxSmallInteger			#generateSmallIntegerConstant:on:indent:
  	
  	#sharedCodeNamed:inCase:		#generateSharedCodeDirective:on:indent:
  
  	#perform:							#generatePerform:on:indent:
  	#perform:with:						#generatePerform:on:indent:
  	#perform:with:with:					#generatePerform:on:indent:
  	#perform:with:with:with:				#generatePerform:on:indent:
  	#perform:with:with:with:with:		#generatePerform:on:indent:
  	#perform:with:with:with:with:with:	#generatePerform:on:indent:
  
  	#value								#generateValue:on:indent:
  	#value:								#generateValue:on:indent:
  	#value:value:						#generateValue:on:indent:
  	#value:value:value:					#generateValue:on:indent:
  	#value:value:value:value:			#generateValue:on:indent:
  
  	#deny:								#generateDeny:on:indent:
  
  	#shouldNotImplement				#generateSmalltalkMetaError:on:indent:
  	#shouldBeImplemented			#generateSmalltalkMetaError:on:indent:
  	#subclassResponsibility			#generateSmalltalkMetaError:on:indent:
  	).
  
  	1 to: pairs size by: 2 do: [:i |
  		translationDict at: (pairs at: i) put: (pairs at: i + 1)].
  
  	pairs := #(
  	#ifTrue:					#generateIfTrueAsArgument:on:indent:	
  	#ifFalse:				#generateIfFalseAsArgument:on:indent:
  	#ifTrue:ifFalse:			#generateIfTrueIfFalseAsArgument:on:indent:
  	#ifFalse:ifTrue:			#generateIfFalseIfTrueAsArgument:on:indent:
  	#ifNotNil:				#generateIfNotNilAsArgument:on:indent:	
  	#ifNil:					#generateIfNilAsArgument:on:indent:
  	#ifNotNil:ifNil:			#generateIfNotNilIfNilAsArgument:on:indent:
  	#ifNil:ifNotNil:			#generateIfNilIfNotNilAsArgument:on:indent:
  	#cCode:				#generateInlineCCodeAsArgument:on:indent:
  	#cCode:inSmalltalk:		#generateInlineCCodeAsArgument:on:indent:
  	#cppIf:ifTrue:ifFalse:	#generateInlineCppIfElseAsArgument:on:indent:
  	#cppIf:ifTrue:			#generateInlineCppIfElseAsArgument:on:indent:
  
  	#value					#generateValueAsArgument:on:indent:
  	#value:					#generateValueAsArgument:on:indent:
  	#value:value:			#generateValueAsArgument:on:indent:
  	).
  
  	asArgumentTranslationDict := Dictionary new: 8.
  	1 to: pairs size by: 2 do: [:i |
  		asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
  !

Item was changed:
  ----- Method: CogVMSimulator>>openOn:extraMemory: (in category 'initialization') -----
  openOn: fileName extraMemory: extraBytes
  	"CogVMSimulator new openOn: 'clone.im' extraMemory: 100000"
  
  	| f version headerSize dataSize count oldBaseAddr bytesToShift swapBytes
  	  headerFlags firstSegSize heapSize
  	  hdrNumStackPages hdrEdenBytes hdrMaxExtSemTabSize
  	  hdrCogCodeSize stackZoneSize methodCacheSize primTraceLogSize allocationReserve |
  	"open image file and read the header"
  
  	f := FileStream readOnlyFileNamed: fileName.
  	f ifNil: [^self error: 'no image found'].
  
  	"Set the image name and the first argument; there are
  	 no arguments during simulation unless set explicitly."
  	systemAttributes at: 1 put: fileName; at: 2 put: nil.
  
  	["begin ensure block..."
  	imageName := f fullName.
  	f binary.
  
  	version := self getWord32FromFile: f swap: false.  "current version: 16r1968 (=6504) vive la revolucion!!"
  	(self readableFormat: version)
  		ifTrue: [swapBytes := false]
+ 		ifFalse: [(version := version byteSwap32) = self imageFormatVersion
- 		ifFalse: [(version := objectMemory byteSwapped: version) = self imageFormatVersion
  					ifTrue: [swapBytes := true]
  					ifFalse: [self error: 'incomaptible image format']].
  	headerSize := self getWord32FromFile: f swap: swapBytes.
  	dataSize := self getLongFromFile: f swap: swapBytes.  "length of heap in file"
  	oldBaseAddr := self getLongFromFile: f swap: swapBytes.  "object memory base address of image"
  	objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  	objectMemory lastHash: (self getLongFromFile: f swap: swapBytes).  "Should be loaded from, and saved to the image header"
  
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	headerFlags		:= self getLongFromFile: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
  	extraVMMemory	:= self getWord32FromFile: f swap: swapBytes.
  	hdrNumStackPages	:= self getShortFromFile: f swap: swapBytes.
  	"4 stack pages is small.  Should be able to run with as few as
  	 three. 4 should be comfortable but slow.  8 is a reasonable
  	 default. Can be changed via vmParameterAt: 43 put: n"
  	numStackPages := desiredNumStackPages ~= 0
  						ifTrue: [desiredNumStackPages]
  						ifFalse: [hdrNumStackPages = 0
  									ifTrue: [self defaultNumStackPages]
  									ifFalse: [hdrNumStackPages]].
  	desiredNumStackPages := hdrNumStackPages.
  	stackZoneSize := self computeStackZoneSize.
  	"This slot holds the size of the native method zone in 1k units. (pad to word boundary)."
  	hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024.
  	cogCodeSize := desiredCogCodeSize ~= 0
  						ifTrue: [desiredCogCodeSize]
  						ifFalse:
  							[hdrCogCodeSize = 0
  									ifTrue: [cogit defaultCogCodeSize]
  									ifFalse: [hdrCogCodeSize]].
  	desiredCogCodeSize := hdrCogCodeSize.
  	self assert: f position = (objectMemory wordSize = 4 ifTrue: [40] ifFalse: [64]).
  	hdrEdenBytes	:= self getWord32FromFile: f swap: swapBytes.
  	objectMemory edenBytes: (desiredEdenBytes ~= 0
  						ifTrue: [desiredEdenBytes]
  						ifFalse:
  							[hdrEdenBytes = 0
  									ifTrue: [objectMemory defaultEdenBytes]
  									ifFalse: [hdrEdenBytes]]).
  	desiredEdenBytes := hdrEdenBytes.
  	hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
  	hdrMaxExtSemTabSize ~= 0 ifTrue:
  		[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  	 Preserve it to be polite to other VMs."
  	the2ndUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	self assert: f position = (objectMemory wordSize = 4 ifTrue: [48] ifFalse: [72]).
  	firstSegSize := self getLongFromFile: f swap: swapBytes.
  	objectMemory firstSegmentSize: firstSegSize.
  	"For Open PICs to be able to probe the method cache during
  	 simulation the methodCache must be relocated to memory."
  	methodCacheSize := methodCache size * objectMemory wordSize.
  	primTraceLogSize := primTraceLog size * objectMemory wordSize.
  	"allocate interpreter memory. This list is in address order, low to high.
  	 In the actual VM the stack zone exists on the C stack."
  	heapBase := (Cogit guardPageSize
  				+ cogCodeSize
  				+ stackZoneSize
  				+ methodCacheSize
  				+ primTraceLogSize
  				+ self rumpCStackSize) roundUpTo: objectMemory allocationUnit.
  	"compare memory requirements with availability"
  	allocationReserve := self interpreterAllocationReserveBytes.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[| freeOldSpaceInImage headroom |
  			 freeOldSpaceInImage := self getLongFromFile: f swap: swapBytes.
  			 headroom := objectMemory
  							initialHeadroom: extraVMMemory
  							givenFreeOldSpaceInImage: freeOldSpaceInImage.
  			 heapSize := objectMemory roundUpHeapSize:
  						   dataSize
  						+ headroom
  						+ objectMemory newSpaceBytes
  						+ (headroom > allocationReserve
  							ifTrue: [0]
  							ifFalse: [allocationReserve])]
  		ifFalse:
  			[heapSize :=  dataSize
  						+ extraBytes
  						+ objectMemory newSpaceBytes
  						+ (extraBytes > allocationReserve
  							ifTrue: [0]
  							ifFalse: [allocationReserve])].
  	heapBase := objectMemory
  					setHeapBase: heapBase
  					memoryLimit:  heapBase + heapSize
  					endOfMemory: heapBase + dataSize.
  
  	self assert: cogCodeSize \\ 4 = 0.
  	self assert: objectMemory memoryLimit \\ 4 = 0.
  	self assert: self rumpCStackSize \\ 4 = 0.
  	"read in the image in bulk, then swap the bytes if necessary"
  	f position: headerSize.
  	objectMemory memory: ((cogit processor endianness == #little
  					ifTrue: [LittleEndianBitmap]
  					ifFalse: [Bitmap]) new: objectMemory memoryLimit // 4).
  	count := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
  	count ~= dataSize ifTrue: [self halt].
  	]
  		ensure: [f close].
  	self moveMethodCacheToMemoryAt: objectMemory cogCodeBase + cogCodeSize + stackZoneSize.
  	self movePrimTraceLogToMemoryAt: objectMemory cogCodeBase + cogCodeSize + stackZoneSize + methodCacheSize.
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.  "adjust pointers for zero base address"
  	Utilities
  		informUser: 'Relocating object pointers...'
  		during: [self initializeInterpreter: bytesToShift].
  	self initializeCodeGenerator!

Item was added:
+ ----- Method: Integer>>byteSwap32 (in category '*VMMaker-bit manipulation') -----
+ byteSwap32
+ 	"swap the bytes of a 32 bit unsigned integer"
+ 	
+ 	^((self << 24) bitAnd: 16rFF000000) bitOr:
+ 	  (((self << 8) bitAnd: 16rFF0000) bitOr:
+ 	  (((self >> 8) bitAnd: 16rFF00) bitOr:
+ 	  (((self >> 24) bitAnd: 16rFF))))!

Item was added:
+ ----- Method: Integer>>byteSwap64 (in category '*VMMaker-bit manipulation') -----
+ byteSwap64
+ 	"swap the bytes of a 64 bit unsigned integer"
+ 	
+ 	^(((self << 56) bitAnd: 16rFF00000000000000) bitOr:
+ 	  (((self << 40) bitAnd: 16rFF000000000000) bitOr:
+ 	  (((self << 24) bitAnd: 16rFF0000000000) bitOr:
+ 	  (((self << 8) bitAnd: 16rFF00000000) bitOr:
+ 	  (((self >> 8) bitAnd: 16rFF000000) bitOr:
+ 	  (((self >> 24) bitAnd: 16rFF0000) bitOr:
+ 	  (((self >> 40) bitAnd: 16rFF00) bitOr:
+ 	  ((self >> 56) bitAnd: 16rFF))))))))!

Item was changed:
  ----- Method: Interpreter>>wordSwapped: (in category 'image save/restore') -----
  wordSwapped: w
  	"Return the given 64-bit integer with its halves in the reverse order."
  
  	self wordSize = 8 ifFalse: [self error: 'This cannot happen.'].
+ 	^   ((w >> 32) bitAnd: 16r00000000FFFFFFFF) bitOr:
+ 	     ((w << 32) bitAnd: 16rFFFFFFFF00000000)
- 	^   ((w bitShift: Byte4ShiftNegated) bitAnd: Bytes3to0Mask)
- 	  + ((w bitShift: Byte4Shift         ) bitAnd: Bytes7to4Mask)
  !

Item was changed:
  ----- Method: InterpreterPrimitives>>magnitude64BitIntegerFor:neg: (in category 'primitive support') -----
  magnitude64BitIntegerFor: magnitude neg: isNegative
  	"Return a Large Integer object for the given integer magnitude and sign"
  	| newLargeInteger largeClass highWord sz isSmall smallVal |
  	<var: 'magnitude' type: #usqLong>
  	<var: 'highWord' type: #usqInt>
  
  	isSmall := isNegative
  				ifTrue: [magnitude <= (objectMemory maxSmallInteger + 1)]
  				ifFalse: [magnitude <= objectMemory maxSmallInteger].
  	isSmall ifTrue:
  		[smallVal := self cCoerceSimple: magnitude to: #sqInt.
  		 isNegative ifTrue: [smallVal := 0 - smallVal].
  		 ^objectMemory integerObjectOf: smallVal].
  
  	largeClass := isNegative
  					ifTrue: [objectMemory classLargeNegativeInteger]
  					ifFalse: [objectMemory classLargePositiveInteger].
  	objectMemory wordSize = 8
  		ifTrue: [sz := 8]
  		ifFalse:
  			[(highWord := magnitude >> 32) = 0
  				ifTrue: [sz := 4] 
  				ifFalse:
  					[sz := 5.
  					 (highWord := highWord >> 8) = 0 ifFalse:
  						[sz := sz + 1.
  						 (highWord := highWord >> 8) = 0 ifFalse:
  							[sz := sz + 1.
  							 (highWord := highWord >> 8) = 0 ifFalse: [sz := sz + 1]]]]].
  	newLargeInteger := objectMemory instantiateClass: largeClass indexableSize:  sz.
  	self cppIf: VMBIGENDIAN
  		ifTrue:
+ 			[sz > 4
+ 				ifTrue: [objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: magnitude byteSwap64]
+ 				ifFalse: [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: (magnitude byteSwap32)]]
- 			[sz > 4 ifTrue:
- 				[objectMemory
- 					storeByte: 7 ofObject: newLargeInteger withValue: (magnitude >> 56 bitAnd: 16rFF);
- 					storeByte: 6 ofObject: newLargeInteger withValue: (magnitude >> 48 bitAnd: 16rFF);
- 					storeByte: 5 ofObject: newLargeInteger withValue: (magnitude >> 40 bitAnd: 16rFF);
- 					storeByte: 4 ofObject: newLargeInteger withValue: (magnitude >> 32 bitAnd: 16rFF)].
- 			objectMemory
- 				storeByte: 3 ofObject: newLargeInteger withValue: (magnitude >> 24 bitAnd: 16rFF);
- 				storeByte: 2 ofObject: newLargeInteger withValue: (magnitude >> 16 bitAnd: 16rFF);
- 				storeByte: 1 ofObject: newLargeInteger withValue: (magnitude >>   8 bitAnd: 16rFF);
- 				storeByte: 0 ofObject: newLargeInteger withValue: (magnitude ">> 0" bitAnd: 16rFF)]
  		ifFalse:
  			[sz > 4
  				ifTrue: [objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: magnitude]
  				ifFalse: [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: (self cCode: [magnitude] inSmalltalk: [magnitude bitAnd: 16rFFFFFFFF])]].
  
  	^newLargeInteger!

Item was changed:
  ----- Method: InterpreterPrimitives>>magnitude64BitValueOf: (in category 'primitive support') -----
  magnitude64BitValueOf: oop
  	"Convert the given object into an integer value.
  	The object may be either a positive SmallInteger or an eight-byte LargeInteger."
  	| sz value ok smallIntValue |
  	<returnTypeC: #usqLong>
  	<var: #value type: #usqLong>
  
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[smallIntValue := (objectMemory integerValueOf: oop).
  		smallIntValue < 0 ifTrue: [smallIntValue := 0 - smallIntValue].
  		^self cCoerce: smallIntValue to: #usqLong].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	ok := objectMemory isClassOfNonImm: oop
  					equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  					compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	ok
  		ifFalse:
  			[ok := objectMemory isClassOfNonImm: oop
  							equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
  							compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
  			ok ifFalse:
  				[self primitiveFail.
  				 ^0]].
  	sz := objectMemory numBytesOfBytes: oop.
  	sz > (self sizeof: #sqLong) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	self cppIf: VMBIGENDIAN
  		ifTrue:
+ 			[sz > 4
+ 				ifTrue: [value := (self cCoerceSimple: (objectMemory fetchLong64: 0 ofObject: oop) to: #usqLong) byteSwap64]
+ 				ifFalse: [value := (self cCoerceSimple: (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int') byteSwap32].]
- 			[value := objectMemory fetchByte: sz - 1 ofObject: oop.
- 			sz - 2 to: 0 by: -1 do:
- 				[:i | value := value << 8 + (objectMemory fetchByte: i ofObject: oop)]]
  		ifFalse:
  			[sz > 4
  				ifTrue: [value := self cCoerceSimple: (objectMemory fetchLong64: 0 ofObject: oop) to: #usqLong]
  				ifFalse: [value := self cCoerceSimple: (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int'].].
  	^value!

Item was changed:
  ----- Method: InterpreterPrimitives>>positive32BitValueOf: (in category 'primitive support') -----
  positive32BitValueOf: oop
  	"Convert the given object into an integer value.
  	The object may be either a positive SmallInteger or a four-byte LargePositiveInteger."
  	<returnTypeC: #usqInt>
  	| value ok sz |
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[value := objectMemory integerValueOf: oop.
  		 (value < 0
  		  or: [objectMemory wordSize > 4
  		  and: [self cCode: [(self cCoerceSimple: value to: #'unsigned int') ~= value]
  					inSmalltalk: [value >> 32 ~= 0]]]) ifTrue:
  			[self primitiveFail. value := 0].
  		 ^value].
  
  	(objectMemory hasSixtyFourBitImmediates
  	 or: [objectMemory isNonIntegerImmediate: oop])
  		ifTrue:
  			[self primitiveFail.
  			 ^0]
  		ifFalse:
  			[ok := objectMemory
  					isClassOfNonImm: oop
  					equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  					compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  			ok ifFalse:
  				[self primitiveFail.
  				 ^0].
  			sz := objectMemory numBytesOfBytes: oop.
  			sz > 4 ifTrue:
  				[self primitiveFail.
  				 ^0].
  			^self cppIf: VMBIGENDIAN
  				ifTrue:
+ 					[(objectMemory fetchLong32: 0 ofObject: oop) byteSwap32]
- 					[   (objectMemory fetchByte: 0 ofObject: oop)
- 					+ ((objectMemory fetchByte: 1 ofObject: oop) <<  8)
- 					+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
- 					+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)]
  				ifFalse:
  					[objectMemory fetchLong32: 0 ofObject: oop]]!

Item was changed:
  ----- Method: InterpreterPrimitives>>positive64BitValueOf: (in category 'primitive support') -----
  positive64BitValueOf: oop
  	"Convert the given object into an integer value.
  	The object may be either a positive SmallInteger or an eight-byte LargePositiveInteger."
  
  	<returnTypeC: #usqLong>
  	| sz value ok |
  	<var: #value type: #usqLong>
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[(objectMemory integerValueOf: oop) < 0 ifTrue:
  			[^self primitiveFail].
  		 ^objectMemory integerValueOf: oop].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	ok := objectMemory
  			isClassOfNonImm: oop
  			equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  			compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	ok ifFalse:
  		[self primitiveFail.
  		 ^0].
  	sz := objectMemory numBytesOfBytes: oop.
  	sz > (self sizeof: #sqLong) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	self cppIf: VMBIGENDIAN
  		ifTrue:
+ 			[sz > 4
+ 				ifTrue: [value := (self cCoerceSimple: (objectMemory fetchLong64: 0 ofObject: oop) to: #usqLong) byteSwap64]
+ 				ifFalse: [value := (self cCoerceSimple: (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int') byteSwap32].]
- 			[value := 0.
- 			0 to: sz - 1 do: [:i |
- 				value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #usqLong) <<  (i*8))]]
  		ifFalse:
  			[sz > 4
  				ifTrue: [value := self cCoerceSimple: (objectMemory fetchLong64: 0 ofObject: oop) to: #usqLong]
  				ifFalse: [value := self cCoerceSimple: (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int'].].
  	^value!

Item was changed:
  ----- Method: InterpreterPrimitives>>positiveMachineIntegerValueOf: (in category 'primitive support') -----
  positiveMachineIntegerValueOf: oop
  	"Answer a value of an integer in address range, i.e up to the size of a machine word.
  	The object may be either a positive SmallInteger or a LargePositiveInteger of size <= word size."
  	<returnTypeC: #'unsigned long'>
  	<inline: true> "only two callers & one is primitiveNewWithArg"
  	| value bs ok |
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[value := objectMemory integerValueOf: oop.
  		 value < 0 ifTrue: [^self primitiveFail].
  		^value].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	ok := objectMemory
  			isClassOfNonImm: oop
  			equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  			compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	ok ifFalse:
  		[self primitiveFail.
  		 ^0].
  	bs := objectMemory numBytesOfBytes: oop.
  	bs > (self sizeof: #'unsigned long') ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	((self sizeof: #'unsigned long') = 8
  	and: [bs > 4]) ifTrue:
  		[^self cppIf: VMBIGENDIAN
  			ifTrue:
+ 				[(objectMemory fetchLong64: 0 ofObject: oop) byteSwap64]
- 				[    (objectMemory fetchByte: 0 ofObject: oop)
- 				 + ((objectMemory fetchByte: 1 ofObject: oop) <<  8)
- 				 + ((objectMemory fetchByte: 2 ofObject: oop) << 16)
- 				 + ((objectMemory fetchByte: 3 ofObject: oop) << 24)
- 				 + ((objectMemory fetchByte: 4 ofObject: oop) << 32)
- 				 + ((objectMemory fetchByte: 5 ofObject: oop) << 40)
- 				 + ((objectMemory fetchByte: 6 ofObject: oop) << 48)
- 				 + ((objectMemory fetchByte: 7 ofObject: oop) << 56)]
  			ifFalse:
  				[objectMemory fetchLong64: 0 ofObject: oop]]
  		ifFalse:
  			[^self cppIf: VMBIGENDIAN
  				ifTrue:
+ 					[(self cCoerceSimple: (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int') byteSwap32]
- 					[    (objectMemory fetchByte: 0 ofObject: oop)
- 					 + ((objectMemory fetchByte: 1 ofObject: oop) <<  8)
- 					 + ((objectMemory fetchByte: 2 ofObject: oop) << 16)
- 					 + ((objectMemory fetchByte: 3 ofObject: oop) << 24)]
  				ifFalse:
  					[self cCoerceSimple: (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int']]!

Item was changed:
  ----- Method: InterpreterPrimitives>>signed32BitValueOf: (in category 'primitive support') -----
  signed32BitValueOf: oop
  	"Convert the given object into an integer value.
  	The object may be either a positive SmallInteger or a four-byte LargeInteger."
  	| value negative ok magnitude |
  	<inline: false>
  	<returnTypeC: #int>
  	<var: #value type: #int>
  	<var: #magnitude type: #'unsigned int'>
  	<var: #value64 type: #long>
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[objectMemory wordSize = 4
  			ifTrue:
  				[^objectMemory integerValueOf: oop]
  			ifFalse: "Must fail for SmallIntegers with digitLength > 4"
  				[| value64 |
  				 value64 := objectMemory integerValueOf: oop.
  				 (self cCode: [(self cCoerceSimple: value64 to: #int) ~= value64]
  						inSmalltalk: [value64 >> 31 ~= 0 and: [value64 >> 31 ~= -1]]) ifTrue:
  					[self primitiveFail. value64 := 0].
  				 ^value64]].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	ok := objectMemory
  			isClassOfNonImm: oop
  			equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  			compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	ok
  		ifTrue: [negative := false]
  		ifFalse:
  			[negative := true.
  			 ok := objectMemory isClassOfNonImm: oop
  							equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
  							compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
  			 ok ifFalse:
  				[self primitiveFail.
  				 ^0]].
  	(objectMemory numBytesOfBytes: oop) > 4 ifTrue:
  		[^self primitiveFail].
  
  	magnitude := self cppIf: VMBIGENDIAN
  				ifTrue:
+ 					[(objectMemory fetchLong32: 0 ofObject: oop) asUnsignedInteger byteSwap32]
- 					[ (objectMemory fetchByte: 0 ofObject: oop) +
- 					 ((objectMemory fetchByte: 1 ofObject: oop) <<  8) +
- 					 ((objectMemory fetchByte: 2 ofObject: oop) << 16) +
- 					 ((objectMemory fetchByte: 3 ofObject: oop) << 24)]
  				ifFalse:
  					[(objectMemory fetchLong32: 0 ofObject: oop) asUnsignedInteger].
  
  	(negative
  		ifTrue: [magnitude > 16r80000000]
  		ifFalse: [magnitude >= 16r80000000])
  			ifTrue:
  				[self primitiveFail.
  				^0].
  	negative
  		ifTrue: [value := 0 - magnitude]
  		ifFalse: [value := magnitude].
  	^value!

Item was changed:
  ----- Method: InterpreterPrimitives>>signed64BitValueOf: (in category 'primitive support') -----
  signed64BitValueOf: oop
  	"Convert the given object into an integer value.
  	 The object may be either a positive SmallInteger or a eight-byte LargeInteger."
  	| sz value negative ok magnitude |
  	<inline: false>
  	<returnTypeC: #sqLong>
  	<var: #value type: #sqLong>
  	<var: #magnitude type: #usqLong>
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[^self cCoerce: (objectMemory integerValueOf: oop) to: #sqLong].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	ok := objectMemory isClassOfNonImm: oop
  					equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  					compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	ok
  		ifTrue: [negative := false]
  		ifFalse:
  			[negative := true.
  			 ok := objectMemory isClassOfNonImm: oop
  							equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
  							compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
  			ok ifFalse:
  				[self primitiveFail.
  				 ^0]].
  	sz := objectMemory numBytesOfBytes: oop.
  	sz > (self sizeof: #sqLong) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	self cppIf: VMBIGENDIAN
  		ifTrue:
+ 			[magnitude := sz > 4
+ 						ifTrue: [(objectMemory fetchLong64: 0 ofObject: oop) byteSwap64]
+ 						ifFalse: [(self cCoerceSimple: (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int') byteSwap32]]
- 			[magnitude := objectMemory fetchByte: sz - 1 ofObject: oop.
- 			 sz - 2 to: 0 by: -1 do: [:i |
- 				magnitude := magnitude << 8 + (objectMemory fetchByte: i ofObject: oop)]]
  		ifFalse:
  			[magnitude := sz > 4
  						ifTrue: [objectMemory fetchLong64: 0 ofObject: oop]
  						ifFalse: [self cCoerceSimple: (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int']].
  
  	(negative
  		ifTrue: [magnitude > 16r8000000000000000]
  		ifFalse: [magnitude >= 16r8000000000000000])
  			ifTrue: [self primitiveFail.
  				^0].
  	negative
  		ifTrue: [value := 0 - magnitude]
  		ifFalse: [value := magnitude].
  	^value!

Item was changed:
  ----- Method: InterpreterPrimitives>>signedMachineIntegerValueOf: (in category 'primitive support') -----
  signedMachineIntegerValueOf: oop
  	"Answer a signed value of an integer up to the size of a machine word.
  	The object may be either a positive SmallInteger or a LargeInteger of size <= word size."
  	<returnTypeC: #'long'>
  	| negative ok bs value limit magnitude |
  	<var: #value type: #long>
  	<var: #magnitude type: #usqInt>
  	<var: #limit type: #usqInt>
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[^objectMemory integerValueOf: oop].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[^self primitiveFail].
  
  	ok := objectMemory isClassOfNonImm: oop
  					equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  					compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	ok
  		ifTrue: [negative := false]
  		ifFalse:
  			[negative := true.
  			 ok := objectMemory isClassOfNonImm: oop
  							equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
  							compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
  			ok ifFalse: [^self primitiveFail]].
  	bs := objectMemory numBytesOf: oop.
  	bs > (self sizeof: #'unsigned long') ifTrue:
  		[^self primitiveFail].
  
  	((self sizeof: #'unsigned long') = 8
  	and: [bs > 4]) ifTrue:
  		[magnitude := self cppIf: VMBIGENDIAN
  					ifTrue:
+ 						[(objectMemory fetchLong64: 0 ofObject: oop) byteSwap64]
- 						[    (objectMemory fetchByte: 0 ofObject: oop)
- 						 + ((objectMemory fetchByte: 1 ofObject: oop) <<  8)
- 						 + ((objectMemory fetchByte: 2 ofObject: oop) << 16)
- 						 + ((objectMemory fetchByte: 3 ofObject: oop) << 24)
- 						 + ((objectMemory fetchByte: 4 ofObject: oop) << 32)
- 						 + ((objectMemory fetchByte: 5 ofObject: oop) << 40)
- 						 + ((objectMemory fetchByte: 6 ofObject: oop) << 48)
- 						 + ((objectMemory fetchByte: 7 ofObject: oop) << 56)]
  					ifFalse:
  						[objectMemory fetchLong64: 0 ofObject: oop]]
  		ifFalse:
  			[magnitude := self cppIf: VMBIGENDIAN
  						ifTrue:
+ 							[(objectMemory fetchLong32: 0 ofObject: oop) asUnsignedInteger byteSwap32]
- 							[    (objectMemory fetchByte: 0 ofObject: oop)
- 							 + ((objectMemory fetchByte: 1 ofObject: oop) <<  8)
- 							 + ((objectMemory fetchByte: 2 ofObject: oop) << 16)
- 							 + ((objectMemory fetchByte: 3 ofObject: oop) << 24)]
  						ifFalse:
  							[(objectMemory fetchLong32: 0 ofObject: oop) asUnsignedInteger]].
  
  	limit := 1 asUnsignedInteger << ((self sizeof: #usqInt) * 8 - 1).
  	(negative
  		ifTrue: [magnitude > limit]
  		ifFalse: [magnitude >= limit])
  			ifTrue: [self primitiveFail.
  				^0].
  	negative
  		ifTrue: [value := 0 - magnitude]
  		ifFalse: [value := magnitude].
  	^value!

Item was changed:
  ----- Method: InterpreterSimulatorMSB64>>byteSwapped: (in category 'memory access') -----
  byteSwapped: w
  	"Return the given integer with its bytes in the reverse order."
  
+ 	^w byteSwap64!
- 	^ (super byteSwapped: ((w bitShift: -32) bitAnd: 16rFFFFFFFF)) +
- 	  ((super byteSwapped: (w bitAnd: 16rFFFFFFFF)) bitShift: 32)!

Item was changed:
  ----- Method: LargeIntegersPlugin>>cDigitSub:len:with:len:into: (in category 'C core') -----
  cDigitSub: pByteSmall len: smallLen with: pByteLarge len: largeLen into: pByteRes
  	| z |
  	<var: #pByteSmall type: #'unsigned char *'>
  	<var: #pByteLarge type: #'unsigned char *'>
  	<var: #pByteRes type: #'unsigned char *'>
+ 	<var: #z type: #'unsigned int'>
  
  	z := 0. "Loop invariant is -1<=z<=1"
  	0 to: smallLen - 1 do: 
  		[:i | 
  		z := z + (pByteLarge at: i) - (pByteSmall at: i).
  		pByteRes at: i put: (self cCode: [z] inSmalltalk: [z bitAnd: 255]).
  		z := z signedBitShift: -8].
  	smallLen to: largeLen - 1 do: 
  		[:i | 
  		z := z + (pByteLarge at: i) .
  		pByteRes at: i put: (self cCode: [z] inSmalltalk: [z bitAnd: 255]).
  		z := z signedBitShift: -8].
  !

Item was changed:
  ----- Method: ObjectMemory class>>initBytesPerWord: (in category 'initialization') -----
  initBytesPerWord: nBytes
  
  	BytesPerWord := nBytes.
- 	"The following is necessary to avoid confusing the compiler with shifts that are larger than the width of the type on which they operate.  In gcc, such shifts cause incorrect code to be generated."
- 	BytesPerWord = 8
- 		ifTrue:					"64-bit VM"
- 			[Byte0Mask := 16r00000000000000FF.	Byte0Shift := 0.
- 			 Byte1Mask := 16r000000000000FF00.	Byte1Shift := 8.
- 			 Byte2Mask := 16r0000000000FF0000.	Byte2Shift := 16.
- 			 Byte3Mask := 16r00000000FF000000.	Byte3Shift := 24.
- 			 Byte4Mask := 16r000000FF00000000.	Byte4Shift := 32.
- 			 Byte5Mask := 16r0000FF0000000000.	Byte5Shift := 40.
- 			 Byte6Mask := 16r00FF000000000000.	Byte6Shift := 48.
- 			 Byte7Mask := 16rFF00000000000000.	Byte7Shift := 56.
- 			 Bytes3to0Mask := 16r00000000FFFFFFFF.
- 			 Bytes7to4Mask := 16rFFFFFFFF00000000]
- 		ifFalse:					"32-bit VM"
- 			[Byte0Mask := 16r00000000000000FF.	Byte0Shift := 0.
- 			 Byte1Mask := 16r000000000000FF00.	Byte1Shift := 8.
- 			 Byte2Mask := 16r0000000000FF0000.	Byte2Shift := 16.
- 			 Byte3Mask := 16r00000000FF000000.	Byte3Shift := 24.
- 			 Byte4Mask := 16r0000000000000000.	Byte4Shift := 0.		"unused"
- 			 Byte5Mask := 16r0000000000000000.	Byte5Shift := 0.		"unused"
- 			 Byte6Mask := 16r0000000000000000.	Byte6Shift := 0.		"unused"
- 			 Byte7Mask := 16r0000000000000000.	Byte7Shift := 0.		"unused"
- 			 Bytes3to0Mask := 16r0000000000000000.					"unused"
- 			 Bytes7to4Mask := 16r0000000000000000					"unused"].
- 	Byte1ShiftNegated := Byte1Shift negated.
- 	Byte3ShiftNegated := Byte3Shift negated.
- 	Byte4ShiftNegated := Byte4Shift negated.
- 	Byte5ShiftNegated := Byte5Shift negated.
- 	Byte7ShiftNegated := Byte7Shift negated.
  	"N.B.  This is *not* output when generating the interpreter file.
  	 It is left to the various sqConfig.h files to define correctly."
  	VMBIGENDIAN := Smalltalk endianness == #big!

Item was changed:
  ----- Method: ObjectMemory>>byteSwapped: (in category 'image save/restore') -----
  byteSwapped: w
  	"Answer the given integer with its bytes in the reverse order."
  	<api>
  	<returnTypeC: #sqInt>
  	self cppIf: self wordSize = 4
+ 		ifTrue: [^w byteSwap32]
+ 		ifFalse: [^w byteSwap64]!
- 		ifTrue:
- 			[^ ((w bitShift: Byte3ShiftNegated) bitAnd: Byte0Mask)
- 			 + ((w bitShift: Byte1ShiftNegated) bitAnd: Byte1Mask)
- 			 + ((w bitShift: Byte1Shift         ) bitAnd: Byte2Mask)
- 			 + ((w bitShift: Byte3Shift         ) bitAnd: Byte3Mask)]
- 		ifFalse:
- 			[^ ((w bitShift: Byte7ShiftNegated) bitAnd: Byte0Mask)
- 			 + ((w bitShift: Byte5ShiftNegated) bitAnd: Byte1Mask)
- 			 + ((w bitShift: Byte3ShiftNegated) bitAnd: Byte2Mask)
- 			 + ((w bitShift: Byte1ShiftNegated) bitAnd: Byte3Mask)
- 			 + ((w bitShift: Byte1Shift         ) bitAnd: Byte4Mask)
- 			 + ((w bitShift: Byte3Shift         ) bitAnd: Byte5Mask)
- 			 + ((w bitShift: Byte5Shift         ) bitAnd: Byte6Mask)
- 			 + ((w bitShift: Byte7Shift         ) bitAnd: Byte7Mask)]!

Item was removed:
- ----- Method: Spur32BitMemoryManager>>byteSwapped32Bits: (in category 'snapshot') -----
- byteSwapped32Bits: w
- 	^self byteSwapped: w!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>byteSwapped: (in category 'snapshot') -----
  byteSwapped: w
  	"Answer the given integer with its bytes in the reverse order."
  	<api>
  	<returnTypeC: #sqInt>
+ 	^w byteSwap32!
- 	^  ((w bitShift: Byte3ShiftNegated) bitAnd: Byte0Mask)
- 	 + ((w bitShift: Byte1ShiftNegated) bitAnd: Byte1Mask)
- 	 + ((w bitShift: Byte1Shift             ) bitAnd: Byte2Mask)
- 	 + ((w bitShift: Byte3Shift             ) bitAnd: Byte3Mask)!

Item was removed:
- ----- Method: Spur64BitMemoryManager>>byteSwapped32Bits: (in category 'snapshot') -----
- byteSwapped32Bits: w
- 	"Answer the given 32-bit integer with its bytes in the reverse order."
- 	^  ((w bitShift: Byte3ShiftNegated) bitAnd: Byte0Mask)
- 	 + ((w bitShift: Byte1ShiftNegated) bitAnd: Byte1Mask)
- 	 + ((w bitShift: Byte1Shift             ) bitAnd: Byte2Mask)
- 	 + ((w bitShift: Byte3Shift             ) bitAnd: Byte3Mask)!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>byteSwapped: (in category 'snapshot') -----
  byteSwapped: w
  	"Answer the given integer with its bytes in the reverse order."
  	<api>
  	<returnTypeC: #sqInt>
+ 	^w byteSwap64!
- 	^  ((w bitShift: Byte7ShiftNegated) bitAnd: Byte0Mask)
- 	 + ((w bitShift: Byte5ShiftNegated) bitAnd: Byte1Mask)
- 	 + ((w bitShift: Byte3ShiftNegated) bitAnd: Byte2Mask)
- 	 + ((w bitShift: Byte1ShiftNegated) bitAnd: Byte3Mask)
- 	 + ((w bitShift: Byte1Shift             ) bitAnd: Byte4Mask)
- 	 + ((w bitShift: Byte3Shift             ) bitAnd: Byte5Mask)
- 	 + ((w bitShift: Byte5Shift             ) bitAnd: Byte6Mask)
- 	 + ((w bitShift: Byte7Shift             ) bitAnd: Byte7Mask)!

Item was changed:
  ----- Method: SpurMemoryManager class>>initBytesPerWord: (in category 'class initialization') -----
  initBytesPerWord: wordSize
  
  	BytesPerWord := BytesPerOop := wordSize.
- 	"The following is necessary to avoid confusing the compiler with shifts that are larger than the width of the type on which they operate.  In gcc, such shifts cause incorrect code to be generated."
- 	BytesPerWord = 8
- 		ifTrue:					"64-bit VM"
- 			[Byte0Mask := 16r00000000000000FF.	Byte0Shift := 0.
- 			 Byte1Mask := 16r000000000000FF00.	Byte1Shift := 8.
- 			 Byte2Mask := 16r0000000000FF0000.	Byte2Shift := 16.
- 			 Byte3Mask := 16r00000000FF000000.	Byte3Shift := 24.
- 			 Byte4Mask := 16r000000FF00000000.	Byte4Shift := 32.
- 			 Byte5Mask := 16r0000FF0000000000.	Byte5Shift := 40.
- 			 Byte6Mask := 16r00FF000000000000.	Byte6Shift := 48.
- 			 Byte7Mask := 16rFF00000000000000.	Byte7Shift := 56.
- 			 Bytes3to0Mask := 16r00000000FFFFFFFF.
- 			 Bytes7to4Mask := 16rFFFFFFFF00000000]
- 		ifFalse:					"32-bit VM"
- 			[Byte0Mask := 16r00000000000000FF.	Byte0Shift := 0.
- 			 Byte1Mask := 16r000000000000FF00.	Byte1Shift := 8.
- 			 Byte2Mask := 16r0000000000FF0000.	Byte2Shift := 16.
- 			 Byte3Mask := 16r00000000FF000000.	Byte3Shift := 24.
- 			 Byte4Mask := nil.							Byte4Shift := 0.	"unused"
- 			 Byte5Mask := nil.							Byte5Shift := 0.	"unused"
- 			 Byte6Mask := nil.							Byte6Shift := 0.	"unused"
- 			 Byte7Mask := nil.							Byte7Shift := 0.	"unused"
- 			 Bytes3to0Mask := nil.											"unused"
- 			 Bytes7to4Mask := nil											"unused"].
- 	Byte1ShiftNegated := Byte1Shift negated.
- 	Byte3ShiftNegated := Byte3Shift negated.
- 	Byte4ShiftNegated := Byte4Shift negated.
- 	Byte5ShiftNegated := Byte5Shift negated.
- 	Byte7ShiftNegated := Byte7Shift negated.
  	"N.B.  This is *not* output when generating the interpreter file.
  	 It is left to the various sqConfig.h files to define correctly."
  	VMBIGENDIAN := Smalltalk endianness == #big!

Item was removed:
- ----- Method: SpurMemoryManager>>byteSwapped32Bits: (in category 'snapshot') -----
- byteSwapped32Bits: w
- 	self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>reverseBytesIn32BitWordsFrom:to: (in category 'snapshot') -----
  reverseBytesIn32BitWordsFrom: startAddr to: stopAddr
  	"Byte-swap the given range of memory (not inclusive of stopAddr!!)."
  	| addr |
  	addr := startAddr.
  	[self oop: addr isLessThan: stopAddr] whileTrue:
+ 		[self long32At: addr put: ((self long32At: addr) byteSwap32).
- 		[self long32At: addr put: (self byteSwapped32Bits: (self long32At: addr)).
  		 addr := addr + 4]!

Item was changed:
  ----- Method: StackInterpreter>>getShortFromFile:swap: (in category 'image save/restore') -----
  getShortFromFile: aFile swap: swapFlag
  	"Answer the next 16 bit word read from aFile, byte-swapped according to the swapFlag."
  
  	<var: #aFile type: #sqImageFile>
  	| w |
+ 	<var: #w type: #'unsigned short'>
- 	<var: #w type: #short>
  	w := 0.
  	self cCode: [self
  					sq: (self addressOf: w)
+ 					Image: (self sizeof: #'unsigned short')
- 					Image: (self sizeof: #short)
  					File: 1
  					Read: aFile]
  		inSmalltalk: [w := objectMemory nextShortFrom: aFile].
  	^swapFlag
+ 		ifTrue: [((w >> 8) bitAnd: 16rFF) bitOr: ((w bitAnd: 16rFF) << 8)]
- 		ifTrue: [objectMemory byteSwapped: w]
  		ifFalse: [w]!

Item was changed:
  ----- Method: StackInterpreter>>getWord32FromFile:swap: (in category 'image save/restore') -----
  getWord32FromFile: aFile swap: swapFlag
  	"Answer the next 32 bit word read from aFile, byte-swapped according to the swapFlag."
  
  	<var: #aFile type: #sqImageFile>
  	| w |
  	<var: #w type: #int>
  	w := 0.
  	self cCode: [self
  					sq: (self addressOf: w)
  					Image: (self sizeof: #int)
  					File: 1
  					Read: aFile]
  		inSmalltalk: [w := objectMemory nextWord32From: aFile].
  	^swapFlag
+ 		ifTrue: [w byteSwap32]
- 		ifTrue: [objectMemory byteSwapped: w]
  		ifFalse: [w]!

Item was changed:
  ----- Method: StackInterpreter>>maybeInlinePositive32BitIntegerFor: (in category 'primitive support') -----
  maybeInlinePositive32BitIntegerFor: integerValue
  	"N.B. will *not* cause a GC.
  	 integerValue is interpreted as POSITIVE, e.g. as the result of Bitmap>at:."
  	<notOption: #Spur64BitMemoryManager>
  	<var: 'integerValue' type: #'unsigned int'>
  	| newLargeInteger |
  	self deny: objectMemory hasSixtyFourBitImmediates.
         "force coercion because slang inliner sometimes incorrectly pass a signed int without converting to unsigned"
         (self cCode: [self cCoerceSimple: integerValue to: #'unsigned int']
  			inSmalltalk: [integerValue bitAnd: 1 << 32 - 1]) <= objectMemory maxSmallInteger ifTrue:
  		[^objectMemory integerObjectOf: integerValue].
  	newLargeInteger := objectMemory
  							eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex
  							format: (objectMemory byteFormatForNumBytes: 4)
  							numSlots: 1.
  	self cppIf: VMBIGENDIAN
  		ifTrue:
+ 			[objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: integerValue byteSwap32]
- 			[objectMemory
- 				storeByte: 3 ofObject: newLargeInteger withValue: (integerValue >> 24 bitAnd: 16rFF);
- 				storeByte: 2 ofObject: newLargeInteger withValue: (integerValue >> 16 bitAnd: 16rFF);
- 				storeByte: 1 ofObject: newLargeInteger withValue: (integerValue >>   8 bitAnd: 16rFF);
- 				storeByte: 0 ofObject: newLargeInteger withValue: (integerValue ">> 0" bitAnd: 16rFF)]
  		ifFalse:
  			[objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: integerValue].
  	^newLargeInteger!

Item was changed:
  ----- Method: StackInterpreter>>noInlineSigned32BitIntegerFor: (in category 'primitive support') -----
  noInlineSigned32BitIntegerFor: integerValue
  	"Answer a full 32 bit integer object for the given integer value."
  	<notOption: #Spur64BitMemoryManager>
  	| newLargeInteger value largeClass |
  	<inline: false>
  	(objectMemory isIntegerValue: integerValue) ifTrue:
  		[^objectMemory integerObjectOf: integerValue].
  	self deny: objectMemory hasSixtyFourBitImmediates.
  	 integerValue < 0
  		ifTrue: [largeClass := ClassLargeNegativeIntegerCompactIndex.
  				value := 0 - integerValue]
  		ifFalse: [largeClass := ClassLargePositiveIntegerCompactIndex.
  				value := integerValue].
  	newLargeInteger := objectMemory
  							eeInstantiateSmallClassIndex: largeClass
  							format: (objectMemory byteFormatForNumBytes: 4)
  							numSlots: 1.
  	self cppIf: VMBIGENDIAN
  		ifTrue:
+ 			[objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: value byteSwap32]
- 			[objectMemory
- 				storeByte: 3 ofObject: newLargeInteger withValue: ((value >> 24) bitAnd: 16rFF);
- 				storeByte: 2 ofObject: newLargeInteger withValue: ((value >> 16) bitAnd: 16rFF);
- 				storeByte: 1 ofObject: newLargeInteger withValue: ((value >> 8) bitAnd: 16rFF);
- 				storeByte: 0 ofObject: newLargeInteger withValue: (value bitAnd: 16rFF)]
  		ifFalse:
  			[objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: value].
  	^newLargeInteger!

Item was changed:
  ----- Method: StackInterpreter>>positive64BitIntegerFor: (in category 'primitive support') -----
  positive64BitIntegerFor: integerValue
  	<api>
  	<var: 'integerValue' type: #usqLong>
  	<var: 'highWord' type: #'unsigned int'>
  	"Answer a Large Positive Integer object for the given integer value.  N.B. will *not* cause a GC."
  	| newLargeInteger highWord sz |
  	objectMemory hasSixtyFourBitImmediates
  		ifTrue:
  			[(self cCode: [integerValue] inSmalltalk: [integerValue bitAnd: 1 << 64 - 1]) <= objectMemory maxSmallInteger ifTrue:
  				[^objectMemory integerObjectOf: integerValue].
  			 sz := 8]
  		ifFalse:
  			[(highWord := integerValue >> 32) = 0 ifTrue:
  				[^self positive32BitIntegerFor: integerValue].
  			 sz := 5.
  			 (highWord := highWord >> 8) = 0 ifFalse:
  				[sz := sz + 1.
  				 (highWord := highWord >> 8) = 0 ifFalse:
  					[sz := sz + 1.
  					 (highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1]]]].
  	newLargeInteger := objectMemory
  							eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex
  							format: (objectMemory byteFormatForNumBytes: sz)
  							numSlots: 8 / objectMemory bytesPerOop.
  	self cppIf: VMBIGENDIAN
  		ifTrue:
+ 			[objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: integerValue byteSwap64]
- 			[objectMemory
- 				storeByte: 7 ofObject: newLargeInteger withValue: (integerValue >> 56 bitAnd: 16rFF);
- 				storeByte: 6 ofObject: newLargeInteger withValue: (integerValue >> 48 bitAnd: 16rFF);
- 				storeByte: 5 ofObject: newLargeInteger withValue: (integerValue >> 40 bitAnd: 16rFF);
- 				storeByte: 4 ofObject: newLargeInteger withValue: (integerValue >> 32 bitAnd: 16rFF);
- 				storeByte: 3 ofObject: newLargeInteger withValue: (integerValue >> 24 bitAnd: 16rFF);
- 				storeByte: 2 ofObject: newLargeInteger withValue: (integerValue >> 16 bitAnd: 16rFF);
- 				storeByte: 1 ofObject: newLargeInteger withValue: (integerValue >>   8 bitAnd: 16rFF);
- 				storeByte: 0 ofObject: newLargeInteger withValue: (integerValue ">> 0" bitAnd: 16rFF)]
  		ifFalse:
  			[objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: integerValue].
  	^newLargeInteger
  !

Item was changed:
  ----- Method: StackInterpreter>>signed64BitIntegerFor: (in category 'primitive support') -----
  signed64BitIntegerFor: integerValue
  	<var: 'integerValue' type: #sqLong>
  	"Answer a Large Integer object for the given integer value.  N.B. will *not* cause a GC."
  	| newLargeInteger magnitude largeClass highWord sz |
  	<inline: false>
  	<var: 'magnitude' type: #usqLong>
  	<var: 'highWord' type: #usqInt>
  
  	integerValue < 0
  		ifTrue:[	integerValue >= objectMemory minSmallInteger ifTrue: [^objectMemory integerObjectOf: integerValue asInteger].
  				largeClass := ClassLargeNegativeIntegerCompactIndex.
  				magnitude := 0 - (self cCoerceSimple: integerValue to: #usqLong)]
  		ifFalse:[	integerValue <= objectMemory maxSmallInteger ifTrue: [^objectMemory integerObjectOf: integerValue asInteger].
  				largeClass := ClassLargePositiveIntegerCompactIndex.
  				magnitude := integerValue].
  
  	objectMemory wordSize = 8
  		ifTrue: [sz := 8]
  		ifFalse: [
  		 (highWord := magnitude >> 32) = 0 
  			ifTrue: [sz := 4] 
  			ifFalse:
  				[sz := 5.
  				 (highWord := highWord >> 8) = 0 ifFalse:
  					[sz := sz + 1.
  					 (highWord := highWord >> 8) = 0 ifFalse:
  						[sz := sz + 1.
  						 (highWord := highWord >> 8) = 0 ifFalse:
  							[sz := sz + 1]]]]].
  
  	newLargeInteger := objectMemory
  							eeInstantiateSmallClassIndex: largeClass
  							format: (objectMemory byteFormatForNumBytes: sz)
  							numSlots: sz + 3 // objectMemory bytesPerOop.
  	self cppIf: VMBIGENDIAN
  		ifTrue:
+ 			[sz > 4
+ 				ifTrue: [objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: magnitude byteSwap64]
+ 				ifFalse: [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: magnitude byteSwap32]]
- 			[sz > 4 ifTrue:
- 				[objectMemory
- 					storeByte: 7 ofObject: newLargeInteger withValue: (magnitude >> 56 bitAnd: 16rFF);
- 					storeByte: 6 ofObject: newLargeInteger withValue: (magnitude >> 48 bitAnd: 16rFF);
- 					storeByte: 5 ofObject: newLargeInteger withValue: (magnitude >> 40 bitAnd: 16rFF);
- 					storeByte: 4 ofObject: newLargeInteger withValue: (magnitude >> 32 bitAnd: 16rFF)].
- 			objectMemory
- 				storeByte: 3 ofObject: newLargeInteger withValue: (magnitude >> 24 bitAnd: 16rFF);
- 				storeByte: 2 ofObject: newLargeInteger withValue: (magnitude >> 16 bitAnd: 16rFF);
- 				storeByte: 1 ofObject: newLargeInteger withValue: (magnitude >>   8 bitAnd: 16rFF);
- 				storeByte: 0 ofObject: newLargeInteger withValue: (magnitude ">> 0" bitAnd: 16rFF)]
  		ifFalse:
  			[sz > 4
  				ifTrue: [objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: magnitude]
  				ifFalse: [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: (self cCode: [magnitude] inSmalltalk: [magnitude bitAnd: 16rFFFFFFFF])]].
  	^newLargeInteger!

Item was changed:
  ----- Method: StackInterpreter>>wordSwapped: (in category 'image save/restore') -----
  wordSwapped: w
  	"Return the given 64-bit integer with its halves in the reverse order."
  
  	objectMemory wordSize = 8 ifFalse: [self error: 'This cannot happen.'].
+ 	^   ((w >> 32) bitAnd: 16r00000000FFFFFFFF) bitOr:
+ 	     ((w << 32) bitAnd: 16rFFFFFFFF00000000)
- 	^   ((w bitShift: Byte4ShiftNegated) bitAnd: Bytes3to0Mask)
- 	  + ((w bitShift: Byte4Shift         ) bitAnd: Bytes7to4Mask)
  !

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiCreateIntegralResultOop:ofAtomicType:in: (in category 'callout support') -----
  ffiCreateIntegralResultOop: retVal ofAtomicType: atomicType in: calloutState
  	<inline: true>
  	<var: #calloutState type: #'CalloutState *'>
  	<var: #retVal type: #usqLong>
  	"Callout support. Return the appropriate oop for the given atomic type"
  	| shift value mask byteSize |
  	<var: 'value' type: #usqLong>
  	<var: 'mask' type: #usqLong>
  	self assert: atomicType < FFITypeSingleFloat.
  
  	atomicType = FFITypeBool ifTrue:
  		["Make sure bool honors the byte size requested"
  		 byteSize := calloutState ffiRetHeader bitAnd: FFIStructSizeMask.
  		 value := byteSize = (self sizeof: retVal)
  					ifTrue:[retVal]
  					ifFalse:[retVal bitAnd: 1 << (byteSize * 8) - 1].
  		 ^value = 0
  			ifTrue:[interpreterProxy falseObject]
  			ifFalse:[interpreterProxy trueObject]].
  	atomicType <= FFITypeSignedInt ifTrue:
  		["these are all generall integer returns"
  		atomicType <= (BytesPerWord = 8 ifTrue: [FFITypeSignedInt] ifFalse: [FFITypeSignedShort]) ifTrue:
  			["byte/short. first extract partial word, then sign extend"
  			shift := (BytesPerWord = 8 and: [atomicType >= FFITypeUnsignedInt])
  						ifTrue: [32]
  						ifFalse: [(atomicType >> 1) * 8]. "# of significant bits"
  			value := retVal bitAnd: (1 asUnsignedLong << shift - 1). 
  			(atomicType anyMask: 1) ifTrue:
  				["make the guy signed"
  				mask := 1 asUnsignedLong << (shift-1).
  				value := (value bitAnd: mask-1) - (value bitAnd: mask)].
  			^interpreterProxy integerObjectOf: value].
  		"Word sized integer return"
  		^(atomicType anyMask: 1)
  			ifTrue:[interpreterProxy signedMachineIntegerFor: retVal] "signed return"
  			ifFalse:[interpreterProxy positiveMachineIntegerFor: retVal]]. "unsigned return"
  
  	"longlong, char"
  	^(atomicType >> 1) = (FFITypeSignedLongLong >> 1) 
  		ifTrue:
  			[(atomicType anyMask: 1)
  				ifTrue:[interpreterProxy signed64BitIntegerFor: retVal] "signed return"
  				ifFalse:[interpreterProxy positive64BitIntegerFor: retVal]]
  		ifFalse:
+ 			[interpreterProxy characterObjectOf: (retVal bitAnd: 16rFF)]!
- 			[interpreterProxy characterObjectOf: (retVal bitAnd: Byte0Mask)]!

Item was changed:
  SharedPool subclass: #VMBasicConstants
  	instanceVariableNames: ''
+ 	classVariableNames: 'BaseHeaderSize BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFreeSpace GCModeFull GCModeImageSegment GCModeIncremental GCModeNewSpace IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimErrWritePastObject PrimNoErr SPURVM STACKVM SistaVM VMBIGENDIAN'
- 	classVariableNames: 'BaseHeaderSize Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFreeSpace GCModeFull GCModeImageSegment GCModeIncremental GCModeNewSpace IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimErrWritePastObject PrimNoErr SPURVM STACKVM SistaVM VMBIGENDIAN'
  	poolDictionaries: ''
  	category: 'VMMaker-Interpreter'!
  
  !VMBasicConstants commentStamp: '<historical>' prior: 0!
  I am a shared pool for basic constants upon which the VM as a whole depends.
  
  self ensureClassPool.
  self classPool declare: #BytesPerWord from: VMSqueakV3ObjectRepresentationConstants classPool.
  self classPool declare: #BaseHeaderSize from: VMSqueakV3ObjectRepresentationConstants classPool
  (ObjectMemory classPool keys select: [:k| k beginsWith: 'Byte']) do:
  	[:k| self classPool declare: k from: ObjectMemory classPool]!



More information about the Vm-dev mailing list