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

commits at source.squeak.org commits at source.squeak.org
Thu Nov 11 02:30:35 UTC 2021


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

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

Name: VMMaker.oscog-eem.3099
Author: eem
Time: 10 November 2021, 6:30:21.435667 pm
UUID: 5e2f37e6-5cf7-4851-9218-ca9e6397319f
Ancestors: VMMaker.oscog-eem.3098

Interpreter printing: must use %s to print object strings since they may contain %'s.

Simulator: 
Fix a stack bounds assert by applying it after the simulated return in handleCallOrJumpSimulationTrap:.
Get printing of strings to work when they contain loads of nulls.
Make Integer>>#singleStepRequiredToTriggerIn: function before the code zone has been initialized.

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

Item was added:
+ ----- Method: CArrayAccessor>>copyFrom:to: (in category 'converting') -----
+ copyFrom: start to: stop
+ 	"Coercion support for Printf"
+ 	^(object copyFrom: start + offset to: stop + offset) asString!

Item was changed:
  ----- Method: CogClass>>cCoerceSimple:to: (in category 'translation support') -----
  cCoerceSimple: value to: cTypeString
  	<doNotGenerate>
  	"Type coercion for translation and simulation.
  	 For simulation answer a suitable surrogate for the struct types"
  	^cTypeString caseOf:
  	   {	[#'unsigned long']							->	[value].
  		[#'unsigned int']							->	[value].
+ 		[#unsigned]								->	[value].
  		[#'unsigned short']							->	[value].
  		[#sqInt]									->	[value].
  		[#'sqIntptr_t']								->	[value].
  		[#'usqIntptr_t']								->	[value].
  		[#usqInt]									->	[value].
  		[#sqLong]									->	[value].
  		[#usqLong]								->	[value].
  		[#'AbstractInstruction *']					->	[value].
  		[#'SpurSegmentInfo *']						->	[value].
  		[#'BytecodeFixup *']						->	[value].
  		[#'CogMethod *']							->	[value].
  		[#'char *']									->	[value].
  		[#'sqInt *']									->	[value].
  		[#'void *']									->	[value].
  		[#void]										->	[value].
  		[#'void (*)()']								->	[value].
  		[#'void (*)(void)']							->	[value].
  		[#'usqIntptr_t (*)(void)']					->	[value].
  		[#'void (*)(usqIntptr_t,usqIntptr_t)']		->	[value].
  		[#'usqIntptr_t (*)(usqIntptr_t)']			->	[value].
  		[#'usqIntptr_t (*)(void)']					->	[value] }!

Item was changed:
  ----- Method: Cogit>>handleCallOrJumpSimulationTrap: (in category 'simulation only') -----
  handleCallOrJumpSimulationTrap: aProcessorSimulationTrap
  	<doNotGenerate>
  	| evaluable function memory result savedFramePointer savedStackPointer savedArgumentCount retpc invalidStackPointersExpected index |
  	"Execution of a single instruction must be within the processorLock critical section to ensure
  	 simulation traps are executed atomically.  However, at this point control is leaving machine
  	 code and entering the run-time and hence the lock must be released."
  	processorLock primitiveExitCriticalSection.
  	"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, and for the short-cut tracing trampolines"
  							[^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. ')'}.
  		 "self halt: evaluable selector."
  	   	 clickConfirm ifTrue:
  		 	[(self confirm: 'skip jump to interpret?') ifFalse:
  				[clickConfirm := false. self halt]].
  		 processor simulateJumpCallOf: aProcessorSimulationTrap address memory: memory.
  		 coInterpreter reenterInterpreter.
  		 "NOTREACHED"
  		 self halt].
  	(invalidStackPointersExpected := function == #ceBaseFrameReturn:) ifFalse:
  		[evaluable isBlock
  			ifTrue: "external primitives..."
  				["The only acceptable exception to the rule are fast C primitive calls..."
  				 (methodZone cogMethodContaining: (self mostLikelyPrimInvocationPC: processor pc or: (processor leafRetpcIn: memory)))
  					ifNil: [self assertf: 'call to block evaluable from non-external method']
  					ifNotNil: [:cogMethod|
  							coInterpreter assertValidExternalStackPointers]]
  			ifFalse:
  				[coInterpreter assertValidExternalStackPointers]].
  	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].
  			
- 	invalidStackPointersExpected ifFalse:
- 		[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.
+ 		 invalidStackPointersExpected ifFalse:
+ 			[coInterpreter assertValidExternalStackPointers].
  		 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: [(index := #(nil true false continueNoReturn) indexOf: result) > 0
  				and: [result := #(0 1 0 16rF00BA4) at: index. true]]]]).
  	processor cResultRegister: (result
  								ifNil: [0]
  								ifNotNil: [result isInteger
  											ifTrue: [result]
  											ifFalse: [16rF00BA222]])!

Item was changed:
  ----- Method: Integer>>singleStepRequiredToTriggerIn: (in category '*VMMaker-breakpoints') -----
  singleStepRequiredToTriggerIn: aCogit
+ 	^aCogit cogCodeBase
+ 		ifNil: [false]
+ 		ifNotNil: [:cogCodeBase| self between: cogCodeBase and: aCogit methodZone limitZony]!
- 	^self between: aCogit cogCodeBase and: aCogit methodZone limitZony!

Item was changed:
  ----- Method: SpurMemoryManager>>printStringDataOf:on: (in category 'debug printing interpreter support') -----
  printStringDataOf: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
  	| i limit n |
  	<var: 'buffer' type: #'char *'>
  	<var: 'wideBuffer' type: #'unsigned int *'>
  	(self isBytesNonImm: oop)
  		ifTrue:
  			[| buffer byte |
  			 buffer := self alloca: 256 * 4.
  			 n := i := 0.
  			 limit := (self numBytesOfBytes: oop) min: 256.
+ 			 [n < limit] whileTrue:
- 			 [i < limit] whileTrue:
  				[byte := self fetchByte: i ofObject: oop.
  				 (byte < 32 "space" and: [byte ~= 9 "tab"])
  					ifTrue:
  						[buffer at: n put: $<. n := n + 1.
  						 (byte = 10 or: [byte = 13])
  							ifTrue:
  								[byte = 10
  									ifTrue: [buffer at: n put: $L; at: n + 1 put: $F]
  									ifFalse: [buffer at: n put: $C; at: n + 1 put: $R].
  								 n := n + 2]
  							ifFalse:
  								[byte >= 10 ifTrue:
  									[buffer at: n put: byte // 10 + $0 asInteger. n := n + 1].
  								 buffer at: n put: byte \\ 10 + $0 asInteger. n := n + 1].
  						 buffer at: n put: $>. n := n + 1]
  					ifFalse: [buffer at: n put: byte. n := n + 1]].
  			 '%.*s%s\n' f: aStream printf: { n. buffer. (self numBytesOfBytes: oop) > limit ifTrue: ['...'] ifFalse: [''] }]
  		ifFalse:
  			[| wideBuffer word |
  			 self assert: (self isWordsNonImm: oop).
  			 wideBuffer := self cCoerce: (self alloca: 1024 * 4) to: 'int *'.
  			 n := i := 0.
  			 limit := (self lengthOf: oop) min: 256.
  			 [i < limit] whileTrue:
  				[word := self fetchLong32: i ofObject: oop.
  				 (word < 32 "space" and: [word ~= 9 "tab"])
  					ifTrue:
  						[wideBuffer at: n put: $<. n := n + 1.
  						 (word = 10 or: [word = 13])
  							ifTrue:
  								[word = 10
  									ifTrue: [wideBuffer at: n put: $L; at: n + 1 put: $F]
  									ifFalse: [wideBuffer at: n put: $C; at: n + 1 put: $R].
  								 n := n + 2]
  							ifFalse:
  								[word >= 10 ifTrue:
  									[wideBuffer at: n put: word // 10 + $0 asInteger. n := n + 1].
  								 wideBuffer at: n put: word \\ 10 + $0 asInteger. n := n + 1].
  						 wideBuffer at: n put: $>. n := n + 1]
  					ifFalse: [wideBuffer at: n put: word. n := n + 1]].
  			 '%.*s%s\n' f: aStream wprintf: { n. wideBuffer. (self lengthOf: oop) > limit ifTrue: ['...'] ifFalse: [''] }]!

Item was changed:
  ----- Method: StackInterpreter>>print: (in category 'debug printing') -----
  print: s
  	<api>
  	<var: #s type: #'char *'>
+ 	transcript f: '%s' printf: s!
- 	transcript fprintf: s!



More information about the Vm-dev mailing list