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

commits at source.squeak.org commits at source.squeak.org
Mon Sep 9 21:02:56 UTC 2013


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

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

Name: VMMaker.oscog-eem.358
Author: eem
Time: 9 September 2013, 2:00:12.991 pm
UUID: acc3e8f6-b86d-4fe3-b487-09082c0a82b7
Ancestors: VMMaker.oscog-eem.357

More isIntegerObject: => isImmediate:'s.
Add isIntegerValue: for the 32-bit system.

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

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSize (in category 'indexing primitives') -----
  primitiveSize
  	| rcvr hdr fmt fixedFields totalLength |
  	rcvr := self stackTop.
+ 	((objectMemory isImmediate: rcvr) "Integers are not indexable"
- 	((objectMemory isIntegerObject: rcvr) "Integers are not indexable"
  	 or: [hdr := objectMemory baseHeader: rcvr.
  		(fmt := objectMemory formatOfHeader: hdr) < 2]) "This is not an indexable object"
  		ifTrue:
  			[^self primitiveFailFor: PrimErrBadReceiver].
  	(fmt = 3 and: [objectMemory isContextHeader: hdr]) ifTrue:
  		[^self primitiveContextSize].
  	totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
  	fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
  	self pop: argumentCount + 1 thenPush: (objectMemory integerObjectOf: totalLength - fixedFields)!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>isIntegerValue: (in category 'interpreter access') -----
+ isIntegerValue: intValue
+ 	"Answer if the given value can be represented as a Smalltalk integer value.
+ 	 In C, use a shift and XOR to set the sign bit if and only if the top two bits of the given
+ 	 value are the same, then test the sign bit. Note that the top two bits are equal for
+ 	 exactly those integers in the range that can be represented in 31-bits or 63-bits."
+ 	<api>
+ 	^self
+ 		cCode: [(intValue bitXor: (intValue << 1)) >= 0]
+ 		inSmalltalk: [intValue >= 16r-40000000 and: [intValue <= 16r3FFFFFFF]]!

Item was changed:
  ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
  isIntegerObject: oop
  	(#(	makeBaseFrameFor:
  		quickFetchInteger:ofObject:
  		frameOfMarriedContext:
  		addressCouldBeClassObj:
  		isMarriedOrWidowedContext:
+ 		shortPrint:
+ 		bytecodePrimAt
+ 		commonAt:
+ 		loadFloatOrIntFrom:) includes: thisContext sender method selector) ifFalse:
- 		shortPrint:) includes: thisContext sender method selector) ifFalse:
  		[self halt].
  	^(oop bitAnd: 1) ~= 0!

Item was added:
+ ----- Method: SpurMemoryManager>>isIntegerValue: (in category 'interpreter access') -----
+ isIntegerValue: intValue
+ 	"Answer if the given value can be represented as a Smalltalk integer value."
+ 	^self subclassResponsibility!

Item was changed:
  ----- Method: StackInterpreter>>bytecodePrimAt (in category 'common selector sends') -----
  bytecodePrimAt
  	"BytecodePrimAt will only succeed if the receiver is in the atCache.
  	Otherwise it will fail so that the more general primitiveAt will put it in the
  	cache after validating that message lookup results in a primitive response."
  	| index rcvr result atIx |
  	index := self internalStackTop.
  	rcvr := self internalStackValue: 1.
+ 	((objectMemory isImmediate: rcvr) not
- 	((objectMemory isIntegerObject: rcvr) not
  	 and: [objectMemory isIntegerObject: index]) ifTrue:
  		[atIx := rcvr bitAnd: AtCacheMask.  "Index into atCache = 4N, for N = 0 ... 7"
  		(atCache at: atIx+AtCacheOop) = rcvr ifTrue:
  			[result := self commonVariable: rcvr at: (objectMemory integerValueOf: index) cacheIndex: atIx.
  			 self successful ifTrue:
  				[self fetchNextBytecode.
  				^self internalPop: 2 thenPush: result].
  			 self initPrimCall]].
  
  	messageSelector := self specialSelector: 16.
  	argumentCount := 1.
  	self normalSend!

Item was changed:
  ----- Method: StackInterpreter>>commonAt: (in category 'indexing primitive support') -----
  commonAt: stringy
  	"This code is called if the receiver responds primitively to at:.
  	 If this is so, it will be installed in the atCache so that subsequent calls of at:
  	 or next may be handled immediately in bytecode primitive routines."
  	| index rcvr atIx result |
  	self initPrimCall.
  	rcvr := self stackValue: 1.
+ 	(objectMemory isImmediate: rcvr) ifTrue:
- 	(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.
  
  	"NOTE:  The at-cache, since it is specific to the non-super response to #at:.
  	Therefore we must determine that the message is #at: (not, eg, #basicAt:),
  	and that the send is not a super-send, before using the at-cache."
  	(messageSelector = (self specialSelector: 16)
  	 and: [lkupClass = (objectMemory fetchClassOfNonImm: rcvr)])
  		ifTrue:
  		["OK -- look in the at-cache"
  		atIx := rcvr bitAnd: AtCacheMask.  "Index into atCache = 4N, for N = 0 ... 7"
  		(atCache at: atIx+AtCacheOop) = rcvr ifFalse:
  			["Rcvr not in cache.  Attempt to install it..."
  			(self install: rcvr inAtCache: atCache at: atIx string: stringy) ifFalse:
  				[self assert: (objectMemory isContextNonInt: rcvr).
  				self initPrimCall.
  				^self primitiveContextAt]].
  		self successful ifTrue:
  			[result := self commonVariable: rcvr at: index cacheIndex: atIx].
  		self successful ifTrue:
  			[^ self pop: argumentCount+1 thenPush: result]].
  
  	"The slow but sure way..."
  	self initPrimCall.
  	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 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]).
- 	self assert: ((objectMemory isIntegerObject: messageSelector) or: [objectMemory addressCouldBeObj: messageSelector]).
  	argumentArray := objectMemory eeInstantiateClass: (objectMemory splObj: ClassArray) indexableSize: argumentCount.
  	message := objectMemory eeInstantiateClass: (objectMemory splObj: ClassMessage) indexableSize: 0.
  
  	"Since the array is new can use unchecked stores."
  	(argumentCount - 1) * BytesPerWord to: 0 by: BytesPerWord negated do:
  		[:i|
+ 		self longAt:  argumentArray + objectMemory baseHeaderSize + i put: self popStack].
- 		self longAt:  argumentArray + 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.
- 	objectMemory storePointerUnchecked: MessageSelectorIndex ofObject: message withValue: messageSelector.
- 	objectMemory storePointerUnchecked: MessageArgumentsIndex ofObject: message withValue: argumentArray.
- 	objectMemory storePointerUnchecked: MessageLookupClassIndex ofObject: message withValue: lookupClass.
  
  	self push: message.
  
  	argumentCount := 1.!

Item was changed:
  ----- Method: StackInterpreter>>storeAndPopReceiverVariableBytecode (in category 'stack bytecodes') -----
  storeAndPopReceiverVariableBytecode
  	"Note: This code uses 
  	storePointerUnchecked:ofObject:withValue: and does the 
  	store check explicitely in order to help the translator 
  	produce better code."
  	| rcvr top |
  	rcvr := self receiver.
  	top := self internalStackTop.
+ 	objectMemory storePointer: (currentBytecode bitAnd: 7) ofObject: rcvr withValue: top.
- 	(self oop: rcvr isLessThan: objectMemory youngStart) ifTrue:
- 		[objectMemory possibleRootStoreInto: rcvr value: top].
- 	objectMemory storePointerUnchecked: (currentBytecode bitAnd: 7) ofObject: rcvr withValue: top.
  	self fetchNextBytecode.
  	self internalPop: 1!



More information about the Vm-dev mailing list