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

commits at source.squeak.org commits at source.squeak.org
Thu Sep 12 05:39:03 UTC 2013


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

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

Name: VMMaker.oscog-eem.374
Author: eem
Time: 11 September 2013, 10:34:21.315 pm
UUID: e7f877e9-5f76-41da-85e9-872da59c1a2e
Ancestors: VMMaker.oscog-eem.373

Implement enterIntoClassTable:.
Rewrite commonVariable:at:put:cacheIndex: to be efficient with
immediate characters.
Sdd printing of hash to longPrintOop:.

I notice that
	'hello' copy at: 1 put: (Character value: 256); yourself
hash disastrous effects.

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

Item was added:
+ ----- Method: NewObjectMemory>>rawHashBitsOf: (in category 'header access') -----
+ rawHashBitsOf: objOop
+ 	"Compatibility with Spur."
+ 	^self hashBitsOf: objOop!

Item was changed:
  ----- Method: SpurMemoryManager>>enterIntoClassTable: (in category 'class table') -----
  enterIntoClassTable: aBehavior
  	"Enter aBehavior into the class table and answer 0.  Otherwise answer a primitive failure code."
+ 	| initialMajorIndex majorIndex minorIndex page |
+ 	majorIndex := classTableIndex >> self classTableMajorIndexShift.
+ 	initialMajorIndex := majorIndex.
+ 	"classTableIndex should never index the first page; it's reserved for known classes"
+ 	self assert: initialMajorIndex > 0.
+ 	minorIndex := classTableIndex bitAnd: self classTableMinorIndexMask.
+ 
+ 	[page := self fetchPointer: majorIndex ofObject: classTableRootObj.
+ 	 page = nilObj ifTrue:
+ 		[page := self allocateSlots: self classTablePageSize
+ 					format: self arrayFormat
+ 					classIndex: self arrayClassIndexPun.
+ 		 page ifNil:
+ 			[^PrimErrNoMemory].
+ 		 self storePointer: majorIndex
+ 			ofObject: classTableRootObj
+ 			withValue: page.
+ 		 minorIndex := 0].
+ 	 minorIndex to: self classTablePageSize - 1 do:
+ 		[:i|
+ 		(self fetchPointer: i ofObject: page) = nilObj ifTrue:
+ 			[classTableIndex := majorIndex << self classTableMajorIndexShift + i.
+ 			 self storePointer: i
+ 				ofObject: page
+ 				withValue: aBehavior.
+ 			 self setHashBitsOf: aBehavior to: classTableIndex.
+ 			 self assert: (self classAtIndex: (self rawHashBitsOf: aBehavior)) = aBehavior.
+ 			 ^0]].
+ 	 majorIndex := (majorIndex + 1 bitAnd: self classIndexMask) max: 1.
+ 	 majorIndex = initialMajorIndex ifTrue: "wrapped; table full"
+ 		[^PrimErrLimitExceeded]] repeat!
- 	self shouldBeImplemented!

Item was changed:
  ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
  isIntegerObject: oop
  	"This list records the valid senders of isIntegerObject: as we replace uses of
  	  isIntegerObject: by isImmediate: where appropriate."
  	(#(	makeBaseFrameFor:
  		quickFetchInteger:ofObject:
  		frameOfMarriedContext:
  		addressCouldBeClassObj:
  		isMarriedOrWidowedContext:
  		shortPrint:
  		bytecodePrimAt
  		commonAt:
  		loadFloatOrIntFrom:
  		positive32BitValueOf:
  		primitiveExternalCall
  		checkedIntegerValueOf:
  		bytecodePrimAtPut
  		commonAtPut:
  		primitiveVMParameter
  		checkIsStillMarriedContext:currentFP:
  		displayBitsOf:Left:Top:Right:Bottom:
+ 		fetchStackPointerOf:
+ 		primitiveContextAt
+ 		primitiveContextAtPut) includes: thisContext sender method selector) ifFalse:
- 		fetchStackPointerOf:) includes: thisContext sender method selector) ifFalse:
  		[self halt].
  	^(oop bitAnd: 1) ~= 0!

Item was changed:
  ----- Method: SpurMemoryManager>>printHeaderTypeOf: (in category 'debug printing') -----
  printHeaderTypeOf: objOop
  	coInterpreter print: ((self numSlotsOf: objOop) >= self numSlotsMask
+ 							ifTrue: [' 8 byte header']
+ 							ifFalse: [' 16 byte header'])!
- 							ifTrue: ['8 byte header']
- 							ifFalse: ['16 byte header'])!

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 |
  	<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 <= objectMemory weakArrayFormat ifTrue:
  			[self assert: (objectMemory isContextNonImm: rcvr) not.
  			 fixedFields := atCache at: atIx+AtCacheFixedFields.
  			 ^objectMemory storePointer: index + fixedFields - 1 ofObject: rcvr withValue: value].
  		fmt < objectMemory firstByteFormat ifTrue:  "Bitmap"
  			[valToPut := self positive32BitValueOf: value.
  			 self successful ifTrue:
  				[objectMemory storeLong32: index - 1 ofObject: rcvr withValue: valToPut.
  				^nil].
  			 ^self primitiveFailFor: PrimErrBadArgument].
  		fmt >= objectMemory firstStringyFakeFormat  "Note fmt >= firstStringyFormat is an artificial flag for strings"
  			ifTrue: [isCharacter := objectMemory isCharacterObject: value.
  					isCharacter ifFalse:
  						[^self primitiveFailFor: PrimErrBadArgument].
+ 					objectMemory hasSpurMemoryManagerAPI
+ 						ifTrue: [valToPut := objectMemory characterValueOf: value]
+ 						ifFalse:
+ 							[valToPut := objectMemory fetchPointer: CharacterValueIndex ofObject: value.
+ 							 valToPut := (objectMemory isIntegerObject: valToPut)
+ 											ifTrue: [objectMemory integerValueOf: valToPut]
+ 											ifFalse: [-1]]]
- 					valToPut := objectMemory fetchPointer: CharacterValueIndex ofObject: value]
  			ifFalse:
+ 				[(fmt >= objectMemory firstCompiledMethodFormat
+ 				  and: [index < (self firstByteIndexOfMethod: rcvr)]) ifTrue:
- 				[(fmt >= objectMemory firstCompiledMethodFormat and: [index < (self firstByteIndexOfMethod: rcvr)]) ifTrue: "CompiledMethod"
  					[^self primitiveFailFor: PrimErrBadIndex].
+ 				valToPut := (objectMemory isIntegerObject: value)
+ 								ifTrue: [objectMemory integerValueOf: value]
+ 								ifFalse: [-1]].
+ 		((valToPut >= 0) and: [valToPut <= 255]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument].
+ 		^objectMemory storeByte: index - 1 ofObject: rcvr withValue: valToPut].
- 				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 isIndexable: rcvr)
  								ifFalse: [PrimErrBadReceiver]
  								ifTrue: [PrimErrBadIndex])!

Item was changed:
  ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
  longPrintOop: oop
  	<api>
  	| class fmt lastIndex startIP bytecodesPerLine column |
  	((objectMemory isImmediate: oop)
  	 or: [(objectMemory addressCouldBeObj: oop) not
  	 or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  	 or: [(objectMemory isFreeObject: oop)
  	 or: [objectMemory isForwarded: oop]]]]) ifTrue:
  		[^self printOop: oop].
  	class := objectMemory fetchClassOfNonImm: oop.
  	self printHex: oop;
  		print: ': a(n) '; printNameOfClass: class count: 5;
  		print: ' ('; printHex: class; print: ')'.
  	fmt := objectMemory formatOf: oop.
  	fmt > objectMemory lastPointerFormat ifTrue:
  		[self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)].
  	objectMemory printHeaderTypeOf: oop.
+ 	self print: ' hash '; printHex: (objectMemory rawHashBitsOf: oop).
  	self cr.
  	(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
  		[^self].
  	"this is nonsense.  apologies."
  	startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop.
  	lastIndex := 256 min: startIP.
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:i| | fieldOop |
  			fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop.
  			self space; printNum: i - 1; space; printHex: fieldOop; space.
  			(i = 1 and: [objectMemory isCompiledMethod: oop])
  				ifTrue: [self printMethodHeaderOop: fieldOop]
  				ifFalse: [self printOopShort: fieldOop].
  			self cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > 64 ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := startIP * BytesPerWord + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 100 ifTrue:
  				[lastIndex := startIP + 100].
  			 bytecodesPerLine := 8.
  			 column := 1.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				column = 1 ifTrue:
  					[self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)'
  						inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']].
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				self cCode: 'printf(" %02x/%-3d", byte,byte)'
  					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
  				column := column + 1.
  				column > bytecodesPerLine ifTrue:
  					[column := 1. self cr]].
  			column = 1 ifFalse:
  				[self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>superclassSend (in category 'send bytecodes') -----
  superclassSend
  	"Send a message to self, starting lookup with the superclass of the class
  	 containing the currently executing method."
  	"Assume: messageSelector and argumentCount have been set, and that
  	 the receiver and arguments have been pushed onto the stack,"
  	"Note: This method is inlined into the interpreter dispatch loop."
  	<sharedCodeNamed: 'commonSupersend' inCase: #singleExtendedSuperBytecode>
+ 	| superclass |
+ 	superclass := self superclassOf: (self methodClassOf: method).
+ 	objectMemory ensureBehaviorHash: superclass.
+ 	lkupClassTag := objectMemory classTagForClass: superclass.
- 	lkupClassTag := objectMemory classTagForClass: (self superclassOf: (self methodClassOf: method)).
  	self assert: lkupClassTag ~= objectMemory nilObject.
  	self commonSend!



More information about the Vm-dev mailing list