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

commits at source.squeak.org commits at source.squeak.org
Wed Mar 5 02:46:24 UTC 2014


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

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

Name: VMMaker.oscog-eem.626
Author: eem
Time: 4 March 2014, 6:43:17.755 pm
UUID: 17970553-7e67-46a4-b329-ccce9e1c7ba3
Ancestors: VMMaker.oscog-eem.625

Add eeInstantiateSmallClassIndex:format:numSlots: for afap
allocation of small objects.

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

Item was changed:
  ----- Method: CoInterpreter>>ceNewArraySlotSize: (in category 'trampolines') -----
  ceNewArraySlotSize: slotSize
  	<api>
  	objectMemory hasSpurMemoryManagerAPI ifTrue:
  		[| obj |
  		 obj := objectMemory
+ 					eeInstantiateSmallClassIndex: ClassArrayCompactIndex
- 					eeInstantiateClassIndex: ClassArrayCompactIndex
  					format: objectMemory arrayFormat
  					numSlots: slotSize.
  		objectMemory fillObj: obj numSlots: slotSize with: objectMemory nilObject.
  		^obj].
  	^objectMemory
  		eeInstantiateAndInitializeClass: (objectMemory splObj: ClassArray)
  		indexableSize: slotSize!

Item was added:
+ ----- Method: NewObjectMemory>>eeInstantiateSmallClassIndex:format:numSlots: (in category 'interpreter access') -----
+ eeInstantiateSmallClassIndex: compactClassIndex format: objFormat numSlots: numSlots
+ 	"This version of instantiateClass assumes that the total object size is under
+ 	 256 bytes, the limit for objects with only one or two header words. 
+ 	 NOTE this code will only work for sizes that are an integral number of words
+ 		(hence not a 32-bit LargeInteger in a 64-bit system).
+ 	 Note that the created small object IS NOT FILLED and must be completed before returning it to Squeak.
+ 	 Since this call is used in routines that do just that we are safe. Break this rule and die in GC.
+ 	 Will *not* cause a GC. Result is guaranteed to be young."
+ 
+ 	| sizeInBytes hash header1 |
+ 	"cannot have a negative indexable field count"
+ 	self assert: (numSlots >= 0 and: [compactClassIndex ~= 0]).
+ 	self assert: (objFormat < self firstByteFormat
+ 					ifTrue: [objFormat]
+ 					ifFalse: [objFormat bitAnd: self byteFormatMask])
+ 				= (self instSpecOfClass: (self compactClassAt: compactClassIndex)).
+ 	sizeInBytes := numSlots << ShiftForWord + BaseHeaderSize.
+ 	self assert: sizeInBytes <= 252.
+ 	hash := self newObjectHash.
+ 	header1 := (objFormat << self instFormatFieldLSB
+ 					bitOr: compactClassIndex << 12)
+ 					bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
+ 	header1 := header1 + (sizeInBytes - (header1 bitAnd: SizeMask+Size4Bit)).
+ 	^self eeAllocate: sizeInBytes headerSize: 1 h1: header1 h2: 0 h3: 0!

Item was added:
+ ----- Method: SpurMemoryManager>>allocateSmallNewSpaceSlots:format:classIndex: (in category 'allocation') -----
+ allocateSmallNewSpaceSlots: numSlots format: formatField classIndex: classIndex
+ 	"Allocate an object with numSlots in newSpace, where numSlots is known to be small.
+ 	 This is for the `ee' execution engine allocations, and must be satisfied.  If no memory
+ 	 is available, abort.  If the allocation pushes freeStart past scavengeThreshold and a
+ 	 scavenge is not already scheduled, schedule a scavenge."
+ 	<inline: true>
+ 	| numBytes newObj |
+ 	self assert: numSlots < self numSlotsMask.
+ 	newObj := freeStart.
+ 	numBytes := self smallObjectBytesForSlots: numSlots.
+ 	self assert: numBytes \\ self allocationUnit = 0.
+ 	self assert: newObj \\ self allocationUnit = 0.
+ 	freeStart + numBytes > scavengeThreshold ifTrue:
+ 		[needGCFlag ifFalse: [self scheduleScavenge].
+ 		 freeStart + numBytes > scavenger eden limit ifTrue:
+ 			[self error: 'no room in eden for allocateSmallNewSpaceSlots:format:classIndex:'.
+ 			 ^0]].
+ 	self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
+ 	freeStart := freeStart + numBytes.
+ 	^newObj!

Item was changed:
  ----- Method: SpurMemoryManager>>eeInstantiateSmallClass:numSlots: (in category 'instantiation') -----
  eeInstantiateSmallClass: classObj numSlots: numSlots
  	"Instantiate an instance of a class, with only a few slots.  ee stands for execution
  	 engine and implies that this allocation will *NOT* cause a GC.  N.B. the instantiated
  	 object IS NOT FILLED and must be completed before returning it to Smalltalk. Since
  	 this call is used in routines that do just that we are safe.  Break this rule and die in GC.
  	 Result is guaranteed to be young."
  	| classIndex |
  	<inline: true>
  	classIndex := self ensureBehaviorHash: classObj.
  	^self
+ 		eeInstantiateSmallClassIndex: classIndex
- 		eeInstantiateClassIndex: classIndex
  		format: (self instSpecOfClass: classObj)
  		numSlots: numSlots!

Item was added:
+ ----- Method: SpurMemoryManager>>eeInstantiateSmallClassIndex:format:numSlots: (in category 'instantiation') -----
+ eeInstantiateSmallClassIndex: knownClassIndex format: objFormat numSlots: numSlots
+ 	"Instantiate a small instance of a compact class.  ee stands for execution engine and
+ 	 implies that this allocation will *NOT* cause a GC.  small implies the object will have
+ 	 less than 255 slots. N.B. the instantiated object IS NOT FILLED and must be completed
+ 	 before returning it to Smalltalk. Since this call is used in routines that do just that we
+ 	 are safe.  Break this rule and die in GC.  Result is guaranteed to be young."
+ 	<inline: true>
+ 	self assert: (numSlots >= 0 and: [knownClassIndex ~= 0]).
+ 	self assert: (objFormat < self firstByteFormat
+ 					ifTrue: [objFormat]
+ 					ifFalse: [objFormat bitAnd: self byteFormatMask])
+ 				= (self instSpecOfClass: (self knownClassAtIndex: knownClassIndex)).
+ 	^self allocateSmallNewSpaceSlots: numSlots format: objFormat classIndex: knownClassIndex!

Item was changed:
  ----- Method: StackInterpreter>>closureIn:numArgs:instructionPointer:copiedValues: (in category 'control primitives') -----
  closureIn: context numArgs: numArgs instructionPointer: initialIP copiedValues: copiedValues
  	| newClosure numCopied |
  	<inline: true>
  	"numCopied should be zero for nil"
  	numCopied := objectMemory fetchWordLengthOf: copiedValues.
  	ClassBlockClosureCompactIndex ~= 0
  		ifTrue:
  			[newClosure := objectMemory
+ 								eeInstantiateSmallClassIndex: ClassBlockClosureCompactIndex
- 								eeInstantiateClassIndex: ClassBlockClosureCompactIndex
  								format: objectMemory indexablePointersFormat
  								numSlots: ClosureFirstCopiedValueIndex + numCopied]
  		ifFalse:
  			[newClosure := objectMemory
  								eeInstantiateSmallClass: (objectMemory splObj: ClassBlockClosure)
  								numSlots: ClosureFirstCopiedValueIndex + numCopied].
  	"Assume: have just allocated a new closure; it must be young. Thus, can use unchecked stores."
  	objectMemory
  		storePointerUnchecked: ClosureOuterContextIndex ofObject: newClosure withValue: context;
  		storePointerUnchecked: ClosureStartPCIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: initialIP);
  		storePointerUnchecked: ClosureNumArgsIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: numArgs).
  	0 to: numCopied - 1 do:
  		[:i|
  		objectMemory storePointerUnchecked: i + ClosureFirstCopiedValueIndex
  			ofObject: newClosure
  			withValue: (objectMemory fetchPointer: i ofObject: copiedValues)].
  	^newClosure!

Item was changed:
  ----- Method: StackInterpreter>>closureIn:numArgs:instructionPointer:numCopiedValues: (in category 'control primitives') -----
  closureIn: context numArgs: numArgs instructionPointer: initialIP numCopiedValues: numCopied
  	| newClosure |
  	<inline: true>
  	ClassBlockClosureCompactIndex ~= 0
  		ifTrue:
  			[newClosure := objectMemory
+ 								eeInstantiateSmallClassIndex: ClassBlockClosureCompactIndex
- 								eeInstantiateClassIndex: ClassBlockClosureCompactIndex
  								format: objectMemory indexablePointersFormat
  								numSlots: ClosureFirstCopiedValueIndex + numCopied]
  		ifFalse:
  			[newClosure := objectMemory
  								eeInstantiateSmallClass: (objectMemory splObj: ClassBlockClosure)
  								numSlots: ClosureFirstCopiedValueIndex + numCopied].
  	"Assume: have just allocated a new closure; it must be young. Thus, can use unchecked stores."
  	objectMemory storePointerUnchecked: ClosureOuterContextIndex ofObject: newClosure withValue: context.
  	objectMemory storePointerUnchecked: ClosureStartPCIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: initialIP).
  	objectMemory storePointerUnchecked: ClosureNumArgsIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: numArgs).
  	^newClosure!

Item was changed:
  ----- Method: StackInterpreter>>createActualMessageTo: (in category 'message sending') -----
  createActualMessageTo: lookupClass 
  	"Bundle up the selector, arguments and lookupClass into a Message object. 
  	 In the process it pops the arguments off the stack, and pushes the message object. 
  	 This can then be presented as the argument of e.g. #doesNotUnderstand:"
  	| argumentArray message |
  	<inline: false> "This is a useful break-point"
  	self assert: ((objectMemory isImmediate: messageSelector) or: [objectMemory addressCouldBeObj: messageSelector]).
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[argumentArray := objectMemory
+ 								eeInstantiateSmallClassIndex: ClassArrayCompactIndex
- 								eeInstantiateClassIndex: ClassArrayCompactIndex
  								format: objectMemory arrayFormat
  								numSlots: argumentCount.
  			 message := objectMemory
+ 								eeInstantiateSmallClassIndex: ClassMessageCompactIndex
- 								eeInstantiateClassIndex: ClassMessageCompactIndex
  								format: objectMemory nonIndexablePointerFormat
  								numSlots: MessageLookupClassIndex + 1]
  		ifFalse:
  			[argumentArray := objectMemory
+ 								eeInstantiateSmallClass: (objectMemory splObj: ClassArray)
+ 								numSlots: argumentCount.
- 								eeInstantiateClass: (objectMemory splObj: ClassArray)
- 								indexableSize: argumentCount.
  			 message := objectMemory
+ 								eeInstantiateSmallClass: (objectMemory splObj: ClassMessage)
+ 								numSlots: MessageLookupClassIndex + 1].
- 								eeInstantiateClass: (objectMemory splObj: ClassMessage)
- 								indexableSize: 0].
  
  	"Since the array is new can use unchecked stores."
  	(argumentCount - 1) * BytesPerOop to: 0 by: BytesPerOop negated do:
  		[:i|
  		self longAt:  argumentArray + objectMemory baseHeaderSize + i put: self popStack].
  	"Since message is new can use unchecked stores."
  	objectMemory
  		storePointerUnchecked: MessageSelectorIndex ofObject: message withValue: messageSelector;
  		storePointerUnchecked: MessageArgumentsIndex ofObject: message withValue: argumentArray;
  		storePointerUnchecked: MessageLookupClassIndex ofObject: message withValue: lookupClass.
  
  	self push: message.
  
+ 	argumentCount := 1!
- 	argumentCount := 1.!

Item was changed:
  ----- Method: StackInterpreter>>floatObjectOf: (in category 'object format') -----
  floatObjectOf: aFloat
  	| newFloatObj |
  	<inline: false>
  	<var: #aFloat type: #double>
  	newFloatObj := objectMemory
+ 						eeInstantiateSmallClassIndex: ClassFloatCompactIndex
- 						eeInstantiateClassIndex: ClassFloatCompactIndex
  						format: objectMemory firstLongFormat
  						numSlots: 8 / objectMemory wordSize.
  	objectMemory storeFloatAt: newFloatObj + objectMemory baseHeaderSize from: aFloat.
  	^newFloatObj!

Item was changed:
  ----- Method: StackInterpreter>>positive32BitIntegerFor: (in category 'primitive support') -----
  positive32BitIntegerFor: integerValue
  	| newLargeInteger |
  	"Note - integerValue is interpreted as POSITIVE, eg, as the result of Bitmap>at:, or integer>bitAnd:."
  	(integerValue >= 0
  	 and: [objectMemory isIntegerValue: integerValue]) ifTrue:
  		[^objectMemory integerObjectOf: integerValue].
  
  	newLargeInteger := objectMemory
+ 							eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex
- 							eeInstantiateClassIndex: ClassLargePositiveIntegerCompactIndex
  							format: (objectMemory byteFormatForNumBytes: 4)
  							numSlots: 1.
  	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).
  	^newLargeInteger!

Item was changed:
  ----- Method: StackInterpreter>>pushNewArrayBytecode (in category 'stack bytecodes') -----
  pushNewArrayBytecode
  	| size popValues array |
  	size := self fetchByte.
  	popValues := size > 127.
  	size := size bitAnd: 127.
  	self fetchNextBytecode.
+ 	self externalizeIPandSP. "in case of abort"
+ 	objectMemory hasSpurMemoryManagerAPI
+ 		ifTrue:
+ 			[array := objectMemory
+ 						eeInstantiateSmallClassIndex: ClassArrayCompactIndex
+ 						format: objectMemory arrayFormat
+ 						numSlots: size]
+ 		ifFalse:
+ 			[array := objectMemory
+ 						eeInstantiateClassIndex: ClassArrayCompactIndex
+ 						format: objectMemory arrayFormat
+ 						numSlots: size].
- 	self externalizeIPandSP.
- 	array := objectMemory
- 				eeInstantiateClassIndex: ClassArrayCompactIndex
- 				format: objectMemory arrayFormat
- 				numSlots: size.
- 	self internalizeIPandSP.
  	popValues
  		ifTrue:
  			[0 to: size - 1 do:
  				[:i|
  				"Assume: have just allocated a new Array; it must be young. Thus, can use unchecked stores."
  				objectMemory storePointerUnchecked: i ofObject: array withValue: (self internalStackValue: size - i - 1)].
  			 self internalPop: size]
  		ifFalse:
  			[0 to: size - 1 do:
  				[:i|
  				objectMemory storePointerUnchecked: i ofObject: array withValue: objectMemory nilObject]].
  	self internalPush: array!



More information about the Vm-dev mailing list