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

commits at source.squeak.org commits at source.squeak.org
Fri Feb 7 19:10:44 UTC 2014


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

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

Name: VMMaker.oscog-eem.612
Author: eem
Time: 7 February 2014, 11:07:27.365 am
UUID: 54335642-7834-48fb-936d-b567fb9857b3
Ancestors: VMMaker.oscog-eem.611

Fix the at cache for wide strings in Spur given that Spur supports
the String at:[put:] primitives on WideString.

Fix isWordsOrBytesNonImm: to answer false for forwarders.
Fix fixedFieldsOf:format:length: to fall through to an assert fail for
forwarders.

Prettify the primitiveAccessorDepthTable literal so I can see what's
what.

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

Item was changed:
  ----- Method: CCodeGenerator>>arrayInitializerCalled:for:sizeString:type: (in category 'utilities') -----
  arrayInitializerCalled: varName for: array sizeString: sizeStringOrNil type: cType
  	"array is a literal array or a CArray on some array."
- 	| sequence lastLine |
- 	sequence := array isCollection ifTrue: [array] ifFalse: [array object].
- 	lastLine := 0.
  	^String streamContents:
+ 		[:s| | sequence lastLine index newLine allIntegers |
+ 		sequence := array isCollection ifTrue: [array] ifFalse: [array object].
+ 		"this is to align -ve and +ve integers nicely in the primitiveAccessorDepthTable"
+ 		allIntegers := sequence allSatisfy: [:element| element isInteger].
+ 		lastLine := index := 0.
+ 		newLine := [sequence size >= 20
+ 						ifTrue: [s cr; nextPutAll: '/*'; print: index; nextPutAll: '*/'; tab]
+ 						ifFalse: [s crtab: 2].
+ 					 lastLine := s position].
- 		[:s|
  		s	nextPutAll: cType;
  			space;
  			nextPutAll: varName;
  			nextPut: $[.
  		sizeStringOrNil ifNotNil: [s nextPutAll: sizeStringOrNil].
  		s nextPutAll: '] = '.
  		sequence isString
  			ifTrue: [s nextPutAll: (self cLiteralFor: sequence)]
  			ifFalse:
+ 				[s nextPut: ${.
+ 				 newLine value.
+ 				 sequence
+ 					do: [:element|
+ 						(allIntegers
+ 						 and: [element < 0
+ 						 and: [s peekLast = Character space]]) ifTrue:
+ 							[s skip: -1].
+ 						s nextPutAll: (self cLiteralFor: element). index := index + 1]
- 				[s nextPut: ${; crtab: 2.
- 				sequence
- 					do: [:element| s nextPutAll: (self cLiteralFor: element)]
  					separatedBy:
  						[s nextPut: $,.
+ 						 ((s position - lastLine) >= 76
+ 						 or: [(index \\ 20) = 0])
+ 							ifTrue: [newLine value]
- 						 (s position - lastLine) > 76
- 							ifTrue: [s crtab: 2. lastLine := s position]
  							ifFalse: [s space]].
+ 				 s crtab; nextPut: $}]]!
- 				s crtab; nextPut: $}]]!

Item was changed:
  ----- Method: SpurMemoryManager>>fixedFieldsOf:format:length: (in category 'object format') -----
  fixedFieldsOf: objOop format: fmt length: wordLength
  	| class |
  	<inline: true>
  	<asmLabel: false>
+ 	"N.B. written to fall through to fetchClassOfNonImm: et al for forwarders
+ 	 so as to trigger an assert fail."
+ 	(fmt >= self sixtyFourBitIndexableFormat or: [fmt = self arrayFormat]) ifTrue:
+ 		[^0].  "indexable fields only"
+ 	fmt < self arrayFormat ifTrue:
+ 		[^wordLength].  "fixed fields only (zero or more)"
- 	(fmt > self lastPointerFormat or: [fmt = 2]) ifTrue: [^0].  "indexable fields only"
- 	fmt < 2 ifTrue: [^wordLength].  "fixed fields only (zero or more)"
  	class := self fetchClassOfNonImm: objOop.
  	^self fixedFieldsOfClassFormat: (self formatOfClass: class)!

Item was changed:
  ----- Method: SpurMemoryManager>>isWordsOrBytesNonImm: (in category 'object testing') -----
  isWordsOrBytesNonImm: objOop
+ 	^(self formatOf: objOop) >= self sixtyFourBitIndexableFormat!
- 	^(self formatOf: objOop) > self lastPointerFormat!

Item was added:
+ ----- Method: SpurMemoryManager>>primitiveFailFor: (in category 'simulation only') -----
+ primitiveFailFor: reasonCode
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter primitiveFailFor: reasonCode!

Item was changed:
  ----- Method: StackInterpreter>>commonVariable:at:cacheIndex: (in category 'indexing primitive support') -----
  commonVariable: rcvr at: index cacheIndex: atIx 
  	"This code assumes the receiver has been identified at location atIx in the atCache."
  	| stSize fmt fixedFields result |
  	<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 fetchPointer: index + fixedFields - 1 ofObject: rcvr].
  		 fmt < objectMemory firstByteFormat ifTrue:  "Bitmap"
  			[result := objectMemory fetchLong32: index - 1 ofObject: rcvr.
  			 ^self positive32BitIntegerFor: result].
  		 fmt >= objectMemory firstStringyFakeFormat  "Note fmt >= firstStringyFormat is an artificial flag for strings"
  			ifTrue: "String"
+ 				["Spur supports the String at:[put:] primitives on WideString"
+ 				 result := (objectMemory hasSpurMemoryManagerAPI
+ 							and: [fmt - objectMemory firstStringyFakeFormat < objectMemory firstByteFormat])
+ 								ifTrue: [objectMemory fetchLong32: index - 1 ofObject: rcvr]
+ 								ifFalse: [objectMemory fetchByte: index - 1 ofObject: rcvr].
+ 				^self characterForAscii: result]
- 				[^self characterForAscii: (objectMemory fetchByte: index - 1 ofObject: rcvr)]
  			ifFalse:
  				[(fmt < objectMemory firstCompiledMethodFormat "ByteArray"
  				  or: [index >= (self firstByteIndexOfMethod: rcvr) "CompiledMethod"]) ifTrue:
  					[^objectMemory integerObjectOf: (objectMemory fetchByte: index - 1 ofObject: rcvr)]]].
  
  	^self primitiveFailFor: ((objectMemory isIndexable: rcvr)
  								ifFalse: [PrimErrBadReceiver]
  								ifTrue: [PrimErrBadIndex])!

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].
- 				[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]].
+ 				 (objectMemory hasSpurMemoryManagerAPI
+ 				  and: [fmt - objectMemory firstStringyFakeFormat < objectMemory firstByteFormat]) ifTrue:
+ 					[^objectMemory storeLong32: index - 1 ofObject: rcvr withValue: valToPut]]
- 										ifFalse: [-1]]]
  			ifFalse:
  				[(fmt >= objectMemory firstCompiledMethodFormat
  				  and: [index < (self firstByteIndexOfMethod: rcvr)]) ifTrue:
  					[^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].
  
  	^self primitiveFailFor: ((objectMemory isIndexable: rcvr)
  								ifFalse: [PrimErrBadReceiver]
  								ifTrue: [PrimErrBadIndex])!

Item was added:
+ ----- Method: StackInterpreterSimulator>>bytecodePrimAtPut (in category 'indexing primitives') -----
+ bytecodePrimAtPut
+ 	"self halt."
+ 	^super bytecodePrimAtPut!



More information about the Vm-dev mailing list