VM Maker: VMMaker.oscog-eem.2032.mcz

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

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

Name: VMMaker.oscog-eem.2032
Author: eem
Time: 8 December 2016, 2:34:11.901673 pm
UUID: 11ee2d57-bc90-4060-9d13-cba0722ad042
Ancestors: VMMaker.oscog-eem.2031

Co/StackInterpreter:
Fix slip in makeBaseFrame:; the code to skip the primitive when activating a method with a primitive used the wrong way to determine the initial PC of a method.  Use the new startPCOfMethodHeader: (consistent with startPCOfMethod:).  Rename initialPCForHeader:method: to initialIPForHeader:method: top avoid confusion; IP is used for instructionPointers, i.e. addresses of bytecodes, not indexes of bytecodes.

Simulator:
Use logSend: consistently and have it also print the selector when printBytecodeAtEachStep is in effect.

RegisterAllocatingCogit:
Fix slips in initSimStackForFramelessMethod:.  Make CogRegisterAllocatingSimStackEntry printing more robust.

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

Item was changed:
  ----- Method: CoInterpreter>>activateCoggedNewMethod: (in category 'message sending') -----
  activateCoggedNewMethod: inInterpreter
  "Activate newMethod when newMethod has been cogged, i.e. create a machine-code frame and (re)enter machine-code."
  | methodHeader cogMethod rcvr numTemps errorCode switched |
  <var: #cogMethod type: #'CogMethod *'>
 
  methodHeader := self rawHeaderOf: newMethod.
  self assert: (self isCogMethodReference: methodHeader).
 
  cogMethod := self cCoerceSimple: methodHeader to: #'CogMethod *'.
  methodHeader := cogMethod methodHeader.
  rcvr := self stackValue: cogMethod cmNumArgs. "could new rcvr be set at point of send?"
  self push: instructionPointer.
  cogMethod stackCheckOffset = 0 ifTrue:
  ["frameless method; nothing to activate..."
  cogit numRegArgs > 0 ifTrue: "dont use and: so as to get Slang to inline cogit numRegArgs > 0"
  [cogMethod cmNumArgs <= cogit numRegArgs ifTrue:
  [self callRegisterArgCogMethod: cogMethod at: cogit noCheckEntryOffset receiver: rcvr]].
  self push: cogMethod asInteger + cogit noCheckEntryOffset.
  self push: rcvr.
  cogit ceCallCogCodePopReceiverReg.
  self error: 'should not be reached'].
  self push: framePointer.
  framePointer := stackPointer.
  self push: cogMethod asInteger.
  self push: objectMemory nilObject. "FxThisContext field"
  self push: rcvr.
 
  "clear remaining temps to nil"
  numTemps := self temporaryCountOfMethodHeader: methodHeader.
  cogMethod cmNumArgs + 1 to: numTemps do:
  [:i | self push: objectMemory nilObject].
 
  (self methodHeaderHasPrimitive: methodHeader) ifTrue:
  [| initialPC |
  "Store the error code if the method starts with a long store temp.  No instructionPointer skip because we're heading for machine code."
+ initialPC := (self initialIPForHeader: methodHeader method: newMethod) + (self sizeOfCallPrimitiveBytecode: methodHeader).
- initialPC := (self initialPCForHeader: methodHeader method: newMethod) + (self sizeOfCallPrimitiveBytecode: methodHeader).
  primFailCode ~= 0 ifTrue:
  [(objectMemory byteAt: initialPC) = (self longStoreBytecodeForHeader: methodHeader) ifTrue:
  [errorCode := self getErrorObjectFromPrimFailCode.
  self stackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"].
  primFailCode := 0]].
 
  "Now check for stack overflow or an event (interrupt, must scavenge, etc)."
  stackPointer >= stackLimit ifTrue:
  [self assert: cogMethod stackCheckOffset > cogit noCheckEntryOffset.
  self push: cogMethod asInteger + cogMethod stackCheckOffset.
  self push: rcvr.
  cogit ceEnterCogCodePopReceiverReg.
  self error: 'should not be reached'].
  instructionPointer := cogMethod asInteger + cogMethod stackCheckOffset.
  switched := self handleStackOverflowOrEventAllowContextSwitch: (self canContextSwitchIfActivating: newMethod header: methodHeader).
  self returnToExecutive: inInterpreter postContextSwitch: switched!

Item was changed:
  ----- Method: CoInterpreter>>activateNewFullClosureMethod:numArgs:mayContextSwitch: (in category 'control primitives') -----
  activateNewFullClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: mayContextSwitch
  "Similar to activateNewMethod but for Closure and newMethod."
  | numCopied theMethod methodHeader numTemps inInterpreter switched |
  <inline: true>
  numCopied := self copiedValueCountOfFullClosure: blockClosure.
  theMethod := objectMemory fetchPointer: FullClosureCompiledBlockIndex ofObject: blockClosure.
  self assert: (objectMemory isOopCompiledMethod: theMethod).
  methodHeader := self rawHeaderOf: theMethod.
  (self isCogMethodReference: methodHeader) ifTrue:
  [^self
  executeFullCogBlock: (self cogMethodOf: theMethod)
  closure: blockClosure
  mayContextSwitch: mayContextSwitch].
  "How do we know when to compile a block method?
  One simple criterion is to check if the block is running within its inner context,
  i.e. if the outerContext is married.
  Even simpler is to remember the previous block entered via the interpreter and
  compile if this is the same one.  But we can thrash trying to compile an uncoggable
  method unless we try and remember which ones can't be cogged.  So also record
  the last block method we failed to compile and avoid recompiling it."
  (self methodWithHeaderShouldBeCogged: methodHeader)
  ifTrue:
  [(instructionPointer < objectMemory startOfMemory "If from machine code (via value primitive) attempt jitting"
   or: [theMethod = lastCoggableInterpretedBlockMethod]) "If from interpreter and repeat block, attempt jitting"
  ifTrue:
  [theMethod ~= lastUncoggableInterpretedBlockMethod ifTrue:
  [cogit cogFullBlockMethod: theMethod numCopied: numCopied.
  (self methodHasCogMethod: theMethod) ifTrue:
  [^self executeFullCogBlock: (self cogMethodOf: theMethod)
  closure: blockClosure
  mayContextSwitch: mayContextSwitch].
  cogCompiledCodeCompactionCalledFor ifFalse:
  [lastUncoggableInterpretedBlockMethod := theMethod]]]
  ifFalse:
  [lastCoggableInterpretedBlockMethod := theMethod]]
  ifFalse:
  [self maybeFlagMethodAsInterpreted: theMethod].
 
  self assert: (self methodHasCogMethod: theMethod) not.
  "Because this is an uncogged method we need to continue via the interpreter.
  We could have been reached either from the interpreter, in which case we
  should simply return, or from a machine code frame or from a compiled
  primitive.  In these latter two cases we must longjmp back to the interpreter.
  The instructionPointer tells us which path we took.
  If the sender was an interpreter frame but called through a (failing) primitive
  then make sure we restore the saved instruction pointer and avoid pushing
  ceReturnToInterpreterPC which is only valid between an interpreter caller
  frame and a machine code callee frame."
  (inInterpreter := instructionPointer >= objectMemory startOfMemory) ifFalse:
  [instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
  [instructionPointer := self iframeSavedIP: framePointer]].
 
  self push: instructionPointer.
  self push: framePointer.
  framePointer := stackPointer.
  self push: theMethod.
  self push: objectMemory nilObject. "FxThisContext field"
  self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
  self push: 0. "FoxIFSavedIP"
  "Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid."
  self push: (objectMemory followField: FullClosureReceiverIndex ofObject: blockClosure).
 
  "Copy the copied values..."
  0 to: numCopied - 1 do:
  [:i|
  self push: (objectMemory
  fetchPointer: i + FullClosureFirstCopiedValueIndex
  ofObject: blockClosure)].
 
  self assert: (self frameIsBlockActivation: framePointer).
  self assert: (self frameHasContext: framePointer) not.
 
  methodHeader := objectMemory methodHeaderOf: theMethod.
  numTemps := self temporaryCountOfMethodHeader: methodHeader.
 
  numArgs + numCopied + 1 to: numTemps do: [ :i | self push: objectMemory nilObject].
 
+ instructionPointer := (self initialIPForHeader: methodHeader method: theMethod) - 1.
- instructionPointer := (self initialPCForHeader: methodHeader method: theMethod) - 1.
 
  self setMethod: theMethod.
 
  "Now check for stack overflow or an event (interrupt, must scavenge, etc)"
  switched := false.
  stackPointer < stackLimit ifTrue:
  [switched := self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch].
  self returnToExecutive: inInterpreter postContextSwitch: switched!

Item was changed:
  ----- Method: CoInterpreter>>activateNewMethod (in category 'message sending') -----
  activateNewMethod
  | methodHeader numArgs numTemps rcvr errorCode inInterpreter switched |
 
  methodHeader := objectMemory methodHeaderOf: newMethod.
  numTemps := self temporaryCountOfMethodHeader: methodHeader.
  numArgs := self argumentCountOfMethodHeader: methodHeader.
 
  rcvr := self stackValue: numArgs. "could new rcvr be set at point of send?"
  self assert: (objectMemory isOopForwarded: rcvr) not.
 
  "Because this is an uncogged method we need to continue via the interpreter.
  We could have been reached either from the interpreter, in which case we
  should simply return, or from a machine code frame or from a compiled
  primitive.  In these latter two cases we must longjmp back to the interpreter.
  The instructionPointer tells us which path we took.
  If the sender was an interpreter frame but called through a (failing) primitive
  then make sure we restore the saved instruction pointer and avoid pushing
  ceReturnToInterpreterPC which is only valid between an interpreter caller
  frame and a machine code callee frame."
  (inInterpreter := instructionPointer >= objectMemory startOfMemory) ifFalse:
  [instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
  [instructionPointer := self iframeSavedIP: framePointer]].
  self push: instructionPointer.
  self push: framePointer.
  framePointer := stackPointer.
  self push: newMethod.
  self setMethod: newMethod methodHeader: methodHeader.
  self push: objectMemory nilObject. "FxThisContext field"
  self push: (self encodeFrameFieldHasContext: false isBlock: false numArgs: numArgs).
  self push: 0. "FoxIFSavedIP"
  self push: rcvr.
 
  "clear remaining temps to nil"
  numArgs+1 to: numTemps do:
  [:i | self push: objectMemory nilObject].
 
+ instructionPointer := (self initialIPForHeader: methodHeader method: newMethod) - 1.
- instructionPointer := (self initialPCForHeader: methodHeader method: newMethod) - 1.
 
  (self methodHeaderHasPrimitive: methodHeader) ifTrue:
  ["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts
   with a long store temp.  Strictly no need to skip the store because it's effectively a noop."
  instructionPointer := instructionPointer + (self sizeOfCallPrimitiveBytecode: methodHeader).
  primFailCode ~= 0 ifTrue:
  [(objectMemory byteAt: instructionPointer + 1)
   = (self longStoreBytecodeForHeader: methodHeader) ifTrue:
  [errorCode := self getErrorObjectFromPrimFailCode.
  self stackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"].
  primFailCode := 0]].
 
  "Now check for stack overflow or an event (interrupt, must scavenge, etc)."
  switched := true.
  stackPointer < stackLimit ifTrue:
  [switched := self handleStackOverflowOrEventAllowContextSwitch:
  (self canContextSwitchIfActivating: newMethod header: methodHeader)].
  self returnToExecutive: inInterpreter postContextSwitch: switched!

Item was changed:
  ----- Method: CoInterpreter>>internalActivateNewMethod (in category 'message sending') -----
  internalActivateNewMethod
  | methodHeader numTemps rcvr errorCode switched |
  <inline: true>
 
  methodHeader := self rawHeaderOf: newMethod.
  self assert: (self isCogMethodReference: methodHeader) not.
  numTemps := self temporaryCountOfMethodHeader: methodHeader.
  self assert: argumentCount = (self argumentCountOfMethodHeader: methodHeader).
  rcvr := self internalStackValue: argumentCount. "could new rcvr be set at point of send?"
  self assert: (objectMemory isOopForwarded: rcvr) not.
 
  self internalPush: localIP.
  self internalPush: localFP.
  localFP := localSP.
  self internalPush: newMethod.
  self setMethod: newMethod methodHeader: methodHeader.
  self internalPush: objectMemory nilObject. "FxThisContext field"
  self internalPush: (self
  encodeFrameFieldHasContext: false
  isBlock: false
  numArgs: (self argumentCountOfMethodHeader: methodHeader)).
  self internalPush: 0. "FoxIFSavedIP"
  self internalPush: rcvr.
 
  "Initialize temps..."
  argumentCount + 1 to: numTemps do:
  [:i | self internalPush: objectMemory nilObject].
 
  "-1 to account for pre-increment in fetchNextBytecode"
+ localIP := self pointerForOop: (self initialIPForHeader: methodHeader method: newMethod) - 1.
- localIP := self pointerForOop: (self initialPCForHeader: methodHeader method: newMethod) - 1.
 
  (self methodHeaderHasPrimitive: methodHeader) ifTrue:
  ["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts
   with a long store temp.  Strictly no need to skip the store because it's effectively a noop."
  localIP := localIP + (self sizeOfCallPrimitiveBytecode: methodHeader).
  primFailCode ~= 0 ifTrue:
  [(objectMemory byteAt: localIP + 1)
   = (self longStoreBytecodeForHeader: methodHeader) ifTrue:
  [errorCode := self getErrorObjectFromPrimFailCode.
  self internalStackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"].
  primFailCode := 0]].
 
  self assert: (self frameNumArgs: localFP) == argumentCount.
  self assert: (self frameIsBlockActivation: localFP) not.
  self assert: (self frameHasContext: localFP) not.
 
  "Now check for stack overflow or an event (interrupt, must scavenge, etc)."
  localSP < stackLimit ifTrue:
  [self externalizeIPandSP.
  switched := self handleStackOverflowOrEventAllowContextSwitch:
  (self canContextSwitchIfActivating: newMethod header: methodHeader).
  self returnToExecutive: true postContextSwitch: switched.
  self internalizeIPandSP]!

Item was changed:
  ----- Method: CoInterpreter>>justActivateNewMethod (in category 'message sending') -----
  justActivateNewMethod
  | methodHeader activateCogMethod cogMethod numArgs numTemps rcvr errorCode initialIP |
  <var: #cogMethod type: #'CogMethod *'>
  <var: #initialIP type: #usqInt>
  <inline: true>
  methodHeader := self rawHeaderOf: newMethod.
  (activateCogMethod := self isCogMethodReference: methodHeader) ifTrue:
  [cogMethod := self cCoerceSimple: methodHeader to: #'CogMethod *'.
  methodHeader := cogMethod methodHeader].
  numTemps := self temporaryCountOfMethodHeader: methodHeader.
  numArgs := self argumentCountOfMethodHeader: methodHeader.
 
  rcvr := self stackValue: numArgs. "could new rcvr be set at point of send?"
  self assert: (objectMemory isOopForwarded: rcvr) not.
 
  (activateCogMethod
  and: [instructionPointer asUnsignedInteger >= objectMemory startOfMemory]) ifTrue:
  [self iframeSavedIP: framePointer put: instructionPointer.
  instructionPointer := cogit ceReturnToInterpreterPC].
  self push: instructionPointer.
  self push: framePointer.
  framePointer := stackPointer.
+ initialIP := self initialIPForHeader: methodHeader method: newMethod.
- initialIP := self initialPCForHeader: methodHeader method: newMethod.
  activateCogMethod
  ifTrue:
  [self push: cogMethod asUnsignedInteger.
  self push: objectMemory nilObject. "FoxThisContext field"
  instructionPointer := cogMethod asUnsignedInteger + cogMethod stackCheckOffset]
  ifFalse:
  [self push: newMethod.
  self setMethod: newMethod methodHeader: methodHeader.
  self push: objectMemory nilObject. "FoxThisContext field"
  self push: (self encodeFrameFieldHasContext: false isBlock: false numArgs: numArgs).
  self push: 0. "FoxIFSavedIP"
  instructionPointer := initialIP - 1].
  self push: rcvr.
 
  "clear remaining temps to nil"
  numArgs+1 to: numTemps do:
  [:i | self push: objectMemory nilObject].
 
  (self methodHeaderHasPrimitive: methodHeader) ifTrue:
  ["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts
   with a long store temp.  Strictly no need to skip the store because it's effectively a noop."
  initialIP := initialIP + (self sizeOfCallPrimitiveBytecode: methodHeader).
  activateCogMethod ifFalse:
  [instructionPointer := initialIP].
  primFailCode ~= 0 ifTrue:
  [(objectMemory byteAt: initialIP + 1)
   = (self longStoreBytecodeForHeader: methodHeader) ifTrue:
  [errorCode := self getErrorObjectFromPrimFailCode.
  self stackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"].
  primFailCode := 0]].
 
  ^methodHeader!

Item was changed:
  ----- Method: CoInterpreter>>makeBaseFrameFor: (in category 'frame access') -----
  makeBaseFrameFor: aContext "<Integer>"
  "Marry aContext with the base frame of a new stack page.  Build the base
  frame to reflect the context's state.  Answer the new page.  Override to
  hold the caller context in a different place,  In the StackInterpreter we use
  the caller saved ip, but in the Cog VM caller saved ip is the ceBaseReturn:
  trampoline.  Simply hold the caller context in the first word of the stack."
  <returnTypeC: #'StackPage *'>
  | page pointer theMethod theIP numArgs stackPtrIndex maybeClosure rcvr |
  <inline: false>
  <var: #page type: #'StackPage *'>
  <var: #pointer type: #'char *'>
  <var: #cogMethod type: #'CogMethod *'>
  "theIP must be typed as signed because it is assigned ceCannotResumePC and so maybe implicitly typed as unsigned."
  <var: #theIP type: #sqInt>
  self assert: (objectMemory isContext: aContext).
  self assert: (self isSingleContext: aContext).
  self assert: (objectMemory goodContextSize: aContext).
  theIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
  self assert: HasBeenReturnedFromMCPC < 0.
  theIP := (objectMemory isIntegerObject: theIP)
  ifTrue: [objectMemory integerValueOf: theIP]
  ifFalse: [HasBeenReturnedFromMCPC].
  theMethod := objectMemory followObjField: MethodIndex ofObject: aContext.
  page := stackPages newStackPage.
  "first word on stack is caller context of base frame"
  stackPages
  longAt: (pointer := page baseAddress)
  put: (objectMemory followObjField: SenderIndex ofObject: aContext).
  "second word is the context itself; needed for cannotReturn processing; see ceBaseReturn:."
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: aContext.
  rcvr := objectMemory followField: ReceiverIndex ofObject: aContext.
  "If the frame is a closure activation then the closure should be on the stack in
  the pushed receiver position (closures receive the value[:value:] messages).
  Otherwise it should be the receiver proper."
  maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aContext.
  maybeClosure ~= objectMemory nilObject
  ifTrue:
  [(objectMemory isForwarded: maybeClosure) ifTrue:
  [maybeClosure := objectMemory fixFollowedField: ClosureIndex ofObject: aContext withInitialValue: maybeClosure].
  numArgs := self argumentCountOfClosure: maybeClosure.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: maybeClosure]
  ifFalse:
  [| header |
  header := objectMemory methodHeaderOf: theMethod.
  numArgs := self argumentCountOfMethodHeader: header.
  "If this is a synthetic context its IP could be pointing at the CallPrimitive opcode.  If so, skip it."
  ((self methodHeaderHasPrimitive: header)
+  and: [theIP = (1 + (self startPCOfMethodHeader: header))]) ifTrue:
-  and: [theIP = (1 + (objectMemory lastPointerOfMethodHeader: header))]) ifTrue:
  [theIP := theIP + (self sizeOfCallPrimitiveBytecode: header)].
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: rcvr].
  "Put the arguments on the stack"
  1 to: numArgs do:
  [:i|
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  "saved caller ip is base return trampoline"
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: cogit ceBaseFrameReturnPC.
  "base frame's saved fp is null"
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: 0.
  "N.B.  Don't set the baseFP, which marks the page as in use, until after
  ensureMethodIsCogged: and/or instructionPointer:forContext:frame:. These
  can cause a compiled code compaction which, if marked as in use, will
  examine this partially initialized page and crash."
  page headFP: pointer.
  "Create either a machine code frame or an interpreter frame based on the pc.  If the pc is -ve
  it is a machine code pc and so we produce a machine code frame.  If +ve an interpreter frame.
  N.B. Do *not* change this to try and map from a bytecode pc to a machine code frame under
  any circumstances.  See ensureContextIsExecutionSafeAfterAssignToStackPointer:"
  theIP < 0
  ifTrue:
  [| cogMethod |
  "Since we would have to generate a machine-code method to be able to map
   the native pc anyway we should create a native method and native frame."
  cogMethod := self ensureMethodIsCogged: theMethod.
  theMethod := cogMethod asInteger.
  maybeClosure ~= objectMemory nilObject
  ifTrue:
  [(self isVanillaBlockClosure: maybeClosure)
  ifTrue:
  ["If the pc is the special HasBeenReturnedFromMCPC pc set the pc
   appropriately so that the frame stays in the cannotReturn: state."
  theIP = HasBeenReturnedFromMCPC
  ifTrue:
  [theMethod := (cogit findMethodForStartBcpc: (self startPCOfClosure: maybeClosure)
  inHomeMethod: (self cCoerceSimple: theMethod
  to: #'CogMethod *')) asInteger.
  theMethod = 0 ifTrue:
  [self error: 'cannot find machine code block matching closure''s startpc'].
  theIP := cogit ceCannotResumePC]
  ifFalse:
  [self assert: (theIP signedBitShift: -16) < -1. "See contextInstructionPointer:frame:"
  theMethod := theMethod - ((theIP signedBitShift: -16) * cogit blockAlignment).
  theIP := theMethod - theIP signedIntFromShort]]
  ifFalse:
  [self assert: (theIP signedBitShift: -16) >= -1.
  "If the pc is the special HasBeenReturnedFromMCPC pc set the pc
   appropriately so that the frame stays in the cannotReturn: state."
  theIP := theIP = HasBeenReturnedFromMCPC
  ifTrue: [cogit ceCannotResumePC]
  ifFalse: [theMethod asInteger - theIP]].
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: theMethod + MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag]
  ifFalse:
  [self assert: (theIP signedBitShift: -16) >= -1.
  "If the pc is the special HasBeenReturnedFromMCPC pc set the pc
   appropriately so that the frame stays in the cannotReturn: state."
  theIP := theIP = HasBeenReturnedFromMCPC
  ifTrue: [cogit ceCannotResumePC]
  ifFalse: [theMethod asInteger - theIP].
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: theMethod + MFMethodFlagHasContextFlag].
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: aContext]
  ifFalse:
  [stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: theMethod.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: aContext.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (self encodeFrameFieldHasContext: true isBlock: maybeClosure ~= objectMemory nilObject numArgs: numArgs).
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: 0. "FoxIFSavedIP"
  theIP := self iframeInstructionPointerForIndex: theIP method: theMethod].
  page baseFP: page headFP.
  self assert: (self frameHasContext: page baseFP).
  self assert: (self frameNumArgs: page baseFP) == numArgs.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: rcvr.
  stackPtrIndex := self quickFetchInteger: StackPointerIndex ofObject: aContext.
  self assert: ReceiverIndex + stackPtrIndex < (objectMemory lengthOf: aContext).
  numArgs + 1 to: stackPtrIndex do:
  [:i|
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  "top of stack is the instruction pointer"
  stackPages longAt: (pointer := pointer - objectMemory wordSize) put: theIP.
  page headSP: pointer.
  self assert: (self context: aContext hasValidInversePCMappingOf: theIP in: page baseFP).
 
  "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) plus SmallInteger tags."
  objectMemory storePointerUnchecked: SenderIndex
  ofObject: aContext
  withValue: (self withSmallIntegerTags: page baseFP).
  objectMemory storePointerUnchecked: InstructionPointerIndex
  ofObject: aContext
  withValue: (self withSmallIntegerTags: 0).
  self assert: (objectMemory isIntegerObject: (objectMemory fetchPointer: SenderIndex ofObject: aContext)).
  self assert: (self frameOfMarriedContext: aContext) = page baseFP.
  self assert: (self validStackPageBaseFrame: page).
  ^page!

Item was changed:
  ----- Method: CogRegisterAllocatingSimStackEntry>>printStateOn: (in category 'printing') -----
  printStateOn: aStream
  <doNotGenerate> "Smalltalk-side only"
  type isInteger ifFalse: [^self].
  aStream nextPut: $(.
  type caseOf: {
  [SSBaseOffset] -> [aStream
  nextPutAll: 'bo ';
  nextPutAll: (cogit backEnd nameForRegister: register).
  offset negative ifFalse: [aStream nextPut: $+].
  aStream print: offset].
  [SSConstant] -> [aStream
  nextPutAll: 'const ';
  nextPutAll: (cogit coInterpreter shortPrint: constant)].
  [SSRegister] -> [aStream
  nextPutAll: 'reg ';
  nextPutAll: (cogit backEnd nameForRegister: register)].
  [SSSpill] -> [aStream
  nextPutAll: 'spill @ ';
  nextPutAll: (cogit backEnd nameForRegister: register).
  offset negative ifFalse: [aStream nextPut: $+].
  aStream print: offset] }.
  (spilled and: [type ~= SSSpill]) ifTrue:
  [aStream nextPutAll: ' (spilled)'].
  liveRegister ~= NoReg ifTrue:
+ [aStream nextPutAll: ' (live: '; nextPutAll: (liveRegister ifNil: ['NIL!!!!'] ifNotNil: [cogit backEnd nameForRegister: liveRegister]); nextPut: $)].
- [aStream nextPutAll: ' (live: '; nextPutAll: (cogit backEnd nameForRegister: liveRegister); nextPut: $)].
  bcptr ifNotNil:
  [aStream space; nextPut: ${; print: bcptr; nextPut: $}].
  aStream nextPut: $)!

Item was changed:
  ----- Method: CogVMSimulator>>findNewMethodInClassTag: (in category 'testing') -----
  findNewMethodInClassTag: classTag
  "
  | cName |
  traceOn ifTrue:
  [cName := (self sizeBitsOf: class) = 16r20
  ifTrue: ['class ' , (self nameOfClass: (self fetchPointer: 6 ofObject: class))]
  ifFalse: [(self nameOfClass: class)].
  self cr; print: cName , '>>' , (self stringOf: messageSelector)].
  "
+ messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue: [self halt].
- (self stringOf: messageSelector) = 'doesNotUnderstand:' ifTrue: [self halt].
 
+ self logSend: messageSelector.
- sendCount := sendCount + 1.
-
- printSends ifTrue:
- [self cr; print: byteCount; space; printStringOf: messageSelector; cr].
  "
  (sendCount > 1000 and: [sendCount\\10 = 0]) ifTrue:
  [Transcript print: sendCount; space.
  self validate].
  "
  "
  (sendCount > 100150) ifTrue:
  [self qvalidate.
  messageQueue == nil ifTrue: [messageQueue := OrderedCollection new].
  messageQueue addLast: (self stringOf: messageSelector)].
  "
  ^super findNewMethodInClassTag: classTag!

Item was changed:
  ----- Method: CogVMSimulator>>logSend: (in category 'debugging traps') -----
  logSend: oop
  sendCount := sendCount + 1.
+ (printSends or: [printBytecodeAtEachStep]) ifTrue:
- printSends ifTrue:
  [transcript print: byteCount; nextPut: $/; print: sendCount; space.
  self printStringOf: oop.
  transcript cr; flush]!

Item was changed:
  ----- Method: CogVMSimulator>>makeBaseFrameFor: (in category 'frame access') -----
  makeBaseFrameFor: aContext "<Integer>"
  "aContext =  26431360 ifTrue: [self halt]."
+ "(objectMemory fetchPointer: MethodIndex ofObject: aContext) = 16rD4C178 ifTrue:
+ [self halt]."
  ^super makeBaseFrameFor: aContext!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>initSimStackForFramelessMethod: (in category 'simulation stack') -----
  initSimStackForFramelessMethod: startpc
  super initSimStackForFramelessMethod: startpc.
  simSelf liveRegister: NoReg.
  0 to: simStackPtr do:
  [:i| | desc |
+ desc := self simStackAt: i.
+ desc liveRegister: (desc type == SSRegister ifTrue: [desc register] ifFalse: [NoReg])]!
- desc := self simStackAt: 1.
- desc liveRegister: desc registerOrNone]!

Item was changed:
  ----- Method: StackInterpreter>>activateNewFullClosureMethod:numArgs:mayContextSwitch: (in category 'control primitives') -----
  activateNewFullClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: mayContextSwitch
  "Similar to activateNewMethod but for Closure and newMethod."
  | numCopied theMethod methodHeader numTemps |
  <inline: true>
  numCopied := self copiedValueCountOfFullClosure: blockClosure.
  theMethod := objectMemory fetchPointer: FullClosureCompiledBlockIndex ofObject: blockClosure.
  self assert: (objectMemory isOopCompiledMethod: theMethod).
  self push: instructionPointer.
  self push: framePointer.
  framePointer := stackPointer.
  self push: theMethod.
  self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
  self push: objectMemory nilObject. "FxThisContext field"
  "Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid."
  self push: (objectMemory followField: FullClosureReceiverIndex ofObject: blockClosure).
 
  "Copy the copied values..."
  0 to: numCopied - 1 do:
  [:i|
  self push: (objectMemory
  fetchPointer: i + FullClosureFirstCopiedValueIndex
  ofObject: blockClosure)].
 
  self assert: (self frameIsBlockActivation: framePointer).
  self assert: (self frameHasContext: framePointer) not.
 
  methodHeader := objectMemory methodHeaderOf: theMethod.
  numTemps := self temporaryCountOfMethodHeader: methodHeader.
 
  numArgs + numCopied + 1 to: numTemps do: [ :i | self push: objectMemory nilObject].
 
+ instructionPointer := (self initialIPForHeader: methodHeader method: theMethod) - 1.
- instructionPointer := (self initialPCForHeader: methodHeader method: theMethod) - 1.
 
  self setMethod: theMethod.
 
  "Now check for stack overflow or an event (interrupt, must scavenge, etc)"
  stackPointer < stackLimit ifTrue:
  [self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch]!

Item was changed:
  ----- Method: StackInterpreter>>callPrimitiveBytecode (in category 'miscellaneous bytecodes') -----
  callPrimitiveBytecode
  "V4: 249 11111001 i i i i i i i i jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
  SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  V3/Spur: 139 10001011 i i i i i i i i jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
  "Note that we simply skip a callPrimitiveBytecode at the start of a method
  that contains a primitive.  This because methods like Context(Part)>>reset
  have to be updated to skip the callPrimtiive bytecode otherwise."
  SistaVM
  ifTrue:
  [| byte1 byte2 prim primSet header |
  byte1 := self fetchByte.
  byte2 := self fetchByte.
  self fetchNextBytecode.
  byte2 < 128 ifTrue:
  [header := objectMemory methodHeaderOf: method.
  ((self methodHeaderHasPrimitive: header)
   and: [localIP asUnsignedInteger
+ = (self initialIPForHeader: header method: method) + (self sizeOfCallPrimitiveBytecode: header)]) ifTrue:
- = (self initialPCForHeader: header method: method) + (self sizeOfCallPrimitiveBytecode: header)]) ifTrue:
  [^self].
  localIP := localIP - 3.
  ^self respondToUnknownBytecode].
  prim := byte2 - 128 << 8 + byte1.
  primSet := prim >> 13 bitAnd: 3.
  prim := prim bitAnd: 8191.
  primSet = 0 ifTrue: [
 
  prim < 1000 ifTrue:
  [^self nullaryInlinePrimitive: prim].
 
  prim < 2000 ifTrue:
  [^self unaryInlinePrimitive: prim - 1000].
 
  prim < 3000 ifTrue:
  [^self binaryInlinePrimitive: prim - 2000].
 
  prim < 4000 ifTrue:
  [^self trinaryInlinePrimitive: prim - 3000].
  ].
 
  LowcodeVM ifTrue: [
  primSet = 1 ifTrue: [
  prim < 1000 ifTrue:
  [^self lowcodeNullaryInlinePrimitive: prim].
 
  prim < 2000 ifTrue:
  [^self lowcodeUnaryInlinePrimitive: prim - 1000].
 
  prim < 3000 ifTrue:
  [^self lowcodeBinaryInlinePrimitive: prim - 2000].
 
  prim < 4000 ifTrue:
  [^self lowcodeTrinaryInlinePrimitive: prim - 3000].
  ].
  ].
 
  localIP := localIP - 3.
  ^self respondToUnknownBytecode]
  ifFalse:
  [| header |
  header := objectMemory methodHeaderOf: method.
  ((self methodHeaderHasPrimitive: header)
+  and: [localIP asInteger = (self initialIPForHeader: header method: method)])
-  and: [localIP asInteger = (self initialPCForHeader: header method: method)])
  ifTrue:
  [localIP := localIP + (self sizeOfCallPrimitiveBytecode: header) - 1.
  ^self fetchNextBytecode]
  ifFalse:
  [^self respondToUnknownBytecode]]!

Item was added:
+ ----- Method: StackInterpreter>>ifSoAssertValidIPAssign:ofContext:with: (in category 'frame access') -----
+ ifSoAssertValidIPAssign: index ofContext: maybeMarriedContext with: anOop
+ self assert: (index ~= InstructionPointerIndex
+ or: [(objectMemory isContextNonImm: maybeMarriedContext) not
+ or: [| mo |
+ mo := self fetchPointer: MethodIndex ofObject: maybeMarriedContext.
+ (anOop = objectMemory nilObject
+ or: [(objectMemory isIntegerObject: anOop)
+  and: [(objectMemory integerValueOf: anOop)
+ between: (LiteralStart + (objectMemory literalCountOf: mo)) * objectMemory bytesPerOop
+ and: (objectMemory numBytesOf: mo)]])]])!

Item was added:
+ ----- Method: StackInterpreter>>initialIPForHeader:method: (in category 'compiled methods') -----
+ initialIPForHeader: methodHeader method: theMethod
+ "Answer a pointer to the initial byte for a method; used only in methods that build a frame."
+ <inline: true>
+ ^theMethod
+ + ((LiteralStart + (objectMemory literalCountOfMethodHeader: methodHeader)) * objectMemory bytesPerOop)
+ + objectMemory baseHeaderSize!

Item was removed:
- ----- Method: StackInterpreter>>initialPCForHeader:method: (in category 'compiled methods') -----
- initialPCForHeader: methodHeader method: theMethod
- "Answer a pointer to the initial byte for a method; used only in methods that build a frame."
- <inline: true>
- ^theMethod
- + ((LiteralStart + (objectMemory literalCountOfMethodHeader: methodHeader)) * objectMemory bytesPerOop)
- + objectMemory baseHeaderSize!

Item was changed:
  ----- Method: StackInterpreter>>internalActivateNewMethod (in category 'message sending') -----
  internalActivateNewMethod
  | methodHeader numTemps rcvr errorCode |
  <inline: true>
 
  methodHeader := objectMemory methodHeaderOf: newMethod.
  numTemps := self temporaryCountOfMethodHeader: methodHeader.
  self assert: argumentCount = (self argumentCountOfMethodHeader: methodHeader).
  rcvr := self internalStackValue: argumentCount. "could new rcvr be set at point of send?"
  self assert: (objectMemory isOopForwarded: rcvr) not.
 
  self internalPush: localIP.
  self internalPush: localFP.
  localFP := localSP.
  self internalPush: newMethod.
  self setMethod: newMethod methodHeader: methodHeader.
  self internalPush: (self
  encodeFrameFieldHasContext: false
  isBlock: false
  numArgs: (self argumentCountOfMethodHeader: methodHeader)).
  self internalPush: objectMemory nilObject. "FxThisContext field"
  self internalPush: rcvr.
 
  "Initialize temps..."
  argumentCount + 1 to: numTemps do:
  [:i | self internalPush: objectMemory nilObject].
 
  "-1 to account for pre-increment in fetchNextBytecode"
+ localIP := self pointerForOop: (self initialIPForHeader: methodHeader method: newMethod) - 1.
- localIP := self pointerForOop: (self initialPCForHeader: methodHeader method: newMethod) - 1.
 
  (self methodHeaderHasPrimitive: methodHeader) ifTrue:
  ["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts
   with a long store temp.  Strictly no need to skip the store because it's effectively a noop."
  localIP := localIP + (self sizeOfCallPrimitiveBytecode: methodHeader).
  primFailCode ~= 0 ifTrue:
  [(objectMemory byteAt: localIP + 1)
   = (self longStoreBytecodeForHeader: methodHeader) ifTrue:
  [errorCode := self getErrorObjectFromPrimFailCode.
  self internalStackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"].
  primFailCode := 0]].
 
  self assert: (self frameNumArgs: localFP) == argumentCount.
  self assert: (self frameIsBlockActivation: localFP) not.
  self assert: (self frameHasContext: localFP) not.
 
  "Now check for stack overflow or an event (interrupt, must scavenge, etc)."
  localSP < stackLimit ifTrue:
  [self externalizeIPandSP.
  self handleStackOverflowOrEventAllowContextSwitch: (self canContextSwitchIfActivating: newMethod header: methodHeader).
  self internalizeIPandSP]!

Item was changed:
  ----- Method: StackInterpreter>>justActivateNewMethod (in category 'message sending') -----
  justActivateNewMethod
  | methodHeader numArgs numTemps rcvr errorCode |
  <inline: true>
  methodHeader := objectMemory methodHeaderOf: newMethod.
  numTemps := self temporaryCountOfMethodHeader: methodHeader.
  numArgs := self argumentCountOfMethodHeader: methodHeader.
 
  rcvr := self stackValue: numArgs. "could new rcvr be set at point of send?"
  self assert: (objectMemory isOopForwarded: rcvr) not.
 
  self push: instructionPointer.
  self push: framePointer.
  framePointer := stackPointer.
  self push: newMethod.
  self setMethod: newMethod methodHeader: methodHeader.
  self push: (self encodeFrameFieldHasContext: false isBlock: false numArgs: numArgs).
  self push: objectMemory nilObject. "FxThisContext field"
  self push: rcvr.
 
  "clear remaining temps to nil"
  numArgs+1 to: numTemps do:
  [:i | self push: objectMemory nilObject].
 
+ instructionPointer := (self initialIPForHeader: methodHeader method: newMethod) - 1.
- instructionPointer := (self initialPCForHeader: methodHeader method: newMethod) - 1.
 
  (self methodHeaderHasPrimitive: methodHeader) ifTrue:
  ["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts
   with a long store temp.  Strictly no need to skip the store because it's effectively a noop."
  instructionPointer := instructionPointer + (self sizeOfCallPrimitiveBytecode: methodHeader).
  primFailCode ~= 0 ifTrue:
  [(objectMemory byteAt: instructionPointer + 1)
   = (self longStoreBytecodeForHeader: methodHeader) ifTrue:
  [errorCode := self getErrorObjectFromPrimFailCode.
  self stackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"].
  primFailCode := 0]].
 
  ^methodHeader!

Item was changed:
  ----- Method: StackInterpreter>>makeBaseFrameFor: (in category 'frame access') -----
  makeBaseFrameFor: aContext "<Integer>"
  "Marry aContext with the base frame of a new stack page.  Build the base
  frame to reflect the context's state.  Answer the new page."
  <returnTypeC: #'StackPage *'>
  | page pointer theMethod theIP numArgs stackPtrIndex maybeClosure rcvr |
  <inline: false>
  <var: #page type: #'StackPage *'>
  <var: #pointer type: #'char *'>
  self assert: (objectMemory isContext: aContext).
  self assert: (self isSingleContext: aContext).
  self assert: (objectMemory goodContextSize: aContext).
  page := stackPages newStackPage.
  pointer := page baseAddress.
  theIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
  theMethod := objectMemory followObjField: MethodIndex ofObject: aContext.
  (objectMemory isIntegerObject: theIP) ifFalse:
  [self error: 'context is not resumable'].
  theIP := objectMemory integerValueOf: theIP.
  rcvr := objectMemory followField: ReceiverIndex ofObject: aContext.
  "If the frame is a closure activation then the closure should be on the stack in
  the pushed receiver position (closures receive the value[:value:] messages).
  Otherwise it should be the receiver proper."
  maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aContext.
  maybeClosure ~= objectMemory nilObject
  ifTrue:
  [(objectMemory isForwarded: maybeClosure) ifTrue:
  [maybeClosure := objectMemory fixFollowedField: ClosureIndex ofObject: aContext withInitialValue: maybeClosure].
  numArgs := self argumentCountOfClosure: maybeClosure.
  stackPages longAt: pointer put: maybeClosure]
  ifFalse:
  [| header |
  header := objectMemory methodHeaderOf: theMethod.
  numArgs := self argumentCountOfMethodHeader: header.
  "If this is a synthetic context its IP could be pointing at the CallPrimitive opcode.  If so, skip it."
  ((self methodHeaderHasPrimitive: header)
+  and: [theIP = (1 + (self startPCOfMethodHeader: header))]) ifTrue:
-  and: [theIP = (1 + (objectMemory lastPointerOfMethodHeader: header))]) ifTrue:
  [theIP := theIP + (self sizeOfCallPrimitiveBytecode: header)].
  stackPages longAt: pointer put: rcvr].
  "Put the arguments on the stack"
  1 to: numArgs do:
  [:i|
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  "saved caller ip is sender context in base frame"
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (objectMemory followObjField: SenderIndex ofObject: aContext).
  "base frame's saved fp is null"
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: 0.
  page baseFP: pointer; headFP: pointer.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: theMethod.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (self encodeFrameFieldHasContext: true isBlock: maybeClosure ~= objectMemory nilObject numArgs: numArgs).
  self assert: (self frameHasContext: page baseFP).
  self assert: (self frameNumArgs: page baseFP) == numArgs.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: aContext.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: rcvr.
  stackPtrIndex := self quickFetchInteger: StackPointerIndex ofObject: aContext.
  self assert: ReceiverIndex + stackPtrIndex < (objectMemory lengthOf: aContext).
  numArgs + 1 to: stackPtrIndex do:
  [:i|
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  "top of stack is the instruction pointer"
  theIP := self iframeInstructionPointerForIndex: theIP method: theMethod.
  stackPages longAt: (pointer := pointer - objectMemory wordSize) put: theIP.
  page headSP: pointer.
  self assert: (self context: aContext hasValidInversePCMappingOf: theIP in: page baseFP).
 
  "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) plus SmallInteger tags."
  objectMemory storePointerUnchecked: SenderIndex
  ofObject: aContext
  withValue: (self withSmallIntegerTags: page baseFP).
  objectMemory storePointerUnchecked: InstructionPointerIndex
  ofObject: aContext
  withValue: (self withSmallIntegerTags: 0).
  self assert: (objectMemory isIntegerObject: (objectMemory fetchPointer: SenderIndex ofObject: aContext)).
  self assert: (self frameOfMarriedContext: aContext) = page baseFP.
  self assert: (self validStackPageBaseFrame: page).
  ^page!

Item was added:
+ ----- Method: StackInterpreter>>startPCOfMethodHeader: (in category 'compiled methods') -----
+ startPCOfMethodHeader: methodHeader
+ "Answer the zero-relative index to the initial byte for a method.
+ Zero-relative version of CompiledMethod>>startpc."
+ ^(objectMemory literalCountOfMethodHeader: methodHeader) + LiteralStart * objectMemory bytesPerOop!

Item was changed:
  ----- Method: StackInterpreter>>storeMaybeContext:receiverVariable:withValue: (in category 'stack bytecodes') -----
+ storeMaybeContext: obj receiverVariable: fieldIndex withValue: anOop
- storeMaybeContext: obj receiverVariable: fieldIndex withValue: anObject
  "Must trap accesses to married and widowed contexts.
  But don't want to check on all inst var accesses.  This
  method is only used by the long-form bytecodes, evading the cost."
  <inline: true>
  ((self isWriteMediatedContextInstVarIndex: fieldIndex)
  and: [(objectMemory isContextNonImm: obj)
  and: [self isMarriedOrWidowedContext: obj]])
  ifTrue:
+ [self instVar: fieldIndex ofContext: obj put: anOop]
- [self instVar: fieldIndex ofContext: obj put: anObject]
  ifFalse:
+ [objectMemory storePointerImmutabilityCheck: fieldIndex ofObject: obj withValue: anOop]!
- [objectMemory storePointerImmutabilityCheck: fieldIndex ofObject: obj withValue: anObject]
- !

Item was changed:
  ----- Method: StackInterpreterSimulator>>findNewMethodInClassTag: (in category 'testing') -----
  findNewMethodInClassTag: classTag
  "
  | cName |
  traceOn ifTrue:
  [cName := (self sizeBitsOf: class) = 16r20
  ifTrue: ['class ' , (self nameOfClass: (self fetchPointer: 6 ofObject: class))]
  ifFalse: [(self nameOfClass: class)].
  self cr; print: cName , '>>' , (self stringOf: messageSelector)].
  "
+ messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue: [self halt].
- (self stringOf: messageSelector) = 'doesNotUnderstand:' ifTrue: [self halt].
 
  sendCount := sendCount + 1.
 
+ (printSends or: [printBytecodeAtEachStep]) ifTrue:
- printSends ifTrue:
  [self cr; print: byteCount; space; printStringOf: messageSelector; cr].
  "
  (sendCount > 1000 and: [sendCount\\10 = 0]) ifTrue:
  [Transcript print: sendCount; space.
  self validate].
  "
  "
  (sendCount > 100150) ifTrue:
  [self qvalidate.
  messageQueue == nil ifTrue: [messageQueue := OrderedCollection new].
  messageQueue addLast: (self stringOf: messageSelector)].
  "
  ^super findNewMethodInClassTag: classTag!