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

commits at source.squeak.org commits at source.squeak.org
Wed Sep 7 11:47:18 UTC 2016


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

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

Name: VMMaker.oscog-eem.1947
Author: eem
Time: 7 September 2016, 1:44:31.485496 pm
UUID: 602f26ce-e176-44a7-be01-ae589e1de1c4
Ancestors: VMMaker.oscog-eem.1946

Fix marryFrame:SP:copyTemps: for full blocks; the closureOrNil field must still be set.  Add an assert to primitiveFindNextUnwindContext that caught a side-effect of the bug.
Eliminate some warnings in genPrimitiveShallowCopy.
Move the abort for loading SqueakFFIPrims later in the method.

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

Item was changed:
  ----- Method: CoInterpreter>>marryFrame:SP:copyTemps: (in category 'frame access') -----
  marryFrame: theFP SP: theSP copyTemps: copyTemps
  	"Marry an unmarried frame.  This means creating a spouse context
  	 initialized with a subset of the frame's state that references the frame.
  	 For the default closure implementation we do not need to copy temps.
  	 Different closure implementations may require temps to be copied.
  
  	 This method is important enough for performance to be worth streamlining.
  
  	Override to set the ``has context'' flag appropriately for both machine code and interpreter frames
  	and to streamline the machine code/interpreter differences.."
  	| theContext methodFieldOrObj closureOrNil rcvr numSlots numArgs numStack numTemps |
  	<inline: true>
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  	<var: #cogMethod type: #'CogMethod *'>
  	self assert: (self frameHasContext: theFP) not.
  	self assert: (self isBaseFrame: theFP) not. "base frames must aready be married for cannotReturn: processing"
  
  	"The SP is expected to be pointing at the last oop on the stack, not at the pc"
  	self assert: (objectMemory addressCouldBeOop: (objectMemory longAt: theSP)).
  
  	"Decide how much of the stack to preserve in widowed contexts.  Preserving too much
  	 state will potentially hold onto garbage.  Holding onto too little may mean that a dead
  	 context isn't informative enough in a debugging situation.  If copyTemps is false (as it
  	 is in the default closure implementation) compromise, retaining only the arguments with
  	 no temporaries.  Note that we still set the stack pointer to its current value, but stack
  	 contents other than the arguments are nil."
  	methodFieldOrObj := self frameMethodField: theFP.
  	methodFieldOrObj asUnsignedInteger < objectMemory startOfMemory "inline (self isMachineCodeFrame: theFP)"
  		ifTrue:
  			[| cogMethod |
  			 stackPages
  				longAt: theFP + FoxMethod
  				put: methodFieldOrObj + MFMethodFlagHasContextFlag.
  			 cogMethod := self cCoerceSimple: (methodFieldOrObj bitAnd: MFMethodMask) to: #'CogMethod *'.
  			 numArgs := cogMethod cmNumArgs.
  			 cogMethod cmType = CMMethod
  				ifTrue:
+ 					[closureOrNil := cogMethod cmIsFullBlock
+ 										ifTrue: [self frameStackedReceiver: theFP numArgs: numArgs]
+ 										ifFalse: [objectMemory nilObject]]
- 					[closureOrNil := objectMemory nilObject]
  				ifFalse:
  					[cogMethod := (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') cmHomeMethod.
  					 closureOrNil := self frameStackedReceiver: theFP numArgs: numArgs].
  			 numSlots := (self methodHeaderIndicatesLargeFrame: cogMethod methodHeader)
  							ifTrue: [LargeContextSlots]
  							ifFalse: [SmallContextSlots].
  			 methodFieldOrObj := cogMethod methodObject.
  			 rcvr := self mframeReceiver: theFP.
  			 numStack := self stackPointerIndexForMFrame: theFP WithSP: theSP numArgs: numArgs]
  		ifFalse:
  			[self setIFrameHasContext: theFP.
  			 numArgs := self iframeNumArgs: theFP.
  			 numSlots := (self methodHeaderIndicatesLargeFrame: (objectMemory methodHeaderOf: methodFieldOrObj))
  							ifTrue: [LargeContextSlots]
  							ifFalse: [SmallContextSlots].
  			 closureOrNil := (self iframeIsBlockActivation: theFP)
  								ifTrue: [self frameStackedReceiver: theFP numArgs: numArgs]
  								ifFalse: [objectMemory nilObject].
  			 rcvr := self iframeReceiver: theFP.
  			 numStack := self stackPointerIndexForIFrame: theFP WithSP: theSP numArgs: numArgs].
  	theContext := objectMemory eeInstantiateMethodContextSlots: numSlots.
  	self setFrameContext: theFP to: theContext.
  	"Mark context as married by setting its sender to the frame pointer plus SmallInteger
  	 tags and the InstructionPointer to the saved fp (which ensures correct alignment
  	 w.r.t. the frame when we check for validity)"
  	objectMemory storePointerUnchecked: SenderIndex
  		ofObject: theContext
  		withValue: (self withSmallIntegerTags: theFP).
  	objectMemory storePointerUnchecked: InstructionPointerIndex
  		ofObject: theContext
  		withValue: (self withSmallIntegerTags: (self frameCallerFP: theFP)).
  	objectMemory storePointerUnchecked: StackPointerIndex
  		ofObject: theContext
  		withValue: (objectMemory integerObjectOf: numStack).
  	objectMemory storePointerUnchecked: MethodIndex
  		ofObject: theContext
  		withValue: methodFieldOrObj.
  	objectMemory storePointerUnchecked: ClosureIndex ofObject: theContext withValue: closureOrNil.
  	objectMemory storePointerUnchecked: ReceiverIndex
  		ofObject: theContext
  		withValue: rcvr.
  	1 to: numArgs do:
  		[:i|
  		objectMemory storePointerUnchecked: ReceiverIndex + i
  			ofObject: theContext
  			withValue: (self temporary: i - 1 in: theFP)].
  	copyTemps ifTrue:
  		[numTemps := self frameNumTemps: theFP.
  		 1 to: numTemps do:
  			[:i|
  			objectMemory storePointerUnchecked: ReceiverIndex + i + numArgs
  				ofObject: theContext
  				withValue: (self temporary: i - 1 in: theFP)].
  		 numArgs := numArgs + numTemps].
  
  	numArgs + 1 to: numStack do:
  		[:i|
  		objectMemory storePointerUnchecked: ReceiverIndex + i
  			ofObject: theContext
  			withValue: objectMemory nilObject].
  
  	self assert: (self frameHasContext: theFP).
  	self assert: (self frameOfMarriedContext: theContext) = theFP.
  	self assert: numStack + ReceiverIndex < (objectMemory lengthOf: theContext).
  
  	^theContext!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genPrimitiveShallowCopy (in category 'primitive generators') -----
  genPrimitiveShallowCopy
  	"Implement primitiveShallowCopy/primitiveClone for convenient cases:
  	- the receiver is not a context
  	- the receiver is not a compiled method
  	- the result fits in eden (actually below scavengeThreshold)"
  
  	| formatReg resultReg slotsReg ptrReg
  	  jumpImmediate jumpIsMethod jumpVariable jumpTooBig jumpEmpty jumpNoSpace
  	  continuance copyLoop |
- 	<var: #continue type: #'AbstractInstruction *'>
  	<var: #copyLoop type: #'AbstractInstruction *'>
  	<var: #jumpTooBig type: #'AbstractInstruction *'>
+ 	<var: #continuance type: #'AbstractInstruction *'>
  	<var: #jumpVariable type: #'AbstractInstruction *'>
  	<var: #jumpNoSpace type: #'AbstractInstruction *'>
  	<var: #jumpIsMethod type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  
  	jumpImmediate := self genJumpImmediate: ReceiverResultReg.
  	resultReg := Arg0Reg.
  	slotsReg := Arg1Reg.
  	"get freeStart as early as possible so as not to wait later..."
  	cogit MoveAw: objectMemory freeStartAddress R: resultReg.
  
  	"formatReg := self formatOf: ReceiverResultReg"
  	self genGetFormatOf: ReceiverResultReg
  		into: (ptrReg := formatReg := SendNumArgsReg)
  		leastSignificantHalfOfBaseHeaderIntoScratch: NoReg.
  
  	cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
  	jumpIsMethod := cogit JumpAboveOrEqual: 0.
  	cogit CmpCq: objectMemory indexablePointersFormat R: formatReg.
  	jumpVariable := cogit JumpZero: 0.
  	continuance := cogit Label.
  
  	self genGetRawSlotSizeOfNonImm: ReceiverResultReg into: slotsReg.
  	cogit CmpCq: objectMemory numSlotsMask R: slotsReg.
  	jumpTooBig := cogit JumpZero: 0.
  
  	cogit CmpCq: 0 R: slotsReg.
  	jumpEmpty := cogit JumpZero: 0.
  
  	"round up to allocationUnit"
  	cogit
  		MoveR: slotsReg R: TempReg;
  		AndCq: 1 R: TempReg;
  		AddR: TempReg R: slotsReg;
  		AddCq: objectMemory baseHeaderSize / objectMemory wordSize R: slotsReg;
  		LogicalShiftLeftCq: objectMemory shiftForWord R: slotsReg;
  	"check if allocation fits (freeSize + byteSize < scavengeThreshold); scavengeThreshold is constant."
  		AddR: resultReg R: slotsReg;
  		CmpCq: objectMemory getScavengeThreshold R: slotsReg.
  	jumpNoSpace := cogit JumpAboveOrEqual: 0.
  	cogit
  		MoveR: resultReg R: ptrReg;
  	"write back new freeStart; get result. slotsReg holds new freeStart, the limit of the object"
  		MoveR: slotsReg Aw: objectMemory freeStartAddress;
  	"set up loop bounds"
  		SubCq: objectMemory wordSize * 2 R: slotsReg;
  	"copy header, masking off irrelevant bits"
  		MoveMw: 0 r: ReceiverResultReg R: TempReg;
  		AndCq: objectMemory formatMask << objectMemory formatShift + objectMemory classIndexMask R: TempReg;
  		MoveR: TempReg Mw: 0 r: resultReg;
  		MoveMw: objectMemory wordSize r: ReceiverResultReg R: TempReg;
  		AndCq: objectMemory numSlotsMask << objectMemory numSlotsHalfShift R: TempReg;
  		MoveR: TempReg Mw: objectMemory wordSize r: resultReg.
  	"copy two fields at a time..."
  	copyLoop := cogit Label.
  	cogit
  		AddCq: objectMemory wordSize * 2 R: ReceiverResultReg;
  		AddCq: objectMemory wordSize * 2 R: ptrReg;
  		MoveMw: 0 r: ReceiverResultReg R: TempReg;
  		MoveR: TempReg Mw: 0 r: ptrReg;
  		MoveMw: objectMemory wordSize r: ReceiverResultReg R: TempReg;
  		MoveR: TempReg Mw: objectMemory wordSize r: ptrReg;
  		CmpR: ptrReg R: slotsReg;
  		JumpAbove: copyLoop;
  		MoveR: resultReg R: ReceiverResultReg;
  		genPrimReturn.
  
  	"If the receiver is variable pointers, fail if its a context, otherwise continue"
  	jumpVariable jmpTarget: cogit Label.
  	self genGetClassIndexOfNonImm: ReceiverResultReg into: ClassReg.
  	cogit
  		CmpCq: ClassMethodContextCompactIndex R: ClassReg;
  		JumpNonZero: continuance.
  
  	jumpImmediate jmpTarget:
  	(jumpNoSpace jmpTarget:
  	(jumpIsMethod jmpTarget:
  	(jumpTooBig jmpTarget:
  	(jumpEmpty jmpTarget: cogit Label)))).
  
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genPrimitiveShallowCopy (in category 'primitive generators') -----
  genPrimitiveShallowCopy
  	"Implement primitiveShallowCopy/primitiveClone for convenient cases:
  	- the receiver is not a context
  	- the receiver is not a compiled method
  	- the result fits in eden (actually below scavengeThreshold)"
  
  	| formatReg resultReg slotsReg ptrReg
  	  jumpImmediate jumpIsMethod jumpVariable jumpTooBig jumpEmpty jumpNoSpace
  	  continuance copyLoop |
- 	<var: #continue type: #'AbstractInstruction *'>
  	<var: #copyLoop type: #'AbstractInstruction *'>
  	<var: #jumpTooBig type: #'AbstractInstruction *'>
+ 	<var: #continuance type: #'AbstractInstruction *'>
  	<var: #jumpVariable type: #'AbstractInstruction *'>
  	<var: #jumpNoSpace type: #'AbstractInstruction *'>
  	<var: #jumpIsMethod type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  
  	jumpImmediate := self genJumpImmediate: ReceiverResultReg.
  	resultReg := Arg0Reg.
  	slotsReg := Arg1Reg.
  	"get freeStart as early as possible so as not to wait later..."
  	cogit MoveAw: objectMemory freeStartAddress R: resultReg.
  
  	"formatReg := self formatOf: ReceiverResultReg"
  	self genGetFormatOf: ReceiverResultReg
  		into: (ptrReg := formatReg := SendNumArgsReg)
  		leastSignificantHalfOfBaseHeaderIntoScratch: NoReg.
  
  	cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
  	jumpIsMethod := cogit JumpAboveOrEqual: 0.
  	cogit CmpCq: objectMemory indexablePointersFormat R: formatReg.
  	jumpVariable := cogit JumpZero: 0.
  	continuance := cogit Label.
  
  	self genGetRawSlotSizeOfNonImm: ReceiverResultReg into: slotsReg.
  	cogit CmpCq: objectMemory numSlotsMask R: slotsReg.
  	jumpTooBig := cogit JumpZero: 0.
  
  	cogit CmpCq: 0 R: slotsReg.
  	jumpEmpty := cogit JumpZero: 0.
  
  	"compute byte size for slots"
  	cogit
  		AddCq: objectMemory baseHeaderSize / objectMemory wordSize R: slotsReg;
  		LogicalShiftLeftCq: objectMemory shiftForWord R: slotsReg;
  	"check if allocation fits (freeSize + byteSize < scavengeThreshold); scavengeThreshold is constant."
  		AddR: resultReg R: slotsReg;
  		CmpCq: objectMemory getScavengeThreshold R: slotsReg.
  	jumpNoSpace := cogit JumpAboveOrEqual: 0.
  	cogit
  		MoveR: resultReg R: ptrReg;
  	"write back new freeStart; get result. slotsReg holds new freeStart, the limit of the object"
  		MoveR: slotsReg Aw: objectMemory freeStartAddress;
  	"set up loop bounds"
  		SubCq: objectMemory wordSize * 2 R: slotsReg;
  	"copy header, masking off irrelevant bits"
  		MoveMw: 0 r: ReceiverResultReg R: TempReg;
  		AndCq: (objectMemory
  					headerForSlots: objectMemory numSlotsMask
  					format: objectMemory formatMask
  					classIndex: objectMemory classIndexMask) R: TempReg;
  		MoveR: TempReg Mw: 0 r: resultReg.
  	copyLoop := cogit Label.
  	cogit
  		AddCq: objectMemory wordSize R: ReceiverResultReg;
  		AddCq: objectMemory wordSize R: ptrReg;
  		MoveMw: 0 r: ReceiverResultReg R: TempReg;
  		MoveR: TempReg Mw: 0 r: ptrReg;
  		CmpR: ptrReg R: slotsReg;
  		JumpAboveOrEqual: copyLoop;
  		MoveR: resultReg R: ReceiverResultReg;
  		genPrimReturn.
  
  	"If the receiver is variable pointers, fail if its a context, otherwise continue"
  	jumpVariable jmpTarget: cogit Label.
  	self genGetClassIndexOfNonImm: ReceiverResultReg into: ClassReg.
  	cogit
  		CmpCq: ClassMethodContextCompactIndex R: ClassReg;
  		JumpNonZero: continuance.
  
  	jumpImmediate jmpTarget:
  	(jumpNoSpace jmpTarget:
  	(jumpIsMethod jmpTarget:
  	(jumpTooBig jmpTarget:
  	(jumpEmpty jmpTarget: cogit Label)))).
  
  	^0!

Item was changed:
  ----- Method: StackInterpreter>>ioLoadExternalFunction:OfLength:FromModule:OfLength:AccessorDepthInto: (in category 'primitive support') -----
  ioLoadExternalFunction: functionName OfLength: functionLength FromModule: moduleName OfLength: moduleLength AccessorDepthInto: accessorDepthPtr
  	"Load and return the requested function from a module.  Assign the accessor depth through accessorDepthPtr.
  	 N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
  	<doNotGenerate>
  	| pluginString functionString |
  	pluginString := String new: moduleLength.
  	1 to: moduleLength do:[:i| pluginString byteAt: i put: (objectMemory byteAt: moduleName+i-1)].
- 	"Pharo images as of 2016 use the FFI plugin (for getenv:?).  We can't simulate such function loads.  So ignore"
- 	pluginString = 'SqueakFFIPrims' ifTrue:
- 		[self transcript cr; show: 'ignoring function load from SqueakFFIPrims'.
- 		 ^0].
  	functionString := String new: functionLength.
  	1 to: functionLength do:[:i| functionString byteAt: i put: (objectMemory byteAt: functionName+i-1)].
+ 	"Pharo images as of 2016 use the FFI plugin (for getenv:?).  We can't simulate such function loads.  So ignore"
+ 	pluginString = 'SqueakFFIPrims' ifTrue:
+ 		["self halt."
+ 		 true ifTrue:
+ 			[self transcript cr; show: 'ignoring function load from SqueakFFIPrims'.
+ 			 ^0]].
  	^self ioLoadFunction: functionString From: pluginString AccessorDepthInto: accessorDepthPtr!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveFindNextUnwindContext (in category 'control primitives') -----
  primitiveFindNextUnwindContext
  	"Primitive. Search up the context stack for the next method context marked for unwind
  	 handling from the receiver up to but not including the argument. Return nil if none found."
  	| stopContext calleeContext handlerOrNilOrZero |
  	<var: #theFP type: #'char *'>
  	stopContext := self stackTop.
  	calleeContext := self stackValue: 1.
  	(stopContext = objectMemory nilObject or: [objectMemory isContext: stopContext]) ifFalse:
  		[^self primitiveFail].
+ 	"The following should never be true, but developing full blocks, early in September
+ 	 2016 we were seeing invalid invocations of this primitive..  Hence the assert:"
+ 	self assert: stopContext ~= calleeContext.
  	self externalWriteBackHeadFramePointers.
  	(self isStillMarriedContext: calleeContext)
  		ifTrue:
  			[| theFP |
  			 theFP := self frameOfMarriedContext: calleeContext.
  			 (self isBaseFrame: theFP)
  				ifTrue:
  					[handlerOrNilOrZero := self findMethodWithPrimitive: 198
  												FromContext: (self frameCallerContext: theFP)
  												UpToContext: stopContext]
  				ifFalse:
  					[handlerOrNilOrZero :=  self findMethodWithPrimitive: 198
  												FromFP: (self frameCallerFP: theFP)
  												UpToContext: stopContext]]
  		ifFalse:
  			[| startContext |
  			 startContext := objectMemory fetchPointer: SenderIndex ofObject: calleeContext.
  			 (objectMemory isContext: startContext)
  				ifTrue:
  					[handlerOrNilOrZero := self findMethodWithPrimitive: 198
  												FromContext: startContext
  												UpToContext: stopContext]
  				ifFalse:
  					[handlerOrNilOrZero := 0]].
  	handlerOrNilOrZero = 0 ifTrue:
  		[handlerOrNilOrZero := objectMemory nilObject].
  	self pop: 2 thenPush: handlerOrNilOrZero!



More information about the Vm-dev mailing list