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

commits at source.squeak.org commits at source.squeak.org
Tue Aug 19 13:24:45 UTC 2014


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

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

Name: VMMaker.oscog-eem.861
Author: eem
Time: 19 August 2014, 2:22:02.411 pm
UUID: fab1298a-2969-4281-816e-0733d5d11443
Ancestors: VMMaker.oscog-eem.860

Spur:
Fix the bootstrap by initializing the become effects flags
constants in SpurMemMgr class>>initialize

Put the stack accessors in their own category to simplify
inferring isStackAccessor: when computing primitive
accessor depths.

Simulator:
Add support for counting full lookups.

Fix the short-cut trampolines for the tracing routines; they
weren't brought forward when trampolines were changed.

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

Item was changed:
  CoInterpreterMT subclass: #CogVMSimulator
+ 	instanceVariableNames: 'enableCog byteCount lastPollCount lastExtPC sendCount lookupCount printSends traceOn myBitBlt displayForm imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters'
- 	instanceVariableNames: 'enableCog byteCount lastPollCount lastExtPC sendCount printSends traceOn myBitBlt displayForm imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JITSimulation'!
  
  !CogVMSimulator commentStamp: 'eem 9/3/2013 11:16' prior: 0!
  This class defines basic memory access and primitive simulation so that the CoInterpreter can run simulated in the Squeak environment.  It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.  Remember that you can test the Cogit using its class-side in-image compilation facilities.
  
  To see the thing actually run, you could (after backing up this image and changes), execute
  
  	(CogVMSimulator new openOn: Smalltalk imageName) test
  
  and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be.  We usually do this with a small and simple benchmark image.
  
  Here's an example to launch the simulator in a window.  The bottom-right window has a menu packed with useful stuff:
  
  (CogVMSimulator newWithOptions: #(Cogit StackToRegisterMappingCogit))
  	desiredNumStackPages: 8;
  	openOn: '/Users/eliot/Cog/startreader.image';
  	openAsMorph;
  	run
  
  Here's a hairier example that I (Eliot) actually use in daily development with some of the breakpoint facilities commented out.
  
  | cos proc opts |
  CoInterpreter initializeWithOptions: (opts := Dictionary newFromPairs: #(Cogit StackToRegisterMappingCogit)).
  CogVMSimulator chooseAndInitCogitClassWithOpts: opts.
  cos := CogVMSimulator new.
  "cos initializeThreadSupport." "to test the multi-threaded VM"
  cos desiredNumStackPages: 8. "to set the size of the stack zone"
  "cos desiredCogCodeSize: 8 * 1024 * 1024." "to set the size of the Cogit's code zone"
  cos openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. "choose your favourite image"
  "cos setBreakSelector: 'r:degrees:'." "set a breakpoint at a specific selector"
  proc := cos cogit processor.
  "cos cogit sendTrace: 7." "turn on tracing"
  "set a complex breakpoint at a specific point in machine code"
  "cos cogit singleStep: true; breakPC: 16r56af; breakBlock: [:cg|  cos framePointer > 16r101F3C and: [(cos longAt: cos framePointer - 4) = 16r2479A and: [(cos longAt: 16r101F30) = (cos longAt: 16r101F3C) or: [(cos longAt: 16r101F2C) = (cos longAt: 16r101F3C)]]]]; sendTrace: 1".
  "[cos cogit compilationTrace: -1] on: MessageNotUnderstood do: [:ex|]." "turn on compilation tracing in the StackToRegisterMappingCogit"
  "cos cogit setBreakMethod: 16rB38880."
  cos
  	openAsMorph;
  	"toggleTranscript;" "toggleTranscript will send output to the Transcript instead of the morph's rather small window"
  	halt;
  	run!

Item was changed:
  ----- Method: CogVMSimulator>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the CogVMSimulator when running the interpreter inside Smalltalk.  The
  	 primary responsibility of this method is to allocate Smalltalk Arrays for variables
  	 that will be declared as statically-allocated global arrays in the translated code."
  	super initialize.
  
  	transcript := Transcript.
  
  	objectMemory ifNil:
  		[objectMemory := self class objectMemoryClass simulatorClass new].
  	cogit ifNil:
  		[cogit := self class cogitClass new setInterpreter: self].
  	objectMemory coInterpreter: self cogit: cogit.
  
  	cogit numRegArgs > 0 ifTrue:
  		[debugStackDepthDictionary := Dictionary new].
  
  	cogThreadManager ifNotNil:
  		[super initialize].
  
  	"Note: we must initialize ConstMinusOne & HasBeenReturnedFromMCPC differently
  	 for simulation, due to the fact that the simulator works only with +ve 32-bit values"
  	ConstMinusOne := objectMemory integerObjectOf: -1.
  	HasBeenReturnedFromMCPC := objectMemory integerObjectOf: -1.
  	cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())"
  	enableCog := true.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	self flushAtCache.
  	cogCompiledCodeCompactionCalledFor := false.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	mappedPluginEntries := OrderedCollection new.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[primitiveAccessorDepthTable := Array new: primitiveTable size.
  			 pluginList := {}.
  			 self loadNewPlugin: '']
  		ifFalse:
  			[pluginList := {'' -> self }].
  	desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0.
  	"This is initialized on loading the image, but convenient for testing stack page values..."
  	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := Time totalSeconds * 1000000.
  	maxLiteralCountForCompile := MaxLiteralCountForCompile.
  	minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
  	flagInterpretedMethods := false.
  
  	"initialize InterpreterSimulator variables used for debugging"
+ 	byteCount := lastPollCount := sendCount := lookupCount := 0.
- 	byteCount := lastPollCount := sendCount := 0.
  	quitBlock := [^ self].
  	traceOn := true.
  	printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	displayForm := 'Display has not yet been installed' asDisplayText form.
  	suppressHeartbeatFlag := deferSmash := deferredSmash := false.
  	systemAttributes := Dictionary new.
  	primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
  	primTraceLogIndex := 0.
  	traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0).
  	traceLogIndex := 0.
  	traceSources := TraceSources.
  	statCodeCompactionCount := 0.
  	statCodeCompactionUsecs := 0.
  	extSemTabSize := 256!

Item was added:
+ ----- Method: CogVMSimulator>>lookupMethodInClass: (in category 'message sending') -----
+ lookupMethodInClass: class
+ 	lookupCount := lookupCount + 1.
+ 	^super lookupMethodInClass: class!

Item was added:
+ ----- Method: CogVMSimulator>>lookupMethodNoMNUEtcInClass: (in category 'callback support') -----
+ lookupMethodNoMNUEtcInClass: class
+ 	lookupCount := lookupCount + 1.
+ 	^super lookupMethodNoMNUEtcInClass: class!

Item was changed:
  ----- Method: Cogit>>compileEntry (in category 'compile abstract instructions') -----
  compileEntry
  	"The entry code to a method checks that the class of the current receiver matches
  	 that in the inline cache.  Other non-obvious elements are that its alignment must be
  	 different from the alignment of the noCheckEntry so that the method map machinery
  	 can distinguish normal and super sends (super sends bind to the noCheckEntry).
  	 In Newspeak we also need to distinguish dynSuperSends from normal and super
  	 and so on Nespeak, bind the dynSuperEntry to the preceeding nop (on x86 there
  	 happens to be one anyway)."
  
  	self cppIf: NewspeakVM ifTrue:
  		[self Nop. "1st nop differentiates dynSuperEntry from no-check entry if using nextMethod"
  		 dynSuperEntry := self Nop].
  	entry := objectRepresentation genGetInlineCacheClassTagFrom: ReceiverResultReg into: TempReg forEntry: true.
  	self CmpR: ClassReg R: TempReg.
  	self JumpNonZero: sendMiss.
  	noCheckEntry := self Label.
+ 	self compileSendTrace ifTrue:
- 	self recordSendTrace ifTrue:
  		[self CallRT: ceTraceLinkedSendTrampoline]!

Item was added:
+ ----- Method: Cogit>>compileSendTrace (in category 'debugging') -----
+ compileSendTrace
+ 	<api>
+ 	<cmacro: '() (traceFlags & 2)'>
+ 	"256 = count sends, which is simulation only"
+ 	^(traceFlags bitAnd: 256 + 2) ~= 0!

Item was changed:
  ----- Method: Cogit>>sendTrace: (in category 'debugging') -----
  sendTrace: aBooleanOrInteger
  	<doNotGenerate>
  	"traceFlags is a set of flags.
  	 1 => print trace (if something below is selected)
  	 2 => trace sends
  	 4 => trace block activations
  	 8 => trace interpreter primitives
  	 16 => trace events (context switches, GCs, etc)
  	 32 => trace stack overflow
  	 64 => send breakpoint on implicit receiver (Newspeak VM only)
+ 	128 => check stack depth on send (simulation only)
+ 	256 => count sends (simulation only)"
- 	128 => check stack depth on send (simulation only)"
  	traceFlags := aBooleanOrInteger isInteger
  							ifTrue: [aBooleanOrInteger]
  							ifFalse: [aBooleanOrInteger ifTrue: [6] ifFalse: [0]]!

Item was changed:
  ----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') -----
  initialize
  	"SpurMemoryManager initialize"
  	BitsPerByte := 8.
  
+ 	"Initialize at least the become constants for the Spur bootstrap where the
+ 	 old ObjectMemory simulator is used before a Spur simulator is created.."
+ 	self initializeSpurObjectRepresentationConstants.
+ 
  	"Pig compact can be repeated to compact better.  Experience shows that 3 times
  	 compacts very well, desirable for snapshots.  But this is overkill for normal GCs."
  	CompactionPassesForGC := 2.
  	CompactionPassesForSnapshot := 3.
  
  	"An obj stack is a stack of objects stored in a hidden root slot, such as
  	 the markStack or the ephemeronQueue.  It is a linked list of segments,
  	 with the hot end at the head of the list.  It is a word object.  The stack
  	 pointer is in ObjStackTopx and 0 means empty.  The list goes through
  	 ObjStackNextx. We don't want to shrink objStacks, since they're used
  	 in GC and its good to keep their memory around.  So unused pages
  	 created by popping emptying pages are kept on the ObjStackFreex list.
  	 ObjStackNextx must be the last field for swizzleObjStackAt:."
  	ObjStackPageSlots := 4092. "+ double header = 16k bytes per page in 32-bits"
  	ObjStackTopx := 0.
  	ObjStackMyx := 1.
  	ObjStackFreex := 2.
  	ObjStackNextx := 3.
  	ObjStackFixedSlots := 4.
  	ObjStackLimit := ObjStackPageSlots - ObjStackFixedSlots.
  	"The hiddenHootsObject contains the classTable pages and up to 8 additional objects.
  	 Currently we use four; the three objStacks, the mark stack, the weaklings and the
  	 ephemeron queue, and the rememberedSet."
  	MarkStackRootIndex := self basicNew classTableRootSlots.
  	WeaklingStackRootIndex := MarkStackRootIndex + 1.
  	EphemeronQueueRootIndex := MarkStackRootIndex + 2.
  	RememberedSetRootIndex := MarkStackRootIndex + 3.
  
  	MarkObjectsForEnumerationPrimitives := false.
  
  	"The remap buffer support is for compatibility; Spur doesn't GC during allocation.
  	 Eventually this should die."
  	RemapBufferSize := 25.
  
  	"Extra roots are for plugin support."
  	ExtraRootsSize := 2048 "max. # of external roots"!

Item was changed:
  ----- Method: StackInterpreter class>>isStackAccessor: (in category 'spur compilation support') -----
  isStackAccessor: selector
+ 	^(StackInterpreter whichCategoryIncludesSelector: selector) = #'stack access'!
- 	^#( stackTop stackValue: stackTopPut: stackValue:put:
- 		stackFloatValue: stackIntegerValue: stackObjectValue:) includes: selector!

Item was changed:
  ----- Method: StackInterpreter>>postBecomeAction: (in category 'object memory support') -----
  postBecomeAction: theBecomeEffectsFlags
  	"Insulate the stack zone from the effects of a become.
  	 All receivers must be unfollowed for two reasons:
  		1. inst var access is direct with no read barrier
  		2. super sends (always to the receiver) have no class check and so don't trap
  		   for forwarded receivers.
  	 Methods must be unfollowed since bytecode access is direct with no read barrier.
  	 But this only needs to be done if the becomeEffectsFlags indicate that a
  	 CompiledMethod was becommed.
+ 	 The scheduler state must be followed, but only if the becomeEffectsFlags indicate
- 	 The sceduler state must be followed, but only if the becomeEffectsFlags indicate
  	 that a pointer object was becommed."
  	self followForwardingPointersInStackZone: theBecomeEffectsFlags.
  	theBecomeEffectsFlags ~= 0 ifTrue:
  		[(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
  			[self followForwardedMethodsInMethodCache.
  			 self followForwardedMethodsInMethodZone]. "for CoInterpreter"
  		 self followForwardingPointersInScheduler.
  		 self followForwardingPointersInSpecialObjectsArray.
  		 self followForwardingPointersInProfileState]!

Item was changed:
+ ----- Method: StackInterpreter>>stackFloatValue: (in category 'stack access') -----
- ----- Method: StackInterpreter>>stackFloatValue: (in category 'internal interpreter access') -----
  stackFloatValue: offset
  	"In the StackInterpreter stacks grow down."
  	<returnTypeC: #double>
  	^self floatValueOf: (stackPages longAt: stackPointer + (offset*BytesPerWord))!

Item was changed:
+ ----- Method: StackInterpreter>>stackIntegerValue: (in category 'stack access') -----
- ----- Method: StackInterpreter>>stackIntegerValue: (in category 'internal interpreter access') -----
  stackIntegerValue: offset
  	"In the StackInterpreter stacks grow down."
  	| integerPointer |
  	integerPointer := stackPages longAt: stackPointer + (offset*BytesPerWord).
  	^self checkedIntegerValueOf: integerPointer!

Item was changed:
+ ----- Method: StackInterpreter>>stackObjectValue: (in category 'stack access') -----
- ----- Method: StackInterpreter>>stackObjectValue: (in category 'internal interpreter access') -----
  stackObjectValue: offset
  	"Ensures that the given object is a real object, not a SmallInteger."
  	"In the StackInterpreter stacks grow down."
  	| oop |
  	oop := stackPages longAt: stackPointer + (offset * BytesPerWord).
  	(objectMemory isImmediate: oop) ifTrue:
  		[self primitiveFail. ^ nil].
  	^oop!

Item was changed:
+ ----- Method: StackInterpreter>>stackPositiveMachineIntegerValue: (in category 'stack access') -----
- ----- Method: StackInterpreter>>stackPositiveMachineIntegerValue: (in category 'internal interpreter access') -----
  stackPositiveMachineIntegerValue: offset
  	<api>
  	"In the StackInterpreter stacks grow down."
  	| integerPointer |
  	integerPointer := stackPages longAt: stackPointer + (offset*BytesPerWord).
  	^self positiveMachineIntegerValueOf: integerPointer!

Item was changed:
+ ----- Method: StackInterpreter>>stackSignedMachineIntegerValue: (in category 'stack access') -----
- ----- Method: StackInterpreter>>stackSignedMachineIntegerValue: (in category 'internal interpreter access') -----
  stackSignedMachineIntegerValue: offset
  	<api>
  	"In the StackInterpreter stacks grow down."
  	| integerPointer |
  	integerPointer := stackPages longAt: stackPointer + (offset*BytesPerWord).
  	^self signedMachineIntegerValueOf: integerPointer!

Item was changed:
+ ----- Method: StackInterpreter>>stackTop (in category 'stack access') -----
- ----- Method: StackInterpreter>>stackTop (in category 'internal interpreter access') -----
  stackTop
  	<api>
  	^stackPages longAt: stackPointer!

Item was changed:
+ ----- Method: StackInterpreter>>stackTopPut: (in category 'stack access') -----
- ----- Method: StackInterpreter>>stackTopPut: (in category 'internal interpreter access') -----
  stackTopPut: aValue
  
  	^stackPages longAtPointer: stackPointer put: aValue!

Item was changed:
+ ----- Method: StackInterpreter>>stackValue: (in category 'stack access') -----
- ----- Method: StackInterpreter>>stackValue: (in category 'internal interpreter access') -----
  stackValue: offset
  	<api>
  	"In the StackInterpreter stacks grow down."
  	^stackPages longAt: stackPointer + (offset*BytesPerWord)!

Item was changed:
+ ----- Method: StackInterpreter>>stackValue:put: (in category 'stack access') -----
- ----- Method: StackInterpreter>>stackValue:put: (in category 'internal interpreter access') -----
  stackValue: offset put: oop
  	"In the StackInterpreter stacks grow down."
  	^stackPages
  		longAt: stackPointer + (offset*BytesPerWord)
  		put: oop!

Item was changed:
  StackInterpreterPrimitives subclass: #StackInterpreterSimulator
+ 	instanceVariableNames: 'parent bootstrapping byteCount breakCount sendCount lookupCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue assertVEPAES'
- 	instanceVariableNames: 'parent bootstrapping byteCount breakCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue assertVEPAES'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-InterpreterSimulation'!
  
  !StackInterpreterSimulator commentStamp: 'eem 9/3/2013 11:05' prior: 0!
  This class defines basic memory access and primitive simulation so that the StackInterpreter can run simulated in the Squeak environment.  It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.
  
  To see the thing actually run, you could (after backing up this image and changes), execute
  
  	(StackInterpreterSimulator new openOn: Smalltalk imageName) test
  
  	((StackInterpreterSimulator newWithOptions: #(NewspeakVM true MULTIPLEBYTECODESETS true))
  		openOn: 'ns101.image') test
  
  and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be.  We usually do this with a small and simple benchmark image.
  
  Here's an example of what Eliot uses to launch the simulator in a window.  The bottom-right window has a menu packed with useful stuff:
  
  | vm |
  vm := StackInterpreterSimulator newWithOptions: #().
  vm openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'.
  vm setBreakSelector: #&.
  vm openAsMorph; run!

Item was changed:
  ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the StackInterpreterSimulator when running the interpreter
  	 inside Smalltalk. The primary responsibility of this method is to allocate
  	 Smalltalk Arrays for variables that will be declared as statically-allocated
  	 global arrays in the translated code."
  	super initialize.
  
  	bootstrapping := false.
  	transcript := Transcript.
  
  	objectMemory ifNil:
  		[objectMemory := self class objectMemoryClass simulatorClass new].
  	objectMemory coInterpreter: self.
  
  	"Note: we must initialize ConstMinusOne differently for simulation,
  		due to the fact that the simulator works only with +ve 32-bit values"
  	ConstMinusOne := objectMemory integerObjectOf: -1.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	mappedPluginEntries := OrderedCollection new.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[primitiveAccessorDepthTable := Array new: primitiveTable size.
  			 pluginList := {}.
  			 self loadNewPlugin: '']
  		ifFalse:
  			[pluginList := {'' -> self }].
  	desiredNumStackPages := desiredEdenBytes := 0.
  	"This is initialized on loading the image, but convenient for testing stack page values..."
  	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := Time totalSeconds * 1000000.
  
  	"initialize InterpreterSimulator variables used for debugging"
+ 	byteCount := sendCount := lookupCount := 0.
- 	byteCount := 0.
- 	sendCount := 0.
  	quitBlock := [^self].
  	traceOn := true.
  	printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	displayForm := 'Display has not yet been installed' asDisplayText form.
  	eventQueue := SharedQueue new.
  	suppressHeartbeatFlag := false.
  	systemAttributes := Dictionary new.
  	extSemTabSize := 256.
  	disableBooleanCheat := false.
  	assertVEPAES := true. "a flag so the assertValidExecutionPointers can be disabled for simulation speed"!

Item was added:
+ ----- Method: StackInterpreterSimulator>>lookupMethodInClass: (in category 'message sending') -----
+ lookupMethodInClass: class
+ 	lookupCount := lookupCount + 1.
+ 	^super lookupMethodInClass: class!

Item was added:
+ ----- Method: StackInterpreterSimulator>>lookupMethodNoMNUEtcInClass: (in category 'callback support') -----
+ lookupMethodNoMNUEtcInClass: class
+ 	lookupCount := lookupCount + 1.
+ 	^super lookupMethodNoMNUEtcInClass: class!

Item was added:
+ ----- Method: StackInterpreterSimulator>>nextImplicitReceiverFor:withMixin: (in category 'newspeak bytecode support') -----
+ nextImplicitReceiverFor: anObject withMixin: mixin
+ 	lookupCount := lookupCount + 1.
+ 	^super nextImplicitReceiverFor: anObject withMixin: mixin!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>generateTracingTrampolines (in category 'initialization') -----
  generateTracingTrampolines
  	"Generate trampolines for tracing.  In the simulator we can save a lot of time
  	 and avoid noise instructions in the lastNInstructions log by short-cutting these
  	 trampolines, but we need them in the real vm."
  	ceTraceLinkedSendTrampoline
  		:= self cCode:
  					[self genSafeTrampolineFor: #ceTraceLinkedSend:
  						called: 'ceTraceLinkedSendTrampoline'
  						arg: ReceiverResultReg]
  				inSmalltalk:
+ 					[self simulatedTrampolineFor: #ceShortCutTraceLinkedSend:].
- 					[| a |
- 					 simulatedTrampolines
- 						at: (a := self simulatedAddressFor: #ceShortCutTraceLinkedSend:)
- 						put: #ceShortCutTraceLinkedSend:.
- 					 a].
  	ceTraceBlockActivationTrampoline
  		:= self cCode:
  					[self genTrampolineFor: #ceTraceBlockActivation
  						called: 'ceTraceBlockActivationTrampoline']
  				inSmalltalk:
+ 					[self simulatedTrampolineFor: #ceShortCutTraceBlockActivation:].
- 					[| a |
- 					 simulatedTrampolines
- 						at: (a := self simulatedAddressFor: #ceShortCutTraceBlockActivation:)
- 						put: #ceShortCutTraceBlockActivation:.
- 					 a].
  	ceTraceStoreTrampoline
  		:= self cCode:
  					[self genSafeTrampolineFor: #ceTraceStoreOf:into:
  						called: 'ceTraceStoreTrampoline'
  						arg: TempReg
  						arg: ReceiverResultReg]
  				inSmalltalk:
+ 					[self simulatedTrampolineFor: #ceShortCutTraceStore:]!
- 					[| a |
- 					simulatedTrampolines
- 						at: (a := self simulatedAddressFor: #ceShortCutTraceStore:)
- 						put: #ceShortCutTraceStore:.
- 					 a]!



More information about the Vm-dev mailing list