VM Maker: VMMaker-dtl.421.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-dtl.421.mcz

commits-2
 
David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.421.mcz

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

Name: VMMaker-dtl.421
Author: dtl
Time: 30 December 2020, 7:24:34.889 pm
UUID: 4859ee92-e4d3-4a0a-9dc0-bc2a845ff019
Ancestors: VMMaker-dtl.420

VMMaker 4.19.4
The global session identifier must be updated when the intepreter resumes into a new image via primitiveResumeFromSnapshot.
Refactoring - move duplicated variables and methods from StackInterpreter and ContextInterpreter up to Interpreter.

=============== Diff against VMMaker-dtl.420 ===============

Item was changed:
  Interpreter subclass: #ContextInterpreter
+ instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext localReturnContext localReturnValue messageSelector currentBytecode primitiveIndex primitiveFunctionPointer methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptPending savedWindowSize deferDisplayUpdates pendingFinalizationSignals compilerInitialized compilerHooks newNativeMethod methodClass receiverClass interpreterVersion imageFormatVersionNumber interpreterProxy showSurfaceFn interruptCheckCounter interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable primitiveTableDefaults jmpBuf jmpDepth jmpMax suspendedCallbacks suspendedMethods imageFormatInitialVersion allowAccessBeyondSP'
- instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext localReturnContext localReturnValue messageSelector currentBytecode primitiveIndex primitiveFunctionPointer methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptPending savedWindowSize deferDisplayUpdates pendingFinalizationSignals compilerInitialized compilerHooks newNativeMethod methodClass receiverClass interpreterVersion imageFormatVersionNumber interpreterProxy showSurfaceFn interruptCheckCounter interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable primitiveTableDefaults globalSessionID jmpBuf jmpDepth jmpMax suspendedCallbacks suspendedMethods imageFormatInitialVersion allowAccessBeyondSP'
  classVariableNames: 'BlockArgumentCountIndex BytecodeTable CacheProbeMax CallerIndex CompilerHooksSize DirBadPath DirEntryFound DirNoMoreEntries DoBalanceChecks HomeIndex InitialIPIndex MaxJumpBuf MessageDictionaryIndex MethodCacheNative TempFrameStart'
  poolDictionaries: 'VMMethodCacheConstants VMSqueakV3BytecodeConstants'
  category: 'VMMaker-Interpreter'!
 
  !ContextInterpreter commentStamp: '<historical>' 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.
 
  It has been modernized with 32-bit pointers, better management of Contexts, 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.
 
  In addition to SmallInteger arithmetic and Floats, it supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
 
  NOTE:  Here follows a list of things to be borne in mind when working on this code, or when making changes for the future.
 
  1.  There are a number of things that should be done the next time we plan to release a copletely incompatible image format.  These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:.  Also, contexts should be given a special format code (see next item).
 
  2.  There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change.  This is necessary because the oops may change during a compaction when the oops are being adjusted.  It's important to be aware of this when writing a new image using the systemTracer.  A better solution would be to reserve one of the format codes for Contexts only.
 
  3.  We have made normal files tolerant to size and positions up to 32 bits.  This has not been done for async files, since they are still experimental.  The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes.
 
  4.  Note that 0 is used in a couple of places as an impossible oop.  This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment).  The places include the method cache and the at cache. !

Item was removed:
- ----- Method: ContextInterpreter>>getThisSessionID (in category 'plugin support') -----
- getThisSessionID
- "return the global session ID value"
- <inline: false>
- ^globalSessionID!

Item was changed:
  ----- Method: ContextInterpreter>>initializeInterpreter: (in category 'initialization') -----
  initializeInterpreter: bytesToShift
  "Initialize Interpreter state before starting execution of a new image."
  self initializeInterpreter.
  interpreterProxy := self sqGetInterpreterProxy.
  self dummyReferToProxy.
  objectMemory initializeObjectMemory: bytesToShift.
  self initCompilerHooks.
  activeContext := objectMemory getNilObj.
  theHomeContext := objectMemory getNilObj.
  method := objectMemory getNilObj.
  receiver := objectMemory getNilObj.
  messageSelector := objectMemory getNilObj.
  newMethod := objectMemory getNilObj.
  methodClass := objectMemory getNilObj.
  lkupClass := objectMemory getNilObj.
  receiverClass := objectMemory getNilObj.
  newNativeMethod := objectMemory getNilObj.
  self flushMethodCache.
  self loadInitialContext.
  self initialCleanup.
  interruptCheckCounter := 0.
  interruptCheckCounterFeedBackReset := 1000.
  interruptChecksEveryNms := 1.
  nextPollTick := 0.
  nextWakeupTick := 0.
  lastTick := 0.
  interruptKeycode := 2094. "cmd-. as used for Mac but no other OS"
  interruptPending := false.
  deferDisplayUpdates := false.
  pendingFinalizationSignals := 0.
- globalSessionID := 0.
- [globalSessionID = 0]
- whileTrue: [globalSessionID := self
- cCode: 'time(NULL) + ioMSecs()'
- inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]].
  jmpDepth := 0.
  jmpMax := MaxJumpBuf. "xxxx: Must match the definition of jmpBuf and suspendedCallbacks"
  !

Item was changed:
  ----- Method: ContextInterpreter>>snapshotResume:heapSize:swapBytes:oldBaseAddr:specialObjectsOop:lastHash:savedWindowSize:fullScreenFlag:extraVMMemory: (in category 'snapshot utility primitives') -----
  snapshotResume: byteArrayOrBitmap heapSize: desiredHeapSize swapBytes: swapBytes oldBaseAddr: oldBaseAddr specialObjectsOop: specialObjects lastHash: hashValue savedWindowSize: windowSize fullScreenFlag: fullScreen extraVMMemory: extraMemory
  "Arrange for the interpreter to resume execution from a snapshot of saved
  memory and interpreter state. The current object memory and interpreter
  state is discarded, and the interpreter resumes execution at the point of
  the supplied image snapshot."
 
  | dataSize sourceBytes mem |
  <returnTypeC: 'usqInt'>
  <var: #desiredHeapSize type: 'usqInt'>
  <var: #dataSize type: 'size_t '>
  <var: #sourceBytes type: 'char *'>
  <var: #mem type: 'char *'>
 
  "Notes - The parameters windowSize, fullScreen and extraMemory are currently
  not used when resuming the VM in a new image. The display size and fullscreen
  mode are probably best set from the image by calling primitiveSetDisplayMode
  prior to primitiveResumeFromSnapshot. The extraMemory parameter is ignored
  here because we are simply copying the new object memory over a previously
  allocated heap space."
 
  dataSize := objectMemory byteSizeOf: byteArrayOrBitmap.
  sourceBytes := objectMemory firstIndexableField: byteArrayOrBitmap.
  objectMemory setSpecialObjectsOop: specialObjects.
  objectMemory setLastHash: hashValue.
 
  "Copy object memory into allocated space"
  objectMemory setMemoryLimits: dataSize heapSize: desiredHeapSize.
  mem := objectMemory pointerForOop: objectMemory getMemory.
  self mem: mem
  cp: sourceBytes
  y: dataSize.
 
  self swapBytesAndPrepareToInterpret: swapBytes oldBaseAddr: oldBaseAddr.
+ self initializeSessionID.
    self interpret. "Resume interpreter execution in the snapshot."
  !

Item was changed:
  InterpreterPrimitives subclass: #Interpreter
+ instanceVariableNames: 'semaphoresUseBufferA semaphoresToSignalA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB extraVMMemory globalSessionID'
- instanceVariableNames: 'semaphoresUseBufferA semaphoresToSignalA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB extraVMMemory'
  classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase MaxExternalPrimitiveTableSize MaxPrimitiveIndex SemaphoresToSignalSize'
  poolDictionaries: ''
  category: 'VMMaker-Interpreter'!
 
  !Interpreter commentStamp: 'dtl 4/22/2016 22:14' 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.
 
  ContextInterpreter is the Squeak interpreter VM as originally implemented by Dan Ingalls.
 
  StackInterpreter is the stack mapped interpreter by Eliot Miranda, which provides the basis for later Cog and Spur VMs.!

Item was added:
+ ----- Method: Interpreter>>getThisSessionID (in category 'plugin support') -----
+ getThisSessionID
+ "return the global session ID value"
+ <inline: false>
+ ^globalSessionID!

Item was changed:
  ----- Method: Interpreter>>initializeInterpreter (in category 'initialization') -----
  initializeInterpreter
  semaphoresUseBufferA := true.
  semaphoresToSignalCountA := 0.
  semaphoresToSignalCountB := 0.
+ self initializeSessionID.
  !

Item was added:
+ ----- Method: Interpreter>>initializeSessionID (in category 'initialization') -----
+ initializeSessionID
+ globalSessionID := 0.
+ [globalSessionID = 0]
+ whileTrue: [globalSessionID := self
+ cCode: 'time(NULL) + ioMSecs()'
+ inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]].
+ !

Item was changed:
  Interpreter subclass: #StackInterpreter
+ instanceVariableNames: 'currentBytecode localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue primitiveFunctionPointer methodCache atCache lkupClass highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptPending savedWindowSize imageHeaderFlags deferDisplayUpdates pendingFinalizationSignals interpreterProxy showSurfaceFn externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassSizeBytes interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered te
 mpOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals classByteArrayCompactIndex messageSelector profileProcess nextProfileTick profileMethod profileSemaphore'
- instanceVariableNames: 'currentBytecode localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue primitiveFunctionPointer methodCache atCache lkupClass highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptPending savedWindowSize imageHeaderFlags deferDisplayUpdates pendingFinalizationSignals interpreterProxy showSurfaceFn externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassSizeBytes interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSign
 alUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals classByteArrayCompactIndex messageSelector profileProcess nextProfileTick profileMethod profileSemaphore'
  classVariableNames: 'BytecodeTable BytesPerWord COGMTVM COGVM CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition IMMUTABILITY MULTIPLEBYTECODESETS MaxJumpBuf MaxQuickPrimitiveIndex MixinIndex NewspeakVM STACKVM VMBIGENDIAN'
  poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets'
  category: 'VMMaker-Interpreter'!
 
  !StackInterpreter commentStamp: '<historical>' 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.
 
  NOTE:  Here follows a list of things to be borne in mind when working on this code, or when making changes for the future.
 
  1.  There are a number of things that should be done the next time we plan to release a completely incompatible image format.  These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:.  Also, contexts should be given a special format code (see next item).
 
  2.  There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change.  This is necessary because the oops may change during a compaction when the oops are being adjusted.  It's important to be aware of this when writing a new image using the SystemTracer.  A better solution would be to reserve one of the format codes for Contexts only.
 
  3.  We have made normal files tolerant to size and positions up to 32 bits.  This has not been done for async files, since they are still experimental.  The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes.
 
  4.  Note that 0 is used in a couple of places as an impossible oop.  This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment).  The places include the method cache and the at cache.
 
  5. Moving to a 2 bit immediate tag and having immediate Characters is a good choice for Unicode and the JIT
 
  6.  If Eliot Miranda's 2 word header scheme is acceptable in terms of footprint (we estimate about a 10% increase in image size with about 35 reclaimed by better representation of CompiledMethod - loss of MethodProperties) then the in-line cache for the JIT is simplified, class access is faster and header access is the same in 32-bit and full 64-bit images.!

Item was removed:
- ----- Method: StackInterpreter>>getThisSessionID (in category 'plugin support') -----
- getThisSessionID
- "return the global session ID value"
- <inline: false>
- ^globalSessionID!

Item was changed:
  ----- Method: StackInterpreter>>initializeInterpreter: (in category 'initialization') -----
  initializeInterpreter: bytesToShift
  "Initialize Interpreter state before starting execution of a new image."
  self initializeInterpreter.
  interpreterProxy := self sqGetInterpreterProxy.
  self dummyReferToProxy.
  objectMemory initializeObjectMemory: bytesToShift.
  self checkAssumedCompactClasses.
  primFailCode := 0.
  self initializeExtraClassInstVarIndices.
  stackLimit := 0. "This is also the initialization flag for the stack system."
  stackPage := overflowedPage := 0.
  extraFramesToMoveOnOverflow := 0.
  self setMethod: objectMemory nilObject.
  messageSelector := objectMemory nilObject.
  newMethod := objectMemory nilObject.
  lkupClass := objectMemory nilObject.
  self flushMethodCache.
  self flushAtCache.
  self initialCleanup.
  highestRunnableProcessPriority := 0.
  nextProfileTick := 0.
  profileSemaphore := objectMemory nilObject.
  profileProcess := objectMemory nilObject.
  profileMethod := objectMemory nilObject.
  nextPollUsecs := 0.
  nextWakeupUsecs := 0.
  tempOop := 0.
  interruptKeycode := 2094. "cmd-. as used for Mac but no other OS"
  interruptPending := false.
  inIOProcessEvents := 0.
  deferDisplayUpdates := false.
  pendingFinalizationSignals := statPendingFinalizationSignals := 0.
- globalSessionID := 0.
- [globalSessionID = 0]
- whileTrue: [globalSessionID := self
- cCode: 'time(NULL) + ioMSecs()'
- inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]].
  jmpDepth := 0.
  longRunningPrimitiveStartUsecs :=
  longRunningPrimitiveStopUsecs := 0.
  maxExtSemTabSizeSet := false.
  statForceInterruptCheck := 0.
  statStackOverflow := 0.
  statCheckForEvents := 0.
  statProcessSwitch := 0.
  statIOProcessEvents := 0.
  statStackPageDivorce := 0!

Item was changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
 
  "VMMaker versionString"
 
+ ^'4.19.4'!
- ^'4.19.3'!