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

commits at source.squeak.org commits at source.squeak.org
Wed Sep 25 19:21:24 UTC 2013


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

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

Name: VMMaker.oscog-eem.412
Author: eem
Time: 25 September 2013, 12:18:41.931 pm
UUID: 6b66ad04-58bc-4be6-8790-cb2f11fc34e8
Ancestors: VMMaker.oscog-eem.411

Sionara the explicit noAtCache at:[put:] machinery in CoInterpreter
now that the atCache is confined to the interreter's special selector
at:[put:] bytecodes.

Add some missing subclass responsibility implementations to SMM.

Add primitiveMakeEphemeron for testing.

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

Item was changed:
  ----- Method: CoInterpreter>>functionPointerForCompiledMethod:primitiveIndex: (in category 'cog jit support') -----
  functionPointerForCompiledMethod: methodObj primitiveIndex: primIndex
  	<api>
  	<returnTypeC: 'void (*functionPointerForCompiledMethodprimitiveIndex(sqInt methodObj, sqInt primIndex))(void)'>
  	| functionPointer |
  	<var: #functionPointer declareC: #'void (*functionPointer)(void)'>
  	functionPointer := self functionPointerFor: primIndex inClass: nil.
- 	functionPointer == #primitiveAt ifTrue:
- 		[^#primitiveNoAtCacheAt].
- 	functionPointer == #primitiveAtPut ifTrue:
- 		[^#primitiveNoAtCacheAtPut].
- 	functionPointer == #primitiveStringAt ifTrue:
- 		[^#primitiveNoAtCacheStringAt].
- 	functionPointer == #primitiveStringAtPut ifTrue:
- 		[^#primitiveNoAtCacheStringAtPut].
  	functionPointer == #primitiveCalloutToFFI ifTrue:
  		[^self functionForPrimitiveCallout].
  	functionPointer == #primitiveExternalCall ifTrue:
  		[^self functionForPrimitiveExternalCall: methodObj].
  	^functionPointer!

Item was removed:
- ----- Method: CoInterpreter>>noAtCacheCommonAt: (in category 'indexing primitive support') -----
- noAtCacheCommonAt: stringy
- 	"This code is called if the receiver responds primitively to at:.
- 	 The cogit can implement at: & at:put: quickly in machine code, and needs a backup
- 	 that provides error codes.  But it does not want the at cache so it does not have to
- 	 waste time assigning messageSelector and lkupClass."
- 	| index rcvr result |
- 	self initPrimCall.
- 	rcvr := self stackValue: 1.
- 	(objectMemory isNonIntegerObject: rcvr) ifFalse:
- 		[^self primitiveFailFor: PrimErrInappropriate].
- 	index := self stackTop.
- 	"No need to test for large positive integers here.  No object has 1g elements"
- 	(objectMemory isIntegerObject: index) ifFalse:
- 		[^self primitiveFailFor: PrimErrBadArgument].
- 	index := objectMemory integerValueOf: index.
- 	result := self stObject: rcvr at: index.
- 	self successful ifTrue:
- 		[stringy ifTrue: [result := self characterForAscii: (objectMemory integerValueOf: result)].
- 		^ self pop: argumentCount+1 thenPush: result]!

Item was removed:
- ----- Method: CoInterpreter>>noAtCacheCommonAtPut: (in category 'indexing primitive support') -----
- noAtCacheCommonAtPut: stringy
- 	"This code is called if the receiver responds primitively to at:Put:.
- 	 The cogit can implement at: & at:put: quickly in machine code, and needs a backup
- 	 that provides error codes.  But it does not want the at cache so it does not have to
- 	 waste time assigning messageSelector and lkupClass."
- 	| value index rcvr |
- 	value := self stackTop.
- 	self initPrimCall.
- 	rcvr := self stackValue: 2.
- 	(objectMemory isNonIntegerObject: rcvr) ifFalse:
- 		[^self primitiveFailFor: PrimErrInappropriate].
- 	index := self stackValue: 1.
- 	"No need to test for large positive integers here.  No object has 1g elements"
- 	(objectMemory isIntegerObject: index) ifFalse:
- 		[^self primitiveFailFor: PrimErrBadArgument].
- 	index := objectMemory integerValueOf: index.
- 	stringy
- 		ifTrue: [self stObject: rcvr at: index put: (self asciiOfCharacter: value)]
- 		ifFalse: [self stObject: rcvr at: index put: value].
- 	self successful ifTrue:
- 		[^ self pop: argumentCount+1 thenPush: value]!

Item was removed:
- ----- Method: CoInterpreterPrimitives>>primitiveNoAtCacheAt (in category 'indexing primitives') -----
- primitiveNoAtCacheAt
- 
- 	self noAtCacheCommonAt: false.!

Item was removed:
- ----- Method: CoInterpreterPrimitives>>primitiveNoAtCacheAtPut (in category 'indexing primitives') -----
- primitiveNoAtCacheAtPut
- 
- 	self noAtCacheCommonAtPut: false.!

Item was removed:
- ----- Method: CoInterpreterPrimitives>>primitiveNoAtCacheStringAt (in category 'indexing primitives') -----
- primitiveNoAtCacheStringAt
- 
- 	self noAtCacheCommonAt: true.!

Item was removed:
- ----- Method: CoInterpreterPrimitives>>primitiveNoAtCacheStringAtPut (in category 'indexing primitives') -----
- primitiveNoAtCacheStringAtPut
- 
- 	self noAtCacheCommonAtPut: true.!

Item was added:
+ ----- Method: SpurMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
+ allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
+ 	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  The header
+ 	 will have been filled-in but not the contents."
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>tagMask (in category 'word size') -----
+ tagMask
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>wordSize (in category 'word size') -----
+ wordSize
+ 	"Answer the manager's word size, whjich is the size of an oop, and which
+ 	 is assumed to be equivslent to the underlying machine's word size."
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveMakeEphemeron (in category 'system control primitives') -----
+ primitiveMakeEphemeron
+ 	"Turn the receiver into an ephemeron.
+ 	 TEMPORARY. For testing ephemeron handling in the VM only.
+ 	 Ephemerons should be instantiated from a suitable class."
+ 	<export: true>
+ 	<option: #Spur>
+ 	((objectMemory isNonImmediate: self stackTop)
+ 	 and: [objectMemory isFixedSizePointerFormat: (objectMemory formatOf: self stackTop)]) ifFalse:
+ 		[^self primitiveFailFor: (argumentCount = 0
+ 									ifTrue: [PrimErrBadReceiver]
+ 									ifFalse: [PrimErrBadArgument])].
+ 	objectMemory
+ 		setFormatOf: self stackTop
+ 		to: objectMemory ephemeronFormat.
+ 	self pop: argumentCount!



More information about the Vm-dev mailing list