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

commits at source.squeak.org commits at source.squeak.org
Wed Apr 1 02:05:02 UTC 2015


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

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

Name: VMMaker.oscog-eem.1142
Author: eem
Time: 31 March 2015, 7:03:04.226 pm
UUID: 518e91ab-2513-4368-acb6-830554983a2b
Ancestors: VMMaker.oscog-eem.1141

Make sure the stack is scanned after a pin operation
that involves forwarding.

Make sure that the unforwarding stack scan post-become
(or post-pin) scans all of the stack contents in the
CoInterpreter, sicne super sends have no read barrier.

Implement the SistaV1 directed super send bytecode
in the StackInterpreter.

Fix BitBlt simulation:
- BitBltSimulator>>halftoneAt: does not work in Cog; nuke it.
- BitBltSimulator>>initialiseModule must answer a boolean.
- tryLoadNewPlugin:pluginEntries: needed to choose
the plugin classes more carefully.

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

Item was removed:
- ----- Method: BitBltSimulator>>halftoneAt: (in category 'simulation') -----
- halftoneAt: idx
- 
- 	^ (halftoneBase + (idx \\ halftoneHeight * 4)) long32At: 0!

Item was changed:
  ----- Method: BitBltSimulator>>initialiseModule (in category 'initialize-release') -----
  initialiseModule
  
  	self class isInitialised ifFalse: [| ivars |
  		ivars := #(opTable maskTable warpBitShiftTable ditherMatrix4x4 ditherThresholds16 ditherValues16 dither8Lookup).
  		super initialiseModule.
  		ivars do: [:symbol | self class instVarNamed: symbol put: (self instVarNamed: symbol)].
  		self class setInitialised].
  	opTable := self class opTable.
  	maskTable := self class maskTable.
  	warpBitShiftTable := self class warpBitShiftTable.
  	ditherMatrix4x4 := self class ditherMatrix4x4.
  	ditherThresholds16 := self class ditherThresholds16.
  	ditherValues16 := self class ditherValues16.
  	dither8Lookup := self class dither8Lookup.
+ 	^true!
- !

Item was changed:
  ----- Method: CoInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
  followForwardingPointersInStackZone: theBecomeEffectsFlags
  	"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
  	 The read-barrier is minimised by arranging that forwarding pointers will fail a method cache
  	 probe, since notionally objects' internals are accessed only via sending messages to them,
  	 the exception is primitives that access the internals of the non-receiver argument(s).
  	 To avoid a read barrier on inst var fetch we scan the receivers in the stack zone and follow
+ 	 any forwarded ones.  This is way cheaper than scanning all of memory as in the old become.
+ 
+ 	 Override to handle machine code frames, and to handle the lack of an explicit read barrier on super sends.
+ 	 With most super send implementations (not Newspeak's absent super bytecodes) self, the receiver of the
+ 	 super send, is pushed before any arguments.  So if self is becommed during argument marshalling, e.g.
+ 		super doSomethingWith: (self become: self somethingElse)
+ 	 then a stale forwarded reference to self could be left on the stack.  In the StackInterpreter we deal with this
+ 	 with an explicit read barrier on supersend.  In the CoInterpreter we deal with it by following all non-argument
+ 	 stack contents."
- 	 any forwarded ones.  This is way cheaper than scanning all of memory as in the old become."
  	| theIPPtr |
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #usqInt>
  
+ 	self externalWriteBackHeadFramePointers.
+ 
  	(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
  		[(objectMemory isForwarded: method) ifTrue:
  			[theIPPtr := instructionPointer - method.
  			 method := objectMemory followForwarded: method.
  			 instructionPointer := method + theIPPtr].
  		(objectMemory isOopForwarded: newMethod) ifTrue:
  			[newMethod := objectMemory followForwarded: newMethod]].
  
  	self assert: stackPage ~= 0.
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP callerFP oop offset |
  		thePage := stackPages stackPageAt: i.
  		thePage isFree ifFalse:
  			[theSP := thePage headSP.
  			 theFP := thePage  headFP.
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage
  				ifTrue: [theIPPtr := 0]
  				ifFalse:
  					[theIPPtr := theSP asUnsignedInteger.
  					 theSP := theSP + objectMemory wordSize].
  			 [self assert: (thePage addressIsInPage: theFP).
  			  self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
  			  offset := self frameStackedReceiverOffset: theFP.
+ 	 		  [theSP <= offset] whileTrue:
+ 				[oop := stackPages longAt: theSP.
+ 				 (objectMemory isOopForwarded: oop) ifTrue:
+ 					[stackPages longAt: theSP put: (objectMemory followForwarded: oop)].
+ 				 theSP := theSP + objectMemory wordSize].
- 			  oop := stackPages longAt: theFP + offset.
- 			  (objectMemory isOopForwarded: oop) ifTrue:
- 				[stackPages
- 					longAt: theFP + offset
- 					put: (objectMemory followForwarded: oop)].
  			  ((self frameHasContext: theFP)
  			   and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
  					put: (objectMemory followForwarded: (self frameContext: theFP))].
  			 (self isMachineCodeFrame: theFP)
  				ifTrue:
  					[oop := stackPages longAt: theFP + FoxMFReceiver.
  					 (objectMemory isOopForwarded: oop) ifTrue:
  						[stackPages
  							longAt: theFP + FoxMFReceiver
  							put: (objectMemory followForwarded: oop)].
  					 oop := (self mframeHomeMethod: theFP) methodObject.
  					 self assert: (objectMemory isForwarded: oop) not]
  				ifFalse:
  					[oop := stackPages longAt: theFP + FoxIFReceiver.
  					 (objectMemory isOopForwarded: oop) ifTrue:
  						[stackPages
  							longAt: theFP + FoxIFReceiver
  							put: (objectMemory followForwarded: oop)].
  					 oop := self iframeMethod: theFP.
  					 (objectMemory isForwarded: oop) ifTrue:
  						[| newOop delta |
  						 newOop := objectMemory followForwarded: oop.
  						 delta := newOop - oop.
  						 (theIPPtr ~= 0
  						  and: [(stackPages longAt: theIPPtr) > oop]) ifTrue:
  							[stackPages
  								longAt: theIPPtr
  								put: (stackPages longAt: theIPPtr) + delta].
  						stackPages
  							longAt: theFP + FoxIFSavedIP
  							put: (stackPages longAt: theFP + FoxIFSavedIP) + delta.
  						stackPages
  							longAt: theFP + FoxMethod
  							put: (oop := newOop)]].
  			  (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theIPPtr := (theFP + FoxCallerSavedIP) asUnsignedInteger.
+ 				 theSP := theIPPtr + objectMemory wordSize.
  				 theFP := callerFP].
  			 "And finally follow the saved context and the caller context."
  			 theSP := thePage baseAddress - objectMemory wordSize.
  			 [theSP <= thePage baseAddress] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory isForwarded: oop) ifTrue:
  					[stackPages longAt: theSP put: (objectMemory followForwarded: oop)].
  				 theSP := theSP + objectMemory wordSize]]]!

Item was changed:
  ----- Method: SpurMemoryManager>>pinObject: (in category 'primitive support') -----
  pinObject: objOop
  	"Attempt to pin objOop, which must not be immediate.
  	 If the attempt succeeds answer objOop's (possibly moved) oop.
  	 If the attept fails, which can only occur if there is no memory, answer 0."
  	<inline: false>
  	| oldClone seg |
  	<var: #seg type: #'SpurSegmentInfo *'>
  	self assert: (self isNonImmediate: objOop).
  	self flag: 'policy decision here. if already old, do we clone in a segment containing pinned objects or merely pin?'.
  	"We choose to clone to keep pinned objects together to reduce fragmentation,
  	 assuming that pinning is rare and that fragmentation is a bad thing."
  	(self isOldObject: objOop) ifTrue:
  		[seg := segmentManager segmentContainingObj: objOop.
  		 seg containsPinned ifTrue:
  			[self setIsPinnedOf: objOop to: true.
  			 ^objOop].
  		 segmentManager someSegmentContainsPinned ifFalse:
  			[self setIsPinnedOf: objOop to: true.
  			 seg containsPinned: true.
  			 ^objOop]].
  	oldClone := self cloneInOldSpaceForPinning: objOop.
  	oldClone ~= 0 ifTrue:
+ 		[becomeEffectsFlags := self becomeEffectFlagsFor: objOop.
+ 		 self setIsPinnedOf: oldClone to: true.
+ 		 self forward: objOop to: oldClone.
+ 		 coInterpreter postBecomeAction: becomeEffectsFlags.
+ 		 self postBecomeScanClassTable: becomeEffectsFlags.
+ 		 becomeEffectsFlags := 0].
- 		[self setIsPinnedOf: oldClone to: true.
- 		 self forward: objOop to: oldClone].
  	^oldClone!

Item was added:
+ ----- Method: StackInterpreter>>directedSuperclassSend (in category 'send bytecodes') -----
+ directedSuperclassSend
+ 	"Send a message to self, starting lookup with the superclass of the class on top of stack."
+ 	"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."
+ 	<sharedCodeInCase: #singleExtendedSuperBytecode>
+ 	<option: #SistaVM>
+ 	| class superclass |
+ 	class := self internalPopStack.
+ 	(objectMemory isForwarded: class) ifTrue:
+ 		[class := objectMemory followForwarded: class].
+ 	superclass := self superclassOf: class.
+ 	objectMemory ensureBehaviorHash: superclass.
+ 	lkupClassTag := objectMemory classTagForClass: superclass.
+ 	"To maintain the invariant that all receivers are unforwarded we need an explicit
+ 	 read barrier in the super send cases.  Even though we always follow receivers
+ 	 on become  e.g. super doSomethingWith: (self become: other) forwards the receiver
+ 	 self pushed on the stack."
+ 	self ensureReceiverUnforwarded.
+ 	self assert: lkupClassTag ~= objectMemory nilObject.
+ 	self commonSend!

Item was changed:
  ----- Method: StackInterpreter>>extSendSuperBytecode (in category 'send bytecodes') -----
  extSendSuperBytecode
+ 	"239		11101111	i i i i i j j j
+ 		ExtendB < 64
+ 			ifTrue: [Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments]
+ 			ifFalse: [Send To Superclass of Stacked Class Literal Selector #iiiii (+ Extend A * 32) with jjj (+ (Extend B bitAnd: 63) * 8) Arguments]"
- 	"239		11101111	i i i i i j j j	Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
  	| byte |
  	byte := self fetchByte.
  	messageSelector := self literal: (byte >> 3) + (extA << 5).
  	extA := 0.
+ 	SistaVM ifTrue:
+ 		[extB >= 64 ifTrue:
+ 			[argumentCount := (byte bitAnd: 7) + (extB << 3).
+ 			 extB := 0.
+ 			 ^self directedSuperclassSend]].
  	argumentCount := (byte bitAnd: 7) + (extB << 3).
  	extB := 0.
+ 	self superclassSend!
- 	self superclassSend.!

Item was changed:
  ----- Method: StackInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
  followForwardingPointersInStackZone: theBecomeEffectsFlags
  	"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
  	 The read-barrier is minimised by arranging that forwarding pointers will fail a method cache
  	 probe, since notionally objects' internals are accessed only via sending messages to them,
  	 the exception is primitives that access the internals of the non-receiver argument(s).
  	 To avoid a read barrier on bytecode, literal and inst var fetch we scan the receivers and
  	 methods in the stack zone and follow any forwarded ones.  This is of course way cheaper
  	 than scanning all of memory as in the old become."
  	| theIPPtr |
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #usqInt>
  
+ 	self externalWriteBackHeadFramePointers.
+ 
  	(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
  		[(objectMemory isForwarded: method) ifTrue:
  			[theIPPtr := instructionPointer - method.
  			 method := objectMemory followForwarded: method.
  			 instructionPointer := method + theIPPtr].
  		(objectMemory isOopForwarded: newMethod) ifTrue:
  			[newMethod := objectMemory followForwarded: newMethod]].
  
  	self assert: stackPage ~= 0.
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP callerFP theIP oop |
  		thePage := stackPages stackPageAt: i.
  		thePage isFree ifFalse:
  			[theSP := thePage headSP.
  			 theFP := thePage  headFP.
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage
  				ifTrue: [theIPPtr := 0]
  				ifFalse:
  					[theIPPtr := theSP asInteger.
  					 theSP := theSP + objectMemory wordSize].
  			 [self assert: (thePage addressIsInPage: theFP).
  			  self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
  			  oop := stackPages longAt: theFP + FoxReceiver.
  			  (objectMemory isOopForwarded: oop) ifTrue:
  				[stackPages
  					longAt: theFP + FoxReceiver
  					put: (objectMemory followForwarded: oop)].
  			  theIP := (theFP + (self frameStackedReceiverOffset: theFP)) asInteger. "reuse theIP; its just an offset here"
  			  oop := stackPages longAt: theIP.
  			  (objectMemory isOopForwarded: oop) ifTrue:
  				[stackPages
  					longAt: theIP
  					put: (objectMemory followForwarded: oop)].
  			  ((self frameHasContext: theFP)
  			   and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
  					put: (objectMemory followForwarded: (self frameContext: theFP))].
  			  oop := self frameMethod: theFP.
  			  (objectMemory isForwarded: oop) ifTrue:
  				[| newOop delta |
  				 newOop := objectMemory followForwarded: oop.
  				 theIPPtr ~= 0 ifTrue:
  					[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
  					 delta := newOop - oop.
  					 stackPages
  						longAt: theIPPtr
  						put: (stackPages longAt: theIPPtr) + delta].
  				stackPages
  					longAt: theFP + FoxMethod
  					put: (oop := newOop)].
  			  (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theIPPtr := (theFP + FoxCallerSavedIP) asInteger.
  				 theFP := callerFP].
  			 "And finally follow the caller context."
  			 self assert: theFP = thePage baseFP.
  			 oop := self frameCallerContext: theFP.
  			 (objectMemory isForwarded: oop) ifTrue:
  				[self frameCallerContext: theFP put: (objectMemory followForwarded: oop)]]]!

Item was changed:
  ----- Method: StackInterpreter>>tryLoadNewPlugin:pluginEntries: (in category 'primitive support') -----
  tryLoadNewPlugin: pluginString pluginEntries: pluginEntries
  	"Load the plugin and if on Spur, populate pluginEntries with the prmitives in the plugin."
  	<doNotGenerate>
  	| plugin realPluginClass plugins simulatorClasses |
  	self transcript cr; show: 'Looking for module ', pluginString.
  	"Defeat loading of the FloatArrayPlugin & Matrix2x3Plugin since complications with 32-bit
  	 float support prevent simulation.  If you feel up to tackling this start by implementing
  		cCoerce: value to: cType
  			^cType = 'float'
  				ifTrue: [value asIEEE32BitWord]
  				ifFalse: [value]
  	 in FloatArrayPlugin & Matrix2x3Plugin and then address the issues in the BalloonEnginePlugin.
  	 See http://forum.world.st/Simulating-the-BalloonEnginePlugin-FloatArrayPlugin-amp-Matrix2x3Plugin-primitives-td4734673.html"
  	(#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: pluginString) ifTrue:
  		[self transcript show: ' ... defeated'. ^nil].
  	pluginString isEmpty
  		ifTrue:
  			[plugin := self]
  		ifFalse:
  			[plugins := InterpreterPlugin allSubclasses select: [:psc| psc moduleName asString = pluginString asString].
  			simulatorClasses := (plugins
  									select: [:psc| psc simulatorClass notNil]
  									thenCollect: [:psc| psc simulatorClass]) asSet.
  			simulatorClasses isEmpty ifTrue: [self transcript show: ' ... not found'. ^nil].
  			simulatorClasses size > 1 ifTrue: [^self error: 'This won''t work...'].
+ 			(plugins copyWithoutAll: simulatorClasses) notEmpty ifTrue:
+ 				[plugins := plugins copyWithoutAll: simulatorClasses].
  			plugins size > 1 ifTrue:
  				[self transcript show: '...multiple plugin classes; choosing ', plugins last name].
  			realPluginClass := plugins last. "hopefully lowest in the hierarchy..."
  			plugin := simulatorClasses anyOne newFor: realPluginClass.
  			plugin setInterpreter: objectMemory. "Ignore return value from setInterpreter"
  			(plugin respondsTo: #initialiseModule) ifTrue:
  				[plugin initialiseModule ifFalse:
  					[self transcript show: ' ... initialiser failed'. ^nil]]]. "module initialiser failed"
  	self transcript show: ' ... loaded'.
  	objectMemory hasSpurMemoryManagerAPI ifTrue:
  		[| realPlugin cg |
  		 self transcript show: '...computing accessor depths'.
  		 plugin class isPluginClass
  			ifTrue:
  				[realPlugin := (plugin isSmartSyntaxPluginSimulator
  									ifTrue: [realPluginClass]
  									ifFalse: [plugin class])
  								 withAllSuperclasses detect: [:class| class shouldBeTranslated].
  				 cg := realPlugin buildCodeGeneratorUpTo: realPlugin]
  			ifFalse:
  				[cg := self codeGeneratorToComputeAccessorDepth.
  				 primitiveTable withIndexDo:
  					[:prim :index| | depth |
  					 prim isSymbol ifTrue:
  						[depth := cg accessorDepthForSelector: prim.
  						 self assert: (depth isInteger or: [depth isNil and: [(plugin class whichClassIncludesSelector: prim) isNil]]).
  						 primitiveAccessorDepthTable at: index - 1 put: depth]]].
  		 cg exportedPrimitiveNames do:
  			[:primName| | fnSymbol |
  			 fnSymbol := primName asSymbol.
  			 pluginEntries addLast: {plugin.
  									fnSymbol.
  									[plugin perform: fnSymbol. self].
  									cg accessorDepthForSelector: fnSymbol}].
  		 self transcript show: '...done'].
  	^pluginString asString -> plugin!



More information about the Vm-dev mailing list