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

commits at source.squeak.org commits at source.squeak.org
Sat Jan 2 21:29:15 UTC 2021


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

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

Name: VMMaker.oscog-eem.2918
Author: eem
Time: 2 January 2021, 1:29:06.750497 pm
UUID: 17130111-28bf-421b-b6f1-722773efdaee
Ancestors: VMMaker.oscog-nice.2917

Simulator:
Fix C stack alignment checking for non-RISC simulators.  With the changes to invoking the interpreter via ceInvokeInterpreter and ceReturnToInterpreter we need to change the simulation machinery to better mimic the production VM, and so handleCallOrJumpSimulationTrap: sends simulateJumpCallOf:memory: immediately before raising ReturnToInterpreter, and getReturnAddress will answer #enterSmalltalkExecutiveImplementation rather than #initialEnterSmalltalkExecutive

Get rid of a break accidentally left behind

=============== Diff against VMMaker.oscog-nice.2917 ===============

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genPrimitiveAtPutSigned: (in category 'primitive generators') -----
  genPrimitiveAtPutSigned: signedVersion
  	"Generate the code for primitives 61 & 165, at:put:/basicAt:put: & integerAt:put:.  If signedVersion is true
  	 then generate signed accesses to the bits classes (a la 164 & 165).  If signedVersion is false,
  	 generate unsigned accesses (a la 60, 61, 63 & 64)."
  	| formatReg nSlotsOrBytesReg methodInBounds
  	  jumpImmediate jumpBadIndex jumpImmutable jumpNotIndexablePointers jumpNotIndexableBits
  	  jumpIsContext jumpIsCompiledMethod jumpIsBytes jumpIsShorts jumpHasFixedFields
  	  jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds
  	  jumpWordsOutOfBounds jumpShortsOutOfBounds jumpBytesOutOfBounds
  	  jumpShortsOutOfRange jumpWordsOutOfRange jumpBytesOutOfRange
  	  jumpNonSmallIntegerValue jumpNotPointers
  	  |
- 	self break.
  	"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
  
  	nSlotsOrBytesReg := ClassReg.
  
  	cogit genLoadArgAtDepth: 1 into: Arg0Reg.
  	cogit genLoadArgAtDepth: 0 into: Arg1Reg.
  	jumpImmediate := self genJumpImmediate: ReceiverResultReg.
  	jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: Arg0Reg.
  	cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
  
  	"formatReg := self formatOf: ReceiverResultReg"
  	self cppIf: IMMUTABILITY
  		ifTrue:
  		[ self genGetFormatOf: ReceiverResultReg
  			into: (formatReg := SendNumArgsReg)
  			leastSignificantHalfOfBaseHeaderIntoScratch: TempReg.
  		jumpImmutable := self genJumpBaseHeaderImmutable: TempReg ]
  		ifFalse: 
  		[ self genGetFormatOf: ReceiverResultReg
  			into: (formatReg := SendNumArgsReg)
  			leastSignificantHalfOfBaseHeaderIntoScratch: NoReg ].
  
  	self genGetNumSlotsOf: ReceiverResultReg into: nSlotsOrBytesReg.
  
  	"dispatch on format in a combination of highest dynamic frequency order first and convenience.
  		  0 = 0 sized objects (UndefinedObject True False et al)
  		  1 = non-indexable objects with inst vars (Point et al)
  		  2 = indexable objects with no inst vars (Array et al)
  		  3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  		  4 = weak indexable objects with inst vars (WeakArray et al)
  		  5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  		  6 unused, reserved for exotic pointer objects?
  		  7 Forwarded Object, 1st field is pointer, rest of fields are ignored
  		  8 unused, reserved for exotic non-pointer objects?
  		  9 64-bit indexable
  		10 - 11 32-bit indexable
  		12 - 15 16-bit indexable
  		16 - 23 byte indexable
  		24 - 31 compiled method"
  	cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
  	jumpNotPointers := cogit JumpAbove: 0.
  	"optimistic store check; assume index in range (almost always is)."
  	self genStoreCheckReceiverReg: ReceiverResultReg
  		valueReg: Arg1Reg
  		scratchReg: TempReg
  		inFrame: false.
  
  	cogit CmpCq: objectMemory arrayFormat R: formatReg.
  	jumpNotIndexablePointers := cogit JumpBelow: 0.
  	jumpHasFixedFields := cogit JumpNonZero: 0.
  	cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
  	jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
  	cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
  	jumpHasFixedFields jmpTarget: cogit Label.
  	self genGetClassIndexOfNonImm: ReceiverResultReg into: formatReg.
  	cogit CmpCq: ClassMethodContextCompactIndex R: formatReg.
  	jumpIsContext := cogit JumpZero: 0.
  	"get # fixed fields in formatReg"
  	cogit PushR: nSlotsOrBytesReg.
  	self genGetClassObjectOfClassIndex: formatReg into: nSlotsOrBytesReg scratchReg: TempReg.
  	self genLoadSlot: InstanceSpecificationIndex sourceReg: nSlotsOrBytesReg destReg: formatReg.
  	cogit PopR: nSlotsOrBytesReg.
  	self genConvertSmallIntegerToIntegerInReg: formatReg.
  	cogit AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg.
  	cogit SubR: formatReg R: nSlotsOrBytesReg.
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: formatReg.
  	cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
  	jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit AddR: formatReg R: Arg0Reg.
  	cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
  	jumpNotPointers jmpTarget: cogit Label.
  	jumpNonSmallIntegerValue := self genJumpNotSmallInteger: Arg1Reg scratchReg: TempReg.
  					cogit CmpCq: objectMemory firstByteFormat R: formatReg.
  	jumpIsBytes := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory firstShortFormat R: formatReg.
  	jumpIsShorts := cogit JumpAboveOrEqual: 0.
  					cogit CmpCq: objectMemory firstLongFormat R: formatReg.
  	"For now ignore 64-bit indexability."
  	jumpNotIndexableBits := cogit JumpBelow: 0.
  
  	"fall through to words"
  	cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
  	jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	signedVersion ifFalse:
  		[(cogit lastOpcode setsConditionCodesFor: JumpLess) ifFalse:
  			[cogit CmpCq: 0 R: TempReg]. "N.B. FLAGS := TempReg - 0"
  		jumpWordsOutOfRange := cogit JumpLess: 0].
  	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
  	cogit MoveR: TempReg Xwr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
  	signedVersion
  		ifTrue:
  			[jumpIsBytes jmpTarget:
  			 (cogit ArithmeticShiftRightCq: 7 + objectMemory numSmallIntegerTagBits R: Arg1Reg R: TempReg). "Maps in range to -1,0".
  			 cogit AddCq: 1 R: TempReg. "Maps in range to 0,1"
  			 cogit CmpCq: 1 R: TempReg]
  		ifFalse:
  			[jumpIsBytes jmpTarget:
  			 (cogit CmpCq: (objectMemory integerObjectOf: 255) R: Arg1Reg)].
  	jumpBytesOutOfRange := cogit JumpAbove: 0.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord R: nSlotsOrBytesReg.
  	cogit AndCq: objectMemory wordSize - 1 R: formatReg R: TempReg.
  	cogit SubR: TempReg R: nSlotsOrBytesReg.
  	cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
  	jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg.
  	jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
  	methodInBounds :=
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
  	cogit MoveR: TempReg Xbr: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
  	signedVersion
  		ifTrue:
  			[jumpIsShorts jmpTarget:
  			 (cogit ArithmeticShiftRightCq: 15 + objectMemory numSmallIntegerTagBits R: Arg1Reg R: TempReg). "Maps in range to -1,0".
  			 cogit AddCq: 1 R: TempReg. "Maps in range to 0,1"
  			 cogit CmpCq: 1 R: TempReg]
  		ifFalse:
  			[jumpIsShorts jmpTarget:
  			 (cogit CmpCq: (objectMemory integerObjectOf: 65535) R: Arg1Reg)].
  	jumpShortsOutOfRange := cogit JumpAbove: 0.
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: nSlotsOrBytesReg.
  	cogit AndCq: objectMemory wordSize / 2 - 1 R: formatReg.
  	cogit SubR: formatReg R: nSlotsOrBytesReg.
  	cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
  	jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
  	cogit MoveR: Arg1Reg R: TempReg.
  	self genConvertSmallIntegerToIntegerInReg: TempReg.
  	cogit AddR: Arg0Reg R: ReceiverResultReg.
  	cogit AddR: Arg0Reg R: ReceiverResultReg.
  	cogit MoveR: TempReg M16: objectMemory baseHeaderSize r: ReceiverResultReg.
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit genPrimReturn.
  
  	"Now check that the index is beyond the method's literals..."
  	jumpIsCompiledMethod jmpTarget: cogit Label.
  	self getLiteralCountOf: ReceiverResultReg plusOne: true inBytes: true into: nSlotsOrBytesReg scratch: TempReg.
  	cogit CmpR: Arg0Reg R: nSlotsOrBytesReg.
  	cogit JumpBelow: methodInBounds.
  
  	jumpIsContext jmpTarget: 
  	(jumpNotIndexableBits jmpTarget:
  	(jumpBytesOutOfRange jmpTarget:
  	(jumpShortsOutOfRange jmpTarget:
  	(jumpIsCompiledMethod jmpTarget:
  	(jumpArrayOutOfBounds jmpTarget:
  	(jumpBytesOutOfBounds jmpTarget:
  	(jumpShortsOutOfBounds jmpTarget:
  	(jumpWordsOutOfBounds jmpTarget:
  	(jumpNotIndexablePointers jmpTarget:
  	(jumpNonSmallIntegerValue jmpTarget:
  	(jumpFixedFieldsOutOfBounds jmpTarget: cogit Label))))))))))).
  	
  	signedVersion ifFalse:
  		[jumpWordsOutOfRange jmpTarget: jumpIsContext getJmpTarget].
  	self cppIf: IMMUTABILITY
  		ifTrue: [jumpImmutable jmpTarget: jumpIsContext getJmpTarget].
  
  	cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
  	self genConvertIntegerToSmallIntegerInReg: Arg0Reg.
  
  	jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label).
  
  	^0 "Can't be complete because of contexts."!

Item was changed:
  ----- Method: CogVMSimulator>>getReturnAddress (in category 'simulation only') -----
  getReturnAddress
+ 	"In the real VM this answers the return address for its caller, i.e. for interpret.
+ 	 In the simulator we're playing fast and loose with initialEnterSmalltalkExecutive
+ 	 and enterSmalltalkExecutiveImplementation and need them to look and act the same."
+ 	| selector |
+ 	selector := (thisContext findContextSuchThat: [:ctxt| ctxt selector == #interpret]) sender method selector.
+ 	^selector == #initialEnterSmalltalkExecutive
+ 		ifTrue: [#enterSmalltalkExecutiveImplementation]
+ 		ifFalse: [selector]!
- 	^(thisContext findContextSuchThat: [:ctxt| ctxt selector == #interpret]) sender method selector!

Item was changed:
  ----- Method: Cogit>>handleCallOrJumpSimulationTrap: (in category 'simulation only') -----
  handleCallOrJumpSimulationTrap: aProcessorSimulationTrap
  	<doNotGenerate>
  	| evaluable function memory result savedFramePointer savedStackPointer savedArgumentCount retpc |
  
  	"This is a hack fix before we revise the simulators.  When a jump call is made, the next
  	 pc is effectively the return address on the stack, not the instruction following the jump."
  	aProcessorSimulationTrap type == #jump ifTrue:
  		[processor hackFixNextPCOfJumpFor: aProcessorSimulationTrap using: objectMemory].
  
  	evaluable := simulatedTrampolines
  					at: aProcessorSimulationTrap address
  					ifAbsent: [self errorProcessingSimulationTrap: aProcessorSimulationTrap
  								in: simulatedTrampolines].
  	function := evaluable isBlock
  					ifTrue: ['aBlock; probably some plugin primitive']
  					ifFalse:
+ 						[evaluable receiver == backEnd ifTrue: "this is for invoking ARMv5 floating-point intrinsics"
- 						[evaluable receiver == backEnd ifTrue:
  							[^self handleABICallOrJumpSimulationTrap: aProcessorSimulationTrap evaluable: evaluable].
  						 evaluable selector].
  	memory := coInterpreter memory.
  	function == #interpret ifTrue: "i.e. we're here via ceInvokeInterpret/ceReturnToInterpreterTrampoline and should discard all state back to enterSmalltalkExecutiveImplementation"
  		[self recordInstruction: {'(simulated jump call of '. aProcessorSimulationTrap address. '/'. function. ')'}.
+ 		 processor simulateJumpCallOf: aProcessorSimulationTrap address memory: memory.
- 		 processor smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize.
  		 coInterpreter reenterInterpreter.
  		 "NOTREACHED"
  		 self halt].
  	function ~~ #ceBaseFrameReturn: ifTrue:
  		[coInterpreter assertValidExternalStackPointers].
  	(backEnd wantsNearAddressFor: function) ifTrue:
  		[^self perform: function with: aProcessorSimulationTrap].
  	processor
  		simulateCallOf: aProcessorSimulationTrap address
  		nextpc: aProcessorSimulationTrap nextpc
  		memory: memory.
  	retpc := processor retpcIn: memory.
  	self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. function. ')'}.
  	savedFramePointer := coInterpreter framePointer.
  	savedStackPointer := coInterpreter stackPointer.
  	savedArgumentCount := coInterpreter argumentCount.
  	result := ["self halt: evaluable selector."
  		   	   clickConfirm ifTrue:
  			 	[(self confirm: 'skip run-time call?') ifFalse:
  					[clickConfirm := false. self halt]].
  			   evaluable valueWithArguments: (processor
  												postCallArgumentsNumArgs: evaluable numArgs
  												in: memory)]
  				on: ReenterMachineCode
  				do: [:ex| ex return: #continueNoReturn].
  			
  	coInterpreter assertValidExternalStackPointers.
  	"Verify the stack layout assumption compileInterpreterPrimitive: makes, provided we've
  	 not called something that has built a frame, such as closure value or evaluate method, or
  	 switched frames, such as primitiveSignal, primitiveWait, primitiveResume, primitiveSuspend et al."
  	(function beginsWith: 'primitive') ifTrue:
  		[coInterpreter primFailCode = 0
  			ifTrue: [(CogVMSimulator stackAlteringPrimitives includes: function) ifFalse:
  						["This is a rare case (e.g. in Scorch where a married context's sender is set to nil on trapTrpped and hence the stack layout is altered."
  						 (function == #primitiveSlotAtPut and: [objectMemory isContext: (coInterpreter frameReceiver: coInterpreter framePointer)]) ifFalse:
  							[self assert: savedFramePointer = coInterpreter framePointer.
  							 self assert: savedStackPointer + (savedArgumentCount * objectMemory wordSize)
  									= coInterpreter stackPointer]]]
  			ifFalse:
  				[self assert: savedFramePointer = coInterpreter framePointer.
  				 self assert: savedStackPointer = coInterpreter stackPointer]].
  	result ~~ #continueNoReturn ifTrue:
  		[self recordInstruction: {'(simulated return to '. processor retpcIn: memory. ')'}.
  		 processor simulateReturnIn: memory.
  		 self assert: processor pc = retpc.
  		 processor smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize].
  	self assert: (result isInteger "an oop result"
  			or: [result == coInterpreter
  			or: [result == objectMemory
  			or: [result == nil
  			or: [result == #continueNoReturn]]]]).
  	processor cResultRegister: (result
  								ifNil: [0]
  								ifNotNil: [result isInteger
  											ifTrue: [result]
  											ifFalse: [16rF00BA222]])!

Item was changed:
  ----- Method: StackInterpreter>>initialEnterSmalltalkExecutive (in category 'initialization') -----
  initialEnterSmalltalkExecutive
  	"Main entry-point into the interpreter at system start-up.
+ 	 In the non-threaded VM this is identical to enterSmalltalkExecutive
+ 
+ 	 N.B. It also provides the simulator's implementation of ceReturnToInterpreter/ceInvokeInterpreter, which
+ 	 via a simulation trap raise the ReenterInterpreter signal in handleCallOrJumpSimulationTrap:/reenterInterpreter.
+ 	 So when ReenterInterpreter is caught this metod invokes interpret directly. "
- 	 In the non-threaded VM this is identical to enterSmalltalkExecutive"
  	<cmacro: '() enterSmalltalkExecutiveImplementation()'>
  	"Simulation of the setjmp in enterSmalltalkExecutiveImplementation for reentry into interpreter."
+ 	| caught |
+ 	caught := false.
+ 	[([caught
+ 			ifFalse: [self enterSmalltalkExecutiveImplementation]
+ 			ifTrue: [self interpret]]
- 	[([self enterSmalltalkExecutiveImplementation]
  		on: ReenterInterpreter
+ 		do: [:ex|
+ 			caught := true.
+ 			ex return: ex returnValue]) = ReturnToInterpreter] whileTrue!
- 		do: [:ex| ex return: ex returnValue]) = ReturnToInterpreter] whileTrue!

Item was removed:
- ----- Method: StackInterpreter>>queueForwardedEvent: (in category 'I/O primitive support') -----
- queueForwardedEvent: event
- 	"SimulatorMorphicModel browse"
- 	<doNotGenerate>
- 	self eventQueue nextPut: event.
- 	self inputSemaphoreIndex
- 		ifNotNil:
- 			[:isi| self signalSemaphoreWithIndex: isi]
- 		ifNil:
- 			[nextPollUsecs := self ioUTCMicroseconds.
- 			 self forceInterruptCheck]!



More information about the Vm-dev mailing list