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

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

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

Name: VMMaker.oscog-eem.406
Author: eem
Time: 23 September 2013, 2:38:38.527 pm
UUID: fa4c2477-036c-424e-9c73-f4e4c8a9bd3f
Ancestors: VMMaker.oscog-eem.405

Fix the scavengeLoop for the mapInterpreterOops call.  mIO can
cause objects to be copied and forwarded /and/ remembered (if
tenured) so the termination condition is nothing forwarded /and/
northing remembered, hence previousRememberedSetSize must be
recorded before sending mIO.

Fix objectBytesForSlots:; ot forgot to include the forwarding slot in
empty objects.

Fix allocateOldSpaceChunkOfBytes: to use freeListsMask (<= not >=).

Fix instanceAfter: (use of objOop after the fact).

refactor objectAfter:limit:, it differs slightly between 32 & 64 bits.

Make printNameOfClass:count: accet a nil class (as answered by
classAtIndex:).

Simulator:
Implement cloneSimulation for debugging.  Allows e.g. rerunning the
same scavenge in the clone for repeatibility.

Simplify the window quitBlocks now I know about containingWindow.

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

Item was changed:
  ----- Method: CogVMSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  "Open a morphic view on this simulation."
+ | localImageName borderWidth window |
- | localImageName borderWidth theWindow |
  localImageName := imageName
  ifNotNil: [FileDirectory default localNameFor: imageName]
  ifNil: [' synthetic image'].
+ window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
- theWindow := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
 
+ window addMorph: (displayView := ImageMorph new image: displayForm)
- theWindow addMorph: (displayView := ImageMorph new image: displayForm)
  frame: (0@0 corner: 1@0.8).
 
  transcript := TranscriptStream on: (String new: 10000).
+ window addMorph: (PluggableTextMorph
- theWindow addMorph: (PluggableTextMorph
  on: transcript text: nil accept: nil
  readSelection: nil menu: #codePaneMenu:shifted:)
  frame: (0@0.8 corner: 0.7@1).
+ window addMorph: (PluggableTextMorph on: self
- theWindow addMorph: (PluggableTextMorph on: self
  text: #byteCountText accept: nil
  readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  frame: (0.7@0.8 corner: 1@1).
 
  borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
  on: MessageNotUnderstood
  do: [:ex| 0]. "3.8"
+ borderWidth := borderWidth + window borderWidth.
+ window openInWorldExtent: (self desiredDisplayExtent
- borderWidth := borderWidth + theWindow borderWidth.
- theWindow openInWorldExtent: (self desiredDisplayExtent
  + (2 * borderWidth)
+ + (0@window labelHeight)
+ * (1@(1/0.8))) rounded.
+ ^window!
- + (0@theWindow labelHeight)
- * (1@(1/0.8))) rounded!

Item was changed:
  ----- Method: CogVMSimulator>>run (in category 'testing') -----
  run
  "Just run"
+ quitBlock := [displayView ifNotNil:
+   [displayView containingWindow ifNotNil:
+ [:topWindow|
+ ((World submorphs includes: topWindow)
+ and: [UIManager default confirm: 'close?']) ifTrue:
+ [topWindow delete]]].
- quitBlock := [| topWindow |
-  
-   (displayView notNil
-   and: [topWindow := displayView outermostMorphThat:
- [:m| m isSystemWindow and: [World submorphs includes: m]].
- topWindow notNil
-   and: [UIManager default confirm: 'close?']]) ifTrue:
- [topWindow delete].
   ^self].
  self initStackPages.
  self loadInitialContext.
  self initialEnterSmalltalkExecutive!

Item was changed:
  ----- Method: CogVMSimulator>>runWithBreakCount: (in category 'testing') -----
  runWithBreakCount: theBreakCount
  "Just run, halting when byteCount is reached"
+ quitBlock := [displayView ifNotNil:
+   [displayView containingWindow ifNotNil:
+ [:topWindow|
+ ((World submorphs includes: topWindow)
+ and: [UIManager default confirm: 'close?']) ifTrue:
+ [topWindow delete]]].
- quitBlock := [(displayView notNil
-   and: [UIManager default confirm: 'close?']) ifTrue:
- [(displayView outermostMorphThat: [:m| m isSystemWindow]) ifNotNil:
- [:topWindow| topWindow delete]].
   ^self].
  breakCount := theBreakCount.
  self initStackPages.
  self loadInitialContext.
  self initialEnterSmalltalkExecutive!

Item was changed:
  ----- Method: InterpreterSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  "Open a morphic view on this simulation."
  | window localImageName |
  localImageName := imageName
  ifNotNil: [FileDirectory default localNameFor: imageName]
  ifNil: [' synthetic image'].
  window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
 
  window addMorph: (displayView := ImageMorph new image: displayForm)
  frame: (0@0 corner: 1@0.8).
 
  transcript := TranscriptStream on: (String new: 10000).
  window addMorph: (PluggableTextMorph on: transcript text: nil accept: nil
  readSelection: nil menu: #codePaneMenu:shifted:)
  frame: (0@0.8 corner: 0.7@1).
 
  window addMorph: (PluggableTextMorph on: self
  text: #byteCountText accept: nil) hideScrollBarsIndefinitely
  frame: (0.7@0.8 corner: 1@1).
 
+ window openInWorld.
+ ^window!
- window openInWorld!

Item was changed:
  ----- Method: NewspeakInterpreterSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  "Open a morphic view on this simulation."
  | window localImageName |
  localImageName := imageName
  ifNotNil: [FileDirectory default localNameFor: imageName]
  ifNil: [' synthetic image'].
  window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
 
  window addMorph: (displayView := ImageMorph new image: displayForm)
  frame: (0@0 corner: 1@0.8).
 
  transcript := TranscriptStream on: (String new: 10000).
  window addMorph: (PluggableTextMorph
  on: transcript text: nil accept: nil
  readSelection: nil menu: #codePaneMenu:shifted:)
  frame: (0@0.8 corner: 0.7@1).
 
  window addMorph: (PluggableTextMorph on: self
  text: #byteCountText accept: nil
  readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  frame: (0.7@0.8 corner: 1@1).
 
  window openInWorldExtent: (self desiredDisplayExtent
  + (2 * window borderWidth)
  + (0@window labelHeight)
+ * (1@(1/0.8))) rounded.
+ ^window!
- * (1@(1/0.8))) rounded!

Item was changed:
  ----- Method: Spur32BitMMLESimulator>>longAt:put: (in category 'memory access') -----
  longAt: byteAddress put: a32BitValue
  "Note: Adjusted for Smalltalk's 1-based array indexing."
+ "(byteAddress = 16r11D8240 and: [a32BitValue = 16r1D8368]) ifTrue:
- "(byteAddress = 16r120DBDC and: [a32BitValue = 16r16000000]) ifTrue:
  [self halt]."
  byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
  ^memory at: byteAddress // 4 + 1 put: a32BitValue!

Item was changed:
  ----- Method: Spur32BitMMLESimulator>>longLongAt:put: (in category 'memory access') -----
  longLongAt: byteAddress put: a64BitValue
  "memory is a Bitmap, a 32-bit indexable array of bits"
  byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
+ "(byteAddress = 16r11D8240 and: [(a64BitValue bitAnd: 16rffffffff) = 16r1D8368]) ifTrue:
+ [self halt]."
- "((byteAddress = 16r120DBDC or: [byteAddress = 16r120DBD8])
- and: [a64BitValue >> 32 = 16r16000000
- or: [(a64BitValue bitAnd: 16rffffffff) = 16r16000000]]) ifTrue:
- [self halt]."
  memory
  at: byteAddress // 4 + 1 put: (a64BitValue bitAnd: 16rffffffff);
  at: byteAddress // 4 + 2 put: a64BitValue >> 32.
  ^a64BitValue!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>stObject:at:put: (in category 'simulation only') -----
+ stObject: objOop at: indexOop put: valueOop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter stObject: objOop at: indexOop put: valueOop!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>objectAfter:limit: (in category 'object enumeration') -----
+ objectAfter: objOop limit: limit
+ "Object parsing.
+ 1. all objects have at least a word following the header, for a forwarding pointer.
+ 2. objects with an overflow size have a preceeing word with a saturated numSlots.  If the word
+   following an object doesn't have a saturated numSlots field it must be a single-header object.
+   If the word following does have a saturated numSlots it must be the overflow size word."
+ | followingWordAddress followingWord |
+ followingWordAddress := self addressAfter: objOop.
+ followingWordAddress >= limit ifTrue:
+ [^limit].
+ self flag: #endianness.
+ followingWord := self longAt: followingWordAddress + 4.
+ ^followingWord >> self numSlotsHalfShift = self numSlotsMask
+ ifTrue: [followingWordAddress + self baseHeaderSize]
+ ifFalse: [followingWordAddress]!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>objectBytesForSlots: (in category 'object enumeration') -----
  objectBytesForSlots: numSlots
  "Answer the total number of bytes in an object with the given
  number of slots, including header and possible overflow size header."
+ ^(numSlots = 0
+ ifTrue: [self allocationUnit] "always at least one slot for forwarding pointer"
+ ifFalse: [numSlots + (numSlots bitAnd: 1) << self shiftForWord])
- ^numSlots + (numSlots bitAnd: 1) << self shiftForWord
  + (numSlots >= self numSlotsMask
  ifTrue: [self baseHeaderSize + self baseHeaderSize]
  ifFalse: [self baseHeaderSize])!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>objectAfter:limit: (in category 'object enumeration') -----
+ objectAfter: objOop limit: limit
+ "Object parsing.
+ 1. all objects have at least a word following the header, for a forwarding pointer.
+ 2. objects with an overflow size have a preceeing word with a saturated numSlots.  If the word
+   following an object doesn't have a saturated numSlots field it must be a single-header object.
+   If the word following does have a saturated numSlots it must be the overflow size word."
+ | followingWordAddress followingWord |
+ followingWordAddress := self addressAfter: objOop.
+ followingWordAddress >= limit ifTrue:
+ [^limit].
+ self flag: #endianness.
+ followingWord := self longAt: followingWordAddress.
+ ^followingWord >> self numSlotsFullShift = self numSlotsMask
+ ifTrue: [followingWordAddress + self baseHeaderSize]
+ ifFalse: [followingWordAddress]!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>objectBytesForSlots: (in category 'object enumeration') -----
  objectBytesForSlots: numSlots
  "Answer the total number of bytes in an object with the given
  number of slots, including header and possible overflow size header."
+ ^(numSlots max: 1) << self shiftForWord
- ^numSlots << self shiftForWord
  + (numSlots >= self numSlotsMask
  ifTrue: [self baseHeaderSize + self baseHeaderSize]
  ifFalse: [self baseHeaderSize])!

Item was changed:
  ----- Method: SpurGenerationScavenger>>scavengeLoop (in category 'scavenger') -----
  scavengeLoop
  "This is the inner loop of the main routine, scavenge.  It first scavenges the new objects immediately
  reachable from old ones. Then it scavenges those that are transitively reachable.  If this results in a
  promotion, the promotee gets remembered, and it first scavenges objects adjacent to the promotee,
  then scavenges the ones reachable from the promoted.  This loop continues until no more reachable
  objects are left.  At that point, pastSurvivorSpace is exchanged with futureSurvivorSpace.
 
  Notice that each pointer in a live object is inspected once and only once.  The previousRememberedSetSize
  and previousFutureSurvivorSpaceLimit variables ensure that no object is scanned twice, as well as
  detecting closure.  If this were not true, some pointers might get forwarded twice."
 
  | firstTime previousRememberedSetSize previousFutureSurvivorStart |
  self assert: futureSurvivorStart = futureSpace start. "future space should be empty at the start"
  firstTime := true.
  previousRememberedSetSize := 0.
  previousFutureSurvivorStart := futureSurvivorStart.
  [self scavengeRememberedSetStartingAt: previousRememberedSetSize.
+ previousRememberedSetSize := rememberedSetSize.
  firstTime ifTrue:
  [coInterpreter mapInterpreterOops.
  firstTime := false].
+ "nothing more copied and forwarded (or remembered by mapInterpreterOops)
+  to scavenge so scavenge is done."
+ (previousRememberedSetSize = rememberedSetSize
+  and: [previousFutureSurvivorStart = futureSurvivorStart]) ifTrue:
- "northing more copied and forwarded to scavenge so scavenge is done."
- previousFutureSurvivorStart = futureSurvivorStart ifTrue:
  [^self].
- previousRememberedSetSize := rememberedSetSize.
 
  self scavengeFutureSurvivorSpaceStartingAt: previousFutureSurvivorStart.
  "no more roots created to scavenge, so scavenge is done."
  previousRememberedSetSize = rememberedSetSize ifTrue:
  [^self].
 
  previousFutureSurvivorStart := futureSurvivorStart] repeat!

Item was changed:
  ----- Method: SpurGenerationScavengerSimulator>>copyAndForward: (in category 'scavenger') -----
  copyAndForward: survivor
  | newLocation |
+ true ifTrue: [^super copyAndForward: survivor.].
+ "(#(16r13BC78 16r13BD68 16r1ED780 16r1FC558) includes: survivor) ifTrue: [self halt]."
- survivor = 16r19BC60 ifTrue: [self halt].
  newLocation := super copyAndForward: survivor.
  comeFroms at: newLocation put: survivor.
+ "((manager isContextNonImm: newLocation)
+ and: [#(16r11D6988 16r11D6A48 16r11D6AC0 16r11D6B80) includes: newLocation]) ifTrue:
+ [self halt]."
  ^newLocation!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') -----
  allocateOldSpaceChunkOfBytes: chunkBytes
  "Answer a chunk of oldSpace from the free lists, if available,
  otherwise answer nil.  N.B.  the chunk is simply a pointer, it has
  no valid header.  The caller *must* fill in the header correctly."
  | index chunk nextIndex nodeBytes parent child smaller larger |
  totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
  index := chunkBytes / self allocationUnit.
+ (index < NumFreeLists and: [1 << index <= freeListsMask]) ifTrue:
- (index < NumFreeLists and: [1 << index >= freeListsMask]) ifTrue:
  [(chunk := freeLists at: index) ~= 0 ifTrue:
  [self assert: chunk = (self startOfObject: chunk).
  ^self unlinkFreeChunk: chunk atIndex: index].
  "first search for free chunks of a multiple of chunkBytes in size"
  nextIndex := index.
+ [1 << index <= freeListsMask
- [1 << index >= freeListsMask
   and: [(nextIndex := nextIndex + index) < NumFreeLists]] whileTrue:
  [((freeListsMask anyMask: 1 << index)
  and: [(chunk := freeLists at: index) ~= 0]) ifTrue:
  [self assert: chunk = (self startOfObject: chunk).
  self unlinkFreeChunk: chunk atIndex: index.
  self assert: (self bytesInObject: chunk) = index * self allocationUnit.
  self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  at: (self startOfObject: chunk) + chunkBytes.
  ^chunk]].
  "now get desperate and use the first that'll fit"
  nextIndex := index.
  [1 << index >= freeListsMask
   and: [(nextIndex := nextIndex + 1) < NumFreeLists]] whileTrue:
  [(freeListsMask anyMask: 1 << index) ifTrue:
  [(chunk := freeLists at: index) ~= 0 ifTrue:
  [self assert: chunk = (self startOfObject: chunk).
  self unlinkFreeChunk: chunk atIndex: index.
  self assert: (self bytesInObject: chunk) = index * self allocationUnit.
  self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  at: (self startOfObject: chunk) + chunkBytes.
  ^chunk].
  freeListsMask := freeListsMask - (1 << index)]]].
 
  "Large chunk, or no space on small free lists.  Search the large chunk list.
  Large chunk list organized as a tree, each node of which is a list of chunks
  of the same size. Beneath the node are smaller and larger blocks."
  parent := 0.
  child := freeLists at: 0.
  [child ~= 0] whileTrue:
  [nodeBytes := self bytesInObject: child.
  parent := child.
  nodeBytes = chunkBytes
  ifTrue: "size match; try to remove from list at node."
  [chunk := self fetchPointer: self freeChunkNextIndex
  ofFreeChunk: child.
  chunk ~= 0 ifTrue:
  [self storePointer: self freeChunkNextIndex
  ofFreeChunk: child
  withValue: (self fetchPointer: self freeChunkNextIndex
  ofFreeChunk: chunk).
  ^self startOfObject: chunk].
  child := 0] "break out of loop to remove interior node"
  ifFalse:"walk down the tree"
  [child := self fetchPointer: (nodeBytes > chunkBytes
  ifTrue: [self freeChunkSmallerIndex]
  ifFalse: [self freeChunkLargerIndex])
  ofFreeChunk: child]].
  parent = 0 ifTrue:
  [totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
  self halt].
 
  "self printFreeChunk: parent"
  self assert: (self bytesInObject: parent) = nodeBytes.
  "attempt to remove from list"
  chunk := self fetchPointer: self freeChunkNextIndex
  ofFreeChunk: parent.
  chunk ~= 0 ifTrue:
  [self storePointer: self freeChunkNextIndex
  ofFreeChunk: parent
  withValue: (self fetchPointer: self freeChunkNextIndex
  ofFreeChunk: chunk).
  chunkBytes ~= nodeBytes ifTrue:
  [self freeChunkWithBytes: nodeBytes - chunkBytes
  at: (self startOfObject: chunk) + chunkBytes].
  ^self startOfObject: chunk].
  "no list; remove an interior node"
  chunk := parent.
  parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk.
  "no parent; stitch the subnodes back into the root"
  parent = 0 ifTrue:
  [smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
  larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
  smaller = 0
  ifTrue: [freeLists at: 0 put: larger]
  ifFalse:
  [freeLists at: 0 put: smaller.
  larger ~= 0 ifTrue:
  [self addFreeSubTree: larger]].
  "coInterpreter transcript ensureCr.
  coInterpreter print: 'new free tree root '.
  (freeLists at: 0) = 0 ifTrue: [coInterpreter print: '0'] ifFalse: [self printFreeChunk: (freeLists at: 0)].
  coInterpreter cr."
  chunkBytes ~= nodeBytes ifTrue:
  [self freeChunkWithBytes: nodeBytes - chunkBytes
  at: (self startOfObject: chunk) + chunkBytes].
  ^self startOfObject: chunk].
  "remove node from tree; reorder tree simply.  two cases (which have mirrors, for four total):
  case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small)
  ___  ___
  | P |  | P |
     _/_ _/_
     | N | => | S |
  _/_
  | S |"
  self halt.
  "case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
  add the left subtree to the bottom left of the right subtree (mirrored for large vs small)
  ___  ___
  | P |  | P |
     _/_ _/_
     | N | => | R |
  _/_  _\_    _/_
  | L | | R |    | L |"
  self halt!

Item was changed:
  ----- Method: SpurMemoryManager>>instanceAfter: (in category 'object enumeration') -----
  instanceAfter: objOop
  | actualObj classIndex |
  actualObj := objOop.
  classIndex := self classIndexOf: objOop.
+
  (self isInEden: objOop) ifTrue:
+ [[actualObj := self objectAfter: actualObj limit: freeStart.
+  actualObj < freeStart] whileTrue:
- [actualObj := self objectAfter: actualObj limit: freeStart.
- [objOop < freeStart] whileTrue:
  [classIndex = (self classIndexOf: actualObj) ifTrue:
+ [^actualObj]].
- [^actualObj].
- actualObj := self objectAfter: objOop limit: freeStart].
  actualObj := pastSpaceStart > scavenger pastSpace start
  ifTrue: [self objectStartingAt: scavenger pastSpace start]
  ifFalse: [nilObj]].
+
  (self isInSurvivorSpace: actualObj) ifTrue:
+ [[actualObj := self objectAfter: actualObj limit: pastSpaceStart.
+  actualObj < pastSpaceStart] whileTrue:
- [actualObj := self objectAfter: actualObj limit: pastSpaceStart.
- [objOop < pastSpaceStart] whileTrue:
  [classIndex = (self classIndexOf: actualObj) ifTrue:
+ [^actualObj]].
- [^actualObj].
- actualObj := self objectAfter: objOop limit: pastSpaceStart].
  actualObj := nilObj].
+
+ [actualObj := self objectAfter: actualObj limit: freeOldSpaceStart.
+ actualObj < freeOldSpaceStart] whileTrue:
- actualObj := self objectAfter: actualObj limit: freeOldSpaceStart.
- [objOop < freeOldSpaceStart] whileTrue:
  [classIndex = (self classIndexOf: actualObj) ifTrue:
+ [^actualObj]].
- [^actualObj].
- actualObj := self objectAfter: objOop limit: freeOldSpaceStart].
  ^nil!

Item was changed:
  ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
  isIntegerObject: oop
  "This list records the valid senders of isIntegerObject: as we replace uses of
   isIntegerObject: by isImmediate: where appropriate."
  | sel |
  sel := thisContext sender method selector.
  (#( DoIt
  DoItIn:
  on:do: "from the debugger"
  makeBaseFrameFor:
  quickFetchInteger:ofObject:
  frameOfMarriedContext:
  objCouldBeClassObj:
  isMarriedOrWidowedContext:
  shortPrint:
  bytecodePrimAt
  bytecodePrimAtPut
  commonAt:
  commonAtPut:
  loadFloatOrIntFrom:
  positive32BitValueOf:
  primitiveExternalCall
  checkedIntegerValueOf:
  bytecodePrimAtPut
  commonAtPut:
  primitiveVMParameter
  checkIsStillMarriedContext:currentFP:
  displayBitsOf:Left:Top:Right:Bottom:
  fetchStackPointerOf:
  primitiveContextAt
  primitiveContextAtPut
  subscript:with:storing:format:
  printContext:
  compare31or32Bits:equal:
  signed64BitValueOf:
  primDigitMultiply:negative:
  digitLength:
  isNegativeIntegerValueOf:
  magnitude64BitValueOf:
  primitiveMakePoint
  primitiveAsCharacter
  primitiveInputSemaphore
  baseFrameReturn
  primitiveExternalCall
  primDigitCompare:
  isLiveContext:
  numPointerSlotsOf:
  fileValueOf:
  loadBitBltDestForm
  fetchIntOrFloat:ofObject:ifNil:
  fetchIntOrFloat:ofObject:
  loadBitBltSourceForm
  loadPoint:from:
  primDigitAdd:
  primDigitSubtract:
  positive64BitValueOf:
  digitBitLogic:with:opIndex:
+ signed32BitValueOf:
+ isNormalized:
+ primDigitDiv:negative:) includes: sel) ifFalse:
- signed32BitValueOf:) includes: sel) ifFalse:
  [self halt].
  ^(oop bitAnd: 1) ~= 0!

Item was changed:
  ----- Method: SpurMemoryManager>>objectAfter:limit: (in category 'object enumeration') -----
  objectAfter: objOop limit: limit
  "Object parsing.
  1. all objects have at least a word following the header, for a forwarding pointer.
  2. objects with an overflow size have a preceeing word with a saturated numSlots.  If the word
    following an object doesn't have a saturated numSlots field it must be a single-header object.
    If the word following does have a saturated numSlots it must be the overflow size word."
+ ^self subclassResponsibility!
- | followingWordAddress followingWord |
- followingWordAddress := self addressAfter: objOop.
- followingWordAddress >= limit ifTrue:
- [^limit].
- self flag: #endianness.
- followingWord := self longAt: followingWordAddress + 4.
- ^followingWord >> self numSlotsHalfShift = self numSlotsMask
- ifTrue: [followingWordAddress + self baseHeaderSize]
- ifFalse: [followingWordAddress]!

Item was changed:
  ----- Method: StackInterpreter>>printNameOfClass:count: (in category 'debug printing') -----
  printNameOfClass: classOop count: cnt
  "Details: The count argument is used to avoid a possible infinite recursion if classOop is a corrupted object."
  <inline: false>
+ (classOop isNil or: [classOop = 0 or: [cnt <= 0]]) ifTrue: [^self print: 'bad class'].
- (classOop = 0 or: [cnt <= 0]) ifTrue: [^self print: 'bad class'].
  ((objectMemory sizeBitsOf: classOop) = metaclassSizeBits
   and: [metaclassSizeBits > (thisClassIndex * BytesPerOop)]) "(Metaclass instSize * 4)"
  ifTrue: [self printNameOfClass: (objectMemory fetchPointer: thisClassIndex ofObject: classOop) count: cnt - 1.
  self print: ' class']
  ifFalse: [self printStringOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)]!

Item was added:
+ ----- Method: StackInterpreterSimulator>>cloneSimulation (in category 'debug support') -----
+ cloneSimulation
+ | savedDisplayView savedDisplayForm savedQuitBlock savedTranscript |
+ savedDisplayView := displayView. displayView := nil.
+ savedDisplayForm := displayForm. displayForm = nil.
+ savedQuitBlock := quitBlock. quitBlock := nil.
+ savedTranscript := transcript. transcript := nil.
+
+ [| clone window |
+ clone := self veryDeepCopy.
+ window := clone openAsMorph.
+ window setLabel: 'Clone of ', (savedDisplayView containingWindow label allButFirst: 'Simulation of ' size)]
+ ensure:
+ [displayView := savedDisplayView.
+ displayForm = savedDisplayForm.
+ quitBlock := savedQuitBlock.
+ transcript := savedTranscript]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  "Open a morphic view on this simulation."
  | window localImageName |
  localImageName := imageName
  ifNotNil: [FileDirectory default localNameFor: imageName]
  ifNil: [' synthetic image'].
  window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
 
  window addMorph: (displayView := ImageMorph new image: displayForm)
  frame: (0@0 corner: 1@0.8).
 
  transcript := TranscriptStream on: (String new: 10000).
  window addMorph: (PluggableTextMorph
  on: transcript text: nil accept: nil
  readSelection: nil menu: #codePaneMenu:shifted:)
  frame: (0@0.8 corner: 0.7@1).
 
  window addMorph: (PluggableTextMorph on: self
  text: #byteCountText accept: nil
  readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  frame: (0.7@0.8 corner: 1@1).
 
  window openInWorldExtent: (self desiredDisplayExtent
  + (2 * window borderWidth)
  + (0@window labelHeight)
+ * (1@(1/0.8))) rounded.
+ ^window!
- * (1@(1/0.8))) rounded!

Item was changed:
  ----- Method: StackInterpreterSimulator>>run (in category 'testing') -----
  run
  "Just run"
+ quitBlock := [displayView ifNotNil:
+   [displayView containingWindow ifNotNil:
+ [:topWindow|
+ ((World submorphs includes: topWindow)
+ and: [UIManager default confirm: 'close?']) ifTrue:
+ [topWindow delete]]].
- quitBlock := [| topWindow |
-  
-   (displayView notNil
-   and: [topWindow := displayView outermostMorphThat:
- [:m| m isSystemWindow and: [World submorphs includes: m]].
- topWindow notNil
-   and: [UIManager default confirm: 'close?']]) ifTrue:
- [topWindow delete].
   ^self].
  self initStackPages.
  self loadInitialContext.
  self internalizeIPandSP.
  self fetchNextBytecode.
  [true] whileTrue:
  [self assertValidExecutionPointers.
  atEachStepBlock value. "N.B. may be nil"
  self dispatchOn: currentBytecode in: BytecodeTable.
  self incrementByteCount].
  localIP := localIP - 1.
  "undo the pre-increment of IP before returning"
  self externalizeIPandSP!

Item was changed:
  ----- Method: StackInterpreterSimulator>>runWithBreakCount: (in category 'testing') -----
  runWithBreakCount: theBreakCount
  "Just run, halting when byteCount is reached"
+ quitBlock := [displayView ifNotNil:
+   [displayView containingWindow ifNotNil:
+ [:topWindow|
+ ((World submorphs includes: topWindow)
+ and: [UIManager default confirm: 'close?']) ifTrue:
+ [topWindow delete]]].
- quitBlock := [| topWindow |
-  
-   (displayView notNil
-   and: [topWindow := displayView outermostMorphThat:
- [:m| m isSystemWindow and: [World submorphs includes: m]].
- topWindow notNil
-   and: [UIManager default confirm: 'close?']]) ifTrue:
- [topWindow delete].
   ^self].
  breakCount := theBreakCount.
  self initStackPages.
  self loadInitialContext.
  self internalizeIPandSP.
  self fetchNextBytecode.
  [true] whileTrue:
  [self assertValidExecutionPointers.
  self dispatchOn: currentBytecode in: BytecodeTable.
  self incrementByteCount].
  localIP := localIP - 1.
  "undo the pre-increment of IP before returning"
  self externalizeIPandSP!

Item was changed:
  ----- Method: StackInterpreterSimulator>>utilitiesMenu: (in category 'UI') -----
  utilitiesMenu: aMenuMorph
  aMenuMorph
  add: 'toggle transcript' action: #toggleTranscript;
+ add: 'clone VM' action: #cloneSimulation;
  addLine;
  add: 'print ext head frame' action: #printExternalHeadFrame;
  add: 'print int head frame' action: #printHeadFrame;
  add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
  add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
  add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
  add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
  add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
  add: 'print call stack' action: #printCallStack;
  add: 'print stack call stack' action: #printStackCallStack;
  add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
  add: 'print all stacks' action: #printAllStacks;
  add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
  self writeBackHeadFramePointers];
  addLine;
  add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
  add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
  addLine;
  add: 'inspect object memory' target: objectMemory action: #inspect;
  add: 'inspect cointerpreter' action: #inspect;
  addLine;
  add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
  s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
  add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
  s notEmpty ifTrue: [self setBreakSelector: s]];
  add: (printSends
  ifTrue: ['no print sends']
  ifFalse: ['print sends'])
  action: [self ensureDebugAtEachStepBlock.
  printSends := printSends not];
  "currently printReturns does nothing"
  "add: (printReturns
  ifTrue: ['no print returns']
  ifFalse: ['print returns'])
  action: [self ensureDebugAtEachStepBlock.
  printReturns := printReturns not];"
  add: (printBytecodeAtEachStep
  ifTrue: ['no print bytecode each bytecode']
  ifFalse: ['print bytecode each bytecode'])
  action: [self ensureDebugAtEachStepBlock.
  printBytecodeAtEachStep := printBytecodeAtEachStep not];
  add: (printFrameAtEachStep
  ifTrue: ['no print frame each bytecode']
  ifFalse: ['print frame each bytecode'])
  action: [self ensureDebugAtEachStepBlock.
  printFrameAtEachStep := printFrameAtEachStep not].
  ^aMenuMorph!