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

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

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

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

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

Name: VMMaker.oscog-eem.2633
Author: eem
Time: 24 December 2019, 6:00:24.559489 pm
UUID: b6ae0fd4-41f4-4d58-bc77-c274f01fdf99
Ancestors: VMMaker.oscog-eem.2632

Simulation:
Provide support for Cogit>>headFrame/StackPointer for the frmae isnpector(s).

Nuke the unused and untested nilLocalFP. Use localFP as the valid flag, nil if invalid. Test for fp: access in handleReadSimulationTrap:.  Fix a bug there-in where signedIntToLong was used, which is broken on 64-bits.

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

Item was removed:
- ----- Method: CoInterpreter>>nilLocalFP (in category 'simulation') -----
- nilLocalFP
- <doNotGenerate>
- localFP := nil!

Item was added:
+ ----- Method: CogVMSimulator>>externalizeIPandSP (in category 'utilities') -----
+ externalizeIPandSP
+ "Copy the local instruction, stack and frame pointers to global variables for use in primitives and other functions outside the interpret loop.
+ Override to record the transition by nilling localFP."
+
+ self assert: localIP asUnsignedInteger ~= cogit ceReturnToInterpreterPC.
+ instructionPointer := self oopForPointer: localIP.
+ stackPointer := localSP.
+ framePointer := localFP.
+ localFP := nil!

Item was changed:
  CogClass subclass: #Cogit
+ instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj enumeratingCogMethod methodHeader initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent hasMovableLiteral primitiveIndex backEnd literalsManager postCompileHook methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry fullBlockEntry cbEntryOffset fullBlockNoContextSwitchEntry cbNoSwitchEntryOffset picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 firstCPICCaseOffs
 et cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes generatorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceReapAndResetErrorCodeTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceEnclosingObjectTrampoline ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetFP ceGetSP ceCa
 ptureCStackPointers ordinarySendTrampolines superSendTrampolines directedSuperSendTrampolines directedSuperBindingSendTrampolines dynamicSuperSendTrampolines outerSendTrampolines selfSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner extA extB numExtB tempOop numIRCs indexOfIRC theIRCs receiverTags implicitReceiverSendTrampolines cogMethodSurrogateClass cogBlockMethodSurrogateClass nsSendCacheSurrogateClass cPICPrototype cPICEndOfCodeOffset cPICEndOfCodeLabel ceMallocTrampoline ceFreeTrampoline ceFFICalloutTrampoline debugBytecodePointers debugOpcodeIndices disassemblingMethod cogConstituentIndex directedSendUsesBinding ceCheckLZCNTFunction processorFrameValid'
- instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj enumeratingCogMethod methodHeader initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent hasMovableLiteral primitiveIndex backEnd literalsManager postCompileHook methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry fullBlockEntry cbEntryOffset fullBlockNoContextSwitchEntry cbNoSwitchEntryOffset picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 firstCPICCaseOffs
 et cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes generatorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceReapAndResetErrorCodeTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceEnclosingObjectTrampoline ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetFP ceGetSP ceCa
 ptureCStackPointers ordinarySendTrampolines superSendTrampolines directedSuperSendTrampolines directedSuperBindingSendTrampolines dynamicSuperSendTrampolines outerSendTrampolines selfSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner extA extB numExtB tempOop numIRCs indexOfIRC theIRCs receiverTags implicitReceiverSendTrampolines cogMethodSurrogateClass cogBlockMethodSurrogateClass nsSendCacheSurrogateClass cPICPrototype cPICEndOfCodeOffset cPICEndOfCodeLabel ceMallocTrampoline ceFreeTrampoline ceFFICalloutTrampoline debugBytecodePointers debugOpcodeIndices disassemblingMethod cogConstituentIndex directedSendUsesBinding ceCheckLZCNTFunction'
  classVariableNames: 'AltBlockCreationBytecodeSize AltFirstSpecialSelector AltNSSendIsPCAnnotated AltNumSpecialSelectors AnnotationConstantNames AnnotationShift AnnotationsWithBytecodePCs BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration FirstAnnotation FirstSpecialSelector HasBytecodePC IsAbsPCReference IsAnnotationExtension IsDirectedSuperBindingSend IsDirectedSuperSend IsDisplacementX2N IsNSDynamicSuperSend IsNSImplicitReceiverSend IsNSSelfSend IsNSSendCall IsObjectReference IsRelativeCall IsSendCall IsSuperSend MapEnd MaxCPICCases MaxCompiledPrimitiveIndex MaxStackAllocSize MaxX2NDisplacement NSCClassTagIndex NSCEnclosingObjectIndex NSCNumArgsIndex NSCSelectorIndex NSCTargetIndex NSSendIsPCAnnotated NumObjRefsInRuntime NumOopsPerNSC NumSpecialSelectors NumTrampolines ProcessorClass RRRName'
  poolDictionaries: 'CogAbstractRegisters CogCompilationConstants CogMethodConstants CogRTLOpcodes VMBasicConstants VMBytecodeConstants VMObjectIndices VMStackFrameOffsets'
  category: 'VMMaker-JIT'!
  Cogit class
  instanceVariableNames: 'generatorTable primitiveTable'!
 
  !Cogit commentStamp: 'eem 10/10/2019 09:40' prior: 0!
  I am the code generator for the Cog VM.  My job is to produce machine code versions of methods for faster execution and to manage inline caches for faster send performance.  I can be tested in the current image using my class-side in-image compilation facilities.  e.g. try
 
  StackToRegisterMappingCogit genAndDis: (Integer >> #benchFib)
 
  I have concrete subclasses that implement different levels of optimization:
  SimpleStackBasedCogit is the simplest code generator.
 
  StackToRegisterMappingCogit is the current production code generator  It defers pushing operands
  to the stack until necessary and implements a register-based calling convention for low-arity sends.
 
  SistaCogit is an experimental code generator with support for counting
  conditional branches, intended to support adaptive optimization.
 
  RegisterAllocatingCogit is an experimental code generator with support for allocating temporary variables
  to registers. It is inended to serve as the superclass to SistaCogit once it is working.
 
  SistaRegisterAllocatingCogit and SistaCogitClone are temporary classes that allow testing a clone of
  SistaCogit that inherits from RegisterAllocatingCogit.  Once things work these will be merged and
  will replace SistaCogit.
 
  coInterpreter <CoInterpreterSimulator>
  the VM's interpreter with which I cooperate
  methodZoneManager <CogMethodZoneManager>
  the manager of the machine code zone
  objectRepresentation <CogObjectRepresentation>
  the object used to generate object accesses
  processor <BochsIA32Alien|?>
  the simulator that executes the IA32/x86 machine code I generate when simulating execution in Smalltalk
  simulatedTrampolines <Dictionary of Integer -> MessageSend>
  the dictionary mapping trap jump addresses to run-time routines used to warp from simulated machine code in to the Smalltalk run-time.
  simulatedVariableGetters <Dictionary of Integer -> MessageSend>
  the dictionary mapping trap read addresses to variables in run-time objects used to allow simulated machine code to read variables in the Smalltalk run-time.
  simulatedVariableSetters <Dictionary of Integer -> MessageSend>
  the dictionary mapping trap write addresses to variables in run-time objects used to allow simulated machine code to write variables in the Smalltalk run-time.
  printRegisters printInstructions clickConfirm <Boolean>
  flags controlling debug printing and code simulation
  breakPC <Integer>
  machine code pc breakpoint
  selectorOop <sqInt>
  the oop of the methodObj being compiled
  methodObj <sqInt>
  the bytecode method being compiled
  initialPC endPC <Integer>
  the start and end pcs of the methodObj being compiled
  methodOrBlockNumArgs <Integer>
  argument count of current method or block being compiled
  needsFrame <Boolean>
  whether methodObj or block needs a frame to execute
  primitiveIndex <Integer>
  primitive index of current method being compiled
  methodLabel <CogAbstractOpcode>
  label for the method header
  blockEntryLabel <CogAbstractOpcode>
  label for the start of the block dispatch code
  stackOverflowCall <CogAbstractOpcode>
  label for the call of ceStackOverflow in the method prolog
  sendMissCall <CogAbstractOpcode>
  label for the call of ceSICMiss in the method prolog
  entryOffset <Integer>
  offset of method entry code from start (header) of method
  entry <CogAbstractOpcode>
  label for the first instruction of the method entry code
  noCheckEntryOffset <Integer>
  offset of the start of a method proper (after the method entry code) from start (header) of method
  noCheckEntry <CogAbstractOpcode>
  label for the first instruction of start of a method proper
  fixups <Array of <AbstractOpcode Label | nil>>
  the labels for forward jumps that will be fixed up when reaching the relevant bytecode.  fixups has one element per byte in methodObj's bytecode; initialPC maps to fixups[0].
  abstractOpcodes <Array of <AbstractOpcode>>
  the code generated when compiling methodObj
  byte0 byte1 byte2 byte3 <Integer>
  individual bytes of current bytecode being compiled in methodObj
  bytecodePointer <Integer>
  bytecode pc (same as Smalltalk) of the current bytecode being compiled
  opcodeIndex <Integer>
  the index of the next free entry in abstractOpcodes (this code is translated into C where OrderedCollection et al do not exist)
  numAbstractOpcodes <Integer>
  the number of elements in abstractOpcocdes
  blockStarts <Array of <BlockStart>>
  the starts of blocks in the current method
  blockCount
  the index into blockStarts as they are being noted, and hence eventually the total number of blocks in the current method
  labelCounter <Integer>
  a nicety for numbering labels not needed in the production system but probably not expensive enough to worry about
  ceStackOverflowTrampoline <Integer>
  ceSend0ArgsTrampoline <Integer>
  ceSend1ArgsTrampoline <Integer>
  ceSend2ArgsTrampoline <Integer>
  ceSendNArgsTrampoline <Integer>
  ceSendSuper0ArgsTrampoline <Integer>
  ceSendSuper1ArgsTrampoline <Integer>
  ceSendSuper2ArgsTrampoline <Integer>
  ceSendSuperNArgsTrampoline <Integer>
  ceSICMissTrampoline <Integer>
  ceCPICMissTrampoline <Integer>
  ceStoreCheckTrampoline <Integer>
  ceReturnToInterpreterTrampoline <Integer>
  ceBaseFrameReturnTrampoline <Integer>
  ceSendMustBeBooleanTrampoline <Integer>
  ceClosureCopyTrampoline <Integer>
  the various trampolines (system-call-like jumps from machine code to the run-time).
  See Cogit>>generateTrampolines for the mapping from trampoline to run-time
  routine and then read the run-time routine for a funcitonal description.
  ceEnterCogCodePopReceiverReg <Integer>
  the enilopmart (jump from run-time to machine-code)
  methodZoneBase <Integer>
  !
  Cogit class
  instanceVariableNames: 'generatorTable primitiveTable'!

Item was changed:
  ----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  #( 'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
  'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass'
  'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
  'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
+ 'processorFrameValid' 'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
- 'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
  [:simulationVariableNotNeededForRealVM|
  aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
  NewspeakVM ifFalse:
  [#( 'selfSendTrampolines' 'dynamicSuperSendTrampolines'
  'implicitReceiverSendTrampolines' 'outerSendTrampolines'
  'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do:
  [:variableNotNeededInNormalVM|
  aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
  aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
  aCCodeGenerator
  addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
  addHeaderFile:'"sqCogStackAlignment.h"';
  addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
  addHeaderFile:'"cogmethod.h"'.
  NewspeakVM ifTrue:
  [aCCodeGenerator addHeaderFile:'"nssendcache.h"'].
  aCCodeGenerator
  addHeaderFile:'#if COGMTVM';
  addHeaderFile:'"cointerpmt.h"';
  addHeaderFile:'#else';
  addHeaderFile:'"cointerp.h"';
  addHeaderFile:'#endif';
  addHeaderFile:'"cogit.h"'.
  aCCodeGenerator
  var: #ceGetFP
  declareC: 'usqIntptr_t (*ceGetFP)(void)';
  var: #ceGetSP
  declareC: 'usqIntptr_t (*ceGetSP)(void)';
  var: #ceCaptureCStackPointers
  declareC: 'void (*ceCaptureCStackPointers)(void)';
  var: #ceEnterCogCodePopReceiverReg
  declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
  var: #realCEEnterCogCodePopReceiverReg
  declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
  var: #ceCallCogCodePopReceiverReg
  declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
  var: #realCECallCogCodePopReceiverReg
  declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
  var: #ceCallCogCodePopReceiverAndClassRegs
  declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
  var: #realCECallCogCodePopReceiverAndClassRegs
  declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
  var: #ceFlushICache
  declareC: 'static void (*ceFlushICache)(usqIntptr_t from, usqIntptr_t to)';
  var: #ceCheckFeaturesFunction
  declareC: 'static usqIntptr_t (*ceCheckFeaturesFunction)(void)';
  var: #ceCheckLZCNTFunction
  declareC: 'static usqIntptr_t (*ceCheckLZCNTFunction)(void)';
  var: #ceTryLockVMOwner
  declareC: 'usqIntptr_t (*ceTryLockVMOwner)(void)';
  var: #ceUnlockVMOwner
  declareC: 'void (*ceUnlockVMOwner)(void)';
  var: #postCompileHook
  declareC: 'void (*postCompileHook)(CogMethod *)';
  var: #openPICList declareC: 'CogMethod *openPICList = 0';
  var: #maxMethodBefore type: #'CogBlockMethod *';
  var: 'enumeratingCogMethod' type: #'CogMethod *'.
  aCCodeGenerator
  declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
  var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
  var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'.
  self declareC: #(abstractOpcodes stackCheckLabel
  blockEntryLabel blockEntryNoContextSwitch
  stackOverflowCall sendMiss
  entry noCheckEntry selfSendEntry dynSuperEntry
  fullBlockNoContextSwitchEntry fullBlockEntry
  picMNUAbort picInterpretAbort  endCPICCase0 endCPICCase1 cPICEndOfCodeLabel)
  as: #'AbstractInstruction *'
  in: aCCodeGenerator.
  aCCodeGenerator
  declareVar: #blockStarts type: #'BlockStart *';
  declareVar: #fixups type: #'BytecodeFixup *'.
  aCCodeGenerator
  var: #ordinarySendTrampolines
  declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]';
  var: #superSendTrampolines
  declareC: 'sqInt superSendTrampolines[NumSendTrampolines]'.
  BytecodeSetHasDirectedSuperSend ifTrue:
  [aCCodeGenerator
  var: #directedSuperSendTrampolines
  declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]';
  var: #directedSuperBindingSendTrampolines
  declareC: 'sqInt directedSuperBindingSendTrampolines[NumSendTrampolines]'].
  NewspeakVM ifTrue:
  [aCCodeGenerator
  var: #selfSendTrampolines
  declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]';
  var: #dynamicSuperSendTrampolines
  declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
  var: #implicitReceiverSendTrampolines
  declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]';
  var: #outerSendTrampolines
  declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]'].
  aCCodeGenerator
  var: #trampolineAddresses
  declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
  var: #objectReferencesInRuntime
  declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime+1]';
  var: #labelCounter
  type: #int;
  var: #traceFlags
  declareC: 'int traceFlags = 8 /* prim trace log on by default */';
  var: #cStackAlignment
  declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
  aCCodeGenerator
  declareVar: #minValidCallAddress type: #'usqIntptr_t';
  declareVar: #debugPrimCallStackOffset type: #'usqIntptr_t'.
  aCCodeGenerator vmClass generatorTable ifNotNil:
  [:bytecodeGenTable|
  aCCodeGenerator
  var: #generatorTable
  declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size printString, ']',
  (self tableInitializerFor: bytecodeGenTable
  in: aCCodeGenerator)].
  "In C the abstract opcode names clash with the Smalltak generator syntactic sugar.
  Most of the syntactic sugar is inlined, but alas some remains.  Rename the syntactic
  sugar to avoid the clash."
  (self organization listAtCategoryNamed: #'abstract instructions') do:
  [:s|
  aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
  aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'!

Item was changed:
  ----- Method: Cogit>>handleReadSimulationTrap: (in category 'simulation only') -----
  handleReadSimulationTrap: aProcessorSimulationTrap
  <doNotGenerate>
  | variableValue accessor |
  variableValue := (simulatedVariableGetters
  at: aProcessorSimulationTrap address
  ifAbsent: [self errorProcessingSimulationTrap: aProcessorSimulationTrap
  in: simulatedVariableGetters])
  value asInteger.
  accessor := aProcessorSimulationTrap registerAccessor.
  processor
  perform: accessor
+ with: (processor convertIntegerToInternal: variableValue).
- with: variableValue signedIntToLong.
  accessor ~~ #pc: ifTrue:
+ [processor pc: aProcessorSimulationTrap nextpc.
+ "In an enilopmart stackPointer is assigned to sp before framePointer.
+  In a trampoline fp and sp are written to the interpreter variables immediately before
+  assigning sp with CStackPointer and immediately there-after fp with CFramePointer.
+  So set processorFrameValid appropriately when assigning fp.  This is for CogHeadFrameInspector"
+ (processor accessorIsFramePointerSetter: accessor) ifTrue:
+ [processorFrameValid := aProcessorSimulationTrap address ~= (simulatedAddresses at: #getCFramePointer)]]!
- [processor pc: aProcessorSimulationTrap nextpc]!

Item was changed:
  ----- Method: Cogit>>initialize (in category 'initialization') -----
  initialize
  | wordSize |
  initialPC := 0.
+ processorFrameValid := false.
  wordSize := self class objectMemoryClass wordSize.
  cogMethodSurrogateClass := NewspeakVM
  ifTrue:
  [wordSize = 4
  ifTrue: [NewspeakCogMethodSurrogate32]
  ifFalse: [NewspeakCogMethodSurrogate64]]
  ifFalse:
  [wordSize = 4
  ifTrue: [CogMethodSurrogate32]
  ifFalse: [CogMethodSurrogate64]].
  cogBlockMethodSurrogateClass := wordSize = 4
  ifTrue: [CogBlockMethodSurrogate32]
  ifFalse: [CogBlockMethodSurrogate64].
  nsSendCacheSurrogateClass := wordSize = 4
  ifTrue: [NSSendCacheSurrogate32]
+ ifFalse: [NSSendCacheSurrogate64]!
- ifFalse: [NSSendCacheSurrogate64].!