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

commits at source.squeak.org commits at source.squeak.org
Fri Nov 1 21:08:49 UTC 2013


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

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

Name: VMMaker.oscog-eem.490
Author: eem
Time: 1 November 2013, 11:06:19.76 am
UUID: 7355becb-538e-4ed9-b13e-adc433688443
Ancestors: VMMaker.oscog-eem.489

Remember to free untraced stack pages after the mark phase.

Include flag bits in SpurMemMgr>>printHeaderTypeOf:.
Fix longPrintOop: to print string contents.

Fix return type conflicts in commonAt: et al.

Fix printActivationNameFor:receiver:isBlock:firstTemporary: for
no method class (which can be reported as nilObj), and nuke unused
printActivationNameForMethod:startClass:isBlock:firstTemporary:.

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

Item was changed:
  ----- Method: CCodeGenerator>>localizeGlobalVariables (in category 'utilities') -----
  localizeGlobalVariables
+ 	| candidates elected localized |
- 	| candidates elected |
  
  	"find all globals used in only one method"
  	candidates := globalVariableUsage select: [:e | e size = 1].
  	(candidates keys select: [:k| vmClass mustBeGlobal: k]) do:
  		[:k| candidates removeKey: k].
  	elected := Set new.
+ 	localized := Dictionary new. "for an ordered report"
- 
  	"move any suitable global to be local to the single method using it"
  	candidates keysAndValuesDo:
  		[:key :targets |
  		targets do:
  			[:name | | procedure newDeclaration |
  			procedure := methods at: name.
  			procedure isRealMethod ifTrue:
+ 				[(localized at: name ifAbsentPut: [SortedCollection new]) add: key.
- 				[logger notNil ifTrue:
- 					[logger ensureCr; show: key, ' localised to ', name; cr].
  				elected add: (procedure locals add: key).
  				newDeclaration := variableDeclarations at: key ifAbsent: ['sqInt ', key].
+ 				(self initializerForInstVar: key inStartClass: procedure definingClass) ifNotNil:
- 				(self initializerForInstVar: key inStartClass: (methods at: name) definingClass) ifNotNil:
  					[:initializerNode|
  					newDeclaration := String streamContents:
  											[:s|
  											 s nextPutAll: newDeclaration; nextPutAll: ' = '.
  											 initializerNode emitCCodeOn: s level: 0 generator: self]].
  				procedure declarationAt: key put: newDeclaration.
  				variableDeclarations removeKey: key ifAbsent: []]]].
+ 	logger ifNotNil:
+ 		[localized keys asSortedCollection do:
+ 			[:name|
+ 			(localized at: name) do:
+ 				[:var|
+ 				logger ensureCr; show: var, ' localised to ', name; cr]]].
  	elected do: [:ea| (variables includes: ea) ifTrue: [self checkDeleteVariable: ea]].
  	variables removeAllFoundIn: elected!

Item was changed:
  ----- Method: SpurMemoryManager>>markWeaklingsAndMarkAndFireEphemerons (in category 'gc - global') -----
  markWeaklingsAndMarkAndFireEphemerons
  	"After the initial scan-mark is complete ephemerons can be processed.
  	 Weaklings have accumulated on the weaklingStack, but more may be
  	 uncovered during ephemeron processing.  So trace the strong slots
  	 of the weaklings, and as ephemerons are processed ensure any newly
  	 reached weaklings are also traced."
  	| numTracedWeaklings |
  	<inline: false>
  	numTracedWeaklings := 0.
  	[coInterpreter markAndTraceUntracedReachableStackPages.
  	 numTracedWeaklings := self markAndTraceWeaklingsFrom: numTracedWeaklings.
  	 self noUnscannedEphemerons ifTrue:
+ 		[coInterpreter
+ 			markAndTraceUntracedReachableStackPages;
+ 			freeUntracedStackPages.
+ 		 ^self].
- 		[^self].
  	 self markInactiveEphemerons ifFalse:
  		[self fireAllUnscannedEphemerons].
  	 self markAllUnscannedEphemerons]
  		repeat!

Item was changed:
  ----- Method: SpurMemoryManager>>printHeaderTypeOf: (in category 'debug printing') -----
  printHeaderTypeOf: objOop
+ 	coInterpreter
+ 		print: ((self numSlotsOf: objOop) >= self numSlotsMask
+ 					ifTrue: [' hdr16 ']
+ 					ifFalse: [' hdr8 ']);
+ 		printChar: ((self isImmutable: objOop) ifTrue: [$i] ifFalse: [$.]);
+ 		printChar: ((self isRemembered: objOop) ifTrue: [$r] ifFalse: [$.]);
+ 		printChar: ((self isPinned: objOop) ifTrue: [$p] ifFalse: [$.]);
+ 		printChar: ((self isMarked: objOop) ifTrue: [$m] ifFalse: [$.]);
+ 		printChar: ((self isGrey: objOop) ifTrue: [$g] ifFalse: [$.])!
- 	coInterpreter print: ((self numSlotsOf: objOop) >= self numSlotsMask
- 							ifTrue: [' 16 byte header']
- 							ifFalse: [' 8 byte header'])!

Item was changed:
  ----- Method: StackInterpreter>>commonAt: (in category 'indexing primitive support') -----
  commonAt: stringy
  	"This code is called if the receiver responds primitively to at:.
  	 N.B. this does *not* use the at cache, instead inlining stObject:at:.
  	 Using the at cache here would require that callers set messageSelector
  	 and lkupClass and that is onerous and error-prone, and in any case,
  	 inlining produces much better performance than using the at cache here."
  	| index rcvr result |
  	<inline: true> "to get it inlined in primitiveAt and primitiveStringAt"
  	self initPrimCall.
  	rcvr := self stackValue: 1.
  	(objectMemory isImmediate: rcvr) ifTrue:
  		[^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.
  	result := self stObject: rcvr at: index.
  	self successful ifTrue:
  		[stringy ifTrue: [result := self characterForAscii: (objectMemory integerValueOf: result)].
+ 		 self pop: argumentCount+1 thenPush: result]!
- 		^self pop: argumentCount+1 thenPush: result]!

Item was changed:
  ----- Method: StackInterpreter>>commonAtPut: (in category 'indexing primitive support') -----
  commonAtPut: stringy
  	"This code is called if the receiver responds primitively to at:Put:.
  	 N.B. this does *not* use the at cache, instead inlining stObject:at:put:.
  	 Using the at cache here would require that callers set messageSelector
  	 and lkupClass and that is onerous and error-prone, and in any case,
  	 inlining produces much better performance than using the at cache here."
  	| value index rcvr |
  	<inline: true> "to get it inlined in primitiveAtPut and primitiveStringAtPut"
  	value := self stackTop.
  	self initPrimCall.
  	rcvr := self stackValue: 2.
  	(objectMemory isNonImmediate: rcvr) ifFalse:
  		[^self primitiveFailFor: PrimErrInappropriate].
  	index := self stackValue: 1.
  	"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.
  	stringy
  		ifTrue: [self stObject: rcvr at: index put: (self asciiOfCharacter: value)]
  		ifFalse: [self stObject: rcvr at: index put: value].
  	self successful ifTrue:
+ 		[self pop: argumentCount+1 thenPush: value]!
- 		[^self pop: argumentCount+1 thenPush: value]!

Item was changed:
  ----- Method: StackInterpreter>>commonCallerReturn (in category 'return bytecodes') -----
  commonCallerReturn
  	"Return to the previous context/frame (sender for method activations, caller for block activations)."
  	<sharedCodeNamed: 'commonCallerReturn' inCase: #returnTopFromBlock>
  	| callersFPOrNull |
  	<var: #callersFPOrNull type: #'char *'>
  
  	callersFPOrNull := self frameCallerFP: localFP.
  	callersFPOrNull == 0 "baseFrame" ifTrue:
  		[self assert: localFP = stackPage baseFP.
  		 ^self baseFrameReturn].
  
  	localIP := self frameCallerSavedIP: localFP.
  	localSP := localFP + (self frameStackedReceiverOffset: localFP).
  	localFP := callersFPOrNull.
  	self setMethod: (self frameMethod: localFP).
  	self fetchNextBytecode.
+ 	self internalStackTopPut: localReturnValue!
- 	^self internalStackTopPut: localReturnValue!

Item was changed:
  ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
  longPrintOop: oop
  	<api>
  	| 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.
  		 ^self].
  	self printHex: oop.
  	(objectMemory fetchClassOfNonImm: oop)
  		ifNil: [self print: ' has a nil class!!!!']
  		ifNotNil: [:class|
  			self print: ': a(n) '; printNameOfClass: class count: 5;
  				print: ' ('; printHex: class; print: ')'].
  	fmt := objectMemory formatOf: oop.
  	self print: ' format '; printHexnp: fmt.
  	fmt > objectMemory lastPointerFormat
  		ifTrue: [self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)]
  		ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue:
  					[| len |
  					len := objectMemory lengthOf: oop.
  					self print: ' size '; printNum: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]].
  	objectMemory printHeaderTypeOf: oop.
  	self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop).
  	self cr.
+ 	(fmt between: objectMemory firstByteFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
+ 		[^self printStringOf: oop; cr].
+ 	(fmt between: objectMemory firstLongFormat and: objectMemory firstByteFormat - 1) ifTrue:
- 	(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 cCode: [self printOopShort: fieldOop]
  							inSmalltalk: [self print: (self shortPrint: 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>>primitiveEventProcessingControl (in category 'I/O primitives') -----
  primitiveEventProcessingControl
  	"With 0 args answers whether ioProcessEvents is enabled and being called.
  	 With 1 arg expects a boolean which will enable ioProcessEvents if true and
  	 disable it if false, answering its previous state."
  	<export: true>
  	| enabled |
  	enabled := inIOProcessEvents >= 0.
  	argumentCount = 0 ifTrue:
  		[^self pop: 1 thenPushBool: enabled].
  	argumentCount = 1 ifTrue:
  		[self stackTop = objectMemory trueObject
  			ifTrue: [inIOProcessEvents < 0 ifTrue:
  					[inIOProcessEvents := 0]]
  			ifFalse:
  				[self stackTop = objectMemory falseObject
  					ifTrue: [inIOProcessEvents := -1]
+ 					ifFalse: [self primitiveFailFor: PrimErrBadArgument.
+ 							^self]].
- 					ifFalse: [^self primitiveFailFor: PrimErrBadArgument]].
  		 ^self pop: 2 thenPushBool: enabled].
  	self primitiveFailFor: PrimErrBadNumArgs!

Item was changed:
  ----- Method: StackInterpreter>>printActivationNameFor:receiver:isBlock:firstTemporary: (in category 'debug printing') -----
  printActivationNameFor: aMethod receiver: anObject isBlock: isBlock firstTemporary: maybeMessage
  	| methClass methodSel classObj |
  	<inline: false>
  	isBlock ifTrue:
  		[self print: '[] in '].
  	methClass := self findClassOfMethod: aMethod forReceiver: anObject.
  	methodSel := self findSelectorOfMethod: aMethod.
  	((objectMemory addressCouldBeOop: anObject)
  	 and: [(objectMemory isOopForwarded: anObject) not
  	 and: [self addressCouldBeClassObj: (classObj := objectMemory fetchClassOf: anObject)]])
  		ifTrue:
+ 			[(classObj = methClass or: [methClass isNil or: [methClass = objectMemory nilObject] "i.e. doits"])
- 			[(classObj = methClass or: [methClass isNil "i.e. doits"])
  				ifTrue: [self printNameOfClass: classObj count: 5]
  				ifFalse:
  					[self printNameOfClass: classObj count: 5.
  					 self print: '('.
  					 self printNameOfClass: methClass count: 5.
  					 self print: ')']]
  		ifFalse:
  			[self cCode: '' inSmalltalk: [self halt].
  			 self print: 'INVALID RECEIVER'].
  	self print: '>'.
  	(objectMemory addressCouldBeOop: methodSel)
  		ifTrue:
  			[methodSel = objectMemory nilObject
+ 				ifTrue: [self print: '(nil)']
- 				ifTrue: [self print: '?']
  				ifFalse: [self printStringOf: methodSel]]
  		ifFalse: [self print: 'INVALID SELECTOR'].
  	(methodSel = (objectMemory splObj: SelectorDoesNotUnderstand)
  	and: [(objectMemory addressCouldBeObj: maybeMessage)
  	and: [(objectMemory fetchClassOfNonImm: maybeMessage) = (objectMemory splObj: ClassMessage)]]) ifTrue:
  		["print arg message selector"
  		methodSel := objectMemory fetchPointer: MessageSelectorIndex ofObject: maybeMessage.
  		self print: ' '.
  		self printStringOf: methodSel]!

Item was removed:
- ----- Method: StackInterpreter>>printActivationNameForMethod:startClass:isBlock:firstTemporary: (in category 'debug printing') -----
- printActivationNameForMethod: aMethod startClass: startClass isBlock: isBlock firstTemporary: maybeMessage
- 	| methClass methodSel |
- 	<inline: false>
- 	isBlock ifTrue:
- 		[self print: '[] in '].
- 	self findSelectorAndClassForMethod: aMethod
- 		lookupClass: startClass
- 		do: [:sel :class|
- 			methodSel := sel.
- 			methClass := class].
- 	((self addressCouldBeOop: startClass) and: [methClass notNil])
- 		ifTrue:
- 			[startClass = methClass
- 				ifTrue: [self printNameOfClass: methClass count: 5]
- 				ifFalse:
- 					[self printNameOfClass: startClass count: 5.
- 					 self printChar: $(.
- 					 self printNameOfClass: methClass count: 5.
- 					 self printChar: $)]]
- 		ifFalse: [self print: 'INVALID CLASS'].
- 	self printChar: $>.
- 	(objectMemory addressCouldBeOop: methodSel)
- 		ifTrue:
- 			[(objectMemory isBytes: methodSel)
- 				ifTrue: [self printStringOf: methodSel]
- 				ifFalse: [self printOopShort: methodSel]]
- 		ifFalse: [self print: 'INVALID SELECTOR'].
- 	(methodSel = (objectMemory splObj: SelectorDoesNotUnderstand)
- 	and: [(objectMemory addressCouldBeObj: maybeMessage)
- 	and: [(objectMemory fetchClassOfNonImm: maybeMessage) = (objectMemory splObj: ClassMessage)]]) ifTrue:
- 		["print arg message selector"
- 		methodSel := objectMemory fetchPointer: MessageSelectorIndex ofObject: maybeMessage.
- 		self print: ' '.
- 		self printStringOf: methodSel]!



More information about the Vm-dev mailing list