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

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

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

Name: VMMaker-dtl.401
Author: dtl
Time: 4 May 2019, 9:22:54.649 am
UUID: c8ffe0ea-c3b8-4f49-8343-df16ac0656ea
Ancestors: VMMaker-dtl.400

VMMaker 4.16.6
Primitive support for snapshot objects, answering object memory and header as in-image objects. Instead of disk-based snapshot file. Currently implemented in ContextInterpreter.

  "ImageSnapshot new"

The primitives are:
  #primitiveInterpreterStateSnapshot - snapshot the header information
  #primitiveMemoryCopy - snapshot the memory
  #primitiveMemorySnapshotBytesWithHeader - snapshot memory bytes and header
  #primitiveMemorySnapshotWithHeader - snapshot memory bitmap and header

mage side support package ImageFormat in http://source.squeak.org/VMMaker:
  ImageFileHeader fromValues: ImageFileHeader primInterpreterStateSnapshot.
  ImageFileHeader primMemoryCopy.

Image side support from package ImageSnapshot in http://www.squeaksource.com/ImageSnapshot:
  ImageSnapshot basicNew getSnapshot.
  ImageBitmapSnapshot basicNew getSnapshot.

Snapshot to disk, equivalent to normal snapshot:
  ImageSnapshot new saveAs: 'newimage.image'

=============== Diff against VMMaker-dtl.400 ===============

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 fullScreenFlag deferDisplayUpdates pendingFinalizationSignals compilerInitialized compilerHooks newNativeMethod methodClass receiverClass interpreterVersion imageFormatVersionNumber interpreterProxy showSurfaceFn interruptCheckCounter interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable globalSessionID 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 fullScreenFlag deferDisplayUpdates pendingFinalizationSignals compilerInitialized compilerHooks extraVMMemory newNativeMethod methodClass receiverClass interpreterVersion imageFormatVersionNumber interpreterProxy showSurfaceFn interruptCheckCounter interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable 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 added:
+ ----- Method: ContextInterpreter>>allocateMemory:heapSize: (in category 'snapshot resume') -----
+ allocateMemory: dataSize heapSize: desiredHeapSize
+ "Allocate memory space sufficient to contain object memory data from an image snapshot."
+
+ | unusedHeaderSize minimumMemory memStart heapSize unusedFileReference savedOldMemoryAddress |
+ <returnTypeC: 'usqInt'>
+ <var: #unusedFileReference type: 'sqImageFile '>
+ <var: #desiredHeapSize type: 'usqInt'>
+ <var: #dataSize type: 'size_t '>
+ <var: #savedOldMemoryAddress type: 'usqInt'>
+
+ unusedFileReference := nil. self flag: #FIXME. "remove unused"
+ unusedHeaderSize := nil. self flag: #FIXME. "remove unused"
+
+ "decrease Squeak object heap to leave extra memory for the VM"
+ heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
+
+ "compare memory requirements with availability".
+ minimumMemory := dataSize + 100000.  "need at least 100K of breathing room"
+ heapSize < minimumMemory ifTrue: [
+ self insufficientMemorySpecifiedError].
+
+ "allocate a contiguous block of memory for the Squeak heap"
+ "below calls a macro that does sqAllocateMemory(minimumMemory, heapSize)"
+ "so save prior value of memory so it can be freed at the end of this method, and
+ call the below to create new memory here"
+ savedOldMemoryAddress := self cCode: 'sqMemoryBase'. self flag: #FIXME. "see package MemoryAccess sqMemoryBaseAddress"
+ "allocate new here"
+ (objectMemory allocateMemory: heapSize
+ minimum: minimumMemory
+ imageFile: unusedFileReference
+ headerSize: unusedHeaderSize) = nil ifTrue: [self insufficientMemoryAvailableError].
+
+ memStart := objectMemory startOfMemory.
+ objectMemory setMemoryLimit: (memStart + heapSize) - 24.  "decrease memoryLimit a tad for safety"
+ objectMemory setEndOfMemory: memStart + dataSize.
+ ^savedOldMemoryAddress.
+  !

Item was added:
+ ----- Method: ContextInterpreter>>displayExtent: (in category 'primitive support') -----
+ displayExtent: screenSizeWord
+ "Answer a Point representing the display extent"
+
+ | displayX displayY extent |
+ extent := objectMemory instantiateClass: objectMemory classPoint indexableSize: 0.
+ displayX := objectMemory positive32BitIntegerFor: (screenSizeWord >> 16).
+ displayY := objectMemory positive32BitIntegerFor: (screenSizeWord bitAnd: 16rFFFF).
+ objectMemory storePointer: 0 ofObject: extent withValue: displayX.
+ objectMemory storePointer: 1 ofObject: extent withValue: displayY.
+ ^extent
+ !

Item was added:
+ ----- Method: ContextInterpreter>>headerAndSnapshotOfSize:class: (in category 'primitive support') -----
+ headerAndSnapshotOfSize: size class: class
+
+ "Answer a snapshot copy of the current object memory and header information. The
+ object memory will be saved as and object of type class"
+ | bytesPerElement oop start copy ptr result |
+ <var: 'start' type: 'usqInt'>
+ <var: 'end' type: 'usqInt'>
+ <var: 'size' type: 'size_t'>
+ <var: 'copy' type: 'void *'>
+ <var: 'ptr' type: 'void *'>
+ "Expect class Bitmap or ByteArray"
+ objectMemory classByteArray = class
+ ifTrue: [bytesPerElement := 1]
+ ifFalse: [objectMemory classBitmap = class
+ ifTrue: [bytesPerElement := 4]
+ ifFalse: [^interpreterProxy primitiveFail]].
+ "Get values needed for object memory copy before first allocation"
+ start := objectMemory getMemory.
+ copy := self malloc: size.
+ copy == nil
+ ifTrue: [^ self primitiveFail].
+ self mem: copy "to temporary allocated space"
+ cp: (objectMemory pointerForOop: start) "from start of memory"
+ y: size. "copy memory to separately allocated space"
+
+ objectMemory pushRemappableOop: (self memoryHeaderState: size). "allocation happens here"
+
+ "Copy the saved memory image back to a Bitmap"
+ oop := objectMemory instantiateClass: class indexableSize: (size / bytesPerElement).
+ self successful
+ ifFalse: [self free: copy.
+ ^ self primitiveFail].
+ ptr := objectMemory firstIndexableField: oop.
+ self mem: ptr cp: copy y: size. "copy saved memory back into newly allocated Bitmap"
+ self free: copy. "free the temp space"
+ objectMemory pushRemappableOop: oop.
+
+ result := objectMemory instantiateClass: objectMemory classArray indexableSize: 2.
+ objectMemory
+ storePointer: 0
+ ofObject: result
+ withValue: (objectMemory popRemappableOop).
+ objectMemory
+ storePointer: 1
+ ofObject: result
+ withValue: (objectMemory popRemappableOop).
+ ^ result
+
+
+ !

Item was added:
+ ----- Method: ContextInterpreter>>headerAndSnapshotOfSize:class:bytesPerElement: (in category 'primitive support') -----
+ headerAndSnapshotOfSize: size class: class bytesPerElement: bytesPerElement
+
+ "Answer a snapshot copy of the current object memory and header information. The
+ object memory will be saved as and object of type class"
+ | oop start copy ptr result |
+ <var: 'start' type: 'usqInt'>
+ <var: 'end' type: 'usqInt'>
+ <var: 'size' type: 'size_t'>
+ <var: 'copy' type: 'void *'>
+ <var: 'ptr' type: 'void *'>
+
+ "Get values needed for object memory copy before first allocation"
+ start := objectMemory getMemory.
+ copy := self malloc: size.
+ copy == nil
+ ifTrue: [^ self primitiveFail].
+ self mem: copy "to temporary allocated space"
+ cp: (objectMemory pointerForOop: start) "from start of memory"
+ y: size. "copy memory to separately allocated space"
+
+ objectMemory pushRemappableOop: (self memoryHeaderState: size). "allocation happens here"
+
+ "Copy the saved memory image back to a Bitmap"
+ oop := objectMemory instantiateClass: class indexableSize: (size / bytesPerElement).
+ self successful
+ ifFalse: [self free: copy.
+ ^ self primitiveFail].
+ ptr := objectMemory firstIndexableField: oop.
+ self mem: ptr cp: copy y: size. "copy saved memory back into newly allocated Bitmap"
+ self free: copy. "free the temp space"
+ objectMemory pushRemappableOop: oop.
+
+ result := objectMemory instantiateClass: objectMemory classArray indexableSize: 2.
+ objectMemory
+ storePointer: 0
+ ofObject: result
+ withValue: (objectMemory popRemappableOop).
+ objectMemory
+ storePointer: 1
+ ofObject: result
+ withValue: (objectMemory popRemappableOop).
+ ^ result
+
+
+ !

Item was added:
+ ----- Method: ContextInterpreter>>memoryHeaderState: (in category 'primitive support') -----
+ memoryHeaderState: dataSize
+ "Answer current interpreter and object memory state information."
+
+ | splObjsOop oopStart headerSize results hash displayExtent |
+
+ "seee ContextInterpreter>>writeImageFileIO:"
+
+ "self putLong: (self imageFormatVersion) toFile: f.
+ self putLong: headerSize toFile: f.
+ self putLong: imageBytes toFile: f.
+ self putLong: (objectMemory startOfMemory) toFile: f.
+ self putLong: objectMemory getSpecialObjectsOop toFile: f.
+ self putLong: objectMemory getLastHash toFile: f.
+ self putLong: (self ioScreenSize) toFile: f.
+ self putLong: fullScreenFlag toFile: f.
+ self putLong: extraVMMemory toFile: f.
+ 1 to: 7 do: [:i | self putLong: 0 toFile: f]."  "fill remaining header words with zeros"
+
+ headerSize := 16 * objectMemory bytesPerWord.  "header size in bytes; do not change!!"
+ oopStart := objectMemory startOfMemory.
+ splObjsOop := objectMemory getSpecialObjectsOop.
+ hash := objectMemory integerObjectOf: objectMemory getLastHash.
+ "self ioScreenSize."
+ "fullScreenFlag"
+ "extraVMMemory"
+ "Pad the rest of the header."
+ "7 timesRepeat: [self putLong: 0 toFile: file]."
+
+ InterpreterProxy pushRemappableOop: (objectMemory
+ instantiateClass: (objectMemory classArray)
+ indexableSize: 16). "results array"
+ displayExtent := self displayExtent: self ioScreenSize. "may trigger GC"
+ results := interpreterProxy popRemappableOop.
+ objectMemory
+ storePointer: 0
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: self imageFormatVersion).
+ objectMemory
+ storePointer: 1
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: headerSize).
+ objectMemory
+ storePointer: 2
+ ofObject: results
+ withValue: (self positive64BitIntegerFor: dataSize).
+ objectMemory
+ storePointer: 3
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: oopStart).
+ objectMemory
+ storePointer: 4
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: splObjsOop).
+ objectMemory
+ storePointer: 5
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: hash).
+ objectMemory
+ storePointer: 6
+ ofObject: results
+ withValue: displayExtent.
+ objectMemory
+ storePointer: 7
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: 0)..
+ objectMemory
+ storePointer: 8
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: extraVMMemory)..
+ objectMemory
+ storePointer: 9
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: 0).
+ objectMemory
+ storePointer: 10
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: 0).
+ objectMemory
+ storePointer: 11
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: 0).
+ objectMemory
+ storePointer: 12
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: 0).
+ objectMemory
+ storePointer: 13
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: 0).
+ objectMemory
+ storePointer: 14
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: 0).
+ objectMemory
+ storePointer: 15
+ ofObject: results
+ withValue: (objectMemory integerObjectOf: 0).
+ ^ results.!

Item was added:
+ ----- Method: ContextInterpreter>>memoryImageCopyAs:bytesPerElement: (in category 'primitive support') -----
+ memoryImageCopyAs: class bytesPerElement: bytesPerElement
+ "Answer a snapshot copy of the current object memory. If class is organized
+ as words, then bytesPerElement should be 4, else 1 for byte organization."
+ | oop start size copy ptr |
+ <var: 'start' type: 'usqInt'>
+ <var: 'size' type: 'size_t'>
+ <var: 'copy' type: 'void *'>
+ <var: 'ptr' type: 'void *'>
+
+ start := objectMemory startOfMemory.
+ size := objectMemory getFreeBlock - start. "Assume all objects are below the start of the free block"
+ copy := self malloc: size.
+ copy == nil
+ ifTrue: [^ self primitiveFail].
+ self mem: copy "to temporary allocated space"
+ cp: (objectMemory pointerForOop: start) "from start of memory"
+ y: size. "copy memory to separately allocated space"
+ oop := objectMemory instantiateClass: class indexableSize: size / bytesPerElement.
+ self successful
+ ifFalse: [self free: copy.
+ ^ self primitiveFail].
+ ptr := objectMemory firstIndexableField: oop.
+ self mem: ptr cp: copy y: size. "copy saved memory back into newly allocated Bitmap"
+ self free: copy. "free the temp space"
+ ^oop.
+ !

Item was added:
+ ----- Method: ContextInterpreter>>memoryImageCopyAsBitmap (in category 'primitive support') -----
+ memoryImageCopyAsBitmap
+ "Answer a snapshot copy of the current object memory. Answer a Bitmap organized
+ in 32 bit words suitable for interpretation as an ObjectMemory."
+
+ ^ self memoryImageCopyAs: objectMemory classBitmap bytesPerElement: 4
+ !

Item was added:
+ ----- Method: ContextInterpreter>>memoryImageCopyAsBytes (in category 'primitive support') -----
+ memoryImageCopyAsBytes
+ "Answer a snapshot copy of the current object memory. Answer the raw memory
+ data as a byte array suitable for fast save to disk or write to network."
+
+ ^ self memoryImageCopyAs: objectMemory classByteArray bytesPerElement: 1
+ !

Item was added:
+ ----- Method: ContextInterpreter>>prepareForSnapshot (in category 'image save/restore') -----
+ prepareForSnapshot
+ "Prepare the object memory to be captured as a resumable snapshot. Answer
+ the size of object memory space to be snapshotted."
+
+ "update state of active context"
+ | activeProc |
+ compilerInitialized
+ ifTrue: [self compilerPreSnapshot]
+ ifFalse: [self storeContextRegisters: activeContext].
+
+ "update state of active process"
+ activeProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: self schedulerPointer.
+ objectMemory
+ storePointer: SuspendedContextIndex
+ ofObject: activeProc
+ withValue: activeContext.
+
+ "compact memory and compute the size of the memory actually in use"
+ objectMemory incrementalGC.
+
+ "maximimize space for forwarding table"
+ objectMemory fullGC.
+ self snapshotCleanUp.
+
+ ^objectMemory getFreeBlock - objectMemory startOfMemory. "Assume all objects are below the start of the free block"
+ !

Item was added:
+ ----- Method: ContextInterpreter>>primitiveInterpreterStateSnapshot (in category 'snapshot utility primitives') -----
+ primitiveInterpreterStateSnapshot
+ "Primitive. Answer state information for the object memory as of the point
+ of entry to this primitive. This is the information that is stored in an image
+ file header when the image is saved to disk. The memory state information,
+ when combined with the object memory image, is sufficient to initialize an
+ an image to be run in an interpreter."
+ <export: true>
+ self methodReturnValue: (self memoryHeaderState: self prepareForSnapshot).
+ !

Item was added:
+ ----- Method: ContextInterpreter>>primitiveMemoryCopy (in category 'snapshot utility primitives') -----
+ primitiveMemoryCopy
+ "Primitive. Answer an exact copy of the object memory as of the point of entry
+ to this primitive. The object memory is not prepared for saving as a snapshot.
+ Compare to primitiveMemorySnapshotWithHeader, which prepares the object
+ memory to be resumed from a saved snapshot"
+ <export: true>
+ self methodReturnValue: self memoryImageCopyAsBitmap
+ !

Item was added:
+ ----- Method: ContextInterpreter>>primitiveMemorySnapshotBytesWithHeader (in category 'snapshot utility primitives') -----
+ primitiveMemorySnapshotBytesWithHeader
+ "Primitive. Answer an array with a snapshot copy of the object memory as
+ of the point of entry to this primitive, and with the header information for
+ the image at the point of the snapshot.
+
+ The memory snapshot is a ByteArray copy of the object memory, and the header
+ information is an array of the values that would be stored in an image file
+ header if the image was being saved to disk. The header state information
+ along with memory snapshot are sufficient to initialize an an image to be run
+ in an interpreter."
+
+ <export: true>
+ "pop rcvr. A resuming image will see this primitive answering true, otherwise
+ it will answer the expected value of a two element array. Test for result equal
+ to true to determine if the image is being resumed from a saved snapshot.."
+ | result |
+ self pop: argumentCount + 1.
+ self push: objectMemory getTrueObj. "resuming image will see this"
+ result := self
+ headerAndSnapshotOfSize: self prepareForSnapshot
+ class: objectMemory classByteArray.
+ self pop: 1. "restore stack"
+ self push: result. "normal sender will see this"
+ !

Item was added:
+ ----- Method: ContextInterpreter>>primitiveMemorySnapshotWithHeader (in category 'snapshot utility primitives') -----
+ primitiveMemorySnapshotWithHeader
+ "Primitive. Answer an array with a snapshot copy of the object memory as
+ of the point of entry to this primitive, and with the header information for
+ the image at the point of the snapshot.
+
+ The memory snapshot is a Bitmap copy of the object memory, and the header
+ information is an array of the values that would be stored in an image file
+ header if the image was being saved to disk. The header state information
+ along with memory snapshot are sufficient to initialize an an image to be run
+ in an interpreter."
+
+ <export: true>
+ "pop rcvr. A resuming image will see this primitive answering true, otherwise
+ it will answer the expected value of a two element array. Test for result equal
+ to true to determine if the image is being resumed from a saved snapshot.."
+ | result |
+ self pop: argumentCount + 1.
+ self push: objectMemory getTrueObj. "resuming image will see this"
+ result := self
+ headerAndSnapshotOfSize: self prepareForSnapshot
+ class: objectMemory classBitmap.
+ self pop: 1. "restore stack"
+ self push: result. "normal sender will see this"
+ !

Item was removed:
- ----- Method: ContextInterpreter>>readImageFormatFromFile:StartingAt: (in category 'image save/restore') -----
- readImageFormatFromFile: f StartingAt: imageOffset
- "Read an image header from the given file stream, and answer the image format
- version number for the saved image. Exported to allow platform support code to
- query image files for image format number."
-
- <export: true>
- <var: #f type: 'sqImageFile '>
- <var: #imageOffset type: 'squeakFileOffsetType '>
-
- self checkImageVersionFrom: f startingAt: imageOffset.
- ^ imageFormatInitialVersion
- !

Item was changed:
+ ----- Method: ContextInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'snapshot resume') -----
- ----- Method: ContextInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
  readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
  "Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
  "Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
  "This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
 
+ | swapBytes headerStart headerSize dataSize oldBaseAddr |
- | swapBytes headerStart headerSize dataSize oldBaseAddr minimumMemory memStart bytesRead bytesToShift heapSize |
  <var: #f type: 'sqImageFile '>
  <var: #desiredHeapSize type: 'usqInt'>
  <var: #headerStart type: 'squeakFileOffsetType '>
  <var: #dataSize type: 'size_t '>
  <var: #imageOffset type: 'squeakFileOffsetType '>
 
  swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
  headerStart := (self sqImageFilePosition: f) - objectMemory bytesPerWord.  "record header start position"
 
  headerSize := self getLongFromFile: f swap: swapBytes.
  dataSize := self getLongFromFile: f swap: swapBytes.
  oldBaseAddr := self getLongFromFile: f swap: swapBytes.
  objectMemory setSpecialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  objectMemory setLastHash: (self getLongFromFile: f swap: swapBytes).
  savedWindowSize := self getLongFromFile: f swap: swapBytes.
  fullScreenFlag := self oldFormatFullScreenFlag: (self getLongFromFile: f swap: swapBytes).
  extraVMMemory := self getLongFromFile: f swap: swapBytes.
 
  objectMemory getLastHash = 0 ifTrue: [
  "lastHash wasn't stored (e.g. by the cloner); use 999 as the seed"
  objectMemory setLastHash: 999].
 
+ self allocateMemory: dataSize heapSize: desiredHeapSize.
+ self sqImageFile: f Seek: headerStart + headerSize. "position file after the header"
+ self snapshotMemoryRead: f size: dataSize. "read object memory data"
+ self swapBytesAndPrepareToInterpret: swapBytes oldBaseAddr: oldBaseAddr.
- "decrease Squeak object heap to leave extra memory for the VM"
- heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
-
- "compare memory requirements with availability".
- minimumMemory := dataSize + 100000.  "need at least 100K of breathing room"
- heapSize < minimumMemory ifTrue: [
- self insufficientMemorySpecifiedError].
-
- "allocate a contiguous block of memory for the Squeak heap"
- (objectMemory allocateMemory: heapSize
- minimum: minimumMemory
- imageFile: f
- headerSize: headerSize) = nil ifTrue: [self insufficientMemoryAvailableError].
-
- memStart := objectMemory startOfMemory.
- objectMemory setMemoryLimit: (memStart + heapSize) - 24.  "decrease memoryLimit a tad for safety"
- objectMemory setEndOfMemory: memStart + dataSize.
-
- "position file after the header"
- self sqImageFile: f Seek: headerStart + headerSize.
-
- "read in the image in bulk, then swap the bytes if necessary"
- bytesRead := self
- sqImage: (objectMemory pointerForOop: objectMemory getMemory)
- read: f
- size: (self cCode: 'sizeof(unsigned char)')
- length: dataSize.
- bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
-
- objectMemory headerTypeBytesAt: 0 put: objectMemory bytesPerWord * 2. "3-word header (type 0)"
- objectMemory headerTypeBytesAt: 1 put: objectMemory bytesPerWord. "2-word header (type 1)"
- objectMemory headerTypeBytesAt: 2 put: 0. "free chunk (type 2)"
- objectMemory headerTypeBytesAt: 3 put: 0. "1-word header (type 3)"
-
- swapBytes ifTrue: [self reverseBytesInImage].
-
- "compute difference between old and new memory base addresses"
- bytesToShift := memStart - oldBaseAddr.
- self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
- self isBigEnder. "work out the machine endianness and cache the answer"
-
- (self initialImageFormatVersion bitAnd: 1) = 1
- ifTrue: ["Low order bit set, indicating that the image was saved from
- a StackInterpreter (Cog) VM. Storage of all Float objects must be
- returned to older object memory format."
- self normalizeFloatOrderingInImage].
-  
  ^ dataSize
  !

Item was changed:
  ----- Method: ContextInterpreter>>snapshot: (in category 'image save/restore') -----
+ snapshot: embedded
- snapshot: embedded
- "update state of active context"
- | activeProc dataSize rcvr setMacType |
- <var: #setMacType type: 'void *'>
- compilerInitialized
- ifTrue: [self compilerPreSnapshot]
- ifFalse: [self storeContextRegisters: activeContext].
 
+ | dataSize rcvr setMacType |
+ dataSize := self prepareForSnapshot.
- "update state of active process"
- activeProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: self schedulerPointer.
- objectMemory
- storePointer: SuspendedContextIndex
- ofObject: activeProc
- withValue: activeContext.
-
- "compact memory and compute the size of the memory actually in use"
- objectMemory incrementalGC.
-
- "maximimize space for forwarding table"
- objectMemory fullGC.
- self snapshotCleanUp.
-
- dataSize := objectMemory getFreeBlock - objectMemory startOfMemory. "Assume all objects are below the start of the free block"
  self successful
  ifTrue: [rcvr := self popStack.
  "pop rcvr"
  self push: objectMemory getTrueObj.
  self writeImageFile: dataSize.
  embedded
  ifFalse: ["set Mac file type and creator; this is a noop on other platforms"
  setMacType := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'.
  setMacType = 0
  ifFalse: [self cCode: '((sqInt (*)(char *, char *, char *))setMacType)(imageName, "STim", "FAST")']].
  self pop: 1].
 
  "activeContext was unmarked in #snapshotCleanUp, mark it old "
  objectMemory beRootIfOld: activeContext.
  self successful
  ifTrue: [self push: objectMemory getFalseObj]
  ifFalse: [self push: rcvr].
  compilerInitialized
  ifTrue: [self compilerPostSnapshot]!

Item was added:
+ ----- Method: ContextInterpreter>>snapshotMemoryRead:size: (in category 'snapshot resume') -----
+ snapshotMemoryRead: imageFile size: dataSize
+ "Read the object memory data from a snapshot file into a previously allocated memory space."
+
+ | bytesRead |
+ <returnTypeC: 'usqInt'>
+ <var: #imageFile type: 'sqImageFile '>
+ <var: #dataSize type: 'size_t '>
+ bytesRead := self
+ sqImage: (objectMemory pointerForOop: objectMemory getMemory)
+ read: imageFile
+ size: (self cCode: 'sizeof(unsigned char)')
+ length: dataSize.
+ bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
+ ^bytesRead.
+ !

Item was added:
+ ----- Method: ContextInterpreter>>swapBytesAndPrepareToInterpret:oldBaseAddr: (in category 'snapshot resume') -----
+ swapBytesAndPrepareToInterpret: swapBytes oldBaseAddr: oldBaseAddr
+ "An object memory has been loaded from a snapshot. Prepare it to be executed by an interpreter."
+
+ | bytesToShift |
+ objectMemory headerTypeBytesAt: 0 put: objectMemory bytesPerWord * 2. "3-word header (type 0)"
+ objectMemory headerTypeBytesAt: 1 put: objectMemory bytesPerWord. "2-word header (type 1)"
+ objectMemory headerTypeBytesAt: 2 put: 0. "free chunk (type 2)"
+ objectMemory headerTypeBytesAt: 3 put: 0. "1-word header (type 3)"
+
+ swapBytes ifTrue: [self reverseBytesInImage].
+
+ "compute difference between old and new memory base addresses"
+ bytesToShift := objectMemory startOfMemory - oldBaseAddr.
+ self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
+ self isBigEnder. "work out the machine endianness and cache the answer"
+
+ (self initialImageFormatVersion bitAnd: 1) = 1
+ ifTrue: ["Low order bit set, indicating that the image was saved from
+ a StackInterpreter (Cog) VM. Storage of all Float objects must be
+ returned to older object memory format."
+ self normalizeFloatOrderingInImage].
+ !

Item was changed:
  InterpreterPrimitives subclass: #Interpreter
+ instanceVariableNames: 'semaphoresUseBufferA semaphoresToSignalA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB extraVMMemory'
- instanceVariableNames: 'semaphoresUseBufferA semaphoresToSignalA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB'
  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 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 fullScreenFlag 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 longRunni
 ngPrimitiveSignalUndelivered tempOop 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 fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory 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 longRunningPrimitiveCheckSequenceNu
 mber longRunningPrimitiveSignalUndelivered 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 changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
 
  "VMMaker versionString"
 
  ^'4.16.6'!