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

commits at source.squeak.org commits at source.squeak.org
Wed Aug 13 03:15:55 UTC 2014


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

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

Name: VMMaker.oscog-eem.859
Author: eem
Time: 12 August 2014, 8:12:57.685 pm
UUID: afaa1544-1a80-43c3-b9b8-575978540d13
Ancestors: VMMaker.oscog-eem.856

Spur:
Fix system crash on using basicNew: on CompiledMethod.
Have instantiateClass:indexableSize: refuse to instantiate a
CompiledMethod, and add instantiateCompiledMethodClass:indexableSize:.
Get the error code right for primitiveNew et al.

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

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveNew (in category 'object access primitives') -----
  primitiveNew
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			["Allocate a new fixed-size instance.  Fail if the allocation would leave
  			  less than lowSpaceThreshold bytes free. This *will not* cause a GC :-)"
  			(objectMemory instantiateClass: self stackTop)
  				ifNotNil: [:obj| self pop: argumentCount + 1 thenPush: obj]
+ 				ifNil: [self primitiveFailFor: ((objectMemory isFixedSizePointerFormat: (objectMemory instSpecOfClass: self stackTop))
+ 											ifTrue: [PrimErrNoMemory]
+ 											ifFalse: [PrimErrBadReceiver])]]
- 				ifNil: [self primitiveFailFor: PrimErrNoMemory]]
  		ifFalse:
  			["Allocate a new fixed-size instance. Fail if the allocation would leave
  			  less than lowSpaceThreshold bytes free. May cause a GC."
  			| spaceOkay |
  			"The following may cause GC!! Use var for result to permit inlining."
  			spaceOkay := objectMemory
  								sufficientSpaceToInstantiate: self stackTop
  								indexableSize: 0.
  			spaceOkay
  				ifTrue:
  					[self
  						pop: argumentCount + 1
  						thenPush: (objectMemory
  									instantiateClass: self stackTop
  									indexableSize: 0)]
  				ifFalse: [self primitiveFailFor: PrimErrNoMemory]]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveNewMethod (in category 'compiled methods') -----
  primitiveNewMethod
  	| header bytecodeCount class size theMethod literalCount |
  	header := self stackTop.
+ 	bytecodeCount := self stackValue: 1.
+ 	((objectMemory isIntegerObject: header)
+ 	 and: [(objectMemory isIntegerObject: bytecodeCount)
+ 	 and: [(bytecodeCount := objectMemory integerValueOf: bytecodeCount) >= 0]]) ifFalse:
+ 		[self primitiveFailFor: PrimErrBadArgument.
+ 		 ^self].
- 	bytecodeCount := self stackIntegerValue: 1.
- 	self success: (objectMemory isIntegerObject: header).
- 	self successful ifFalse: [^nil].
  	class := self stackValue: 2.
  	literalCount := objectMemory literalCountOfMethodHeader: header.
  	size := literalCount + LiteralStart * BytesPerOop + bytecodeCount.
+ 	objectMemory hasSpurMemoryManagerAPI
+ 		ifTrue:
+ 			[theMethod := objectMemory instantiateCompiledMethodClass: class indexableSize: size.
+ 			 theMethod ifNil:
+ 				[self primitiveFailFor: ((objectMemory isCompiledMethodFormat: (objectMemory instSpecOfClass: class))
+ 										ifTrue: [PrimErrNoMemory]
+ 										ifFalse: [PrimErrBadReceiver]).
+ 				 ^self]]
+ 		ifFalse:
+ 			[theMethod := objectMemory instantiateClass: class indexableSize: size].
- 	theMethod := objectMemory instantiateClass: class indexableSize: size.
  	objectMemory storePointerUnchecked: HeaderIndex ofObject: theMethod withValue: header.
  	1 to: literalCount do:
  		[:i | objectMemory storePointer: i ofObject: theMethod withValue: objectMemory nilObject].
  	self pop: 3 thenPush: theMethod!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveNewWithArg (in category 'object access primitives') -----
  primitiveNewWithArg
  	"Allocate a new indexable instance. Fail if the allocation would leave less than lowSpaceThreshold bytes free. May cause a GC."
  	| size spaceOkay |
  	size := self positiveMachineIntegerValueOf: self stackTop.
  	self cppIf: NewspeakVM
  		ifTrue: "For the mirror prims check that the class obj is actually a valid class."
  			[(argumentCount < 2
  			  or: [self addressCouldBeClassObj: (self stackValue: 1)]) ifFalse:
  				[self primitiveFailFor: PrimErrBadArgument]].
  	self successful "positiveMachineIntegerValueOf: succeeds only for non-negative integers."
  		ifTrue:
  			[objectMemory hasSpurMemoryManagerAPI
  				ifTrue:
  					[(objectMemory instantiateClass: (self stackValue: 1) indexableSize: size)
  						ifNotNil: [:obj| self pop: argumentCount + 1 thenPush: obj]
+ 						ifNil: [self primitiveFailFor: ((objectMemory isCompiledMethodFormat: (objectMemory instSpecOfClass: (self stackValue: 1)))
+ 														ifTrue: [PrimErrBadReceiver]
+ 														ifFalse: [PrimErrNoMemory])]]
- 						ifNil: [self primitiveFailFor: PrimErrNoMemory]]
  				ifFalse:
  					[spaceOkay := objectMemory sufficientSpaceToInstantiate: (self stackValue: 1) indexableSize: size.
  					 spaceOkay
  						ifTrue:
  							[self
  								pop: argumentCount + 1
  								thenPush: (objectMemory instantiateClass: (self stackValue: 1) indexableSize: size)]
  						ifFalse:
  							[self primitiveFailFor: PrimErrNoMemory]]]
  		ifFalse:
  			[self primitiveFailFor: PrimErrBadArgument]!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>instantiateClass:indexableSize: (in category 'instantiation') -----
  instantiateClass: classObj indexableSize: nElements
  	<var: #nElements type: #usqInt>
+ 	"Allocate an instance of a variable class, excepting CompiledMethod."
  	| instSpec classFormat numSlots classIndex newObj fillValue |
  	classFormat := self formatOfClass: classObj.
  	instSpec := self instSpecOfClassFormat: classFormat.
  	fillValue := 0.
  	instSpec caseOf: {
  		[self arrayFormat]	->
  			[nElements > self maxSlotsForAlloc ifTrue:
  				[^nil].
  			 numSlots := nElements.
  			 fillValue := nilObj].
  		[self indexablePointersFormat]	->
  			[nElements > (self maxSlotsForAlloc - (self fixedFieldsOfClassFormat: classFormat)) ifTrue:
  				[^nil].
  			 numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
  			 fillValue := nilObj].
  		[self weakArrayFormat]	->
  			[nElements > (self maxSlotsForAlloc - (self fixedFieldsOfClassFormat: classFormat)) ifTrue:
  				[^nil].
  			 numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
  			 fillValue := nilObj].
  		[self sixtyFourBitIndexableFormat]	->
  			[nElements > (self maxSlotsForAlloc / 2) ifTrue:
  				[^nil].
  			 numSlots := nElements * 2].
  		[self firstLongFormat]	->
  			[nElements > self maxSlotsForAlloc ifTrue:
  				[^nil].
  			 numSlots := nElements].
  		[self firstShortFormat]	->
  			[numSlots := nElements + 1 // 2.
  			 numSlots > self maxSlotsForAlloc ifTrue:
  				[^nil].
  			 instSpec := instSpec + (nElements bitAnd: 1)].
  		[self firstByteFormat]	->
  			[numSlots := nElements + 3 // 4.
  			 numSlots > self maxSlotsForAlloc ifTrue:
  				[^nil].
- 			 instSpec := instSpec + (4 - nElements bitAnd: 3)].
- 		[self firstCompiledMethodFormat]	->
- 			[numSlots := nElements + 3 // 4.
- 			 numSlots > self maxSlotsForAlloc ifTrue:
- 				[^nil].
  			 instSpec := instSpec + (4 - nElements bitAnd: 3)] }
  		otherwise: ["some Squeak images include funky fixed subclasses of abstract variable
  					 superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection.
  					 Allow fixed classes to be instantiated here iff nElements = 0."
  					 (nElements ~= 0 or: [instSpec > self lastPointerFormat]) ifTrue:
  						[^nil].
  					 numSlots := self fixedFieldsOfClassFormat: classFormat]. "non-indexable"
  	classIndex := self ensureBehaviorHash: classObj.
  	classIndex < 0 ifTrue:
  		[coInterpreter primitiveFailFor: classIndex negated.
  		 ^nil].
  	numSlots > self maxSlotsForNewSpaceAlloc
  		ifTrue: [newObj := self allocateSlotsInOldSpace: numSlots format: instSpec classIndex: classIndex]
  		ifFalse: [newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex].
  	newObj ifNotNil:
  		[self fillObj: newObj numSlots: numSlots with: fillValue].
  	^newObj!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>instantiateCompiledMethodClass:indexableSize: (in category 'instantiation') -----
+ instantiateCompiledMethodClass: classObj indexableSize: nElements
+ 	<var: #nElements type: #usqInt>
+ 	"Allocate an instance of a CompiledMethod class."
+ 	<inline: true>
+ 	| instSpec classFormat numSlots classIndex newObj |
+ 	classFormat := self formatOfClass: classObj.
+ 	instSpec := self instSpecOfClassFormat: classFormat.
+ 	instSpec ~= self firstCompiledMethodFormat ifTrue:
+ 		[^nil].
+ 	numSlots := nElements + 3 // 4.
+ 	instSpec := instSpec + (4 - nElements bitAnd: 3).
+ 	classIndex := self ensureBehaviorHash: classObj.
+ 	classIndex < 0 ifTrue:
+ 		[coInterpreter primitiveFailFor: classIndex negated.
+ 		 ^nil].
+ 	numSlots > self maxSlotsForNewSpaceAlloc
+ 		ifTrue:
+ 			[numSlots > self maxSlotsForAlloc ifTrue:
+ 				[^nil].
+ 			 newObj := self allocateSlotsInOldSpace: numSlots format: instSpec classIndex: classIndex]
+ 		ifFalse:
+ 			[newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex].
+ 	newObj ifNotNil:
+ 		[self fillObj: newObj numSlots: numSlots with: 0].
+ 	^newObj!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>instantiateClass:indexableSize: (in category 'instantiation') -----
  instantiateClass: classObj indexableSize: nElements
  	<var: #nElements type: #usqInt>
+ 	"Allocate an instance of a variable class, excepting CompiledMethod."
  	| instSpec classFormat numSlots classIndex newObj fillValue |
  	classFormat := self formatOfClass: classObj.
  	instSpec := self instSpecOfClassFormat: classFormat.
  	fillValue := 0.
  	instSpec caseOf: {
  		[self arrayFormat]	->
  			[numSlots := nElements.
  			 fillValue := nilObj].
  		[self indexablePointersFormat]	->
  			[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
  			 fillValue := nilObj].
  		[self weakArrayFormat]	->
  			[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
  			 fillValue := nilObj].
  		[self sixtyFourBitIndexableFormat]	->
  			[numSlots := nElements].
  		[self firstLongFormat]	->
  			[numSlots := nElements + 1 // 2.
  			 instSpec := instSpec + (nElements bitAnd: 1)].
  		[self firstShortFormat]	->
  			[numSlots := nElements + 3 // 4.
  			 instSpec := instSpec + (4 - nElements bitAnd: 3)].
  		[self firstByteFormat]	->
  			[numSlots := nElements + 7 // 8.
- 			 instSpec := instSpec + (8 - nElements bitAnd: 7)].
- 		[self firstCompiledMethodFormat]	->
- 			[numSlots := nElements + 7 // 8.
  			 instSpec := instSpec + (8 - nElements bitAnd: 7)] }
  		otherwise: ["some Squeak images include funky fixed subclasses of abstract variable
  					 superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection.
  					 Allow fixed classes to be instantiated here iff nElements = 0."
  					 (nElements ~= 0 or: [instSpec > self lastPointerFormat]) ifTrue:
  						[^nil].
  					 numSlots := self fixedFieldsOfClassFormat: classFormat]. "non-indexable"
  	classIndex := self ensureBehaviorHash: classObj.
  	classIndex < 0 ifTrue:
  		[coInterpreter primitiveFailFor: classIndex negated.
  		 ^nil].
  	numSlots > self maxSlotsForNewSpaceAlloc
  		ifTrue:
  			[numSlots > self maxSlotsForAlloc ifTrue:
  				[^nil].
  			 newObj := self allocateSlotsInOldSpace: numSlots format: instSpec classIndex: classIndex]
  		ifFalse:
  			[newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex].
  	newObj ifNotNil:
  		[self fillObj: newObj numSlots: numSlots with: fillValue].
  	^newObj!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>instantiateCompiledMethodClass:indexableSize: (in category 'instantiation') -----
+ instantiateCompiledMethodClass: classObj indexableSize: nElements
+ 	<var: #nElements type: #usqInt>
+ 	"Allocate an instance of a CompiledMethod class."
+ 	<inline: true>
+ 	| instSpec classFormat numSlots classIndex newObj |
+ 	classFormat := self formatOfClass: classObj.
+ 	instSpec := self instSpecOfClassFormat: classFormat.
+ 	instSpec ~= self firstCompiledMethodFormat ifTrue:
+ 		[^nil].
+ 	numSlots := nElements + 7 // 8.
+ 	instSpec := instSpec + (8 - nElements bitAnd: 7).
+ 	classIndex := self ensureBehaviorHash: classObj.
+ 	classIndex < 0 ifTrue:
+ 		[coInterpreter primitiveFailFor: classIndex negated.
+ 		 ^nil].
+ 	numSlots > self maxSlotsForNewSpaceAlloc
+ 		ifTrue:
+ 			[numSlots > self maxSlotsForAlloc ifTrue:
+ 				[^nil].
+ 			 newObj := self allocateSlotsInOldSpace: numSlots format: instSpec classIndex: classIndex]
+ 		ifFalse:
+ 			[newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex].
+ 	newObj ifNotNil:
+ 		[self fillObj: newObj numSlots: numSlots with: 0].
+ 	^newObj!

Item was changed:
  ----- Method: SpurMemoryManager>>instantiateClass:indexableSize: (in category 'instantiation') -----
  instantiateClass: classObj indexableSize: nElements
  	<var: #nElements type: #usqInt>
+ 	"Allocate an instance of a variable class, excepting CompiledMethod."
  	^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>instantiateCompiledMethodClass:indexableSize: (in category 'instantiation') -----
+ instantiateCompiledMethodClass: classObj indexableSize: nElements
+ 	<var: #nElements type: #usqInt>
+ 	"Allocate an instance of a CompiledMethod class."
+ 	^self subclassResponsibility!



More information about the Vm-dev mailing list