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

commits at source.squeak.org commits at source.squeak.org
Sun May 17 19:51:39 UTC 2015

Eliot Miranda uploaded a new version of VMMaker to project VM Maker:

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

Name: VMMaker.oscog-eem.1309
Author: eem
Time: 17 May 2015, 12:49:48.29 pm
UUID: e84bfebb-45e5-4768-8af7-865503cec26a
Ancestors: VMMaker.oscog-rmacnak.1308

Fix ceActivateFailingPrimitiveMethod: to return
properly after retrying a primitive after
checkForAndFollowForwardedPrimitiveState. e.g. fixes
| s |
1 to: 5 do:
	s := 'bar'.
	s becomeForward: 'bzzt' copy.
	'foo' <= s]

Fix bug in followForwardedFrameContents:stackPointer:
so that arguments are actually followed.  N.B. drives
the above bug underground ;-).

Make the bounds check in primitiveObject:perform:...
more restrictive and fix bugs in the commentary.

Make stack pages a reasonable size.  My math was
wrong and the size was half as big as intended.

Refactor accessor depth determination of accessors
so that simulator derives correct values for translated
primitives.  And fix
translatedPrimitiveArgument:ofType:using: so that
translated primitives will fail in the simulator.

=============== Diff against VMMaker.oscog-rmacnak.1308 ===============

Item was changed:
  ----- Method: CCodeGenerator>>accessorsAndAssignmentsForMethod:actuals:depth:interpreterClass:into: (in category 'spur primitive compilation') -----
  accessorsAndAssignmentsForMethod: method actuals: actualParameters depth: depth interpreterClass: interpreterClass into: aTrinaryBlock
  	"Evaluate aTrinaryBlock with the root accessor sends, accessor sends and assignments in the method."
  	| accessors assignments roots |
  	accessors := Set new.
  	assignments := Set new.
  	roots := Set new.
  	actualParameters with: method args do:
  		[:actual :argName|
  		 (actual isVariable or: [actual isSend]) ifTrue:
+ 			[(actual isSend and: [self isStackAccessor: actual selector given: interpreterClass]) ifTrue:
+ 				[roots add: actual].
+ 			assignments add: (TAssignmentNode new
- 			[assignments add: (TAssignmentNode new
  									setVariable: (TVariableNode new setName: argName)
  									expression: actual)]].
  	method parseTree nodesDo:
  		node isSend ifTrue:
+ 			[(self isStackAccessor: node selector given: interpreterClass) ifTrue:
- 			[(interpreterClass isStackAccessor: node selector) ifTrue:
  				[roots add: node].
+ 			 (self isObjectAccessor: node selector given: interpreterClass) ifTrue:
- 			 (interpreterClass isObjectAccessor: node selector) ifTrue:
  				[accessors add: node].
  			 (self accessorDepthDeterminationFollowsSelfSends
  			  and: [node receiver isVariable
  			  and: [node receiver name = 'self'
  			  and: [roots isEmpty
  				or: [node args anySatisfy:
  					 (roots includes: arg)
  					 or: [(accessors includes: arg)
  					 or: [assignments anySatisfy: [:assignment| assignment variable isSameAs: arg]]]]]]]]) ifTrue:
  				[self accessorsAndAssignmentsForSubMethodNamed: node selector
  					actuals: node args
  					depth: depth + 1
  					interpreterClass: interpreterClass
  					into: [:subRoots :subAccessors :subAssignments|
  						(subRoots isEmpty and: [subAccessors isEmpty and: [subAssignments isEmpty]]) ifFalse:
  							[roots addAll: subRoots.
  							 accessors add: node.
  							 accessors addAll: subAccessors.
  							 assignments addAll: subAssignments]]]].
  		(node isAssignment
  		 and: [(roots includes: node expression)
  			or: [(accessors includes: node expression)
  			or: [node expression isVariable and: [node expression name ~= 'nil']]]]) ifTrue:
  			[assignments add: node]].
  		value: roots
  		value: accessors
  		value: assignments!

Item was added:
+ ----- Method: CCodeGenerator>>isObjectAccessor:given: (in category 'spur primitive compilation') -----
+ isObjectAccessor: selector given: interpreterClass
+ 	^interpreterClass isObjectAccessor: selector!

Item was added:
+ ----- Method: CCodeGenerator>>isStackAccessor:given: (in category 'spur primitive compilation') -----
+ isStackAccessor: selector given: interpreterClass
+ 	^interpreterClass isStackAccessor: selector!

Item was changed:
  ----- Method: CoInterpreter>>ceActivateFailingPrimitiveMethod: (in category 'enilopmarts') -----
  ceActivateFailingPrimitiveMethod: aPrimitiveMethod
  	"An external call or FFI primitive has failed.  Build the frame and
  	 activate as appropriate.  Enter either the interpreter or machine
  	 code depending on whether aPrimitiveMethod has been or is still
  	 cogged.  Note that we could always interpret but want the efficiency
  	 of executing machine code if it is available."
+ 	| methodHeader result |
- 	| methodHeader |
  	self assert: primFailCode ~= 0.
  	self assert: newMethod = aPrimitiveMethod.
  	"If we're on Spur, check for forwarders and retry,
  	 returning if successful the second time around."
  	(objectMemory hasSpurMemoryManagerAPI
  	 and: [self checkForAndFollowForwardedPrimitiveState]) ifTrue:
  		[self initPrimCall.
  		 self cCode: [self dispatchFunctionPointer: primitiveFunctionPointer]
  				[| evaluable |
  				 evaluable := primitiveFunctionPointer isInteger
  								ifTrue: [cogit simulatedTrampolines at: primitiveFunctionPointer]
  								ifFalse: [primitiveFunctionPointer].
  				 evaluable isMessageSend
  					ifTrue: [self assert: evaluable receiver == self]
  					ifFalse: [self assert: evaluable isBlock].
  				 evaluable value].
  		 self successful ifTrue:
+ 			[result := self stackTop.
+ 			 self stackTopPut: instructionPointer.
+ 			 self push: result.
+ 			 cogit ceEnterCogCodePopReceiverReg]].
- 			[^self]].
  	methodHeader := self rawHeaderOf: aPrimitiveMethod.
  	(self isCogMethodReference: methodHeader)
  		ifTrue: [self activateCoggedNewMethod: false]
  		ifFalse: [self activateNewMethod]!

Item was changed:
  ----- Method: CogVMSimulator>>utilitiesMenu: (in category 'UI') -----
  utilitiesMenu: aMenuMorph
  		add: 'toggle transcript' action: #toggleTranscript;
  		add: 'clone VM' action: #cloneSimulationWindow;
  		add: 'print ext head frame' action: #printExternalHeadFrame;
  		add: 'print int head frame' action: #printHeadFrame;
  		add: 'print mc/cog frame' action: [self printFrame: cogit processor fp WithSP: cogit processor sp];
  		add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
  		add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
  		add: 'short print mc/cog frame & callers' action: [self shortPrintFrameAndCallers: cogit processor fp];
  		add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
  		add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
  		add: 'long print mc/cog frame & callers' action: [self printFrameAndCallers: cogit processor fp SP: cogit processor sp];
  		add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
  		add: 'print call stack' action: #printCallStack;
  		add: 'print stack call stack' action: #printStackCallStack;
  		add: 'print stack call stack of...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printStackCallStackOf: fp]];
  		add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
  		add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
  		add: 'print all stacks' action: #printAllStacks;
  		add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
  											self writeBackHeadFramePointers];
  		add: 'write back mc ptrs' action: [stackPointer := cogit processor sp. framePointer := cogit processor fp. instructionPointer := cogit processor eip.
  											self writeBackHeadFramePointers];
  		add: 'print rump C stack' action: [objectMemory printMemoryFrom: cogit processor sp to: self CStackPointer];
  		add: 'print registers' action: [cogit processor printRegistersOn: transcript];
  		add: 'print register map' action: [cogit printRegisterMapOn: transcript];
  		add: 'disassemble method/trampoline...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit disassembleCodeAt: pc]];
+ 		add: 'disassemble method/trampoline at pc' action:
+ 			[cogit disassembleCodeAt: ((cogit methodZone methodFor: cogit processor pc) = 0
+ 											ifTrue: [instructionPointer]
+ 											ifFalse: [cogit processor pc])];
- 		add: 'disassemble method/trampoline at pc' action: [cogit disassembleCodeAt: cogit processor pc];
  		add: 'disassemble ext head frame method' action: [cogit disassembleMethod: (self frameMethod: framePointer)];
  		add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
  		add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
  		add: 'print context...' action: [(self promptHex: 'print context') ifNotNil: [:oop| self printContext: oop]];
  		add: 'inspect object memory' target: objectMemory action: #inspect;
  		add: 'inspect cointerpreter' action: #inspect;
  		add: 'inspect cogit' target: cogit action: #inspect;
  		add: 'inspect method zone' target: cogit methodZone action: #inspect.
  	self isThreadedVM ifTrue:
  		[aMenuMorph add: 'inspect thread manager' target: self threadManager action: #inspect].
  		add: 'print cog methods' target: cogMethodZone action: #printCogMethods;
  		add: 'print cog methods with prim...' action: [(self promptNum: 'prim index') ifNotNil: [:pix| cogMethodZone printCogMethodsWithPrimitive: pix]];
  		add: 'print cog methods with selector...' action:
  			[|s| s := UIManager default request: 'selector'.
  			s notEmpty ifTrue:
  				[s = 'nil' ifTrue: [s := nil].
  				 cogMethodZone methodsDo:
  					(s ifNil: [m selector = objectMemory nilObject]
  					 ifNotNil: [(objectMemory numBytesOf: m selector) = s size
  							and: [(self str: s
  									n: (m selector + objectMemory baseHeaderSize)
  									cmp: (objectMemory numBytesOf: m selector)) = 0]]) ifTrue:
  						[cogit printCogMethod: m]]]];
  		add: 'print cog method for...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit printCogMethodFor: pc]];
  		add: 'print cog method header for...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit printCogMethodHeaderFor: pc]];
  		add: 'print trampoline table' target: cogit action: #printTrampolineTable;
  		add: 'print prim trace log' action: #dumpPrimTraceLog;
  		add: 'report recent instructions' target: cogit action: #reportLastNInstructions;
  		add: 'set break pc (', (cogit breakPC isInteger ifTrue: [cogit breakPC hex] ifFalse: [cogit breakPC printString]), ')...' action: [(self promptHex: 'break pc') ifNotNil: [:bpc| cogit breakPC: bpc]];
  		add: (cogit singleStep
  				ifTrue: ['no single step']
  				ifFalse: ['single step'])
  			action: [cogit singleStep: cogit singleStep not];
  		add: (cogit printRegisters
  				ifTrue: ['no print registers each instruction']
  				ifFalse: ['print registers each instruction'])
  			action: [cogit printRegisters: cogit printRegisters not];
  		add: (cogit printInstructions
  				ifTrue: ['no print instructions each instruction']
  				ifFalse: ['print instructions each instruction'])
  			action: [cogit printInstructions: cogit printInstructions not];
  		add: 'click step' action: [cogit setClickStepBreakBlock];
  		add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
  											s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
  		add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
  											s notEmpty ifTrue: [self setBreakSelector: s]];
  		add: 'set break block...' action: [|s| s := UIManager default request: 'break block' initialAnswer: '[:theCogit| false]'.
  											s notEmpty ifTrue: [self setBreakBlockFromString: s]];
  		add: 'set cogit break method...' action: [(self promptHex: 'cogit breakMethod') ifNotNil: [:bm| cogit setBreakMethod: bm]];
  		add: (printBytecodeAtEachStep
  				ifTrue: ['no print bytecode each bytecode']
  				ifFalse: ['print bytecode each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printBytecodeAtEachStep := printBytecodeAtEachStep not];
  		add: (printFrameAtEachStep
  				ifTrue: ['no print frame each bytecode']
  				ifFalse: ['print frame each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printFrameAtEachStep := printFrameAtEachStep not].

Item was changed:
  ----- Method: Cogit>>recordLastInstruction (in category 'simulation only') -----
+ 	| inst pc |
+ 	(EagerInstructionDecoration or: [printInstructions])
+ 		ifTrue:
+ 			[inst := processor
+ 						disassembleNextInstructionIn: coInterpreter memory
+ 						for: self.
+ 			 printInstructions ifTrue:
+ 				[pc := Integer readFrom: (ReadStream on: inst from: 1 to: (inst indexOf: $:) - 1) base: 16.
+ 				 (self relativeLabelForPC: pc) ifNotNil:
+ 					[:label| inst := inst, ' ', label]]]
+ 		ifFalse:
+ 			[inst := processor
+ 						disassembleNextInstructionIn: coInterpreter memory
+ 						for: nil].
+ 	^self recordInstruction: inst!
- 	^self recordInstruction: (processor
- 								disassembleNextInstructionIn: coInterpreter memory
- 								for: ((EagerInstructionDecoration or: [printInstructions]) ifTrue: [self]))!

Item was changed:
  ----- Method: InterpreterPlugin>>translatedPrimitiveArgument:ofType:using: (in category 'simulation') -----
  translatedPrimitiveArgument: index ofType: cTypeString using: aCCodeGenerator
  	| oop |
  	oop := interpreterProxy stackValue: interpreterProxy methodArgumentCount - index.
+ 	(interpreterProxy isOopForwarded: oop) ifTrue: [^nil]. 
  	cTypeString last == $* ifTrue:
  		[^ObjectProxyForTranslatedPrimitiveSimulation new
  			interpreter: interpreterProxy
  			oop: oop
  			unitSize: (self sizeof: (aCCodeGenerator baseTypeForPointerType: cTypeString) asSymbol)].
  	((interpreterProxy isIntegerObject: oop)
  	 and: [aCCodeGenerator isIntegralCType: cTypeString]) ifTrue:
  		[^interpreterProxy integerValueOf: oop].
  	self halt!

Item was changed:
  ----- Method: StackInterpreter>>followForwardedFrameContents:stackPointer: (in category 'lazy become') -----
  followForwardedFrameContents: theFP stackPointer: theSP
  	"follow pointers in the current stack frame up to theSP."
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  	<inline: false>
  	<var: #ptr type: #'char *'>
+ 	theSP
+ 		to: (self frameReceiverLocation: theFP)
- 	theFP + (self frameStackedReceiverOffset: theFP)
- 		to: theFP + FoxCallerSavedIP + objectMemory wordSize
  		by: objectMemory wordSize
  		do: [:ptr| | oop |
  			oop := stackPages longAt: ptr.
  			((objectMemory isNonImmediate: oop)
  			 and: [objectMemory isForwarded: oop]) ifTrue:
  				[stackPages longAt: ptr put: (objectMemory followForwarded: oop)]].
+ 	theFP + FoxCallerSavedIP + objectMemory wordSize
+ 		to: theFP + (self frameStackedReceiverOffset: theFP)
- 	theSP
- 		to: (self frameReceiverLocation: theFP)
  		by: objectMemory wordSize
  		do: [:ptr| | oop |
  			oop := stackPages longAt: ptr.
  			((objectMemory isNonImmediate: oop)
  			 and: [objectMemory isForwarded: oop]) ifTrue:
  				[stackPages longAt: ptr put: (objectMemory followForwarded: oop)]].
  	self assert: (objectMemory isForwarded: (self frameMethodObject: theFP)) not.
  	(self frameHasContext: theFP) ifTrue:
  		[self assert: (objectMemory isForwarded: (self frameContext: theFP)) not]!

Item was changed:
  ----- Method: StackInterpreter>>primitiveObject:perform:withArguments:lookedUpIn: (in category 'control primitives') -----
  primitiveObject: actualReceiver perform: selector withArguments: argumentArray lookedUpIn: lookupClassOrNil
  	"Common routine used by perform:withArgs:, perform:withArgs:inSuperclass:,
  	 object:perform:withArgs:inClass: et al.  Answer nil on success.
  	 NOTE:  The case of doesNotUnderstand: is not a failure to perform.
  	 The only failures are arg types and consistency of argumentCount.
  	 Since we're in the stack VM we can assume there is space to push the arguments
  	 provided they are within limits (max argument count is 15).  We can therefore deal
  	 with the arbitrary amount of state to remove from the stack (lookup class, selector,
  	 mirror receiver) and arbitrary argument orders by deferring popping anything until
  	 we know whether the send has succeeded.  So on failure we merely have to remove
  	 the actual receiver and arguments pushed, and on success we have to slide the actual
  	 receiver and arguments down to replace the original ones."
  	<inline: true>
  	| arraySize performArgCount delta |
  	(objectMemory isArray: argumentArray) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	"Check if number of arguments is reasonable; MaxNumArgs isn't available
  	 so just use LargeContextSize"
  	arraySize := objectMemory numSlotsOf: argumentArray.
+ 	arraySize > (LargeContextSlots - CtxtTempFrameStart) ifTrue:
- 	arraySize > LargeContextSlots ifTrue:
  		[^self primitiveFailFor: PrimErrBadNumArgs].
  	performArgCount := argumentCount.
  	"Push newMethod to save it in case of failure,
+ 	 then push the actual receiver and the args in the array."
- 	 then push the actual receiver and args out of the array."
  	self push: newMethod.
  	self push: actualReceiver.
+ 	"Copy the arguments to the stack, in case of MNU, and lookup"
- 	"Copy the arguments to the stack, and execute"
  	1 to: arraySize do:
  		[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
  	argumentCount := arraySize.
  	messageSelector := selector.
  	self sendBreakpoint: messageSelector receiver: actualReceiver.
  	self printSends ifTrue:
  		[self printActivationNameForSelector: messageSelector
  				startClass: (lookupClassOrNil isNil
  								ifTrue: [objectMemory fetchClassOf: actualReceiver]
  								ifFalse: [lookupClassOrNil]);
  	self findNewMethodInClassTag: (lookupClassOrNil isNil
  										ifTrue: [objectMemory fetchClassTagOf: actualReceiver]
  										ifFalse: [objectMemory classTagForClass: lookupClassOrNil]).
  	"Only test CompiledMethods for argument count - any other objects playacting as CMs will have to take their chances"
  	((objectMemory isOopCompiledMethod: newMethod)
  	  and: [(self argumentCountOf: newMethod) ~= argumentCount]) ifTrue:
+ 		["Restore the state by popping the array entries, the actual receiver and the saved
+ 		  newMethod, leaving the selector and array, and fail.  N.B.  If an MNU has happened
+ 		  then argumentCount will match newMethod, so this code will not be reached."
+ 		 "These asserts check that an MNU has not occurred if the argumentCount doesn't match the newMethod."
+ 		 self assert: (self stackTop = (arraySize = 0
+ 											ifTrue: [actualReceiver]
+ 											ifFalse: [(objectMemory fetchPointer: arraySize - 1 ofObject: argumentArray)])).
+ 		 self assert:  argumentCount = arraySize.
- 		["Restore the state by popping all those array entries and pushing back the selector and array, and fail"
  		 self pop: arraySize + 1.
  		 newMethod := self popStack.
  		 ^self primitiveFailFor: PrimErrBadNumArgs].
  	"Cannot fail this primitive from here-on.  Slide the actual receiver and arguments down
  	 to replace the perform arguments and saved newMethod and then execute the new
  	 method. Use argumentCount not arraySize because an MNU may have changed it."
  	delta := objectMemory wordSize * (performArgCount + 2). "+2 = receiver + saved newMethod"
  	argumentCount * objectMemory wordSize to: 0 by: objectMemory wordSize negated do:
  			longAt: stackPointer + offset + delta
  			put: (stackPages longAt: stackPointer + offset)].
  	self pop: performArgCount + 2.
  	self executeNewMethod.
  	self initPrimCall.  "Recursive xeq affects primErrorCode"

Item was changed:
  ----- Method: StackInterpreter>>stackPageByteSize (in category 'stack pages') -----
  	"Answer a page size that is a power-of-two and contains a useful number of frames.
+ 	 Room for 256 slots for frames gives around 40 frames a page which is a
- 	 Room for 512 bytes of frames gives around 40 frames a page which is a
  	 good compromise between overflow rate and latency in divorcing a page."
  	<inline: false>
  	| pageBytes largeSize smallSize |
  	pageBytes := self stackPageFrameBytes + self stackLimitOffset + self stackPageHeadroom.
  	(pageBytes bitAnd: pageBytes - 1) = 0 ifTrue: "= 0 => a power of two"
  	"round up or round down; that is the question.  If rounding down reduces
  	 the size by no more than 1/8th round down, otherwise roundup."
  	largeSize := 1 << pageBytes highBit.
  	smallSize := 1 << (pageBytes highBit - 1).
  	self assert: (largeSize > pageBytes and: [pageBytes > smallSize]).
  	^(pageBytes - smallSize) <= (smallSize / 8)
  		ifTrue: [smallSize]
  		ifFalse: [largeSize]!

Item was changed:
  ----- Method: StackInterpreter>>stackPageFrameBytes (in category 'stack pages') -----
+ 	"Answer a byte size that accomodates a useful number of frames.  The minimum frame size is
+ 	 7 slots in the StackInterpreter, and 6 slots in the CoInterpreter, and the maximum size is 56 + 7
+ 	 slots in the StackInterpreter and 56 + 8 slots in the CoInterpreter. 256 slots gives from 4 to 36
+ 	 frames in the StackInterpreter and from 4 to 42 in the CoInterpreter. Hence 2048 bytes in 32-bits
+ 	 and 4096 bytes in 64-bits; a compromise between overflow rate and latency in divorcing a page."
+ 	"Defining as a macro simplifies hand editing the C for experiments..."
+ 	<cmacro: '() (256 * BytesPerWord)'>
+ 	^256 * objectMemory wordSize!
- 	"Answer a byte size that accomodates a useful number of frames.
- 	 512 bytes is room for around 40 frames a page which is a good
- 	 compromise between overflow rate and latency in divorcing a page."
- 	^objectMemory bytesPerOop = 8
- 		ifTrue: [1024]
- 		ifFalse: [512]!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>isObjectAccessor:given: (in category 'spur primitive compilation') -----
+ isObjectAccessor: selector given: interpreterClass
+ 	"Override to include the selectors transformed into accessors for translated primitives.
+ 	 InterpreterPlugin browseTranslatedPrimitives"
+ 	^(#(asciiValue at: at:put: basicAt: size) includes: selector)
+ 	  or: [super isObjectAccessor: selector given: interpreterClass]!

More information about the Vm-dev mailing list