[Vm-dev] VM Maker: VMMaker.oscog-eem.936.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Nov 18 04:48:54 UTC 2014


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.936.mcz

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

Name: VMMaker.oscog-eem.936
Author: eem
Time: 17 November 2014, 8:44:35.833 pm
UUID: e52558f4-f06e-4d8b-8e7a-ee476528106b
Ancestors: VMMaker.oscog-eem.935

Add Spur64BitMMLESimulator, fleshing it out from
Spur32BitMMLESimulator.
Implement allocateSlots:format:classIndex: in
Spur32BitMemoryManager and Spur64BitMemoryManager.
Make the superclass implementatiuon a subclassResponsibility.
Delete the simulator isIntegerObject:'s that check for
rewritten clients.  They have served their purpose.
Nuke the obsolete longLongAt:[put:].
Make positive64BitValueOf: always answer a value.
Move the cogitClass implementations up into VMClass.

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

Item was changed:
  ----- Method: CCodeGenerator>>computeKernelReturnTypes (in category 'public') -----
  computeKernelReturnTypes
  	^Dictionary newFromPairs:
  		#(oopAt: #sqInt oopAt:put: #sqInt
  			oopAtPointer: #sqInt oopAtPointer:put: #sqInt
  		 byteAt: #sqInt byteAt:put: #sqInt
  			byteAtPointer: #sqInt byteAtPointer:put: #sqInt
  		 shortAt: #sqInt shortAt:put: #sqInt
  			shortAtPointer: #sqInt shortAtPointer:put: #sqInt
  		 intAt: #sqInt intAt:put: #sqInt
  			intAtPointer: #sqInt intAtPointer:put: #sqInt
  		 longAt: #sqInt longAt:put: #sqInt
  			longAtPointer: #sqInt longAtPointer:put: #sqInt
  				long32At: #sqInt long32At:put: #sqInt
  
+ 		 long64At: #sqLong long64At:put: #sqLong
- 		 longLongAt: #sqLong longLongAt:put: #sqLong
- 			longLongAtPointer: #sqLong longLongAtPointer:put: #sqLong
- 				long64At: #sqLong long64At:put: #sqLong
  		
  		 fetchFloatAt:into: #void storeFloatAt:from: #void
  			fetchFloatAtPointer:into: #void storeFloatAtPointer:from: #void
  		 fetchSingleFloatAt:into: #void storeSingleFloatAt:from: #void
  			fetchSingleFloatAtPointer:into: #void storeSingleFloatAtPointer:from: #void
  
  		 pointerForOop: #'char *' oopForPointer: #sqInt)!

Item was changed:
  ----- Method: CCodeGenerator>>isKernelSelector: (in category 'utilities') -----
  isKernelSelector: sel
  	"Answer true if the given selector is one of the kernel selectors that are implemented as macros."
  
  	^(#(error:
  		 oopAt: oopAt:put: oopAtPointer: oopAtPointer:put:
  		 byteAt: byteAt:put: byteAtPointer: byteAtPointer:put:
  		 shortAt: shortAt:put: shortAtPointer: shortAtPointer:put:
  		 intAt: intAt:put: intAtPointer: intAtPointer:put:
+ 		 longAt: longAt:put: longAtPointer: longAtPointer:put:
+ 		 long32At: long32At:put: long64At: long64At:put:
- 		 longAt: longAt:put: longAtPointer: longAtPointer:put: long32At: long32At:put:
- 		 longLongAt: longLongAt:put: longLongAtPointer: longLongAtPointer:put: 	long64At: long64At:put:
  		 fetchFloatAt:into: storeFloatAt:from: fetchFloatAtPointer:into: storeFloatAtPointer:from:
  		 fetchSingleFloatAt:into: storeSingleFloatAt:from: fetchSingleFloatAtPointer:into: storeSingleFloatAtPointer:from:
  		 pointerForOop: oopForPointer:
  		 cCoerce:to: cCoerceSimple:to:)
  			includes: sel)!

Item was removed:
- ----- Method: CoInterpreter class>>cogitClass (in category 'accessing class hierarchy') -----
- cogitClass
- 	^Smalltalk classNamed: (initializationOptions
- 								at: #Cogit
- 								ifAbsent: [#SimpleStackBasedCogit])!

Item was removed:
- ----- Method: CogObjectRepresentation class>>cogitClass (in category 'accessing class hierarchy') -----
- cogitClass
- 	^initializationOptions ifNotNil:
- 		[Smalltalk classNamed: (initializationOptions
- 									at: #Cogit
- 									ifAbsent: [#SimpleStackBasedCogit])]!

Item was removed:
- ----- Method: Cogit class>>cogitClass (in category 'accessing class hierarchy') -----
- cogitClass
- 	^Smalltalk classNamed: (initializationOptions
- 								at: #Cogit
- 								ifAbsent: [#SimpleStackBasedCogit])!

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 and: [(sz := objectMemory lengthOf: oop) <= (self sizeof: #sqLong)]) ifFalse:
+ 		[self primitiveFail.
+ 		 ^0].
- 		[^self primitiveFail].
  
  	value := 0.
  	0 to: sz - 1 do: [:i |
  		value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #usqLong) <<  (i*8))].
  	^value!

Item was removed:
- ----- Method: LittleEndianBitmap>>longLongAt: (in category 'accessing') -----
- longLongAt: byteAddress
- 	"memory is a Bitmap, a 32-bit indexable array of bits"
- 	| hiWord loWord |
- 	byteAddress - 1 \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
- 	loWord := self at: byteAddress - 1 // 4 + 1.
- 	hiWord := self at: byteAddress - 1 // 4 + 2.
- 	^hiWord = 0
- 		ifTrue: [loWord]
- 		ifFalse: [(hiWord signedIntFromLong bitShift: 32) + loWord]!

Item was removed:
- ----- Method: LittleEndianBitmap>>longLongAt:put: (in category 'accessing') -----
- longLongAt: byteAddress put: a64BitValue
- 	byteAddress - 1 \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
- 	self
- 		longAt: byteAddress put: (a64BitValue bitAnd: 16rffffffff);
- 		longAt: byteAddress + 4 put: a64BitValue >> 32.
- 	^a64BitValue!

Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>isIntegerObject: (in category 'object testing') -----
- isIntegerObject: oop
- 	"This list records the valid senders of isIntegerObject: as we replace uses of
- 	  isIntegerObject: by isImmediate: where appropriate."
- 	"| sel |
- 	sel := thisContext sender method selector.
- 	(#(	DoIt
- 		DoItIn:
- 		baseFrameReturn
- 		bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
- 		bytecodePrimAt
- 		bytecodePrimAtPut
- 		bytesOrInt:growTo:
- 		ceBaseFrameReturn:
- 		checkIsStillMarriedContext:currentFP:
- 		checkedIntegerValueOf:
- 		cogMethodDoesntLookKosher:
- 		commonAt:
- 		commonAtPut:
- 		commonVariable:at:put:cacheIndex:
- 		compare31or32Bits:equal:
- 		digitBitLogic:with:opIndex:
- 		digitLength:
- 		displayBitsOf:Left:Top:Right:Bottom:
- 		ensureContextHasBytecodePC:
- 		externalInstVar:ofContext:
- 		fetchIntOrFloat:ofObject:
- 		fetchIntOrFloat:ofObject:ifNil:
- 		fetchStackPointerOf:
- 		fileValueOf:
- 		frameOfMarriedContext:
- 		functionForPrimitiveExternalCall:
- 		genSpecialSelectorArithmetic
- 		genSpecialSelectorComparison
- 		inlineCacheTagForInstance:
- 		instVar:ofContext:
- 		isCogMethodReference:
- 		isLiveContext:
- 		isMarriedOrWidowedContext:
- 		isNegativeIntegerValueOf:
- 		isNormalized:
- 		loadBitBltDestForm
- 		loadBitBltSourceForm
- 		loadFloatOrIntFrom:
- 		loadPoint:from:
- 		magnitude64BitValueOf:
- 		makeBaseFrameFor:
- 		numPointerSlotsOf:
- 		objCouldBeClassObj:
- 		on:do: ""from the debugger""
- 		positive32BitValueOf:
- 		positive64BitValueOf:
- 		primDigitAdd:
- 		primDigitBitShiftMagnitude:
- 		primDigitCompare:
- 		primDigitDiv:negative:
- 		primDigitMultiply:negative:
- 		primDigitSubtract:
- 		primitiveAllInstances
- 		primitiveAsCharacter
- 		primitiveContextAt
- 		primitiveContextAtPut
- 		primitiveExternalCall
- 		primitiveFileSetPosition
- 		primitiveFileTruncate	DoIt
- 		primitiveForwardSignalToSemaphore
- 		primitiveGrowMemoryByAtLeast
- 		primitiveInputSemaphore
- 		primitiveMakePoint
- 		primitiveNewMethod
- 		primitiveObjectAtPut
- 		primitiveSizeInBytesOfInstance
- 		primitiveVMParameter
- 		printContext:
- 		quickFetchInteger:ofObject:
- 		shortPrint:
- 		shortPrintOop:
- 		signed32BitValueOf:
- 		signed64BitValueOf:
- 		subscript:with:storing:format:
- 		unlockSurfaces
- 		establishFrameForContextToReturnTo:
- 		positiveMachineIntegerValueOf:) includes: sel) ifFalse:
- 		[self halt]."
- 	^super isIntegerObject: oop!

Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>isNonIntegerObject: (in category 'object testing') -----
- isNonIntegerObject: oop
- 	"This list records the valid senders of isNonIntegerObject: as we replace uses of
- 	  isNonIntegerObject: by isNonImmediate: where appropriate."
- 	"(#(	on:do: ""from the debugger""
- 		reverseDisplayFrom:to:
- 		primitiveObjectAtPut
- 		isCogMethodReference:) includes: thisContext sender method selector) ifFalse:
- 		[self halt]."
- 	^super isNonIntegerObject: oop!

Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>longLongAt: (in category 'memory access') -----
- longLongAt: byteAddress
- 	"memory is a Bitmap, a 32-bit indexable array of bits"
- 	| hiWord loWord |
- 	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
- 	loWord := memory at: byteAddress // 4 + 1.
- 	hiWord := memory at: byteAddress // 4 + 2.
- 	^hiWord = 0
- 		ifTrue: [loWord]
- 		ifFalse: [(hiWord bitShift: 32) + loWord]!

Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>longLongAt:put: (in category 'memory access') -----
- longLongAt: byteAddress put: a64BitValue
- 	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
- 	self
- 		longAt: byteAddress put: (a64BitValue bitAnd: 16rffffffff);
- 		longAt: byteAddress + 4 put: a64BitValue >> 32.
- 	^a64BitValue!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>isIntegerObject: (in category 'object testing') -----
- isIntegerObject: oop
- 	"This list records the valid senders of isIntegerObject: as we replace uses of
- 	  isIntegerObject: by isImmediate: where appropriate."
- 	"| sel |
- 	sel := thisContext sender method selector.
- 	(#(	DoIt
- 		DoItIn:
- 		baseFrameReturn
- 		bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
- 		bytecodePrimAt
- 		bytecodePrimAtPut
- 		bytesOrInt:growTo:
- 		ceBaseFrameReturn:
- 		checkIsStillMarriedContext:currentFP:
- 		checkedIntegerValueOf:
- 		cogMethodDoesntLookKosher:
- 		commonAt:
- 		commonAtPut:
- 		commonVariable:at:put:cacheIndex:
- 		compare31or32Bits:equal:
- 		digitBitLogic:with:opIndex:
- 		digitLength:
- 		displayBitsOf:Left:Top:Right:Bottom:
- 		ensureContextHasBytecodePC:
- 		externalInstVar:ofContext:
- 		fetchIntOrFloat:ofObject:
- 		fetchIntOrFloat:ofObject:ifNil:
- 		fetchStackPointerOf:
- 		fileValueOf:
- 		frameOfMarriedContext:
- 		functionForPrimitiveExternalCall:
- 		genSpecialSelectorArithmetic
- 		genSpecialSelectorComparison
- 		inlineCacheTagForInstance:
- 		instVar:ofContext:
- 		isCogMethodReference:
- 		isLiveContext:
- 		isMarriedOrWidowedContext:
- 		isNegativeIntegerValueOf:
- 		isNormalized:
- 		loadBitBltDestForm
- 		loadBitBltSourceForm
- 		loadFloatOrIntFrom:
- 		loadPoint:from:
- 		magnitude64BitValueOf:
- 		makeBaseFrameFor:
- 		numPointerSlotsOf:
- 		objCouldBeClassObj:
- 		on:do: ""from the debugger""
- 		positive32BitValueOf:
- 		positive64BitValueOf:
- 		primDigitAdd:
- 		primDigitBitShiftMagnitude:
- 		primDigitCompare:
- 		primDigitDiv:negative:
- 		primDigitMultiply:negative:
- 		primDigitSubtract:
- 		primitiveAllInstances
- 		primitiveAsCharacter
- 		primitiveContextAt
- 		primitiveContextAtPut
- 		primitiveExternalCall
- 		primitiveFileSetPosition
- 		primitiveFileTruncate	DoIt
- 		primitiveForwardSignalToSemaphore
- 		primitiveGrowMemoryByAtLeast
- 		primitiveInputSemaphore
- 		primitiveMakePoint
- 		primitiveNewMethod
- 		primitiveObjectAtPut
- 		primitiveSizeInBytesOfInstance
- 		primitiveVMParameter
- 		printContext:
- 		quickFetchInteger:ofObject:
- 		shortPrint:
- 		shortPrintOop:
- 		signed32BitValueOf:
- 		signed64BitValueOf:
- 		subscript:with:storing:format:
- 		unlockSurfaces
- 		establishFrameForContextToReturnTo:
- 		positiveMachineIntegerValueOf:) includes: sel) ifFalse:
- 		[self halt]."
- 	^super isIntegerObject: oop!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>isNonIntegerObject: (in category 'object testing') -----
- isNonIntegerObject: oop
- 	"This list records the valid senders of isNonIntegerObject: as we replace uses of
- 	  isNonIntegerObject: by isNonImmediate: where appropriate."
- 	"(#(	on:do: ""from the debugger""
- 		reverseDisplayFrom:to:
- 		primitiveObjectAtPut
- 		isCogMethodReference:) includes: thisContext sender method selector) ifFalse:
- 		[self halt]."
- 	^super isNonIntegerObject: oop!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>longLongAt: (in category 'memory access') -----
- longLongAt: byteAddress
- 	"memory is a Bitmap, a 32-bit indexable array of bits"
- 	| hiWord loWord |
- 	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
- 	loWord := memory at: byteAddress // 4 + 1.
- 	hiWord := memory at: byteAddress // 4 + 2.
- 	^hiWord = 0
- 		ifTrue: [loWord]
- 		ifFalse: [(hiWord bitShift: 32) + loWord]!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>longLongAt:put: (in category 'memory access') -----
- longLongAt: byteAddress put: a64BitValue
- 	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
- 	self
- 		longAt: byteAddress put: (a64BitValue bitAnd: 16rffffffff);
- 		longAt: byteAddress + 4 put: a64BitValue >> 32.
- 	^a64BitValue!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
+ allocateSlots: numSlots format: formatField classIndex: classIndex
+ 	"Allocate an object with numSlots space.  If there is room beneath scavengeThreshold
+ 	 allocate in newSpace, otherwise alocate in oldSpace.  If there is not room in newSpace
+ 	 and a scavenge is not already scheduled, schedule a scavenge."
+ 	<inline: true>
+ 	| numBytes newObj |
+ 	"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
+ 	 16 bytes otherwise (num slots in preceeding word).
+ 	 Objects always have at least one slot, for the forwarding pointer,
+ 	 and are multiples of 8 bytes in length."
+ 	numSlots >= self numSlotsMask
+ 		ifTrue:
+ 			[newObj := freeStart + self baseHeaderSize.
+ 			 numBytes := self largeObjectBytesForSlots: numSlots]
+ 		ifFalse:
+ 			[newObj := freeStart.
+ 			 numBytes := self smallObjectBytesForSlots: numSlots].
+ 	
+ 	freeStart + numBytes > scavengeThreshold ifTrue:
+ 		[needGCFlag ifFalse: [self scheduleScavenge].
+ 		 ^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex].
+ 	numSlots >= self numSlotsMask
+ 		ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
+ 			[self flag: #endianness.
+ 			 self longAt: freeStart put: numSlots.
+ 			 self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
+ 			 self long64At: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
+ 		ifFalse:
+ 			[self long64At: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
+ 	self assert: numBytes \\ self allocationUnit = 0.
+ 	self assert: newObj \\ self allocationUnit = 0.
+ 	freeStart := freeStart + numBytes.
+ 	^newObj!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>isIntegerObject: (in category 'object testing') -----
+ isIntegerObject: oop
+ 	^(oop bitAnd: 1) ~= 0!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>isNonIntegerObject: (in category 'object testing') -----
+ isNonIntegerObject: oop
+ 	^(oop bitAnd: 1) = 0!

Item was added:
+ Spur64BitMemoryManager subclass: #Spur64BitMMLESimulator
+ 	instanceVariableNames: 'parent bootstrapping'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-SpurMemoryManagerSimulation'!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>bootstrapping (in category 'accessing') -----
+ bootstrapping
+ 	^bootstrapping!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>bootstrapping: (in category 'accessing') -----
+ bootstrapping: aBoolean
+ 	bootstrapping := aBoolean.
+ 	segmentManager initForBootstrap!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>byteAt: (in category 'memory access') -----
+ byteAt: byteAddress
+ 	| lowBits long32 |
+ 	lowBits := byteAddress bitAnd: 3.
+ 	long32 := self long32At: byteAddress - lowBits.
+ 	^(lowBits caseOf: {
+ 		[0] -> [ long32 ].
+ 		[1] -> [ long32 bitShift: -8  ].
+ 		[2] -> [ long32 bitShift: -16 ].
+ 		[3] -> [ long32 bitShift: -24 ].
+ 	}) bitAnd: 16rFF!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>byteAt:put: (in category 'memory access') -----
+ byteAt: byteAddress put: byte
+ 	| lowBits long32 longAddress |
+ 	lowBits := byteAddress bitAnd: 3.
+ 	longAddress := byteAddress - lowBits.
+ 	long32 := self long32At: longAddress.
+ 	long32 := (lowBits caseOf: {
+ 		[0] -> [ (long32 bitAnd: 16rFFFFFF00) bitOr: byte ].
+ 		[1] -> [ (long32 bitAnd: 16rFFFF00FF) bitOr: (byte bitShift: 8) ].
+ 		[2] -> [ (long32 bitAnd: 16rFF00FFFF) bitOr: (byte bitShift: 16) ].
+ 		[3] -> [ (long32 bitAnd: 16r00FFFFFF) bitOr: (byte bitShift: 24) ].
+ 	}).
+ 	self long32At: longAddress put: long32.
+ 	^byte!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>byteAtPointer: (in category 'memory access') -----
+ byteAtPointer: pointer
+ 	"This gets implemented by Macros in C, where its types will also be checked.
+ 	 pointer is a raw address."
+ 
+ 	^self byteAt: pointer!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>eek (in category 'debug support') -----
+ eek
+ 	self halt!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>endianness (in category 'memory access') -----
+ endianness
+ 	^#little!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>fetchFloatAt:into: (in category 'float primitives') -----
+ fetchFloatAt: floatBitsAddress into: aFloat
+ 	aFloat at: 1 put: (self long64At: floatBitsAddress)!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>fetchPointer:ofObject: (in category 'object access') -----
+ fetchPointer: fieldIndex ofObject: objOop
+ 	self assert: (self isForwarded: objOop) not.
+ 	self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop)
+ 				or: [fieldIndex = 0 "forwarders and free objs"]]).
+ 	^super fetchPointer: fieldIndex ofObject: objOop!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>firstIndexableField: (in category 'object format') -----
+ firstIndexableField: objOop
+ 	"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
+ 	 There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
+ 	 The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
+ 	 of the object).  For 3 we must go to the class."
+ 	| fmt classFormat |
+ 	<returnTypeC: #'void *'>
+ 	fmt := self formatOf: objOop.
+ 	fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
+ 		[(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
+ 			[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
+ 			 ^self cCoerce: (self pointerForOop: objOop
+ 												+ self baseHeaderSize
+ 												+ ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord))
+ 					to: #'oop *'].
+ 		^self cCoerce: (self pointerForOop: objOop
+ 											+ self baseHeaderSize
+ 											+ ((self numSlotsOf: objOop) << self shiftForWord))
+ 				to: #'oop *'].
+ 	"All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
+ 	self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
+ 	^self
+ 		cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
+ 		to: (fmt < self firstByteFormat
+ 				ifTrue:
+ 					[fmt = self sixtyFourBitIndexableFormat
+ 						ifTrue: ["64 bit field objects" #'long long *']
+ 						ifFalse:
+ 							[fmt < self firstShortFormat
+ 								ifTrue: ["32 bit field objects" #'int *']
+ 								ifFalse: ["16-bit field objects" #'short *']]]
+ 				ifFalse: ["byte objects (including CompiledMethod" #'char *'])!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>freeLists (in category 'spur bootstrap') -----
+ freeLists
+ 	^freeLists!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>globalGarbageCollect (in category 'gc - global') -----
+ globalGarbageCollect
+ 	"If we're /not/ a clone, clone the VM and push it over the cliff.
+ 	 If it survives, destroy the clone and continue.  We should be OK until next time."
+ 	parent ifNil:
+ 		[coInterpreter cr; print: 'GC number '; print: statFullGCs; tab; flush.
+ 		 coInterpreter cloneSimulation objectMemory globalGarbageCollect.
+ 		 Smalltalk garbageCollect].
+ 	^super globalGarbageCollect!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>growOldSpaceByAtLeast: (in category 'growing/shrinking memory') -----
+ growOldSpaceByAtLeast: minAmmount
+ 	"Attempt to grow memory by at least minAmmount.
+ 	 Answer the size of the new segment, or nil if the attempt failed.
+ 	 Override to not grow during the Spur image bootstrap."
+ 	^bootstrapping ifFalse:
+ 		[super growOldSpaceByAtLeast: minAmmount]!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ 	"Used by Balloon"
+ 
+ 	^long32 bitAnd: 16rFFFF!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ 	"Used by Balloon"
+ 
+ 	^long32 bitShift: -16!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>headerForSlots:format:classIndex: (in category 'header format') -----
+ headerForSlots: numSlots format: formatField classIndex: classIndex
+ 	"The header format in LSB is
+ 	 MSB:	| 2 bits				|
+ 			| 22: identityHash	|
+ 			| 8: slotSize			|
+ 			| 3 bits				|
+ 			| 5: format			|
+ 			| 2 bits				|
+ 			| 22: classIndex		| : LSB"
+ 	self assert: (numSlots bitAnd: self numSlotsMask) = numSlots.
+ 	self assert: (formatField bitAnd: self formatMask) = formatField.
+ 	self assert: (classIndex bitAnd: self classIndexMask) = classIndex.
+ 	^super headerForSlots: numSlots format: formatField classIndex: classIndex!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>heapMapAtWord: (in category 'debug support') -----
+ heapMapAtWord: address
+ 	^heapMap heapMapAtWord: address!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>inSortedFreeListLink:to:given: (in category 'compaction') -----
+ inSortedFreeListLink: freeChunk to: nextFree given: prevFree
+ 	"thisContext sender selector = #sweepToCoallesceFreeSpaceForPigCompactFrom: ifTrue:
+ 		[| pit |
+ 			pit := [:label :thing|
+ 					coInterpreter print: label; space; printHex: thing.
+ 					(thing ~= 0 and: [self isFreeObject: thing]) ifTrue:
+ 						[coInterpreter print: ' (free) ']].
+ 			pit value: 'link ' value: freeChunk.
+ 			pit value: ' to ' value: nextFree.
+ 			pit value: ' from ' value: prevFree.
+ 			coInterpreter cr]."
+ 	"freeChunk = 16r10B0730 ifTrue:
+ 		[self halt]."
+ 	super inSortedFreeListLink: freeChunk to: nextFree given: prevFree!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>initialize (in category 'initialization') -----
+ initialize
+ 	super initialize.
+ 	bootstrapping := false!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>intAt:put: (in category 'memory access') -----
+ intAt: byteAddress put: a32BitValue
+ 	^self longAt: byteAddress put: (a32BitValue bitAnd: 16rFFFFFFFF)!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>loadImageSegmentFrom:outPointers: (in category 'image segment in/out') -----
+ loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray
+ 	self leakCheckImageSegments ifTrue:
+ 		[self halt].
+ 	^super loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>long32At: (in category 'memory access') -----
+ long32At: byteAddress
+ 	"Note: Adjusted for Smalltalk's 1-based array indexing."
+ 	byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ 	^memory at: byteAddress // 4 + 1!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>long32At:put: (in category 'memory access') -----
+ long32At: byteAddress put: a32BitValue
+ 	"Note: Adjusted for Smalltalk's 1-based array indexing."
+ 	"(byteAddress = 16r183FB00 and: [a32BitValue = 16r3FFFFC]) ifTrue:
+ 		[self halt]."
+ 	"(byteAddress between: 16r33FBB8 and: 16r33FBCF) ifTrue:
+ 		[self halt]."
+ 	byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ 	^memory at: byteAddress // 4 + 1 put: a32BitValue!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>long64At: (in category 'memory access') -----
+ long64At: byteAddress
+ 	"memory is a Bitmap, a 32-bit indexable array of bits"
+ 	| hiWord loWord |
+ 	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
+ 	loWord := memory at: byteAddress // 4 + 1.
+ 	hiWord := memory at: byteAddress // 4 + 2.
+ 	^hiWord = 0
+ 		ifTrue: [loWord]
+ 		ifFalse: [(hiWord bitShift: 32) + loWord]!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>long64At:put: (in category 'memory access') -----
+ long64At: byteAddress put: a64BitValue
+ 	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
+ 	self
+ 		long32At: byteAddress put: (a64BitValue bitAnd: 16rffffffff);
+ 		long32At: byteAddress + 4 put: a64BitValue >> 32.
+ 	^a64BitValue!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ 	"Answer the 64-bit word at byteAddress which must be 0 mod 4."
+ 
+ 	^self long64At: byteAddress!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ 	"Store the 64-bit value at byteAddress which must be 0 mod 4."
+ 
+ 	^self long64At: byteAddress put: a32BitValue!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>markAndTrace: (in category 'gc - global') -----
+ markAndTrace: objOop
+ 	"objOop = 16rB26020 ifTrue: [self halt].
+ 	objOop = 16rB25FD8 ifTrue: [self halt].
+ 	objOop = 16rB26010 ifTrue: [self halt]."
+ 	^super markAndTrace: objOop!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>memoryBaseForImageRead (in category 'snapshot') -----
+ memoryBaseForImageRead
+ 	"Answer the address to read the image into.  Override so that when bootstrapping,
+ 	 the segmentManager's segments are undisturbed in adjustSegmentSwizzlesBy:"
+ 	^bootstrapping
+ 		ifTrue: [0] 
+ 		ifFalse: [super memoryBaseForImageRead]!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>moveARunOfObjectsStartingAt:upTo: (in category 'compaction') -----
+ moveARunOfObjectsStartingAt: startAddress upTo: limit
+ 	| result |.
+ 	"self checkTraversableSortedFreeList."
+ 	result := super moveARunOfObjectsStartingAt: startAddress upTo: limit.
+ 	"self checkTraversableSortedFreeList."
+ 	^result!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>numClassTablePages (in category 'spur bootstrap') -----
+ numClassTablePages
+ 	^numClassTablePages!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>parent (in category 'accessing') -----
+ parent
+ 
+ 	^ parent!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>parent: (in category 'accessing') -----
+ parent: anObject
+ 
+ 	parent := anObject!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>return:restoringObjectsIn:savedHashes:and:savedHashes: (in category 'image segment in/out') -----
+ return: errCode restoringObjectsIn: firstArray savedHashes: firstSavedHashes and: secondArray savedHashes: secondSavedHashes
+ 	self leakCheckImageSegments ifTrue:
+ 		[self halt: errCode printString].
+ 	^super return: errCode restoringObjectsIn: firstArray savedHashes: firstSavedHashes and: secondArray savedHashes: secondSavedHashes!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
+ runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ 	(coInterpreter displayView isNil
+ 	 and: [fullGCFlag
+ 			ifTrue: [self leakCheckFullGC]
+ 			ifFalse: [self leakCheckNewSpaceGC]]) ifTrue:
+ 		[coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
+ 	^super
+ 		runLeakCheckerForFullGC: fullGCFlag
+ 		excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
+ 		classIndicesShouldBeValid: classIndicesShouldBeValid!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>scavengingGCTenuringIf: (in category 'generation scavenging') -----
+ scavengingGCTenuringIf: tenuringCriterion
+ 	"Run the scavenger."
+ 	"self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19)
+ 													ifTrue: ['th']
+ 													ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'."
+ 													
+ 	"statFullGCs > 0 ifTrue:
+ 		[self halt]."
+ 	^super scavengingGCTenuringIf: tenuringCriterion!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>setIsMarkedOf:to: (in category 'header access') -----
+ setIsMarkedOf: objOop to: aBoolean
+ 	"objOop = 16rB26020 ifTrue: [self halt]."
+ 	"(#(16r1971D0 16r196EE0 16r197048 16r197148) includes: objOop) ifTrue:
+ 		[self halt]."
+ 	super setIsMarkedOf: objOop to: aBoolean.
+ 	"(aBoolean
+ 	 and: [(self isContextNonImm: objOop)
+ 	 and: [(coInterpreter
+ 			checkIsStillMarriedContext: objOop
+ 			currentFP: coInterpreter framePointer)
+ 	 and: [(coInterpreter stackPages stackPageFor: (coInterpreter frameOfMarriedContext: objOop)) trace = 0]]]) ifTrue:
+ 		[self halt]"!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+     "Return the half-word at byteAddress which must be even."
+ 	| lowBits long |
+ 	lowBits := byteAddress bitAnd: 2.
+ 	long := self long32At: byteAddress - lowBits.
+ 	^ lowBits = 2
+ 		ifTrue: [ long bitShift: -16 ]
+ 		ifFalse: [ long bitAnd: 16rFFFF ]!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+     "Return the half-word at byteAddress which must be even."
+ 	| lowBits long longAddress |
+ 	lowBits := byteAddress bitAnd: 2.
+ 	lowBits = 0
+ 		ifTrue: "storing into LS word"
+ 			[long := self long32At: byteAddress.
+ 			 self longAt: byteAddress
+ 				put: ((long bitAnd: 16rFFFF0000) bitOr: a16BitValue)]
+ 		ifFalse: "storing into MS word"
+ 			[longAddress := byteAddress - 2.
+ 			long := self long32At: longAddress.
+ 			self long32At: longAddress
+ 				put: ((long bitAnd: 16rFFFF) bitOr: (a16BitValue bitShift: 16))].
+ 	^a16BitValue!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>storeFloatAt:from: (in category 'float primitives') -----
+ storeFloatAt: floatBitsAddress from: aFloat
+ 	self long32At: floatBitsAddress put: (aFloat at: 1).
+ 	self long32At: floatBitsAddress+4 put: (aFloat at: 2)!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>storeImageSegmentInto:outPointers:roots: (in category 'image segment in/out') -----
+ storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots
+ 	self leakCheckImageSegments ifTrue:
+ 		[self halt].
+ 	^super storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots!

Item was added:
+ ----- Method: Spur64BitMMLESimulator>>vmEndianness (in category 'memory access') -----
+ vmEndianness
+ 	"1 = big, 0 = little"
+ 	^0!

Item was added:
+ ----- Method: Spur64BitMemoryManager class>>simulatorClass (in category 'simulation only') -----
+ simulatorClass
+ 	^Spur64BitMMLESimulator!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
+ allocateSlots: numSlots format: formatField classIndex: classIndex
+ 	"Allocate an object with numSlots space.  If there is room beneath scavengeThreshold
+ 	 allocate in newSpace, otherwise alocate in oldSpace.  If there is not room in newSpace
+ 	 and a scavenge is not already scheduled, schedule a scavenge."
+ 	<inline: true>
+ 	| numBytes newObj |
+ 	"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
+ 	 16 bytes otherwise (num slots in preceeding word).
+ 	 Objects always have at least one slot, for the forwarding pointer,
+ 	 and are multiples of 8 bytes in length."
+ 	numSlots >= self numSlotsMask
+ 		ifTrue:
+ 			[numSlots >> 56 > 0 ifTrue:
+ 				[^nil]. "overflow size must fit in 56-bits"
+ 			 newObj := freeStart + self baseHeaderSize.
+ 			 numBytes := self largeObjectBytesForSlots: numSlots]
+ 		ifFalse:
+ 			[newObj := freeStart.
+ 			 numBytes := self smallObjectBytesForSlots: numSlots].
+ 	
+ 	freeStart + numBytes > scavengeThreshold ifTrue:
+ 		[needGCFlag ifFalse: [self scheduleScavenge].
+ 		 ^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex].
+ 	numSlots >= self numSlotsMask
+ 		ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
+ 			[self flag: #endianness.
+ 			 self longAt: freeStart put: self numSlotsMask << self numSlotsFullShift + numSlots.
+ 			 self longAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
+ 		ifFalse:
+ 			[self longAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
+ 	self assert: numBytes \\ self allocationUnit = 0.
+ 	self assert: newObj \\ self allocationUnit = 0.
+ 	freeStart := freeStart + numBytes.
+ 	^newObj!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>isIntegerObject: (in category 'object testing') -----
+ isIntegerObject: oop
+ 	^(oop bitAnd: self tagMask) = 1!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>isIntegerValue: (in category 'interpreter access') -----
+ isIntegerValue: intValue
+ 	"Answer if the given value can be represented as a Smalltalk integer value.
+ 	 In 64-bits we use a 3 bit tag which leaves 61 bits for 2's complement signed
+ 	 integers. In C, use a shift add and mask to test if the top 4 bits are all the same."
+ 	<api>
+ 	^self
+ 		cCode: [(intValue >> 60 + 1 bitAnd: 16rF) <= 1]
+ 		inSmalltalk: [intValue >= -16r2000000000000000 and: [intValue <= 16r1FFFFFFFFFFFFFFF]]!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>isNonIntegerObject: (in category 'object testing') -----
+ isNonIntegerObject: oop
+ 	^(oop bitAnd: self tagMask) ~= 1!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>rawOverflowSlotsOf: (in category 'object access') -----
  rawOverflowSlotsOf: objOop
  	<returnTypeC: #usqLong>
  	<inline: true>
  	self flag: #endianness.
+ 	^self
+ 		cCode: [((self longAt: objOop - self baseHeaderSize) << 8) asUnsignedLong >> 8]
+ 		inSmalltalk: [(self longAt: objOop - self baseHeaderSize) bitAnd: 16rFFFFFFFFFFFFFF]!
- 	^((self longAt: objOop - self baseHeaderSize) << 8) asUnsignedLong >> 8!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
  allocateSlots: numSlots format: formatField classIndex: classIndex
  	"Allocate an object with numSlots space.  If there is room beneath scavengeThreshold
  	 allocate in newSpace, otherwise alocate in oldSpace.  If there is not room in newSpace
  	 and a scavenge is not already scheduled, schedule a scavenge."
+ 	self subclassResponsibility!
- 	<inline: true>
- 	| numBytes newObj |
- 	"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
- 	 16 bytes otherwise (num slots in preceeding word).
- 	 Objects always have at least one slot, for the forwarding pointer,
- 	 and are multiples of 8 bytes in length."
- 	numSlots >= self numSlotsMask
- 		ifTrue:
- 			[(self wordSize >= 8 and: [numSlots > 16rffffffff]) ifTrue:
- 				[^nil]. "overflow size must fit in 32-bits"
- 			 newObj := freeStart + self baseHeaderSize.
- 			 numBytes := self largeObjectBytesForSlots: numSlots]
- 		ifFalse:
- 			[newObj := freeStart.
- 			 numBytes := self smallObjectBytesForSlots: numSlots].
- 	
- 	freeStart + numBytes > scavengeThreshold ifTrue:
- 		[needGCFlag ifFalse: [self scheduleScavenge].
- 		 ^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex].
- 	numSlots >= self numSlotsMask
- 		ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
- 			[self flag: #endianness.
- 			 self longAt: freeStart put: numSlots.
- 			 self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
- 			 self long64At: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
- 		ifFalse:
- 			[self long64At: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
- 	self assert: numBytes \\ self allocationUnit = 0.
- 	self assert: newObj \\ self allocationUnit = 0.
- 	freeStart := freeStart + numBytes.
- 	^newObj!

Item was changed:
  ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
  isIntegerObject: oop
+ 	^self subclassResponsibility!
- 	^(oop bitAnd: 1) ~= 0!

Item was changed:
  ----- Method: SpurMemoryManager>>isNonIntegerObject: (in category 'object testing') -----
  isNonIntegerObject: oop
+ 	^self subclassResponsibility!
- 	^(oop bitAnd: 1) = 0!

Item was changed:
  ----- Method: VMClass class>>cogitClass (in category 'accessing class hierarchy') -----
  cogitClass
+ 	^initializationOptions ifNotNil:
+ 		[Smalltalk classNamed: (initializationOptions
+ 									at: #Cogit
+ 									ifAbsent: [#SimpleStackBasedCogit])]!
- 	^nil!



More information about the Vm-dev mailing list