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

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

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

Name: VMMaker.oscog-eem.2237
Author: eem
Time: 7 June 2017, 3:10:26.925647 pm
UUID: 478bccfa-1316-4b8a-b3a9-7f3fd01c3b71
Ancestors: VMMaker.oscog-eem.2236

Spur:
Implement an allocated bytes tally accessible via vmParameterAt: 34 (which used to access statAllocationCount).
Do this by counting bytes allocated in eden plus change in usage between scavenges.  hence maintain totalHeapSizeIncludingBridges in SpurSegmentManager.

Fix a bug in calculating heapSizeAtPreviousGC which simply calculated the extent of oldSpace, potentially a huge overestimate, not its size.

Interpreter:
Provide a breakLookupClassTag check on full lookup sends for debugging.

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

Item was changed:
  ----- Method: CoInterpreter>>lookupLexicalNoMNU:from:rule: (in category 'message sending') -----
  lookupLexicalNoMNU: selector from: mixin rule: rule
  "A shared part of the lookup for implicit receiver sends that found a lexically visible
  method, and self and outer sends."
  | receiverClass mixinApplication dictionary found |
  receiverClass := objectMemory fetchClassOf: localAbsentReceiver.
  lkupClass := receiverClass. "MNU lookup starts here."
+ self lookupBreakFor: lkupClass.
  mixinApplication := self findApplicationOfTargetMixin: mixin startingAtBehavior: receiverClass.
  dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: mixinApplication.
  found := self lookupMethodInDictionary: dictionary.
  (found and: [(self isPrivateMethod: newMethod)]) ifTrue:
  [^0].
  ^self lookupProtectedNoMNU: selector startingAt: receiverClass rule: rule!

Item was changed:
  ----- Method: CoInterpreter>>lookupProtectedNoMNU:startingAt:rule: (in category 'message sending') -----
  lookupProtectedNoMNU: selector startingAt: mixinApplication rule: rule
  "A shared part of the lookup for self, outer or implicit receiver sends that did not find a
  private lexically visible method, and (Newspeak) super sends."
  | currentClass dictionary found |
+ self lookupBreakFor: mixinApplication.
  currentClass := mixinApplication.
  [currentClass = objectMemory nilObject] whileFalse:
  [dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
  found := self lookupMethodInDictionary: dictionary.
  (found and: [(self isPrivateMethod: newMethod) not]) ifTrue:
  [^0].
  currentClass := self superclassOf: currentClass].
  ^SelectorDoesNotUnderstand!

Item was added:
+ ----- Method: CogVMSimulator>>primitiveVMParameter (in category 'system control primitives') -----
+ primitiveVMParameter
+ (argumentCount = 2
+ and: [(self stackValue: 1) = (objectMemory integerObjectOf: 34)]) ifTrue:
+ [self halt].
+ ^super primitiveVMParameter!

Item was added:
+ ----- Method: ObjectMemory>>shouldBreakForLookupIn:given: (in category 'debug support') -----
+ shouldBreakForLookupIn: lookupClass given: breakClassTag
+ <inline: true>
+ ^lookupClass == breakClassTag!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>methodDictionaryHash:mask: (in category 'interpreter access') -----
  methodDictionaryHash: oop mask: mask
  <inline: true>
  ^mask bitAnd: ((self isImmediate: oop)
  ifTrue: [(self isIntegerObject: oop)
  ifTrue: [self integerValueOf: oop]
  ifFalse: [self characterValueOf: oop]]
+ ifFalse: [self rawHashBitsOf: oop]) "If no hash then it isn't in the dictionary..."!
- ifFalse: [self hashBitsOf: oop])!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>methodDictionaryHash:mask: (in category 'interpreter access') -----
  methodDictionaryHash: oop mask: mask
  <inline: true>
  ^mask bitAnd: ((self isImmediate: oop)
+ ifTrue: [self integerValueOf: oop] "this will fail for SmallFloat64 but we don't care"
+ ifFalse: [self rawHashBitsOf: oop]) "If no hash then it isn't in the dictionary..."!
- ifTrue: [self integerValueOf: oop] "this will fail for ShortFloat but we don't care"
- ifFalse: [self hashBitsOf: oop])!

Item was changed:
  CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)

Item was changed:
  ----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  self declareCAsOop: #( memory freeStart scavengeThreshold newSpaceStart newSpaceLimit pastSpaceStart
  lowSpaceThreshold freeOldSpaceStart oldSpaceStart endOfMemory firstFreeChunk lastFreeChunk)
  in: aCCodeGenerator.
+ self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs']), #(statAllocatedBytes)
- self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs'])
  in: aCCodeGenerator.
  aCCodeGenerator
  var: #freeListsMask type: #usqInt;
  var: #freeLists type: #'sqInt *';
  var: #objStackInvalidBecause type: #'char *';
  var: #unscannedEphemerons type: #SpurContiguousObjStack;
  var: #heapGrowthToSizeGCRatio type: #float;
  var: #heapSizeAtPreviousGC type: #usqInt;
  var: #totalFreeOldSpace type: #usqInt;
+ var: #maxOldSpaceSize type: #usqInt;
+ var: #oldSpaceUsePriorToScavenge type: #usqInt.
- var: #maxOldSpaceSize type: #usqInt.
  aCCodeGenerator
  var: #remapBuffer
  declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
  aCCodeGenerator
  var: #extraRoots
  declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'!

Item was added:
+ ----- Method: SpurMemoryManager>>currentAllocatedBytes (in category 'allocation accounting') -----
+ currentAllocatedBytes
+ "Compute the current allocated bytes since last set.
+ This is the cumulative total in statAllocatedBytes plus the allocation since the last scavenge."
+ | use |
+ use := segmentManager totalOldSpaceCapacity - totalFreeOldSpace.
+ ^statAllocatedBytes
+ + (freeStart - scavenger eden start)
+ + (use - oldSpaceUsePriorToScavenge)!

Item was added:
+ ----- Method: SpurMemoryManager>>doAllocationAccountingForScavenge (in category 'allocation accounting') -----
+ doAllocationAccountingForScavenge
+ <inline: true>
+ statAllocatedBytes := self currentAllocatedBytes!

Item was changed:
  ----- Method: SpurMemoryManager>>doScavenge: (in category 'gc - scavenging') -----
  doScavenge: tenuringCriterion
  "The inner shell for scavenge, abstrascted out so globalGarbageCollect can use it."
  <inline: false>
+ self doAllocationAccountingForScavenge.
  gcPhaseInProgress := ScavengeInProgress.
  pastSpaceStart := scavenger scavenge: tenuringCriterion.
  self assert: (self
  oop: pastSpaceStart
  isGreaterThanOrEqualTo: scavenger pastSpace start
  andLessThanOrEqualTo: scavenger pastSpace limit).
  freeStart := scavenger eden start.
  self initSpaceForAllocationCheck: (self addressOf: scavenger eden) limit: scavengeThreshold.
+ gcPhaseInProgress := 0.
+ self resetAllocationAccountingAfterGC!
- gcPhaseInProgress := 0!

Item was changed:
  ----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
  initialize
  "We can put all initializations that set something to 0 or to false here.
  In C all global variables are initialized to 0, and 0 is false."
  remapBuffer := Array new: RemapBufferSize.
  remapBufferCount := extraRootCount := 0. "see below"
  freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
  checkForLeaks := 0.
  needGCFlag := signalLowSpace := marking := false.
  becomeEffectsFlags := gcPhaseInProgress := 0.
  statScavenges := statIncrGCs := statFullGCs := 0.
  statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statCompactionUsecs := statGCEndUsecs := 0.
  statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
+ statGrowMemory := statShrinkMemory := statRootTableCount := statAllocatedBytes := 0.
- statGrowMemory := statShrinkMemory := statRootTableCount := 0.
  statRootTableOverflows := statMarkCount := statCompactPassCount := statCoalesces := 0.
 
  "We can initialize things that are allocated but are lazily initialized."
  unscannedEphemerons := SpurContiguousObjStack new.
 
  "we can initialize things that are virtual in C."
  scavenger := SpurGenerationScavenger simulatorClass new manager: self; yourself.
  segmentManager := SpurSegmentManager simulatorClass new manager: self; yourself.
  compactor := self class compactorClass simulatorClass new manager: self; yourself.
 
  "We can also initialize here anything that is only for simulation."
  heapMap := CogCheck32BitHeapMap new.
 
  "N.B. We *don't* initialize extraRoots because we don't simulate it."
  maxOldSpaceSize := self class initializationOptions
  ifNotNil: [:initOpts| initOpts at: #maxOldSpaceSize ifAbsent: [0]]
  ifNil: [0]!

Item was added:
+ ----- Method: SpurMemoryManager>>resetAllocationAccountingAfterGC (in category 'allocation accounting') -----
+ resetAllocationAccountingAfterGC
+ "oldSpaceUsePriorToScavenge is used to maintain an accurate allocation count.
+ Since scavenging may tenure objects and tenuring does not count as allocation (that
+ would count twice) we must compute heapSizeAtPreviousGC after any tenuring.
+ fullGC reclaims space which does not count as deallocation (that would not count
+ allocations at all), so we must reset heapSizeAtPreviousGC after GC also."
+ <inline: true>
+ oldSpaceUsePriorToScavenge := segmentManager totalOldSpaceCapacity - totalFreeOldSpace!

Item was added:
+ ----- Method: SpurMemoryManager>>setCurrentAllocatedBytesTo: (in category 'allocation accounting') -----
+ setCurrentAllocatedBytesTo: n
+ "Reset the allocation count to n (n will typically be zero).  Since we wish to
+ discount the current use we must set statAllocatedBytes to n and update
+ oldSpaceUsePriorToScavenge to discount the current allocated bytes."
+ | delta |
+ delta := self currentAllocatedBytes - statAllocatedBytes.
+ statAllocatedBytes := n.
+ oldSpaceUsePriorToScavenge := oldSpaceUsePriorToScavenge + delta.
+ self assert: self currentAllocatedBytes = n!

Item was changed:
+ ----- Method: SpurMemoryManager>>setHeapSizeAtPreviousGC (in category 'allocation accounting') -----
- ----- Method: SpurMemoryManager>>setHeapSizeAtPreviousGC (in category 'gc - global') -----
  setHeapSizeAtPreviousGC
+ "heapSizeAtPreviousGC is used to invoke full GC when lots of oldSpace objects are created.
+ Also reset oldSpaceUsePriorToScavenge."
+ <inline: true>
+ heapSizeAtPreviousGC := segmentManager totalOldSpaceCapacity - totalFreeOldSpace.
+ self resetAllocationAccountingAfterGC!
- heapSizeAtPreviousGC := endOfMemory - nilObj - totalFreeOldSpace!

Item was added:
+ ----- Method: SpurMemoryManager>>shouldBreakForLookupIn:given: (in category 'debug support') -----
+ shouldBreakForLookupIn: lookupClass given: breakClassTag
+ <inline: true>
+ ^breakClassTag notNil
+  and: [lookupClass == breakClassTag
+ or: [(self rawHashBitsOf: lookupClass) == breakClassTag]]!

Item was changed:
  CogClass subclass: #SpurSegmentManager
+ instanceVariableNames: 'manager numSegments numSegInfos segments firstSegmentSize canSwizzle sweepIndex preferredPinningSegment totalHeapSizeIncludingBridges'
- instanceVariableNames: 'manager numSegments numSegInfos segments firstSegmentSize canSwizzle sweepIndex preferredPinningSegment'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'VMMaker-SpurMemoryManager'!
 
+ !SpurSegmentManager commentStamp: 'eem 6/7/2017 14:00' prior: 0!
- !SpurSegmentManager commentStamp: 'eem 11/29/2013 11:48' prior: 0!
  Instances of SpurSegmentManager manage oldSpace, which is organized as a sequence of segments.  Segments can be obtained from the operating system and returned to the operating system when empty and shrinkage is required.  Segments are kept invisible from the SpurMemoryManager by using "bridge" objects, "fake" pinned objects to bridge the gaps between segments.  A pinned object header occupies the last 16 bytes of each segment, and the pinned object's size is the distance to the start of the next segment.  So when the memory manager enumerates objects it skips over these bridges and memory appears linear.  The constraint is that segments obtained from the operating system must be at a higher address than the first segment.  The maximum size of large objects, being an overflow slot size, should be big enough to bridge the gaps, because in 32-bits the maximum size is 2^32 slots.  In 64-bits the maximum size of large objects is 2^56 slots, or 2^59 bits, which we hope will suffice.
 
  When an image is written to a snapshot file the second word of the header of the bridge at the end of each segment is replaced by the size of the following segment, the segments are written to the file, and the second word of each bridge is restored.  Hence the length of each segment is derived from the bridge at the end of the preceeding segment.  The length of the first segment is stored in the image header as firstSegmentBytes.  The start of each segment is also derived from the bridge as a delta from the start of the previous segment.  The start of The first segment is stored in the image header as startOfMemory.
 
  On load all segments are read into one single segment, eliminating the bridge objects, and computing the swizzle distance for each segment, based on where the segments were in memory when the image file was written, and where the coalesced segment ends up on load.  Then the segment is traversed, swizzling pointers by selecting the relevant swizzle for each oop's segment.
 
  Instance Variables
+ manager <SpurMemoryManager>
+ numSegments <Integer>
+ numSegInfos <Integer>
+ segments <Array of SpurSegmentInfo>
+ firstSegmentSize <Integer>
+ canSwizzle <Boolean>
+ sweepIndex <Integer>
+ preferredPinningSegment <SpurSegmentInfo>
+ totalHeapSizeIncludingBridges <integer>
- manager: <SpurMemoryManager>
- numSegments: <Integer>
- numSegInfos: <Integer>
- segments: <Array of SpurSegmentInfo>
- firstSegmentSize: <Integer>
- canSwizzle: <Boolean>
- sweepIndex: <Integer>
- preferredPinningSegment: <SpurSegmentInfo>
 
  canSwizzle
  - a flag set and cleared during initialization to validate that swizzling is only performed at the right time
 
  firstSegmentSize
  - the size of the first segment when loading an image
 
  manager
  - the memory manager the receiver manages segments for (simulation only)
 
  numSegInfos
  - the size of the segments array in units of SpurSegmentInfo size
 
  numSegments
  - the number of segments (the number of used entries in segments, <= numSegInfos)
 
  preferredPinningSegment
  - the segment in which objects should be copied when pinned, so as to cluster pinned objects in as few segments as possible.  As yet unimplemented.
 
  segments
  - the start addresses, lengths and offsets to adjust oops on image load, for each segment
 
  sweepIndex
+ - a segment index used to optimize setting the containsPinned flag on segments during freeUnmarkedObjectsAndSortAndCoalesceFreeSpace
+
+ totalHeapSizeIncludingBridges
+ - the total size of all segments, used to compute heap usage!
- - a segment index used to optimize setting the containsPinned flag on segments during freeUnmarkedObjectsAndSortAndCoalesceFreeSpace!

Item was changed:
  ----- Method: SpurSegmentManager class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
+ aCCodeGenerator
+ var: #segments type: #'SpurSegmentInfo *';
+ var: #totalHeapSizeIncludingBridges type: #usqInt!
- aCCodeGenerator var: #segments type: #'SpurSegmentInfo *'!

Item was changed:
  ----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') -----
  addSegmentOfSize: ammount
  <returnTypeC: #'SpurSegmentInfo *'>
  <inline: false>
  | allocatedSize |
  <var: #newSeg type: #'SpurSegmentInfo *'>
  <var: #segAddress type: #'void *'>
  <var: #allocatedSize type: #'usqInt'>
  self cCode: [] inSmalltalk: [segments ifNil: [^nil]]. "bootstrap"
  (manager "sent to the manager so that the simulator can increase memory to simulate a new segment"
  sqAllocateMemorySegmentOfSize: ammount
  Above: (self firstGapOfSizeAtLeast: ammount)
  AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize]
  inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil:
  [:segAddress| | newSegIndex newSeg |
  newSegIndex := self insertSegmentFor: segAddress asUnsignedIntegerPtr.
  newSeg := self addressOf: (segments at: newSegIndex).
  newSeg
  segStart: segAddress asUnsignedIntegerPtr;
  segSize: allocatedSize.
  self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg.
  self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse:
  [self addressOf: (segments at: newSegIndex + 1)]).
+ totalHeapSizeIncludingBridges := totalHeapSizeIncludingBridges + allocatedSize.
  "test isInMemory:"
  0 to: numSegments - 1 do:
  [:i|
  self assert: (self isInSegments: (segments at: i) segStart).
  self assert: (self isInSegments: (segments at: i) segLimit - manager wordSize).
  self assert: ((self isInSegments: (segments at: i) segLimit) not
  or: [i < (numSegments - 1)
  and: [(segments at: i) segLimit = (segments at: i + 1) segStart]]).
  self assert: ((self isInSegments: (segments at: i) segStart - manager wordSize) not
  or: [i > 0
  and: [(segments at: i - 1) segLimit = (segments at: i) segStart]])].
  ^newSeg].
  ^nil!

Item was changed:
  ----- Method: SpurSegmentManager>>collapseSegmentsPostSwizzle (in category 'snapshot') -----
  collapseSegmentsPostSwizzle
  "The image has been loaded, old segments reconstructed, and the heap
  swizzled into a single contiguous segment.  Collapse the segments into one."
  <inline: false>
  canSwizzle := false.
  self cCode: []
  inSmalltalk:
  [segments ifNil:
  [self allocateOrExtendSegmentInfos]].
  numSegments := 1.
  (segments at: 0)
  segStart: manager oldSpaceStart;
+ segSize: (totalHeapSizeIncludingBridges := manager endOfMemory - manager oldSpaceStart).
- segSize: manager endOfMemory - manager oldSpaceStart.
  manager bootstrapping ifTrue:
  ["finally plant a bridge at the end of the coalesced segment and cut back the
   manager's notion of the end of memory to immediately before the bridge."
  self assert: manager endOfMemory = (segments at: 0) segLimit.
  manager
  initSegmentBridgeWithBytes: manager bridgeSize
  at: manager endOfMemory - manager bridgeSize].
  self assert: (manager isSegmentBridge: (self bridgeAt: 0)).
  self assert: (manager numSlotsOfAny: (self bridgeAt: 0)) = 0!

Item was changed:
  ----- Method: SpurSegmentManager>>initialize (in category 'initialization') -----
  initialize
+ numSegments := numSegInfos := sweepIndex := totalHeapSizeIncludingBridges := 0.
- numSegments := numSegInfos := sweepIndex := 0.
  canSwizzle := false!

Item was changed:
  ----- Method: SpurSegmentManager>>removeSegment: (in category 'growing/shrinking memory') -----
  removeSegment: emptySeg
  <var: #emptySeg type: #'SpurSegmentInfo *'>
  | i |
  i := self indexOfSegment: emptySeg.
  self assert: i > 0.
 
+ totalHeapSizeIncludingBridges := totalHeapSizeIncludingBridges - emptySeg segSize.
  manager sqDeallocateMemorySegmentAt: emptySeg segStart asVoidPointer OfSize: emptySeg segSize.
 
  i to: numSegments - 1 do:
  [:j| segments at: j put: (segments at: j + 1)].
  self cCode: [] inSmalltalk: [segments at: numSegments - 1 put: SpurSegmentInfo new].
  numSegments := numSegments - 1.
 
  self bridgeFrom: (self addressOf: (segments at: i - 1))
  to: (i <= (numSegments - 1) ifTrue: [self addressOf: (segments at: i)]).
 
  manager setLastSegment: (self addressOf: (segments at: numSegments - 1))!

Item was changed:
+ ----- Method: SpurSegmentManager>>totalBytesInSegments (in category 'accessing') -----
- ----- Method: SpurSegmentManager>>totalBytesInSegments (in category 'snapshot') -----
  totalBytesInSegments
  | total |
  <var: #total type: #usqInt>
  total := 0.
  0 to: numSegments - 1 do:
  [:i|
  total := total + (segments at: i) segSize].
+ self assert: totalHeapSizeIncludingBridges = total.
  ^total!

Item was added:
+ ----- Method: SpurSegmentManager>>totalOldSpaceCapacity (in category 'accessing') -----
+ totalOldSpaceCapacity
+ ^totalHeapSizeIncludingBridges - (numSegments * manager bridgeSize)!

Item was changed:
  InterpreterPrimitives subclass: #StackInterpreter
+ instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver localAbsentReceiverOrZero extA extB numExtB primitiveFunctionPointer methodCache nsMethodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelector
 Length breakLookupClassTag longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 tempOop3 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex checkedPluginName nativeSP nativeStackPointer lowcodeCalloutState shadowCallStackPointer displayBits displayWidth displayHeight displayDepth statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals statIdleUsecs debugCallbackPath debugCallbackReturns debugCallbackInvokes'
- instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver localAbsentReceiverOrZero extA extB numExtB primitiveFunctionPointer methodCache nsMethodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelector
 Length longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 tempOop3 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex checkedPluginName nativeSP nativeStackPointer lowcodeCalloutState shadowCallStackPointer displayBits displayWidth displayHeight displayDepth statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals statIdleUsecs debugCallbackPath debugCallbackReturns debugCallbackInvokes'
  classVariableNames: 'AccessModifierPrivate AccessModifierProtected AccessModifierPublic AltBytecodeEncoderClassName AltLongStoreBytecode AlternateHeaderHasPrimFlag AlternateHeaderIsOptimizedFlag AlternateHeaderNumLiteralsMask AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex EnforceAccessControl FailImbalancedPrimitives LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MethodHeaderArgCountShift MethodHeaderFlagBitPosition MethodHeaderTempCountShift MixinIndex PrimNumberDoExternalCall PrimNumberExternalCall PrimNumberFFICall PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached V3PrimitiveBitsMask'
  poolDictionaries: 'VMBasicConstants VMBytecodeConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMStackFrameOffsets'
  category: 'VMMaker-Interpreter'!
 
  !StackInterpreter commentStamp: 'eem 12/5/2014 11:32' prior: 0!
  This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas.  This VM supports Closures but *not* old-style BlockContexts.
 
  It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
 
  The VM does not use Contexts directly.  Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image.  There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up.  The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations.  A send establishes a new frame in the current stack page, a return returns to the previous frame.  This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return.  Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together).  Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse f
 rame has been returned from (died).  A married context is specially marked (more details in the code) and refers to its frame.  Likewise a married frame is specially marked and refers to its context.
 
  In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
 
  StackInterpreter and subclasses support multiple memory managers.  Currently there are two.  NewMemoryManager is a slightly refined version of ObjectMemory, and is the memory manager and garbage collector for the original Squeak object representation as described in "Back to the Future The Story of Squeak, A Practical Smalltalk Written in Itself", see http://ftp.squeak.org/docs/OOPSLA.Squeak.html.  Spur is a faster, more regular object representation that is designed for more performance and functionality, and to have a common header format for both 32-bit and 64-bit versions.  You can read about it in SpurMemoryManager's class comment.  There is also a video of a presentation at ESUG 2014 (https://www.youtube.com/watch?v=k0nBNS1aHZ4), along with slides (http://www.slideshare.net/esug/spur-a-new-object-representation-for-cog?related=1).!

Item was changed:
  ----- Method: StackInterpreter class>>mustBeGlobal: (in category 'translation') -----
  mustBeGlobal: var
  "Answer if a variable must be global and exported.  Used for inst vars that are accessed from VM support code."
 
  ^(super mustBeGlobal: var)
    or: [(self objectMemoryClass mustBeGlobal: var)
    or: [(#('interpreterProxy' 'interpreterVersion' 'inIOProcessEvents'
  'deferDisplayUpdates' 'extraVMMemory'
  'showSurfaceFn' 'displayBits' 'displayWidth' 'displayHeight' 'displayDepth'
  'desiredNumStackPages' 'desiredEdenBytes'
+ 'breakLookupClassTag' 'breakSelector' 'breakSelectorLength' 'sendTrace' 'checkAllocFiller' 'checkedPluginName'
- 'breakSelector' 'breakSelectorLength' 'sendTrace' 'checkAllocFiller' 'checkedPluginName'
  'suppressHeartbeatFlag' 'debugCallbackInvokes' 'debugCallbackPath' 'debugCallbackReturns') includes: var)
    or: [ "This allows slow machines to define bytecodeSetSelector as 0
  to avoid the interpretation overhead."
  MULTIPLEBYTECODESETS not and: [var = 'bytecodeSetSelector']]]]!

Item was added:
+ ----- Method: StackInterpreter>>lookupBreakFor: (in category 'debug support') -----
+ lookupBreakFor: lookupClass
+ <inline: true>
+ (objectMemory shouldBreakForLookupIn: lookupClass given: breakLookupClassTag) ifTrue:
+ [self
+ cCode: [self warning: 'lookup class send break (heartbeat suppressed)']
+ inSmalltalk: [self halt: 'Lookup in class ', lookupClass hex]]!

Item was changed:
  ----- Method: StackInterpreter>>lookupLexical:from:rule: (in category 'message sending') -----
  lookupLexical: selector from: mixin rule: rule
  "A shared part of the lookup for implicit receiver sends that found a lexically visible
  method, and self and outer sends."
  | receiverClass mixinApplication dictionary found |
  receiverClass := objectMemory fetchClassOf: localAbsentReceiver.
+ self lookupBreakFor: receiverClass.
  lkupClass := receiverClass. "MNU lookup starts here."
  mixinApplication := self findApplicationOfTargetMixin: mixin startingAtBehavior: receiverClass.
  dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: mixinApplication.
  found := self lookupMethodInDictionary: dictionary.
  (found and: [(self isPrivateMethod: newMethod)]) ifTrue:
  [^rule].
  ^self lookupProtected: selector startingAt: receiverClass rule: rule
  !

Item was changed:
  ----- Method: StackInterpreter>>lookupMNU (in category 'message sending') -----
  lookupMNU
  "A send lookup failed. Replace the arguments on the stack with a Message and lookup
  #doesNotUndestand: starting at lkupClass. Note that MNU lookup ignores access modifiers.
  This makes it different from an ordinary send of #doesNotUnderstand:, which must only
  find public methods.
  IN: lkupClass
  IN: messageSelector
  IN: argumentCount
  OUT: newMethod
  OUT: primitiveIndex
  RESULT: LookupRuleMNU"
 
  | currentClass dictionary found |
+ self lookupBreakFor: lkupClass.
  self createActualMessageTo: lkupClass.
  messageSelector := objectMemory splObj: SelectorDoesNotUnderstand.
  currentClass := lkupClass.
  [currentClass ~= objectMemory nilObject] whileTrue:
  [dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
  found := self lookupMethodInDictionary: dictionary.
  found ifTrue: [^LookupRuleMNU].
  currentClass := self superclassOf: currentClass].
 
  self error: 'Recursive not understood error encountered'
  !

Item was changed:
  ----- Method: StackInterpreter>>lookupMNUInClass: (in category 'message sending') -----
  lookupMNUInClass: class
  "Lookup messageSelector in class.  Answer 0 on success. Answer the splObj: index
  for the error selector to use on failure rather than performing MNU processing etc."
  | currentClass dictionary found |
  <inline: false>
+ self lookupBreakFor: class.
  currentClass := class.
  [currentClass ~= objectMemory nilObject] whileTrue:
  [dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
  dictionary = objectMemory nilObject ifTrue:
  [lkupClass := self superclassOf: currentClass.
  ^SelectorCannotInterpret].
  found := self lookupMethodInDictionary: dictionary.
  NewspeakVM
  ifTrue: [found ifTrue: [lkupClass := class. self addNewMethodToNSCache: LookupRuleMNU. ^0]]
  ifFalse: [found ifTrue: [self addNewMethodToCache: class. ^0]].
  currentClass := self superclassOf: currentClass].
  lkupClass := class.
  ^SelectorDoesNotUnderstand!

Item was changed:
  ----- Method: StackInterpreter>>lookupMethodInClass: (in category 'message sending') -----
  lookupMethodInClass: class
  | currentClass dictionary found |
  <inline: false>
  self assert: (self addressCouldBeClassObj: class).
+ self lookupBreakFor: class.
  currentClass := class.
  [currentClass ~= objectMemory nilObject] whileTrue:
  [dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
  dictionary = objectMemory nilObject ifTrue:
  ["MethodDict pointer is nil (hopefully due a swapped out stub)
  -- raise exception #cannotInterpret:."
  self createActualMessageTo: class.
  messageSelector := objectMemory splObj: SelectorCannotInterpret.
  self sendBreakpoint: messageSelector receiver: nil.
  ^self lookupMethodInClass: (self superclassOf: currentClass)].
  found := self lookupMethodInDictionary: dictionary.
  found ifTrue: [^currentClass].
  currentClass := self superclassOf: currentClass].
 
  "Could not find #doesNotUnderstand: -- unrecoverable error."
  messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue:
  [self error: 'Recursive not understood error encountered'].
 
  "Cound not find a normal message -- raise exception #doesNotUnderstand:"
  self createActualMessageTo: class.
  messageSelector := objectMemory splObj: SelectorDoesNotUnderstand.
  self sendBreak: messageSelector + objectMemory baseHeaderSize
  point: (objectMemory lengthOf: messageSelector)
  receiver: nil.
  ^self lookupMethodInClass: class!

Item was changed:
  ----- Method: StackInterpreter>>lookupOrdinaryNoMNUEtcInClass: (in category 'message sending') -----
  lookupOrdinaryNoMNUEtcInClass: class
  "Lookup messageSelector in class.  Answer 0 on success. Answer the splObj: index
  for the error selector to use on failure rather than performing MNU processing etc."
  | currentClass dictionary found |
  <inline: false>
+ self lookupBreakFor: class.
  currentClass := class.
  [currentClass ~= objectMemory nilObject] whileTrue:
  [dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
  dictionary = objectMemory nilObject ifTrue:
  [lkupClass := self superclassOf: currentClass.
  ^SelectorCannotInterpret].
  found := self lookupMethodInDictionary: dictionary.
  NewspeakVM
  ifTrue:
  [found ifTrue:
  [(self isPublicMethod: newMethod) ifTrue:
  [self addNewMethodToCache: class. ^0].
  (self isProtectedMethod: newMethod) ifTrue:
  [lkupClass := class. ^SelectorDoesNotUnderstand]]]
  ifFalse:
  [found ifTrue:
  [self addNewMethodToCache: class. ^0]].
  currentClass := self superclassOf: currentClass].
  lkupClass := class.
  ^SelectorDoesNotUnderstand!

Item was changed:
  ----- Method: StackInterpreter>>lookupOrdinarySend (in category 'message sending') -----
  lookupOrdinarySend
  "Do the full lookup for an ordinary send (i.e., a Newspeak or Smalltalk ordinary send or a Smalltalk super send).
  IN: lkupClass
  IN: messageSelector
  IN: argumentCount
  OUT: newMethod
  OUT: primitiveIndex
  RESULT: LookupRuleOrdinary or LookupRuleMNU"
  <option: #NewspeakVM>
  | currentClass dictionary found |
  self assert: (self addressCouldBeClassObj: lkupClass).
+ self lookupBreakFor: lkupClass.
  currentClass := lkupClass.
  [currentClass ~= objectMemory nilObject] whileTrue:
  [dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
  found := self lookupMethodInDictionary: dictionary.
  found ifTrue:
  [(self isPublicMethod: newMethod) ifTrue:
  [^LookupRuleOrdinary].
  (self isProtectedMethod: newMethod) ifTrue:
  [^self lookupMNU]].
  currentClass := self superclassOf: currentClass].
  ^self lookupMNU!

Item was changed:
  ----- Method: StackInterpreter>>lookupProtected:startingAt:rule: (in category 'message sending') -----
  lookupProtected: selector startingAt: mixinApplication rule: rule
  "A shared part of the lookup for self, outer or implicit receiver sends that did not find a
  private lexically visible method, and (Newspeak) super sends."
  | currentClass dictionary found |
+ self lookupBreakFor: mixinApplication.
  currentClass := mixinApplication.
  [currentClass = objectMemory nilObject] whileFalse:
  [dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
  found := self lookupMethodInDictionary: dictionary.
  (found and: [(self isPrivateMethod: newMethod) not]) ifTrue:
  [^rule].
  currentClass := self superclassOf: currentClass].
  ^self lookupMNU!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveVMParameter (in category 'system control primitives') -----
(excessive size, no diff calculated)