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

commits at source.squeak.org commits at source.squeak.org
Fri Dec 20 19:13:41 UTC 2013


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

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

Name: VMMaker.oscog-eem.565
Author: eem
Time: 20 December 2013, 11:10:35.058 am
UUID: aa89a317-26e5-404d-aaff-e2433a344379
Ancestors: VMMaker.oscog-eem.564

Rescue the Stack VM by refactoring the snapshot bereavement code
to be CoInterpreter-agnostic.  Give CoInterpreter its own method
cache print routine for the same reason.

Change some mistaken uses of methodLabel in the Cogit to backEnd.

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

Item was added:
+ ----- Method: CoInterpreter>>printMethodCacheFor: (in category 'debug printing') -----
+ printMethodCacheFor: thing
+ 	<api>
+ 	0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do:
+ 		[:i | | s c m p |
+ 		s := methodCache at: i + MethodCacheSelector.
+ 		c := methodCache at: i + MethodCacheClass.
+ 		m := methodCache at: i + MethodCacheMethod.
+ 		p := methodCache at: i + MethodCachePrimFunction.
+ 		((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing
+ 			or: [(objectMemory addressCouldBeObj: m)
+ 				and: [(self maybeMethodHasCogMethod: m)
+ 				and: [(self cogMethodOf: m) asInteger = thing]]]]]]])
+ 		 and: [(objectMemory addressCouldBeOop: s)
+ 		 and: [c ~= 0
+ 		 and: [(self addressCouldBeClassObj: c)
+ 			or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue:
+ 			[self cCode: [] inSmalltalk: [self transcript ensureCr].
+ 			 self printNum: i; cr; tab.
+ 			 (objectMemory isBytesNonImm: s)
+ 				ifTrue: [self cCode: 'printf("%x %.*s\n", s, byteLengthOf(s), (char *)firstIndexableField(s))'
+ 						inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]]
+ 				ifFalse: [self shortPrintOop: s].
+ 			 self tab.
+ 			 (self addressCouldBeClassObj: c)
+ 				ifTrue: [self shortPrintOop: c]
+ 				ifFalse: [self printNum: c; space; shortPrintOop: (objectMemory classForClassTag: c)].
+ 			self tab; shortPrintOop: m; tab.
+ 			self cCode:
+ 					[p > 1024
+ 						ifTrue: [self printHexnp: p]
+ 						ifFalse: [self printNum: p]]
+ 				inSmalltalk:
+ 					[p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]].
+ 			self cr]]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>ceShortCutTraceLinkedSend: (in category 'simulation only') -----
  ceShortCutTraceLinkedSend: aProcessorSimulationTrap
  	self shortcutTrampoline: aProcessorSimulationTrap
+ 		to: [coInterpreter ceTraceLinkedSend: (processor registerAt: (backEnd concreteRegister: ReceiverResultReg))]!
- 		to: [coInterpreter ceTraceLinkedSend: (processor registerAt: (methodLabel concreteRegister: ReceiverResultReg))]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>ceShortCutTraceStore: (in category 'simulation only') -----
  ceShortCutTraceStore: aProcessorSimulationTrap
  	<doNotGenerate>
  	self shortcutTrampoline: aProcessorSimulationTrap
  		to: [coInterpreter
+ 				ceTraceStoreOf: (processor registerAt: (backEnd concreteRegister: ClassReg))
+ 				into: (processor registerAt: (backEnd concreteRegister: ReceiverResultReg))]!
- 				ceTraceStoreOf: (processor registerAt: (methodLabel concreteRegister: ClassReg))
- 				into: (processor registerAt: (methodLabel concreteRegister: ReceiverResultReg))]!

Item was changed:
  ----- Method: StackInterpreter>>bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf: (in category 'frame access') -----
  bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf: flushExtPrims
  	"Enumerate all contexts and convert married contexts to widowed contexts so
  	 that the snapshot contains only single contexts.  This allows the test for being
  	 married to avoid checking for a context's frame pointer being in bounds.  If
  	 flushExtPrims is true, flush references to external primitives in methods."
  	<asmLabel: false>
  	objectMemory allObjectsDo:
  		[:obj| | fmt |
  		fmt := objectMemory formatOf: obj.
  		(fmt = objectMemory indexablePointersFormat
  		  and: [objectMemory isContextNonImm: obj]) ifTrue:
+ 			[(self isMarriedOrWidowedContext: obj)
+ 				ifTrue: "The stack pages have already been discarded.  Any remaining married contexts are actually widows."
+ 					[self markContextAsDead: obj]
+ 				ifFalse:
+ 					[self ensureContextHasBytecodePC: obj].
- 			[(self isMarriedOrWidowedContext: obj) ifTrue:
- 				[self markContextAsDead: obj].
  			 "Fill slots beyond top of stack with nil"
  			 (self fetchStackPointerOf: obj) + CtxtTempFrameStart
  				to: (objectMemory numSlotsOf: obj) - 1
  				do: [:i |
  					objectMemory
  						storePointerUnchecked: i
  						ofObject: obj
  						withValue: objectMemory nilObject]].
  		 "Clean out external functions from compiled methods"
  		 (flushExtPrims
  		  and: [fmt >= objectMemory firstCompiledMethodFormat]) ifTrue:
  			["Its primitiveExternalCall"
  			 (self primitiveIndexOf: obj) = PrimitiveExternalCallIndex ifTrue:
  				[self flushExternalPrimitiveOf: obj]]]!

Item was added:
+ ----- Method: StackInterpreter>>ensureContextHasBytecodePC: (in category 'frame access') -----
+ ensureContextHasBytecodePC: aContext
+ 	"Make sure the context has a byetcode pc.  Can only be used on single contexts.
+ 	 This is a nop in the StackInterpreter."!

Item was changed:
  ----- Method: StackInterpreter>>printMethodCacheFor: (in category 'debug printing') -----
  printMethodCacheFor: thing
  	<api>
  	0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do:
  		[:i | | s c m p |
  		s := methodCache at: i + MethodCacheSelector.
  		c := methodCache at: i + MethodCacheClass.
  		m := methodCache at: i + MethodCacheMethod.
  		p := methodCache at: i + MethodCachePrimFunction.
+ 		((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing]]]])
- 		((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing
- 			or: [(objectMemory addressCouldBeObj: m)
- 				and: [(self maybeMethodHasCogMethod: m)
- 				and: [(self cogMethodOf: m) asInteger = thing]]]]]]])
  		 and: [(objectMemory addressCouldBeOop: s)
  		 and: [c ~= 0
  		 and: [(self addressCouldBeClassObj: c)
  			or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue:
  			[self cCode: [] inSmalltalk: [self transcript ensureCr].
  			 self printNum: i; cr; tab.
  			 (objectMemory isBytesNonImm: s)
  				ifTrue: [self cCode: 'printf("%x %.*s\n", s, byteLengthOf(s), (char *)firstIndexableField(s))'
  						inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]]
  				ifFalse: [self shortPrintOop: s].
  			 self tab.
  			 (self addressCouldBeClassObj: c)
  				ifTrue: [self shortPrintOop: c]
  				ifFalse: [self printNum: c; space; shortPrintOop: (objectMemory classForClassTag: c)].
  			self tab; shortPrintOop: m; tab.
  			self cCode:
  					[p > 1024
  						ifTrue: [self printHexnp: p]
  						ifFalse: [self printNum: p]]
  				inSmalltalk:
  					[p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]].
  			self cr]]!

Item was removed:
- ----- Method: StackInterpreterPrimitives>>bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf: (in category 'frame access') -----
- bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf: flushExtPrims
- 	"Enumerate all contexts and convert married contexts to widowed contexts so
- 	 that the snapshot contains only single contexts.  This allows the test for being
- 	 married to avoid checking for a context's frame pointer being in bounds.  If
- 	 flushExtPrims is true, flush references to external primitives in methods."
- 	<asmLabel: false>
- 	objectMemory allObjectsDo:
- 		[:obj| | fmt |
- 		fmt := objectMemory formatOf: obj.
- 		(fmt = objectMemory indexablePointersFormat
- 		  and: [objectMemory isContextNonImm: obj]) ifTrue:
- 			[(self isMarriedOrWidowedContext: obj)
- 				ifTrue: "The stack pages have already been discarded.  Any remaining married contexts are actually widows."
- 					[self markContextAsDead: obj]
- 				ifFalse:
- 					[| decodedIP |
- 					decodedIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: obj.
- 					((objectMemory isIntegerObject: decodedIP)
- 					 and: [decodedIP signedIntFromLong < 0]) ifTrue:
- 						[decodedIP := self mustMapMachineCodePC: (objectMemory integerValueOf: decodedIP)
- 											context: obj.
- 						 objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: obj withValue: decodedIP]].
- 			 "Fill slots beyond top of stack with nil"
- 			 (self fetchStackPointerOf: obj) + CtxtTempFrameStart
- 				to: (objectMemory numSlotsOf: obj) - 1
- 				do: [:i |
- 					objectMemory
- 						storePointerUnchecked: i
- 						ofObject: obj
- 						withValue: objectMemory nilObject]].
- 		 "Clean out external functions from compiled methods"
- 		 (flushExtPrims
- 		  and: [fmt >= objectMemory firstCompiledMethodFormat]) ifTrue:
- 			["Its primitiveExternalCall"
- 			 (self primitiveIndexOf: obj) = PrimitiveExternalCallIndex ifTrue:
- 				[self flushExternalPrimitiveOf: obj]]]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ceShortCutTraceStore: (in category 'simulation only') -----
  ceShortCutTraceStore: aProcessorSimulationTrap
  	<doNotGenerate>
  	self shortcutTrampoline: aProcessorSimulationTrap
  		to: [coInterpreter
+ 				ceTraceStoreOf: (processor registerAt: (backEnd concreteRegister: TempReg))
+ 				into: (processor registerAt: (backEnd concreteRegister: ReceiverResultReg))]!
- 				ceTraceStoreOf: (processor registerAt: (methodLabel concreteRegister: TempReg))
- 				into: (processor registerAt: (methodLabel concreteRegister: ReceiverResultReg))]!



More information about the Vm-dev mailing list