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

commits at source.squeak.org commits at source.squeak.org
Tue Jun 26 22:36:28 UTC 2012


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

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

Name: VMMaker.oscog-eem.176
Author: eem
Time: 26 June 2012, 3:33:34.126 pm
UUID: 6bd2ee1f-4fbf-4172-8f57-1b7b5d7aa05c
Ancestors: VMMaker.oscog-eem.175

Some nicer syntactic sugar for determinign instances of Array ByteString Character and Float.

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

Item was changed:
  ----- Method: StackInterpreter>>bytecodePrimSize (in category 'common selector sends') -----
  bytecodePrimSize
  	| rcvr sz isString isArray |
  	self initPrimCall.
  	rcvr := self internalStackTop.
  
  	"Shortcut the mega-lookup for ByteString and Array, the two big consumers of cycles
  	 here. Both of these have compact class indices and neither has any added fields."
+       isString := self isInstanceOfClassByteString: rcvr.
-       isString := objectMemory
- 					is: rcvr
- 					instanceOf: (objectMemory splObj: ClassString)
- 					compactClassIndex: ClassByteStringCompactIndex.
  	isString ifTrue:
  		[sz := objectMemory lengthOf: rcvr.
  		 self internalStackTopPut: (objectMemory integerObjectOf: sz).
  		^self fetchNextBytecode].
  
+       isArray := self isInstanceOfClassArray: rcvr.
-       isArray := objectMemory
- 					is: rcvr
- 					instanceOf: (objectMemory splObj: ClassArray)
- 					compactClassIndex: ClassArrayCompactIndex.
  	isArray ifTrue:
  		[sz := objectMemory lengthOf: rcvr.
  		 self internalStackTopPut: (objectMemory integerObjectOf: sz).
  		^self fetchNextBytecode].
  
  	messageSelector := self specialSelector: 18.
  	argumentCount := 0.
  	self normalSend!

Item was changed:
  ----- Method: StackInterpreter>>commonVariable:at:put:cacheIndex: (in category 'indexing primitive support') -----
  commonVariable: rcvr at: index put: value cacheIndex: atIx
  	"This code assumes the receiver has been identified at location atIx in the atCache."
+ 	| stSize fmt fixedFields valToPut isCharacter |
- 	| stSize fmt fixedFields valToPut |
  	<inline: true>
  	stSize := atCache at: atIx+AtCacheSize.
  	((self oop: index isGreaterThanOrEqualTo: 1)
  	  and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue:
  		[fmt := atCache at: atIx+AtCacheFmt.
  		fmt <= 4 ifTrue:
  			[self assert: (objectMemory isContextNonInt: rcvr) not.
  			 fixedFields := atCache at: atIx+AtCacheFixedFields.
  			 ^objectMemory storePointer: index + fixedFields - 1 ofObject: rcvr withValue: value].
  		fmt < 8 ifTrue:  "Bitmap"
  			[valToPut := self positive32BitValueOf: value.
  			self successful ifTrue: [objectMemory storeLong32: index - 1 ofObject: rcvr withValue: valToPut].
  			^nil].
  		fmt >= 16  "Note fmt >= 16 is an artificial flag for strings"
+ 			ifTrue: [isCharacter := self isInstanceOfClassCharacter: value.
+ 					isCharacter ifFalse:
- 			ifTrue: [(objectMemory
- 							is: value
- 							instanceOf: (objectMemory splObj: ClassCharacter)
- 							compactClassIndex: 0) ifFalse:
  						[^self primitiveFailFor: PrimErrBadArgument].
  					valToPut := objectMemory fetchPointer: CharacterValueIndex ofObject: value]
  			ifFalse:
  				[(fmt >= 12 and: [index < (self firstByteIndexOfMethod: rcvr)]) ifTrue: "CompiledMethod"
  					[^self primitiveFailFor: PrimErrBadIndex].
  				valToPut := value].
  		(objectMemory isIntegerObject: valToPut) ifTrue:
  			[valToPut := objectMemory integerValueOf: valToPut.
  			((valToPut >= 0) and: [valToPut <= 255]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument].
  			^objectMemory storeByte: index - 1 ofObject: rcvr withValue: valToPut]].
  
  	^self primitiveFailFor: ((objectMemory formatOf: rcvr) <= 1
  								ifTrue: [PrimErrBadReceiver]
  								ifFalse: [PrimErrBadIndex])!

Item was added:
+ ----- Method: StackInterpreter>>isInstanceOfClassArray: (in category 'primitive support') -----
+ isInstanceOfClassArray: oop
+ 	<inline: true>
+ 	^objectMemory
+ 		is: oop
+ 		instanceOf: (objectMemory splObj: ClassArray) 
+ 		compactClassIndex: ClassArrayCompactIndex!

Item was added:
+ ----- Method: StackInterpreter>>isInstanceOfClassByteString: (in category 'primitive support') -----
+ isInstanceOfClassByteString: oop
+ 	<inline: true>
+ 	^objectMemory
+ 		is: oop
+ 		instanceOf: (objectMemory splObj: ClassString) 
+ 		compactClassIndex: ClassByteStringCompactIndex!

Item was added:
+ ----- Method: StackInterpreter>>isInstanceOfClassCharacter: (in category 'primitive support') -----
+ isInstanceOfClassCharacter: oop
+ 	<inline: true>
+ 	^objectMemory
+ 		is: oop
+ 		instanceOf: (objectMemory splObj: ClassCharacter) 
+ 		compactClassIndex: 0!

Item was added:
+ ----- Method: StackInterpreter>>isInstanceOfClassFloat: (in category 'primitive support') -----
+ isInstanceOfClassFloat: oop
+ 	<inline: true>
+ 	^objectMemory
+ 		is: oop
+ 		instanceOf: (objectMemory splObj: ClassFloat) 
+ 		compactClassIndex: ClassFloatCompactIndex!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveDoNamedPrimitiveWithArgs (in category 'plugin primitives') -----
  primitiveDoNamedPrimitiveWithArgs
  	"Simulate an primitiveExternalCall invocation (e.g. for the Debugger).  Do not cache anything.
  	 e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments"
  	| argumentArray arraySize methodArg methodHeader
  	  moduleName functionName moduleLength functionLength
  	  spec addr primRcvr ctxtRcvr isArray |
  	<var: #addr declareC: 'void (*addr)()'>
  	argumentArray := self stackTop.
  	(objectMemory isArray: argumentArray) ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  	arraySize := objectMemory fetchWordLengthOf: argumentArray.
  	self success: (self roomToPushNArgs: arraySize).
  
  	methodArg := self stackObjectValue: 2.
  	self successful ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  
  	(objectMemory isOopCompiledMethod: methodArg) ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  
  	methodHeader := self headerOf: methodArg.
  
  	(self literalCountOfHeader: methodHeader) > 2 ifFalse:
  		[^self primitiveFailFor: -3]. "invalid methodArg state"
+ 	spec := objectMemory fetchPointer: 1 "first literal" ofObject: methodArg.
+ 	isArray := self isInstanceOfClassArray: spec.
- 	isArray := objectMemory
- 					is: (spec := objectMemory fetchPointer: 1 "first literal" ofObject: methodArg)
- 					instanceOf: (objectMemory splObj: ClassArray) 
- 					compactClassIndex: ClassArrayCompactIndex.
  	(isArray
  	and: [(objectMemory lengthOf: spec) = 4
  	and: [(self primitiveIndexOfMethodHeader: methodHeader) = 117]]) ifFalse:
  		[^self primitiveFailFor: -3]. "invalid methodArg state"
  
  	(self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args (Array args wrong size)"
  
  	"The function has not been loaded yet. Fetch module and function name."
  	moduleName := objectMemory fetchPointer: 0 ofObject: spec.
  	moduleName = objectMemory nilObject
  		ifTrue: [moduleLength := 0]
  		ifFalse: [self success: (objectMemory isBytes: moduleName).
  				moduleLength := objectMemory lengthOf: moduleName.
  				self cCode: '' inSmalltalk:
  					[ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName)) "??"
  						ifTrue: [moduleLength := 0  "Cause all of these to fail"]]].
  	functionName := objectMemory fetchPointer: 1 ofObject: spec.
  	self success: (objectMemory isBytes: functionName).
  	functionLength := objectMemory lengthOf: functionName.
  	self successful ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state"
  
  	addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
  				OfLength: functionLength
  				FromModule: moduleName + BaseHeaderSize
  				OfLength: moduleLength.
  	addr = 0 ifTrue:
  		[^self primitiveFailFor: -1]. "could not find function; answer generic failure (see below)"
  
  	"Cannot fail this primitive from now on.  Can only fail the external primitive."
  	objectMemory pushRemappableOop: (argumentArray := self popStack).
  	objectMemory pushRemappableOop: (primRcvr := self popStack).
  	objectMemory pushRemappableOop: self popStack. "the method"
  	objectMemory pushRemappableOop: self popStack. "the context receiver"
  	self push: primRcvr. "replace context receiver with actual receiver"
  	argumentCount := arraySize.
  	1 to: arraySize do:
  		[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
  	"Run the primitive (sets primFailCode)"
  	lkupClass := objectMemory nilObject.
  	self callExternalPrimitive: addr.
  	ctxtRcvr  := objectMemory popRemappableOop.
  	methodArg := objectMemory popRemappableOop.
  	primRcvr := objectMemory popRemappableOop.
  	argumentArray := objectMemory popRemappableOop.
  	self successful ifFalse: "If primitive failed, then restore state for failure code"
  		[self pop: arraySize + 1.
  		 self push: ctxtRcvr.
  		 self push: methodArg.
  		 self push: primRcvr.
  		 self push: argumentArray.
  		 argumentCount := 3.
  		 "Hack.  A nil prim error code (primErrorCode = 1) is interpreted by the image
  		  as meaning this primitive is not implemented.  So to pass back nil as an error
  		  code we use -1 to indicate generic failure."
  		 primFailCode = 1 ifTrue:
  			[primFailCode := -1]]!



More information about the Vm-dev mailing list