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

commits at source.squeak.org commits at source.squeak.org
Fri Nov 21 00:09:21 UTC 2014


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

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

Name: VMMaker.oscog-eem.947
Author: eem
Time: 20 November 2014, 4:06:51.711 pm
UUID: bfefff63-4592-4c2c-84d9-4d8753db03ba
Ancestors: VMMaker.oscog-eem.946

Add class side implementations of min/maxSmallInteger
as required for translation.
Add a first cut at the primitiveSlotAt[Put] primitives.

If asUnsignedLong needs an assert to check for
> 0 then so does asUnsignedInteger.

Spur:
Have checkForAndFollowForwardedPrimitiveState
follow other referencesin the frame if a forwarder
is found on the stack.

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

Item was changed:
  ----- Method: Integer>>asUnsignedInteger (in category '*VMMaker-interpreter simulator') -----
  asUnsignedInteger
+ 	self assert: self >= 0.
  	^self!

Item was added:
+ ----- Method: InterpreterPrimitives>>asUnsigned: (in category 'primitive support') -----
+ asUnsigned: anInteger
+ 	<inline: true>
+ 	^self cCode: [anInteger asUnsignedLong] inSmalltalk: [anInteger bitAnd: objectMemory maxSmallInteger]!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveSlotAt (in category 'object access primitives') -----
+ primitiveSlotAt
+ 	| index rcvr numSlots |
+ 	index := self stackTop.
+ 	rcvr := self stackValue: 1.
+ 	(objectMemory isIntegerObject: index) ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadArgument].
+ 	(objectMemory isImmediate: rcvr) ifTrue:
+ 		[^self primitiveFailFor: PrimErrBadReceiver].
+ 	index := objectMemory integerValueOf: index.
+ 	(objectMemory isPointersNonImm: rcvr) ifTrue:
+ 		[numSlots := objectMemory numSlotsOf: rcvr.
+ 		 (self asUnsigned: index) < numSlots ifTrue:
+ 			[self pop: argumentCount + 1 thenPush: (objectMemory fetchPointer: index ofObject: rcvr).
+ 			 ^0].
+ 		 ^self primitiveFailFor: PrimErrBadIndex].
+ 	"for now just fail for non-pointer objects; the issue here is should
+ 	 strings answer characters and if so how do we efficiently identify strings?"
+ 	^self primitiveFailFor: PrimErrBadReceiver!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveSlotAtPut (in category 'object access primitives') -----
+ primitiveSlotAtPut
+ 	| newValue index rcvr numSlots |
+ 	newValue := self stackTop.
+ 	index := self stackValue: 1.
+ 	rcvr := self stackValue: 2.
+ 	(objectMemory isIntegerObject: index) ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadArgument].
+ 	(objectMemory isImmediate: rcvr) ifTrue:
+ 		[^self primitiveFailFor: PrimErrBadReceiver].
+ 	index := objectMemory integerValueOf: index.
+ 	(objectMemory isPointersNonImm: rcvr) ifTrue:
+ 		[numSlots := objectMemory numSlotsOf: rcvr.
+ 		 (self asUnsigned: index) < numSlots ifTrue:
+ 			[objectMemory storePointer: index ofObject: rcvr withValue: newValue.
+ 			 self pop: argumentCount + 1 thenPush: newValue.
+ 			 ^0].
+ 		 ^self primitiveFailFor: PrimErrBadIndex].
+ 	"for now just fail for non-pointer objects; the issue here is should
+ 	 strings answer characters and if so how do we efficiently identify strings?"
+ 	^self primitiveFailFor: PrimErrBadReceiver!

Item was added:
+ ----- Method: ObjectMemory class>>maxSmallInteger (in category 'translation') -----
+ maxSmallInteger
+ 	^1073741823!

Item was added:
+ ----- Method: ObjectMemory class>>minSmallInteger (in category 'translation') -----
+ minSmallInteger
+ 	^-1073741824!

Item was added:
+ ----- Method: Spur32BitMemoryManager class>>maxSmallInteger (in category 'translation') -----
+ maxSmallInteger
+ 	^16r3FFFFFFF!

Item was added:
+ ----- Method: Spur32BitMemoryManager class>>minSmallInteger (in category 'translation') -----
+ minSmallInteger
+ 	^-16r40000000!

Item was added:
+ ----- Method: Spur64BitMemoryManager class>>maxSmallInteger (in category 'translation') -----
+ maxSmallInteger
+ 	^16rFFFFFFFFFFFFFFF!

Item was added:
+ ----- Method: Spur64BitMemoryManager class>>minSmallInteger (in category 'translation') -----
+ minSmallInteger
+ 	^-16r1000000000000000!

Item was added:
+ ----- Method: SpurMemoryManager>>maxSmallInteger (in category 'interpreter access') -----
+ maxSmallInteger
+ 	self subclassResponsibility!

Item was changed:
  ----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)

Item was changed:
  ----- Method: StackInterpreter>>checkForAndFollowForwardedPrimitiveState (in category 'primitive support') -----
  checkForAndFollowForwardedPrimitiveState
  	"In Spur a primitive may fail due to encountering a forwarder. On failure,
  	 check the accessorDepth for the primitive and if non-negative scan the
  	 args to the depth, following any forwarders.  Answer if any are found so
  	 the prim can be retried.  The primitive index is derived from newMethod.
  	 If the primitive is 118, then primitiveDoPrimitiveWithArgs sets newMethod
  	 to a SmallInteger whose value is the primitive it is evaluating."
  	<option: #SpurObjectMemory>
+ 	| primIndex accessorDepth found scannedStackFrame |
- 	| primIndex accessorDepth found |
  	self assert: self failed.
+ 	found := scannedStackFrame := false.
- 	found := false.
  	primIndex := (objectMemory isIntegerObject: newMethod)
  					ifTrue: [objectMemory integerValueOf: newMethod]
  					ifFalse:
  						[self assert: argumentCount = (self argumentCountOf: newMethod).
  						 self primitiveIndexOf: newMethod].
  	accessorDepth := primitiveAccessorDepthTable at: primIndex.
  	"For the method-executing primitives, failure could have been in those primitives or the
  	 primitives of the methods they execute.  Find out which failed by seeing what is in effect."
  	((primIndex = 117 and: [primitiveFunctionPointer ~~ #primitiveExternalCall])
  	 or: [primIndex = 218 and: [primitiveFunctionPointer ~~ #primitiveDoNamedPrimitiveWithArgs]])
  		ifTrue:
  			[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod]
  		ifFalse:
  			[self assert: (self saneFunctionPointerForFailureOfPrimIndex: primIndex)].
  	accessorDepth >= 0 ifTrue:
  		[0 to: argumentCount do:
  			[:index| | oop |
  			oop := self stackValue: index.
  			(objectMemory isNonImmediate: oop) ifTrue:
  				[(objectMemory isForwarded: oop) ifTrue:
  					[self assert: index < argumentCount. "receiver should have been caught at send time."
  					 found := true.
  					 oop := objectMemory followForwarded: oop.
+ 					 self stackValue: index put: oop.
+ 					 scannedStackFrame ifFalse:
+ 						[scannedStackFrame := true.
+ 						 self
+ 							followForwardedFrameContents: framePointer
+ 							stackPointer: stackPointer + (argumentCount + 1 * objectMemory wordSize) "don't repeat effort"]].
- 					 self stackValue: index put: oop].
  				((objectMemory hasPointerFields: oop)
  				 and: [objectMemory followForwardedObjectFields: oop toDepth: accessorDepth]) ifTrue:
  					[found := true]]]].
  	^found!

Item was changed:
  ----- Method: StackInterpreter>>followForwardedFrameContents:stackPointer: (in category 'lazy become') -----
  followForwardedFrameContents: theFP stackPointer: theSP
  	"follow pointers in the current stack frame up to theSP."
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
+ 	<inline: false>
  	<var: #ptr type: #'char *'>
  	theFP + (self frameStackedReceiverOffset: theFP)
  		to: theFP + FoxCallerSavedIP + objectMemory wordSize
  		by: objectMemory wordSize
  		do: [:ptr| | oop |
  			oop := stackPages longAt: ptr.
  			((objectMemory isNonImmediate: oop)
  			 and: [objectMemory isForwarded: oop]) ifTrue:
  				[stackPages longAt: ptr put: (objectMemory followForwarded: oop)]].
  	theSP
  		to: (self frameReceiverOffset: theFP)
  		by: objectMemory wordSize
  		do: [:ptr| | oop |
  			oop := stackPages longAt: ptr.
  			((objectMemory isNonImmediate: oop)
  			 and: [objectMemory isForwarded: oop]) ifTrue:
  				[stackPages longAt: ptr put: (objectMemory followForwarded: oop)]].
  	self assert: (objectMemory isForwarded: (self frameMethodObject: theFP)) not.
  	(self frameHasContext: theFP) ifTrue:
  		[self assert: (objectMemory isForwarded: (self frameContext: theFP)) not]!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveSlotAt (in category 'object access primitives') -----
+ primitiveSlotAt
+ 	| index rcvr numSlots value |
+ 	index := self stackTop.
+ 	rcvr := self stackValue: 1.
+ 	(objectMemory isIntegerObject: index) ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadArgument].
+ 	(objectMemory isImmediate: rcvr) ifTrue:
+ 		[^self primitiveFailFor: PrimErrBadReceiver].
+ 	index := objectMemory integerValueOf: index.
+ 	(objectMemory isPointersNonImm: rcvr) ifTrue:
+ 		[numSlots := objectMemory numSlotsOf: rcvr.
+ 		 (self asUnsigned: index) < numSlots ifTrue:
+ 			[(objectMemory isContextNonImm: rcvr)
+ 							ifTrue: [value := self externalInstVar: index ofContext: rcvr]
+ 							ifFalse: [value := objectMemory fetchPointer: index ofObject: rcvr].
+ 			 self pop: argumentCount + 1 thenPush: value.
+ 			 ^0].
+ 		 ^self primitiveFailFor: PrimErrBadIndex].
+ 	"for now just fail for non-pointer objects; the issue here is should
+ 	 strings answer characters and if so how do we efficiently identify strings?"
+ 	^self primitiveFailFor: PrimErrBadReceiver!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveSlotAtPut (in category 'object access primitives') -----
+ primitiveSlotAtPut
+ 	| newValue index rcvr numSlots |
+ 	newValue := self stackTop.
+ 	index := self stackValue: 1.
+ 	rcvr := self stackValue: 2.
+ 	(objectMemory isIntegerObject: index) ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadArgument].
+ 	(objectMemory isImmediate: rcvr) ifTrue:
+ 		[^self primitiveFailFor: PrimErrBadReceiver].
+ 	index := objectMemory integerValueOf: index.
+ 	(objectMemory isPointersNonImm: rcvr) ifTrue:
+ 		[numSlots := objectMemory numSlotsOf: rcvr.
+ 		 (self asUnsigned: index) < numSlots ifTrue:
+ 			[(objectMemory isContextNonImm: rcvr)
+ 				ifTrue: [self externalInstVar: index ofContext: rcvr put: newValue]
+ 				ifFalse: [objectMemory storePointer: index ofObject: rcvr withValue: newValue].
+ 			 self pop: argumentCount + 1 thenPush: newValue.
+ 			 ^0].
+ 		 ^self primitiveFailFor: PrimErrBadIndex].
+ 	"for now just fail for non-pointer objects; the issue here is should
+ 	 strings answer characters and if so how do we efficiently identify strings?"
+ 	^self primitiveFailFor: PrimErrBadReceiver!



More information about the Vm-dev mailing list