[Vm-dev] VM Maker: VMMaker.oscog-mt.3178.mcz

Marcel Taeumel marcel.taeumel at hpi.de
Mon Apr 11 05:27:32 UTC 2022


Hi Eliot, hi all --

Okay, I will take a look at the generated sources and merge the changes.

Best,
Marcel
Am 08.04.2022 16:30:27 schrieb Marcel Taeumel <marcel.taeumel at hpi.de>:
Hi Eliot --

Would you re-generate the relevant sources?

Then you can also double-check whether my IMMUTABILITY fixes (getCogVMFeatureFlags) for v3.cog and v3.stack are good for all flavors. And that ifdef I removed from bytecodeFixup regarding a LowcodeVM specialization.

Thanks :-)

Best,
Marcel
Am 08.04.2022 16:09:16 schrieb commits at source.squeak.org <commits at source.squeak.org>:

Marcel Taeumel uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-mt.3178.mcz

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

Name: VMMaker.oscog-mt.3178
Author: mt
Time: 8 April 2022, 4:08:35.320968 pm
UUID: 5a32c82a-059d-cc45-bbeb-6dfad10915b0
Ancestors: VMMaker.oscog-mt.3177, VMMaker.oscog-dtl.3124

Merges VMMaker.oscog-dtl.3124. See http://lists.squeakfoundation.org/pipermail/vm-dev/2022-April/037807.html

VMMaker.oscog-dtl.3124:
Support image formats 68533 and 7033. Add improvements suggested by Eliot. Add FormatNumberTests to verify format number reading and writing. Fix a bug exposed by the tests.

VMMaker.oscog-dtl.3123:
Support image formats 68533 and 7033. Let the image inform the VM that alternate bytecodes either are or are not in use, and remember the setting when writing or reading the image format number in a shapshot file header. Also support testing the current value of multipleBytecodeSetsActive, and listing the encoder names of supported bytecode sets.

Adds two primitives:

primitiveMultipleBytecodeSetsActive
"Given one boolean parameter, set multipleBytecodeSetsActive to inform
the VM that alternate bytecode sets such as SistaV1 are now in use and
that the image format number should be updated accordingly. With zero
parameters, answer the current value of multipleBytecodeSetsActive."

primitiveBytecodeSetsAvailable
"Answer the encoder names for the supported bytecode sets."

=============== Diff against VMMaker.oscog-mt.3177 ===============

Item was added:
+ TestCase subclass: #FormatNumberTests
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Tests'!
+
+ !FormatNumberTests commentStamp: 'dtl 12/27/2021 13:02' prior: 0!
+ FomatNumberTests verifies image format numbers as saved to or loaded from an image snapshot file. Requires package ImageFormat.!

Item was added:
+ ----- Method: FormatNumberTests>>testImageFormatCog (in category 'tests') -----
+ testImageFormatCog
+
+ | interp readableNumbers |
+ interp := StackInterpreterSimulator newWithOptions: #(ObjectMemory).
+ self assert: 6505 equals: interp imageFormatVersion.
+ self assert: nil equals: interp multipleBytecodeSetsActive description: 'not yet initialized by image load'.
+ self assert: 6505 equals: (interp imageFormatVersionFromSnapshot: 6505) description: 'clears multipleBytecodSetsActive as side effect'.
+ self deny: interp multipleBytecodeSetsActive.
+ self assert: 6505 equals: interp imageFormatVersionForSnapshot.
+ self assert: 6505 equals: interp imageFormatVersion.
+ self assert: 6504 equals: (interp imageFormatVersionFromSnapshot: 6504) description: 'image format compatability version'.
+ self deny: interp multipleBytecodeSetsActive.
+ self assert: 6505 equals: interp imageFormatVersionForSnapshot.
+ self assert: 6505 equals: interp imageFormatVersion.
+
+ "multiple bytecode support is not provided for non-Spur images, but confirm that the support code has no ill effects"
+ self assert: 6505 equals: (interp imageFormatVersionFromSnapshot: 7017) description: 'hypothetical format 7017 does not exist in the wild'.
+ self assert: interp multipleBytecodeSetsActive.
+ self assert: 7017 equals: interp imageFormatVersionForSnapshot. "7017 does not exist in practice but is thoretically possible"
+ self assert: 6505 equals: interp imageFormatVersion description: 'base format value not affected by state of multipleBytecodSetsActive'.
+
+ readableNumbers := (Smalltalk classNamed: #ImageFormat) knownVersionNumbers
+ select: [ :ver |interp readableFormat: ver ].
+ self assert: #(6504 6505) equals: readableNumbers.
+ !

Item was added:
+ ----- Method: FormatNumberTests>>testImageFormatSpur32 (in category 'tests') -----
+ testImageFormatSpur32
+
+ | interp readableNumbers |
+ interp := StackInterpreterSimulator newWithOptions: #(ObjectMemory Spur32BitMemoryManager MULTIPLEBYTECODESETS true).
+ self assert: 6521 equals: interp imageFormatVersion.
+ self assert: nil equals: interp multipleBytecodeSetsActive description: 'not yet initialized by image load'.
+ self assert: 6521 equals: (interp imageFormatVersionFromSnapshot: 6521) description: 'clears multipleBytecodSetsActive as side effect'.
+ self deny: interp multipleBytecodeSetsActive.
+ self assert: 6521 equals: interp imageFormatVersionForSnapshot.
+ self assert: 6521 equals: interp imageFormatVersion.
+ self assert: 6521 equals: (interp imageFormatVersionFromSnapshot: 7033) description: 'sets multipleBytecodSetsActive as side effect'.
+ self assert: interp multipleBytecodeSetsActive.
+ self assert: 7033 equals: interp imageFormatVersionForSnapshot.
+ self assert: 6521 equals: interp imageFormatVersion description: 'base format value not affected by state of multipleBytecodSetsActive'.
+ readableNumbers := (Smalltalk classNamed: #ImageFormat) knownVersionNumbers
+ select: [ :ver | interp readableFormat: ver ].
+ self assert: #(6521 7033) equals: readableNumbers.
+ !

Item was added:
+ ----- Method: FormatNumberTests>>testImageFormatSpur64 (in category 'tests') -----
+ testImageFormatSpur64
+
+ | interp readableNumbers |
+ interp := StackInterpreterSimulator newWithOptions: #(ObjectMemory Spur64BitMemoryManager MULTIPLEBYTECODESETS true).
+ self assert: 68021 equals: interp imageFormatVersion.
+ self assert: nil equals: interp multipleBytecodeSetsActive description: 'not yet initialized by image load'.
+ self assert: 68021 equals: (interp imageFormatVersionFromSnapshot: 68021) description: 'clears multipleBytecodSetsActive as side effect'.
+ self deny: interp multipleBytecodeSetsActive.
+ self assert: 68021 equals: interp imageFormatVersionForSnapshot.
+ self assert: 68021 equals: interp imageFormatVersion.
+ self assert: 68021 equals: (interp imageFormatVersionFromSnapshot: 68533) description: 'sets multipleBytecodSetsActive as side effect'.
+ self assert: interp multipleBytecodeSetsActive.
+ self assert: 68533 equals: interp imageFormatVersionForSnapshot.
+ self assert: 68021 equals: interp imageFormatVersion description: 'base format value not affected by state of multipleBytecodSetsActive'.
+ readableNumbers := (Smalltalk classNamed: #ImageFormat) knownVersionNumbers
+ select: [ :ver | interp readableFormat: ver ].
+ self assert: #(68021 68533) equals: readableNumbers.
+ !

Item was changed:
VMClass subclass: #InterpreterPrimitives
+ instanceVariableNames: 'objectMemory messageSelector argumentCount newMethod primFailCode secondaryErrorCode exceptionPC inFFIFlags profileMethod profileProcess profileSemaphore nextProfileTick preemptionYields sHEAFn ffiExceptionResponse eventTraceMask multipleBytecodeSetsActive'
- instanceVariableNames: 'objectMemory messageSelector argumentCount newMethod primFailCode secondaryErrorCode exceptionPC inFFIFlags profileMethod profileProcess profileSemaphore nextProfileTick preemptionYields sHEAFn ffiExceptionResponse eventTraceMask'
classVariableNames: 'CrossedX EndOfRun MillisecondClockMask'
poolDictionaries: 'VMBasicConstants VMBytecodeConstants VMMethodCacheConstants VMObjectIndices VMSqueakClassIndices VMStackFrameOffsets'
category: 'VMMaker-Interpreter'!

!InterpreterPrimitives commentStamp: 'eem 9/23/2021 13:20' prior: 0!
InterpreterPrimitives implements most of the VM's core primitives. It is the root of the interpreter hierarchy so as to share the core primitives amongst the varioius interpreters.

Instance Variables
argumentCount
eventTraceMask
exceptionPC
ffiExceptionResponse
inFFIFlags
messageSelector
newMethod
nextProfileTick
objectMemory (simulation only)
preemptionYields
primFailCode
secondaryErrorCode
profileMethod
profileProcess
profileSemaphore
sHEAFn

argumentCount
- the number of arguments of the current message

eventTraceMask
- a bit mask corresponding to the Event type codes in sq.h that decides what events are printed in primitiveGetNextEvent

exceptionPC
- the pc of an exception for an exception reporting primitive failure such as PrimErrFFIException

ffiExceptionResponse
- controls system response to exceptions during FFI calls. See primitiveFailForFFIException:at:

inFFIFlags
- flags recording currently only whether the system is in an FFI call

messageSelector
- the oop of the selector of the current message

newMethod
- the oop of the result of looking up the current message

nextProfileTick
- the millisecond clock value of the next profile tick (if profiling is in effect)

objectMemory
- the memory manager and garbage collector that manages the heap

preemptionYields
- a boolean controlling the process primitives. If true (old, incorrect, blue-book semantics) a preempted process is sent to the back of its run-queue. If false, a process preempted by a higher-priority process is put back at the head of its run queue, hence preserving cooperative scheduling within priorities.

primFailCode
- primitive success/failure flag, 0 for success, otherwise the reason code for failure

profileMethod
- the primitive method active when the last profile sample was taken (if any)

profileProcess
- the process active when the last profile sample was taken

profileSemaphore
- the semaphore to be signalled when a profile sample is taken; if nil disables profiling

secondaryErrorCode
- a 64-bit value settable for clonable primitive failures (PrimErrOSError, PrimErrFFIException et al)

profileMethod
- the oop of the method at the time nextProfileTick was reached

profileProcess
- the oop of the activeProcess at the time nextProfileTick was reached

profileSemaphore
- the oop of the semaphore to signal when nextProfileTick is reached

secondaryErrorCode
- an additional value associated with various primitive failures

sHEAFn
- the function to call to check if access to the envronment should be granted to primitiveGetenv!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveBytecodeSetsAvailable (in category 'other primitives') -----
+ primitiveBytecodeSetsAvailable
+ "Answer the encoder names for the supported bytecode sets."
+
+ | encoderNames |
+ argumentCount >0 ifTrue:
+ [^self primitiveFailFor: PrimErrBadNumArgs].
+ encoderNames := self instantiateClass: self classArray indexableSize: 3.
+ self storePointer: 0 ofObject: encoderNames withValue: (objectMemory stringForCString: 'EncoderForV3').
+ self storePointer: 1 ofObject: encoderNames withValue: (objectMemory stringForCString: 'EncoderForV3PlusClosures').
+ self storePointer: 2 ofObject: encoderNames withValue: (objectMemory stringForCString: 'EncoderForSistaV1').
+ self methodReturnValue: encoderNames.
+ !

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveMultipleBytecodeSetsActive (in category 'other primitives') -----
+ primitiveMultipleBytecodeSetsActive
+ "Given one boolean parameter, set multipleBytecodeSetsActive to inform
+ the VM that alternate bytecode sets such as SistaV1 are now in use and
+ that the image format number should be updated accordingly. With zero
+ parameters, answer the current value of multipleBytecodeSetsActive."
+
+
+ argumentCount >1 ifTrue:
+ [^self primitiveFailFor: PrimErrBadNumArgs].
+ argumentCount = 1
+ ifTrue: [self stackTop = objectMemory trueObject
+ ifTrue: [self cppIf: MULTIPLEBYTECODESETS
+ ifTrue: [multipleBytecodeSetsActive := true]
+ ifFalse: [^self primitiveFailFor: PrimErrUnsupported]]
+ ifFalse: [self stackTop = objectMemory falseObject
+ ifTrue: [multipleBytecodeSetsActive := false]
+ ifFalse:[^self primitiveFailFor: PrimErrBadArgument]]].
+ self methodReturnBool: multipleBytecodeSetsActive.
+ !

Item was changed:
InterpreterPrimitives subclass: #StackInterpreter
(excessive size, no diff calculated)

Item was changed:
----- Method: StackInterpreter class>>initializeMiscConstants (in category 'initialization') -----
initializeMiscConstants

super initializeMiscConstants.
STACKVM := true.

RevisedSuspend := true. "primitiveSuspendBackingUpV1/2 no longer allow a process waiting on a condition variable to go past the condition variable"

"These flags identify a GC operation (& hence a reason to leak check),
or just operations the leak checker can be run for."
GCModeFull := 1. "stop-the-world global GC"
GCModeNewSpace := 2. "Spur's scavenge, or V3's incremental"
GCModeIncremental := 4. "incremental global gc (Dijkstra tri-colour marking); as yet unimplemented"
GCModeBecome := 8. "v3 post-become sweeping/Spur forwarding"
GCCheckImageSegment := 16. "just a flag for leak checking image segments"
GCCheckFreeSpace := 32. "just a flag for leak checking free space; Spur only"
GCCheckShorten := 64. "just a flag for leak checking object shortening operations; Spur only"
GCCheckPrimCall := 128. "just a flag for leak checking external primitive calls"

StackPageTraceInvalid := -1.
StackPageUnreached := 0.
StackPageReachedButUntraced := 1.
StackPageTraced := 2.

MillisecondClockMask := 16r1FFFFFFF.
"Note: The external primitive table should actually be dynamically sized but for the sake of inferior platforms (e.g., Mac :-) who cannot allocate memory in any reasonable way, we keep it static (and cross our fingers...)"
MaxExternalPrimitiveTableSize := 4096. "entries"

FailImbalancedPrimitives := InitializationOptions at: #FailImbalancedPrimitives ifAbsentPut: [true].
EnforceAccessControl := InitializationOptions at: #EnforceAccessControl ifAbsent: [true].

ReturnToInterpreter := 1. "setjmp/longjmp code."

"Because of a hack with callbacks in the non-threaded VM they must not conflct with the VM's tag bits."
DisownVMForFFICall := 16.
+ DisownVMForThreading := 32.
+
+ "The multiple bytecodes active bit in the image format number"
+ MultipleBytecodeSetsBitmask := 512.!
- DisownVMForThreading := 32
- !

Item was added:
+ ----- Method: StackInterpreter>>imageFormatVersionForSnapshot (in category 'image save/restore') -----
+ imageFormatVersionForSnapshot
+ "Snapshot image format includes the state of multipleBytecodeSetsActive,
+ set the bit when writing a snapshot"
+ multipleBytecodeSetsActive
+ ifTrue: [^self imageFormatVersion bitOr: MultipleBytecodeSetsBitmask]
+ ifFalse: [^self imageFormatVersion].
+ !

Item was added:
+ ----- Method: StackInterpreter>>imageFormatVersionFromSnapshot: (in category 'image save/restore') -----
+ imageFormatVersionFromSnapshot: imageVersion
+ "Snapshot image format includes the state of multipleBytecodeSetsActive,
+ mask it out when checking compatibility with this interpreter"
+
+ multipleBytecodeSetsActive := (imageVersion bitAnd: MultipleBytecodeSetsBitmask) ~= 0.
+ ^imageVersion bitAnd: ( -1 - MultipleBytecodeSetsBitmask)
+ !

Item was changed:
----- Method: StackInterpreter>>readableFormat: (in category 'image save/restore') -----
readableFormat: imageVersion
"Anwer true if images of the given format are readable by this interpreter.
Allows a virtual machine to accept selected older image formats."

+ ^objectMemory hasSpurMemoryManagerAPI
+ ifTrue: [(self imageFormatVersionFromSnapshot: imageVersion) = self imageFormatVersion]
+ ifFalse: [imageVersion = self imageFormatVersion
+ or: [imageVersion = self imageFormatCompatibilityVersion "Float words in BigEndian order"]].
+ !
- ^imageVersion = self imageFormatVersion "Float words in platform-order"
- or: [objectMemory hasSpurMemoryManagerAPI not "No compatibility version for Spur as yet"
- and: [imageVersion = self imageFormatCompatibilityVersion]] "Float words in BigEndian order"!

Item was changed:
----- Method: StackInterpreter>>writeImageFileIO (in category 'image save/restore') -----
writeImageFileIO
"Write the image header and heap contents to imageFile for snapshot. c.f. writeImageFileIOSimulation.
The game below is to maintain 64-bit alignment for all putLong:toFile: occurrences."

| imageName headerStart headerSize f imageBytes bytesWritten sCWIfn okToWrite |





self cCode: [] inSmalltalk: [imageName := 'sooth compiler'. ^self writeImageFileIOSimulation].

"If the security plugin can be loaded, use it to check for write permission.
If not, assume it's ok"
sCWIfn := self ioLoadFunction: 'secCanWriteImage' From: 'SecurityPlugin'.
sCWIfn ~= 0 ifTrue:
[okToWrite := self cCode: '((sqInt (*)(void))sCWIfn)()'.
okToWrite ifFalse:[^self primitiveFail]].

"local constants"
headerStart := 0.
headerSize := objectMemory wordSize * 16. "64 or 128; header size in bytes; do not change!!"

f := self sqImageFile: imageName Open: 'wb'.
(self invalidSqImageFile: f) ifTrue: "could not open the image file for writing"
[^self primitiveFailFor: PrimErrOperationFailed].

imageBytes := objectMemory imageSizeToWrite.
headerStart := self sqImage: f File: imageName StartLocation: headerSize + imageBytes.
self cCode: '/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'.
"position file to start of header"
self sqImageFile: f Seek: headerStart.

+ self putWord32: self imageFormatVersionForSnapshot toFile: f.
- self putWord32: self imageFormatVersion toFile: f.
self putWord32: headerSize toFile: f.
self putLong: imageBytes toFile: f.
self putLong: objectMemory baseAddressOfImage toFile: f.
self putLong: objectMemory specialObjectsOop toFile: f.
self putLong: objectMemory newObjectHash toFile: f.
self putLong: self getSnapshotScreenSize toFile: f.
self putLong: self getImageHeaderFlags toFile: f.
self putWord32: extraVMMemory toFile: f.
self putShort: desiredNumStackPages toFile: f.
self putShort: self unknownShortOrCodeSizeInKs toFile: f.
self putWord32: desiredEdenBytes toFile: f.
self putShort: (maxExtSemTabSizeSet ifTrue: [self ioGetMaxExtSemTableSize] ifFalse: [0]) toFile: f.
self putShort: the2ndUnknownShort toFile: f.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[self putLong: objectMemory firstSegmentBytes toFile: f.
self putLong: objectMemory bytesLeftInOldSpace toFile: f.
2 timesRepeat: [self putLong: 0 toFile: f] "Pad the rest of the header."]
ifFalse:
[4 timesRepeat: [self putLong: 0 toFile: f]]. "Pad the rest of the header."

objectMemory wordSize = 8 ifTrue:
[3 timesRepeat: [self putLong: 0 toFile: f]]. "Pad the rest of the header."

self assert: headerStart + headerSize = (self sqImageFilePosition: f).
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.

self successful ifFalse: "file write or seek failure"
[self sqImageFileClose: f.
^nil].

"write the image data"
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[bytesWritten := objectMemory writeImageSegmentsToFile: f]
ifFalse:
[bytesWritten := self sq: (self pointerForOop: objectMemory baseAddressOfImage)
Image: (self sizeof: #char)
File: imageBytes
Write: f].
self success: bytesWritten = imageBytes.
self sqImageFileClose: f!

Item was added:
+ ----- Method: StackInterpreterSimulator>>multipleBytecodeSetsActive (in category 'accessing') -----
+ multipleBytecodeSetsActive
+ ^multipleBytecodeSetsActive!

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20220411/1e90914f/attachment-0001.html>


More information about the Vm-dev mailing list