David T. Lewis uploaded a new version of VMMaker to project VM Maker Inbox: http://source.squeak.org/VMMakerInbox/VMMaker.oscog-dtl.3124.mcz

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

Name: VMMaker.oscog-dtl.3124 Author: dtl Time: 27 December 2021, 1:13:16.655501 pm UUID: c2f75042-e365-4331-893f-7c32080423ad Ancestors: VMMaker.oscog-dtl.3123

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.

=============== Diff against VMMaker.oscog-dtl.3123 ===============

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: ----- Method: InterpreterPrimitives>>primitiveBytecodeSetsAvailable (in category 'other primitives') ----- primitiveBytecodeSetsAvailable "Answer the encoder names for the supported bytecode sets." <export: true> | 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. - self pop: 1 thenPush: encoderNames. !

Item was changed: ----- 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."

<export: true> 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. - multipleBytecodeSetsActive - ifTrue: [self pop: argumentCount + 1 thenPush: objectMemory trueObject] - ifFalse: [self pop: argumentCount + 1 thenPush: objectMemory falseObject]. !

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." <api> + ^objectMemory hasSpurMemoryManagerAPI + ifTrue: [(self imageFormatVersionFromSnapshot: imageVersion) = self imageFormatVersion] + ifFalse: [imageVersion = self imageFormatVersion + or: [imageVersion = self imageFormatCompatibilityVersion "Float words in BigEndian order"]]. + ! - ^ (self imageFormatVersion = (imageVersion bitAnd: ( -1 - MultipleBytecodeSetsBitmask))) "Ignore multiple bytecode support identifier" - 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." <inline: #never> | imageName headerStart headerSize f imageBytes bytesWritten sCWIfn okToWrite | <var: 'f' type: #sqImageFile> <var: 'headerStart' type: #squeakFileOffsetType> <var: 'sCWIfn' type: #'void *'> <var: 'imageName' declareC: 'extern char imageName[]'>

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. - multipleBytecodeSetsActive - ifTrue: [self putWord32: (self imageFormatVersion bitOr: MultipleBytecodeSetsBitmask) toFile: f] - ifFalse: [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!