Vm-dev April 2019

vm-dev@lists.squeakfoundation.org

23 participants
69 discussions

Errored: OpenSmalltalk/opensmalltalk-vm#1738 (Cog - 07aabba)
by Travis CI 11 Apr '19

11 Apr '19

Build Update for OpenSmalltalk/opensmalltalk-vm ------------------------------------- Build: #1738 Status: Errored Duration: 12 mins and 48 secs Commit: 07aabba (Cog) Author: Nicolas Cellier Message: Let the .git/hooks work for git 2.18 and later GIT_DIR is not set any longer since git 2.18, so the hook is not recognized as running as hook Replace with a test of $dirname $0 instead as suggested on SO https://stackoverflow.com/questions/55627720/how-to-recognize-if-git-hook-s… This should fix issue #389 View the changeset: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/72506af6911a...07… View the full build log and details: https://travis-ci.org/OpenSmalltalk/opensmalltalk-vm/builds/518740987?utm_m… -- You can unsubscribe from build emails from the OpenSmalltalk/opensmalltalk-vm repository going to https://travis-ci.org/account/preferences/unsubscribe?repository=8795279&ut…. Or unsubscribe from *all* email updating your settings at https://travis-ci.org/account/preferences/unsubscribe?utm_medium=notificati…. Or configure specific recipients for build notifications in your .travis.yml file. See https://docs.travis-ci.com/user/notifications.

1 0

[OpenSmalltalk/opensmalltalk-vm] 07aabb: Let the .git/hooks work for git 2.18 and later
by Nicolas Cellier 11 Apr '19

11 Apr '19

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 07aabbaf15c6eac285faea94d370a7a373da69ab https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/07aabbaf15c6eac285… Author: Nicolas Cellier <nicolas.cellier(a)sirehna.com> Date: 2019-04-11 (Thu, 11 Apr 2019) Changed paths: M scripts/updateSCCSVersions Log Message: ----------- Let the .git/hooks work for git 2.18 and later GIT_DIR is not set any longer since git 2.18, so the hook is not recognized as running as hook Replace with a test of $dirname $0 instead as suggested on SO https://stackoverflow.com/questions/55627720/how-to-recognize-if-git-hook-s… This should fix issue #389

1 0

Fwd: [squeak-dev] The Inbox: ImageFormat-kks.34.mcz
by K K Subbu 11 Apr '19

11 Apr '19

Hi, How do I submit fixes to VMMaker? Is there a separate Inbox? I just uploaded *-34.mcz nad *-35.mcz to Inbox. I hope I didn't annoy squeak-dev readers with VMMaker patches. Thanks and Regards .. Subbu -------- Forwarded Message -------- Subject: [squeak-dev] The Inbox: ImageFormat-kks.34.mcz Date: Wed, 10 Apr 2019 17:13:58 0000 From: commits(a)source.squeak.org Reply-To: squeak-dev(a)lists.squeakfoundation.org To: squeak-dev(a)lists.squeakfoundation.org A new version of ImageFormat was added to project The Inbox: http://source.squeak.org/inbox/ImageFormat-kks.34.mcz ==================== Summary ==================== Name: ImageFormat-kks.34 Author: kks Time: 10 April 2019, 10:43:56.983339 pm UUID: b6d8d060-b305-437e-93b7-68e5427a76e0 Ancestors: ImageFormat-dtl.33 Added support for images whose header begins 512 bytes into the file. Expanded comments to explain magic file use. ==================== Snapshot ==================== SystemOrganization addCategory: #'ImageFormat-Header'! SystemOrganization addCategory: #'ImageFormat-Tests'! Object subclass: #ImageFileHeader instanceVariableNames: 'imageFormat headerSize imageBytes startOfMemory specialObjectsOop lastHash screenSize imageHeaderFlags extraVMMemory' classVariableNames: '' poolDictionaries: '' category: 'ImageFormat-Header'! !ImageFileHeader commentStamp: 'dtl 11/1/2012 07:46' prior: 0! An ImageFileHeader represents the information in the header block of an image file, used by an interpreter VM. Subclasses may implement extensions for Cog or other header extensions. Instance variables correspond to the fields in an image file header. An instance of ImageFileHeader may be created by reading from an image file, and an ImageFileHeader may be written to a file. When stored to a file, the file header fields may be 32 or 64 bits in size, depending on the image format. The byte ordering of each field will be little endian or big endian, depending on the convention of the host platform. When reading from disk, endianness is inferred from the contents of the first data field. To explore the file header of an image file: | fs | fs := (FileStream readOnlyFileNamed: Smalltalk imageName) binary. ([ImageFileHeader readFrom: fs] ensure: [fs close]) explore ! ImageFileHeader subclass: #CogImageFileHeader instanceVariableNames: 'desiredNumStackPages unknownShortOrCodeSizeInKs desiredEdenBytes maxExtSemTabSizeSet' classVariableNames: '' poolDictionaries: '' category: 'ImageFormat-Header'! !CogImageFileHeader commentStamp: 'dtl 10/31/2012 20:23' prior: 0! CogImageFileHeader is an extension of ImageFileHeader with additional fields that are used by Cog and Stack VMs. Some of the additional fields are encoded as short short integers, which are 16 bits when the header word size is 32, and 32 bits when the header word size is 64. All current Cog VMs use 32 bit word size with 16 bit short integer fields.! ----- Method: CogImageFileHeader>>desiredEdenBytes (in category 'accessing') ----- desiredEdenBytes ^ desiredEdenBytes! ----- Method: CogImageFileHeader>>desiredEdenBytes: (in category 'accessing') ----- desiredEdenBytes: anInteger desiredEdenBytes := anInteger! ----- Method: CogImageFileHeader>>desiredNumStackPages (in category 'accessing') ----- desiredNumStackPages ^ desiredNumStackPages! ----- Method: CogImageFileHeader>>desiredNumStackPages: (in category 'accessing') ----- desiredNumStackPages: anInteger desiredNumStackPages := anInteger! ----- Method: CogImageFileHeader>>fromEntryStream: (in category 'reading') ----- fromEntryStream: streamOfHeaderStateObjects super fromEntryStream: streamOfHeaderStateObjects. desiredNumStackPages := streamOfHeaderStateObjects next. unknownShortOrCodeSizeInKs := streamOfHeaderStateObjects next. desiredEdenBytes := streamOfHeaderStateObjects next. maxExtSemTabSizeSet := streamOfHeaderStateObjects next. ! ----- Method: CogImageFileHeader>>maxExtSemTabSizeSet (in category 'accessing') ----- maxExtSemTabSizeSet ^ maxExtSemTabSizeSet! ----- Method: CogImageFileHeader>>maxExtSemTabSizeSet: (in category 'accessing') ----- maxExtSemTabSizeSet: anInteger maxExtSemTabSizeSet := anInteger! ----- Method: CogImageFileHeader>>readFieldsFrom:startingAt:headerWordSize:littleEndian:into: (in category 'reading') ----- readFieldsFrom: aStream startingAt: imageOffset headerWordSize: headerWordSize littleEndian: littleEndian into: aCollection "Read data fields and answer number of bytes read" | remainder bytesRead | bytesRead := super readFieldsFrom: aStream startingAt: imageOffset headerWordSize: headerWordSize littleEndian: littleEndian into: aCollection. aCollection add: (self nextNumber: headerWordSize / 2 from: aStream littleEndian: littleEndian). "desiredNumStackPages" aCollection add: (self nextNumber: headerWordSize / 2 from: aStream littleEndian: littleEndian). "unknownShortOrCodeSizeInKs" aCollection add: (self nextNumber: headerWordSize from: aStream littleEndian: littleEndian). "desiredEdenBytes" aCollection add: (self nextNumber: headerWordSize / 2 from: aStream littleEndian: littleEndian). "maxExtSemTabSizeSet" self nextNumber: headerWordSize / 2 from: aStream littleEndian: littleEndian. remainder := headerSize - (12 * imageFormat wordSize). self assert: remainder >= 0. "n.b. Mantis 7455 bug in original 64 bit image due to VMM error" ^3 * imageFormat wordSize + bytesRead. ! ----- Method: CogImageFileHeader>>storeOn: (in category 'printing') ----- storeOn: aStream "Append to the argument aStream a sequence of characters that is an expression whose evaluation creates an object similar to the receiver." super storeOn: aStream. aStream nextPutAll: '; desiredNumStackPages: '. desiredNumStackPages storeOn: aStream. aStream nextPutAll: '; unknownShortOrCodeSizeInKs: '. unknownShortOrCodeSizeInKs storeOn: aStream. aStream nextPutAll: '; desiredEdenBytes: '. desiredEdenBytes storeOn: aStream. aStream nextPutAll: '; maxExtSemTabSizeSet: '. maxExtSemTabSizeSet storeOn: aStream. ! ----- Method: CogImageFileHeader>>unknownShortOrCodeSizeInKs (in category 'accessing') ----- unknownShortOrCodeSizeInKs ^ unknownShortOrCodeSizeInKs! ----- Method: CogImageFileHeader>>unknownShortOrCodeSizeInKs: (in category 'accessing') ----- unknownShortOrCodeSizeInKs: anInteger unknownShortOrCodeSizeInKs := anInteger! ----- Method: CogImageFileHeader>>writeFieldsTo:littleEndian:headerWordSize: (in category 'writing') ----- writeFieldsTo: aStream littleEndian: littleEnder headerWordSize: headerWordSize "Write data fields and answer number of bytes written" | bytesWritten | bytesWritten := super writeFieldsTo: aStream littleEndian: littleEnder headerWordSize: headerWordSize. self nextNumber: headerWordSize / 2 put: desiredNumStackPages to: aStream littleEndian: littleEnder. self nextNumber: headerWordSize / 2 put: unknownShortOrCodeSizeInKs to: aStream littleEndian: littleEnder. self nextNumber: headerWordSize put: desiredEdenBytes to: aStream littleEndian: littleEnder. self nextNumber: headerWordSize / 2 put: maxExtSemTabSizeSet to: aStream littleEndian: littleEnder. self nextNumber: headerWordSize / 2 put: 0 to: aStream littleEndian: littleEnder. ^3 * imageFormat wordSize + bytesWritten. ! ----- Method: ImageFileHeader class>>fromValues: (in category 'instance creation') ----- fromValues: headerValues "Answer an new instance initialized from an array of values corresponding to fields in an image file header on disk. The values may have been read from a file, or they may have been created by querying the running VM." "self fromValues:self primInterpreterStateSnapshot" ^self basicNew fromEntryStream: headerValues readStream ! ----- Method: ImageFileHeader class>>primInterpreterStateSnapshot (in category 'primitive access') ----- primInterpreterStateSnapshot "Answer an array of values suitable for creating an image file header" "ImageFileHeader primInterpreterStateSnapshot" "ImageFileHeader fromValues: ImageFileHeader primInterpreterStateSnapshot" <primitive: 'primitiveInterpreterStateSnapshot'> self primitiveFailed! ----- Method: ImageFileHeader class>>primMemoryCopy (in category 'primitive access') ----- primMemoryCopy "Answer an exact copy of the current object memory" "ImageFileHeader primMemoryCopy" <primitive: 'primitiveMemoryCopy'> self primitiveFailed! ----- Method: ImageFileHeader class>>primMemorySnapshotWithHeader (in category 'primitive access') ----- primMemorySnapshotWithHeader "Answer an array with a snapshot of the object memory, and with an interpreter state array of values suitable for creating an image file header. This is an atomic request for primitiveMemorySnapshot and primitiveInterpreterStateSnapshot." "ImageFileHeader primMemorySnapshotWithHeader" " | result | result := ImageFileHeader primMemorySnapshotWithHeader. { result first . ImageFileHeader fromValues: result second } " <primitive: 'primitiveMemorySnapshotWithHeader'> self primitiveFailed! ----- Method: ImageFileHeader class>>readFrom: (in category 'instance creation') ----- readFrom: aStream ^self readFrom: aStream startingAt: 0! ----- Method: ImageFileHeader class>>readFrom:startingAt: (in category 'instance creation') ----- readFrom: aStream startingAt: imageOffset ^self basicNew readFrom: aStream startingAt: imageOffset into: OrderedCollection new! ----- Method: ImageFileHeader>>= (in category 'comparing') ----- = other self species == other species ifFalse: [^ false]. 1 to: self class instSize do: [:i | (self instVarAt: i) = (other instVarAt: i) ifFalse: [^ false]]. ^ true! ----- Method: ImageFileHeader>>asByteArray (in category 'converting') ----- asByteArray ^ ByteArray streamContents: [:strm | self writeTo: strm littleEndian: Smalltalk isLittleEndian]! ----- Method: ImageFileHeader>>asValues (in category 'converting') ----- asValues "Answer an array of values from which a copy of this instance could be created with #fromValues:" "self fromValues: (self fromValues:self primInterpreterStateSnapshot) asValues" ^Array new writeStream nextPut: imageFormat asInteger; nextPut: headerSize; nextPut: imageBytes; nextPut: startOfMemory; nextPut: specialObjectsOop; nextPut: lastHash; nextPut: screenSize; nextPut: imageHeaderFlags; nextPut: extraVMMemory; contents ! ----- Method: ImageFileHeader>>extraVMMemory (in category 'accessing') ----- extraVMMemory ^ extraVMMemory! ----- Method: ImageFileHeader>>extraVMMemory: (in category 'accessing') ----- extraVMMemory: anInteger extraVMMemory := anInteger! ----- Method: ImageFileHeader>>fromEntryStream: (in category 'reading') ----- fromEntryStream: streamOfHeaderStateObjects imageFormat := ImageFormat fromInteger: streamOfHeaderStateObjects next. headerSize := streamOfHeaderStateObjects next. imageBytes := streamOfHeaderStateObjects next. startOfMemory := streamOfHeaderStateObjects next. specialObjectsOop := streamOfHeaderStateObjects next. lastHash := streamOfHeaderStateObjects next. screenSize := streamOfHeaderStateObjects next. "a Point with two integer values for X and Y extent" imageHeaderFlags := streamOfHeaderStateObjects next. extraVMMemory := streamOfHeaderStateObjects next. ! ----- Method: ImageFileHeader>>hash (in category 'comparing') ----- hash ^imageBytes hash xor: lastHash! ----- Method: ImageFileHeader>>headerSize (in category 'accessing') ----- headerSize ^ headerSize! ----- Method: ImageFileHeader>>headerSize: (in category 'accessing') ----- headerSize: anInteger headerSize := anInteger! ----- Method: ImageFileHeader>>imageBytes (in category 'accessing') ----- imageBytes ^ imageBytes! ----- Method: ImageFileHeader>>imageBytes: (in category 'accessing') ----- imageBytes: anInteger imageBytes := anInteger! ----- Method: ImageFileHeader>>imageFormat (in category 'accessing') ----- imageFormat ^ imageFormat! ----- Method: ImageFileHeader>>imageFormat: (in category 'accessing') ----- imageFormat: anImageFormat imageFormat := anImageFormat! ----- Method: ImageFileHeader>>imageHeaderFlags (in category 'accessing') ----- imageHeaderFlags ^ imageHeaderFlags! ----- Method: ImageFileHeader>>imageHeaderFlags: (in category 'accessing') ----- imageHeaderFlags: anInteger imageHeaderFlags := anInteger! ----- Method: ImageFileHeader>>lastHash (in category 'accessing') ----- lastHash ^ lastHash! ----- Method: ImageFileHeader>>lastHash: (in category 'accessing') ----- lastHash: anInteger lastHash := anInteger! ----- Method: ImageFileHeader>>nextNumber:from:littleEndian: (in category 'reading') ----- nextNumber: length from: aStream littleEndian: littleEnder littleEnder ifTrue: [^aStream nextLittleEndianNumber: length] ifFalse: [^aStream nextNumber: length]! ----- Method: ImageFileHeader>>nextNumber:put:to:littleEndian: (in category 'writing') ----- nextNumber: n put: v to: aStream littleEndian: littleEnder littleEnder ifTrue: [^aStream nextLittleEndianNumber: n put: v] ifFalse: [^aStream nextNumber: n put: v]! ----- Method: ImageFileHeader>>printOn: (in category 'printing') ----- printOn: aStream super printOn: aStream. imageFormat ifNotNil: [ aStream nextPutAll: ' for '. imageFormat printDescriptionOn: aStream]! ----- Method: ImageFileHeader>>readFieldsFrom:startingAt:headerWordSize:littleEndian:into: (in category 'reading') ----- readFieldsFrom: aStream startingAt: imageOffset headerWordSize: headerWordSize littleEndian: littleEndian into: aCollection "Read data fields and answer number of bytes read" | remainder screenSizeWord | headerSize := self nextNumber: headerWordSize from: aStream littleEndian: littleEndian. aCollection add: headerSize. aCollection add: ( self nextNumber: headerWordSize from: aStream littleEndian: littleEndian). "imageBytes" aCollection add: (self nextNumber: headerWordSize from: aStream littleEndian: littleEndian). "startOfMemory" aCollection add: (self nextNumber: headerWordSize from: aStream littleEndian: littleEndian). "specialObjectsOop" aCollection add: (self nextNumber: headerWordSize from: aStream littleEndian: littleEndian). "lastHash" screenSizeWord := self nextNumber: headerWordSize from: aStream littleEndian: littleEndian. aCollection add: ((screenSizeWord >> 16) @ (screenSizeWord bitAnd: 16rFFFF)). aCollection add: (self nextNumber: headerWordSize from: aStream littleEndian: littleEndian). "imageHeaderFlags" aCollection add: (self nextNumber: headerWordSize from: aStream littleEndian: littleEndian). "extraVMMemory" remainder := headerSize - (9 * imageFormat wordSize). self assert: remainder >= 0. "n.b. Mantis 7455 bug in original 64 bit image due to VMM error" ^9 * imageFormat wordSize. ! ----- Method: ImageFileHeader>>readFrom:startingAt:into: (in category 'reading') ----- readFrom: aStream startingAt: imageOffset into: aCollection | remainder bytesRead headerWordSize littleEndian | littleEndian := self readImageVersionFrom: aStream startingAt: imageOffset. headerWordSize := aStream position - imageOffset. aCollection add: imageFormat asInteger. bytesRead := self readFieldsFrom: aStream startingAt: imageOffset headerWordSize: headerWordSize littleEndian: littleEndian into: aCollection. remainder := headerSize - bytesRead. self assert: remainder >= 0. "n.b. Mantis 7455 bug in original 64 bit image due to VMM error" aStream next: (headerSize - bytesRead). self fromEntryStream: aCollection readStream. ! ----- Method: ImageFileHeader>>readImageVersionFrom:startingAt: (in category 'reading') ----- readImageVersionFrom: aStream startingAt: imageOffset "Look for image format in the next 4 or 8 bytes and set imageFormat. Answer true if the header is written in little endian format." (aStream nextNumber: 4) caseOf: { [ 16r00001966 "6502" ] -> [ imageFormat := ImageFormat fromInteger: 6502. ^false ] . [ 16r66190000 "6502" ] -> [ imageFormat := ImageFormat fromInteger: 6502. ^true ] . [ 16r00001968 "6504" ] -> [ imageFormat := ImageFormat fromInteger: 6504. ^false ] . [ 16r68190000 "6504" ] -> [ imageFormat := ImageFormat fromInteger: 6504. ^true ] . [ 16r00001969 "6505" ] -> [ imageFormat := ImageFormat fromInteger: 6505. ^false ] . [ 16r69190000 "6505" ] -> [ imageFormat := ImageFormat fromInteger: 6505. ^true ] . [ 16r00001979 "6521" ] -> [ imageFormat := ImageFormat fromInteger: 6521. ^false ] . [ 16r79190000 "6521" ] -> [ imageFormat := ImageFormat fromInteger: 6521. ^true ] . [ 16rA0090100 "68000" ] -> [ imageFormat := ImageFormat fromInteger: 68000. aStream next: 4. ^true ] . [ 16rA2090100 "68002" ] -> [ imageFormat := ImageFormat fromInteger: 68002. aStream next: 4. ^true ] . [ 16rA3090100 "68003" ] -> [ imageFormat := ImageFormat fromInteger: 68003. aStream next: 4. ^true ] . [ 16rB3090100 "68019" ] -> [ imageFormat := ImageFormat fromInteger: 68019. aStream next: 4. ^true ] . [ 16r000109B3 "68019" ] -> [ imageFormat := ImageFormat fromInteger: 68019. aStream next: 4. ^false ] . [ 16rB5090100 "68021" ] -> [ imageFormat := ImageFormat fromInteger: 68021. aStream next: 4. ^true ] . [ 16r000109B5 "68021" ] -> [ imageFormat := ImageFormat fromInteger: 68021. aStream next: 4. ^false ] . [ 16r00000000 ] -> [ "Standard interpreter VM puts the format number in the first 64 bits for a 64 bit image, so the leading 4 bytes are zero in this case. Cog/Spur VMs put the format number in the first 32 bits for both 32 and 64 bit images." (aStream nextNumber: 4) caseOf: { [ 16r000109A0 "68000" ] -> [ imageFormat := ImageFormat fromInteger: 68000. ^false ] . [ 16r000109A2 "68002" ] -> [ imageFormat := ImageFormat fromInteger: 68002. ^false ] . [ 16r000109A3 "68003" ] -> [ imageFormat := ImageFormat fromInteger: 68003. ^false ] . [ 16r000109B3 "68019" ] -> [ imageFormat := ImageFormat fromInteger: 68019. ^false ] . } otherwise: [self error: self asString , ' unrecognized format number'] ] } otherwise: [self error: self asString , ' unrecognized format number'] "ImageFormat versionNumberByteArrays do: [:e | Transcript cr; show: e printString , ': ', (ImageFormat fromBytes: e) description] #[0 0 25 102]: a 32-bit image with no closure support and no native platform float word order requirement (6502) #[102 25 0 0]: a 32-bit image with no closure support and no native platform float word order requirement (6502) #[0 0 25 104]: a 32-bit image with closure support and no native platform float word order requirement (6504) #[104 25 0 0]: a 32-bit image with closure support and no native platform float word order requirement (6504) #[0 0 0 0 0 1 9 160]: a 64-bit image with no closure support and no native platform float word order requirement (68000) #[160 9 1 0 0 0 0 0]: a 64-bit image with no closure support and no native platform float word order requirement (68000) #[0 0 0 0 0 1 9 162]: a 64-bit image with closure support and no native platform float word order requirement (68002) #[162 9 1 0 0 0 0 0]: a 64-bit image with closure support and no native platform float word order requirement (68002) #[0 0 25 105]: a 32-bit image with closure support and float words stored in native platform order (6505) #[105 25 0 0]: a 32-bit image with closure support and float words stored in native platform order (6505) #[0 0 0 0 0 1 9 163]: a 64-bit image with closure support and float words stored in native platform order (68003) #[163 9 1 0 0 0 0 0]: a 64-bit image with closure support and float words stored in native platform order (68003) #[0 0 25 121]: a 32-bit image with closure support and float words stored in native platform order using Spur object format (6521) #[121 25 0 0]: a 32-bit image with closure support and float words stored in native platform order using Spur object format (6521) #[0 0 0 0 0 1 9 179]: a 64-bit image with closure support and float words stored in native platform order using Spur object format (obsolete) (68019) #[179 9 1 0 0 0 0 0]: a 64-bit image with closure support and float words stored in native platform order using Spur object format (obsolete) (68019) #[0 0 0 0 0 1 9 181]: a 64-bit image with closure support and float words stored in native platform order using Spur object format (68021) #[181 9 1 0 0 0 0 0]: a 64-bit image with closure support and float words stored in native platform order using Spur object format (68021) " ! ----- Method: ImageFileHeader>>screenSize (in category 'accessing') ----- screenSize "World extent at the time of image save, packed into 32 bit integer when saved to file header." "right= windowBounds.x + ((unsigned)savedWindowSize >> 16); bottom= windowBounds.y + (savedWindowSize & 0xFFFF);" ^ screenSize! ----- Method: ImageFileHeader>>screenSize: (in category 'accessing') ----- screenSize: aPoint "World extent at the time of image save, packed into 32 bit integer when saved to file header." "right= windowBounds.x + ((unsigned)savedWindowSize >> 16); bottom= windowBounds.y + (savedWindowSize & 0xFFFF);" screenSize := aPoint ! ----- Method: ImageFileHeader>>specialObjectsOop (in category 'accessing') ----- specialObjectsOop ^ specialObjectsOop! ----- Method: ImageFileHeader>>specialObjectsOop: (in category 'accessing') ----- specialObjectsOop: anInteger specialObjectsOop := anInteger! ----- Method: ImageFileHeader>>startOfMemory (in category 'accessing') ----- startOfMemory ^ startOfMemory! ----- Method: ImageFileHeader>>startOfMemory: (in category 'accessing') ----- startOfMemory: anInteger startOfMemory := anInteger! ----- Method: ImageFileHeader>>storeOn: (in category 'printing') ----- storeOn: aStream "Append to the argument aStream a sequence of characters that is an expression whose evaluation creates an object similar to the receiver." aStream nextPutAll: self class name; nextPutAll: ' new imageFormat: ('. imageFormat storeOn: aStream. aStream nextPutAll: '); headerSize: '. headerSize storeOn: aStream. aStream nextPutAll: '; imageBytes: '. imageBytes storeOn: aStream. aStream nextPutAll: '; startOfMemory: '. startOfMemory storeOn: aStream. aStream nextPutAll: '; specialObjectsOop: '. specialObjectsOop storeOn: aStream. aStream nextPutAll: '; lastHash: '. lastHash storeOn: aStream. aStream nextPutAll: '; screenSize: '. screenSize storeOn: aStream. aStream nextPutAll: '; imageHeaderFlags: '. imageHeaderFlags storeOn: aStream. aStream nextPutAll: '; extraVMMemory: '. extraVMMemory storeOn: aStream. ! ----- Method: ImageFileHeader>>writeFieldsTo:littleEndian:headerWordSize: (in category 'writing') ----- writeFieldsTo: aStream littleEndian: littleEnder headerWordSize: headerWordSize "Write data fields and answer number of bytes written" self nextNumber: headerWordSize put: imageFormat asInteger to: aStream littleEndian: littleEnder. self nextNumber: headerWordSize put: headerSize to: aStream littleEndian: littleEnder. self nextNumber: headerWordSize put: imageBytes to: aStream littleEndian: littleEnder. self nextNumber: headerWordSize put: startOfMemory to: aStream littleEndian: littleEnder. self nextNumber: headerWordSize put: specialObjectsOop to: aStream littleEndian: littleEnder. self nextNumber: headerWordSize put: lastHash to: aStream littleEndian: littleEnder. self nextNumber: headerWordSize put: ((screenSize x) << 16 + (screenSize y)) to: aStream littleEndian: littleEnder. self nextNumber: headerWordSize put: imageHeaderFlags to: aStream littleEndian: littleEnder. self nextNumber: headerWordSize put: extraVMMemory to: aStream littleEndian: littleEnder. ^9 * imageFormat wordSize. ! ----- Method: ImageFileHeader>>writeTo:littleEndian: (in category 'writing') ----- writeTo: aStream littleEndian: littleEnder | headerWordSize remainder bytesWritten | headerWordSize := imageFormat wordSize. bytesWritten := self writeFieldsTo: aStream littleEndian: littleEnder headerWordSize: headerWordSize. remainder := headerSize - bytesWritten. self assert: remainder >= 0. "n.b. Mantis 7455 bug in original 64 bit image due to VMM error" remainder timesRepeat: [aStream nextPut: 0]. ! Object subclass: #ImageFormat instanceVariableNames: 'wordSize requiresClosureSupport requiresNativeFloatWordOrder requiresSpurSupport requiresNewSpur64TagAssignment' classVariableNames: 'BaseVersionMask BaseVersionNumbers CapabilitiesBitsMask KnownVersionNumbers PlatformByteOrderBit ReservedBitsMask SpurObjectBit' poolDictionaries: '' category: 'ImageFormat-Header'! !ImageFormat commentStamp: 'dtl 11/7/2010 22:13' prior: 0! ImageFormat represents the requirements of the image in terms of capabilities that must be supported by the virtual machine. The image format version is saved as an integer value in the header of an image file. When an image is loaded, the virtual machine checks the image format version to determine whether it is capable of supporting the requirements of that image. The image format version value is treated as a bit map of size 32, derived from the 32-bit integer value saved in the image header. Bits in the bit map represent image format requirements. For example, if the image sets bit 15 to indicate that it requires some capability from the VM, then the VM can check bit 15 and decide whether it is able to satisfy that requirement. The base image format numbers (6502, 6504, 68000, and 68002) utiliize 10 of the 32 available bits. The high order bit is reserved as an extension bit for future use. The remaining 21 bits are used to represent additional image format requirements. For example, the low order bit is used to indication that the image uses (and requires support for) the platform byte ordering implemented in the StackInterpreter (Cog) VM. "(ImageFormat fromFile: Smalltalk imageName) description" ! ----- Method: ImageFormat class>>allVersionNumberByteArrays (in category 'utility') ----- allVersionNumberByteArrays "All known version numbers expressed as byte arrays of size 4 and 8 in little endian and big endian byte ordering." "ImageFormat allVersionNumberByteArrays" | byteArrays | byteArrays := OrderedCollection new. KnownVersionNumbers do: [:version | byteArrays add: ((WriteStream on: (ByteArray new: 4)) nextNumber: 4 put: version; yourself) contents. byteArrays add: ((WriteStream on: (ByteArray new: 8)) nextNumber: 8 put: version; yourself) contents. byteArrays add: ((WriteStream on: (ByteArray new: 4)) nextLittleEndianNumber: 4 put: version; yourself) contents. byteArrays add: ((WriteStream on: (ByteArray new: 8)) nextLittleEndianNumber: 8 put: version; yourself) contents]. ^byteArrays! ----- Method: ImageFormat class>>availableBits (in category 'initialize-release') ----- availableBits "Bits available for use as capability bits. Reserve high order bit as the extension bit, to be set true if additional bits are required in the future." "ImageFormat availableBits printStringBase: 2" | mask | mask := 0. self bitAssignments doWithIndex: [ :e :i | mask := mask bitAt: i put: (e isNil ifTrue: [ 1 ] ifFalse: [ 0 ])]. ^ mask ! ----- Method: ImageFormat class>>baseVersionMask (in category 'image formats') ----- baseVersionMask "Mask the bits associated with base format number exclusive of capability bits" "ImageFormat baseVersionMask printStringBase: 2" ^ BaseVersionNumbers inject: 0 into: [:accum :e | accum bitOr: e] ! ----- Method: ImageFormat class>>baseVersionNumbers (in category 'image formats') ----- baseVersionNumbers "The well-known image format versions for basic 32 and 64 bit images, including images that require closure bytecode support. These base format numbers my be modified by application of various capability bits representing additional requirements that the image expects to be supported by the virtual machine." ^#(6502 6504 68000 68002) ! ----- Method: ImageFormat class>>bitAssignments (in category 'initialize-release') ----- bitAssignments "ImageFormat bitAssignments doWithIndex: [ :e :i | Transcript cr; show: 'bit ', i asString, ' is ', (e ifNil: ['unused'])]" | bits | bits := Array new: 32. "If bit 1 is set, the high and low order 32-bit words of a Float are stored in platform word order. If bit 1 is not set, big-endian word order is used for Float regardless of the platform." bits at: 1 put: 'the use platform float word order bit (Cog and StackInterpreter)'. bits at: 2 put: 'used in base version numbers'. bits at: 3 put: 'used in base version numbers'. bits at: 4 put: 'used in base version numbers'. bits at: 5 put: 'the Spur object format bit'. bits at: 6 put: 'used in base version numbers'. bits at: 7 put: 'used in base version numbers'. bits at: 8 put: 'used in base version numbers'. bits at: 9 put: 'used in base version numbers'. bits at: 10 put: nil. "unassigned bit available for future image formats" bits at: 11 put: nil. "unassigned bit available for future image formats" bits at: 12 put: 'used in base version numbers'. bits at: 13 put: 'used in base version numbers'. bits at: 14 put: nil. "unassigned bit available for future image formats" bits at: 15 put: nil. "unassigned bit available for future image formats" bits at: 16 put: nil. "unassigned bit available for future image formats" bits at: 17 put: 'used in base version numbers'. bits at: 18 put: nil. "unassigned bit available for future image formats" bits at: 19 put: nil. "unassigned bit available for future image formats" bits at: 20 put: nil. "unassigned bit available for future image formats" bits at: 21 put: nil. "unassigned bit available for future image formats" bits at: 22 put: nil. "unassigned bit available for future image formats" bits at: 23 put: nil. "unassigned bit available for future image formats" bits at: 24 put: nil. "unassigned bit available for future image formats" bits at: 25 put: nil. "unassigned bit available for future image formats" bits at: 26 put: nil. "unassigned bit available for future image formats" bits at: 27 put: nil. "unassigned bit available for future image formats" bits at: 28 put: nil. "unassigned bit available for future image formats" bits at: 29 put: nil. "unassigned bit available for future image formats" bits at: 30 put: nil. "unassigned bit available for future image formats" bits at: 31 put: nil. "unassigned bit available for future image formats" "If bit 32 is set, additional image format information will be stored in one or more additional words. Currently this is unused, and bit 32 is always zero." bits at: 32 put: 'the extension bit (reserved for future use)'. ^bits ! ----- Method: ImageFormat class>>bitsInUse (in category 'image formats') ----- bitsInUse "Answer a mask of the bits used by all known version format numbers" "Transcript cr; show: (ImageFormat bitsInUse printStringBase: 2)" | mask | mask := 0. self bitAssignments doWithIndex: [ :e :i | mask := mask bitAt: i put: (e notNil ifTrue: [ 1 ] ifFalse: [ 0 ])]. ^ mask ! ----- Method: ImageFormat class>>capabilitiesBitsMask (in category 'image formats') ----- capabilitiesBitsMask "Bits currently used as capability bits." "ImageFormat capabilitiesBitsMask printStringBase: 2" ^ (0 bitAt: PlatformByteOrderBit put: 1) bitAt: SpurObjectBit put: 1 ! ----- Method: ImageFormat class>>createCkFormatProgram (in category 'ckformat') ----- createCkFormatProgram "Create ckformat source file in the default directory" "ImageFormat createCkFormatProgram" ^self storeCkFormatOnFile: 'ckformat.c' ! ----- Method: ImageFormat class>>default (in category 'instance creation') ----- default "The original Squeak image format number" ^ self wordSize: 4! ----- Method: ImageFormat class>>fromBytes: (in category 'instance creation') ----- fromBytes: bytes ^ self fromStream: (ReadStream on: bytes) ! ----- Method: ImageFormat class>>fromFile: (in category 'instance creation') ----- fromFile: imageFile "Answer a new instance from a saved image file. The image format number is saved in the first 4 or 8 bytes of the file. Word size and byte ordering are dependent on the image and platform that saved the file, and must be decoded to obtain the image format." "ImageFormat fromFile: Smalltalk imageName" | f | f := (FileStream oldFileNamed: imageFile) ifNil: [FileStream readOnlyFileNamed: imageFile]. f ifNotNil: [ | imageFormat | [f binary. imageFormat := self fromStream: f] ensure: [f close]. ^imageFormat]. ^self error: 'could not open ', imageFile ! ----- Method: ImageFormat class>>fromInteger: (in category 'instance creation') ----- fromInteger: anInteger "Answer a new instance from an integer, typically obtained from an image file header." ^ self new fromInteger: anInteger! ----- Method: ImageFormat class>>fromStream: (in category 'instance creation') ----- fromStream: stream "Answer a new instance from a saved image file stream. Word size and byte ordering are dependent on the image and platform that saved the file, and must be decoded to obtain the image format. There may be a 512 byte offset, also." { 0 . 512 } do: [:offset | | num | [stream position: offset. num := stream nextNumber: 4. "try 32 bit big endian format" ^ self fromInteger: num] on: Error do: [[stream position: offset. num := stream nextLittleEndianNumber: 4. "try 32 bit little endian format" ^ self fromInteger: num] on: Error do: [[stream position: offset. num := stream nextNumber: 8. "try 64 bit big endian format" ^ self fromInteger: num] on: Error do: [[stream position: offset. num := stream nextLittleEndianNumber: 8. "try 64 bit little endian format" ^ self fromInteger: num] on: Error do: ["nothing. fall through for possible second round."]]]]]. self error: 'unrecognized image format'! ----- Method: ImageFormat class>>generateCkFormatProgram:on: (in category 'ckformat') ----- generateCkFormatProgram: programName on: stream "Generate source code for an image format version reader. The program is intended for testing image file format from a unix shell script such that the shell script can decide what VM to run based on image requirements." | formatNumber | stream nextPutAll: '/* ', programName, ': Print the image format number on standard output */'; cr; nextPutAll: '/* for use in a shell script to test image format requirements. */'; cr; nextPutAll: '/* A non-zero return status code indicates failure. */'; cr; cr; nextPutAll: '/* Usage: ', programName, ' imageFileName */'; cr; cr; nextPutAll: '/* --- DO NOT EDIT THIS FILE --- */'; cr; nextPutAll: '/* --- Automatically generated from class ', self name, ' ', DateAndTime now asString, '--- */'; cr; nextPutAll: '/* --- Source code is in package ImageFormat in the VMMaker repository --- */'; cr; nextPutAll: '/* --- DO NOT EDIT THIS FILE --- */'; cr; cr; nextPutAll: '#include <stdio.h>'; cr; nextPutAll: '#include <stdlib.h>'; cr; nextPutAll: '#include <string.h>'; cr; cr; nextPutAll: 'int main(int argc, char **argv) {'; cr; tab; nextPutAll: 'FILE *f;'; cr; tab; nextPutAll: 'unsigned char buf[8];'; cr; tab; nextPutAll: 'int formatNumber;'; cr; tab; nextPutAll: 'unsigned char c;'; cr; tab; nextPutAll: 'int match;'; cr; tab; nextPutAll: 'if (argc !!= 2) {'; cr; tab; tab; nextPutAll: 'printf("usage: ', programName, ' imageFileName\n");'; cr; tab; tab; nextPutAll: 'exit(1);'; cr; tab; nextPutAll: '}'; cr; tab; nextPutAll: 'f = fopen(argv[1], "r");'; cr; tab; nextPutAll: 'if (f == NULL) {'; cr; tab; tab; nextPutAll: 'perror(argv[1]);'; cr; tab; tab; nextPutAll: 'exit(2);'; cr; tab; nextPutAll: '}'; cr. { 0. 512 } do: [:offset | stream tab; nextPutAll: 'if(fseek(f, '; nextPutAll: offset asString; nextPutAll: 'L, SEEK_SET) !!= 0) {';cr; tab; tab; nextPutAll: 'fprintf(stderr, "cannot go to pos %d in %s\n", '; nextPutAll: offset asString; nextPutAll: ', argv[1]);'; cr; tab; tab; nextPutAll: 'exit(3);'; cr; tab; nextPutAll: '}'; cr; tab; nextPutAll: 'if (fread(buf, 1, 8, f) < 8) {'; cr; tab; tab; nextPutAll: 'fprintf(stderr, "cannot read %s\n", argv[1]);'; cr; tab; tab; nextPutAll: 'exit(3);'; cr; tab; nextPutAll: '}'; cr. self versionNumberByteArrays withIndexDo: [ :v :tag | | b | formatNumber := (self fromBytes: v) asInteger. b := 'b_', formatNumber asString, '_', tag asString. stream tab; nextPutAll: '{'; cr; tab; nextPutAll: 'unsigned char ', b, '[', v size asString, ']= { '. v inject: true into: [:first : elem | first ifFalse: [stream nextPutAll: ', ']. stream nextPutAll: elem asString. false]. stream nextPutAll: '};'; cr; tab; nextPutAll: 'if (memcmp(buf, ', b, ', ', v size asString, ') == 0) {'; cr; tab; tab; nextPutAll: 'printf("%d\n", ', formatNumber, ');'; cr; tab; tab; nextPutAll: 'exit(0);'; cr; tab; nextPutAll: '}'; cr; tab; nextPutAll: '}'; cr]]. stream tab; nextPutAll: 'printf("0\n"); /* print an invalid format number */';cr; tab; nextPutAll: 'exit (-1); /* not found, exit with error code */'; cr; nextPutAll: '}'; cr ! ----- Method: ImageFormat class>>initialize (in category 'initialize-release') ----- initialize "ImageFormat initialize" PlatformByteOrderBit := 1. SpurObjectBit := 5. BaseVersionNumbers := self baseVersionNumbers. BaseVersionMask := self baseVersionMask. CapabilitiesBitsMask := self capabilitiesBitsMask. ReservedBitsMask := self availableBits. KnownVersionNumbers := self knownVersionNumbers. ! ----- Method: ImageFormat class>>knownVersionNumbers (in category 'initialize-release') ----- knownVersionNumbers "Version numbers currently in use or likely to be used (e.g. 64-bit Cog formats)" "ImageFormat knownVersionNumbers collect: [:e | (ImageFormat fromInteger: e) description]" ^ ( self baseVersionNumbers, "the original format number variants" { 6505 . "Cog and StackVM" 68003 . "Cog and StackVM running 64-bit image" 6521 . "Spur 32 bit object memory" 68019 . "Spur 64 bit object memory (early)" 68021 . "Spur 64 bit object memory" " ... add others here as bits are allocated to represent requirements of other image formats" } ) sort. ! ----- Method: ImageFormat class>>storeCkFormatOnFile: (in category 'ckformat') ----- storeCkFormatOnFile: fileName "Store source code for an image format version reader in a file. The program is intended for testing image file format from a unix shell script such that the shell script can decide what VM to run based on image requirements." | f | f := CrLfFileStream newFileNamed: fileName. [self generateCkFormatProgram: 'ckformat' on: f] ensure: [f ifNotNil: [f close]]. ^fileName! ----- Method: ImageFormat class>>storeCkstatusOnFile: (in category 'ckformat') ----- storeCkstatusOnFile: fileName "Deprecated 07-Dec-2012, use storeCkFormatOnFile:" ^self storeCkFormatOnFile: fileName ! ----- Method: ImageFormat class>>thisImageFileFormat (in category 'instance creation') ----- thisImageFileFormat "The image format read from the header of the file from which the current image was loaded. This may be different from the current format if the VM has modified the image at load time or in the course of running the image." "ImageFormat thisImageFileFormat description" ^self fromFile: Smalltalk imageName ! ----- Method: ImageFormat class>>unixMagicFileEntries (in category 'unix magic file entries') ----- unixMagicFileEntries "Answer a string that can be appended to /etc/magic on a Unix system to support the file(1) utility. For example, the file magic produced by (FileStream newFileNamed: 'magic') in: [:fs | [fs nextPutAll: ImageFormat unixMagicFileEntries ] ensure: [ fs close ]] can be appended to $HOME/.magic and then $ file squeak.image pharo.image ... will describe the given image files precisely" ^String streamContents: [:s | s nextPutAll: '# Smalltalk image file formats'; lf. KnownVersionNumbers do: [ :num | | fmt | #( 'le' 'be' ) do: [ :endian | #(0 512) do: [ :offset | fmt := self fromInteger: num. (fmt is64Bit and: [ endian = 'be' ]) ifTrue: [ s nextPutAll: (offset+4) asString ] ifFalse: [ s nextPutAll: offset asString ]. s tab; nextPutAll: endian; nextPutAll: 'long'; tab; nextPutAll: num asString; tab; nextPutAll: 'Smalltalk '. fmt printTerseDescriptionOn: s. s lf. s nextPutAll: '!!:mime application/'; nextPutAll: fmt simpleName; nextPutAll: '-image'; lf ] ] ]. s lf. ]! ----- Method: ImageFormat class>>versionDescriptions (in category 'utility') ----- versionDescriptions "ImageFormat versionDescriptions do: [:e | Transcript cr; show: e]" "| d | d := ImageFormat versionDescriptions. KnownVersionNumbers do: [ :v | Transcript cr; show: v asString, '- ', (d at: v)]" ^ Dictionary withAll: (KnownVersionNumbers collect: [:e | e -> (self fromInteger: e) description])! ----- Method: ImageFormat class>>versionNumberByteArrays (in category 'utility') ----- versionNumberByteArrays "All byte array expressions of known version numbers. These are the possible values that may appear in the first 4 or 8 bytes of a saved image file. All 32 bit images have this number in the first 4 bytes of the image file header. A 64 bit V3 image has this number saved in the first 8 bytes of the header (only 4 bytes of which are significant). For a 64 bit Spur image, the number is saved in the first 4 bytes. In all cases, the value may be stored in little endian or big endian byte ordering depending on the host platform (although all currently supported VMs are for little endian host platforms)." "ImageFormat versionNumberByteArrays do: [:e | Transcript cr; show: e printString , ': ', (ImageFormat fromBytes: e) description]" ^self allVersionNumberByteArrays select: [:e | e size = 4 or: [ (self fromBytes: e) requiresSpurSupport not ]]. ! ----- Method: ImageFormat class>>wordSize: (in category 'instance creation') ----- wordSize: bytesPerWord bytesPerWord = 4 ifTrue: [^self new fromInteger: 6502]. bytesPerWord = 8 ifTrue: [^self new fromInteger: 68000]. self error: 'unsupported word size ', bytesPerWord! ----- Method: ImageFormat class>>wordSize:closures: (in category 'instance creation') ----- wordSize: bytesPerWord closures: aBoolean ^(self wordSize: bytesPerWord) setClosureSupportRequirement: aBoolean ! ----- Method: ImageFormat class>>wordSize:cog: (in category 'instance creation') ----- wordSize: bytesPerWord cog: cogRequired ^(self wordSize: bytesPerWord) setClosureSupportRequirement: cogRequired; setCogSupportRequirement: cogRequired ! ----- Method: ImageFormat class>>wordSize:spur: (in category 'instance creation') ----- wordSize: bytesPerWord spur: spurRequired "Answer a Spur image format, or default to Cog if Spur is not specified" | update64 | update64 := bytesPerWord == 8. "The 64 bit Spur image has an updated version" ^self wordSize: bytesPerWord spur: spurRequired requiresNewSpur64TagAssignment: update64! ----- Method: ImageFormat class>>wordSize:spur:requiresNewSpur64TagAssignment: (in category 'instance creation') ----- wordSize: bytesPerWord spur: spurRequired requiresNewSpur64TagAssignment: newSpur64 "Answer a Spur image format, or default to Cog if Spur is not specified" ^(self wordSize: bytesPerWord) setClosureSupportRequirement: true; setCogSupportRequirement: true; setSpurSupportRequirement: spurRequired; setRequiresNewSpur64TagAssignmentRequirement: newSpur64 ! ----- Method: ImageFormat>>= (in category 'comparing') ----- = anImageFormat ^self class == anImageFormat class and: [self asInteger = anImageFormat asInteger]. ! ----- Method: ImageFormat>>asInteger (in category 'converting') ----- asInteger "Answer an integer representation of this image format suitable for storage in an image file header. The stored value in the file header will be used when loading the image from the snapshot file." | val | val := wordSize = 4 ifTrue: [6502] ifFalse: [68000]. self requiresClosureSupport ifTrue: [val := val + 2]. self requiresNativeFloatWordOrder ifTrue: [val := val + 1]. self requiresSpurSupport ifTrue: [val := val + 2r10000]. self requiresNewSpur64TagAssignment ifTrue: [val := val + 2]. ^val ! ----- Method: ImageFormat>>baseVersionBits (in category 'private') ----- baseVersionBits "Answer the bits associated with base format number exclusive of capability bits" ^self baseVersionBitsOf: self asInteger ! ----- Method: ImageFormat>>baseVersionBitsOf: (in category 'private') ----- baseVersionBitsOf: anInteger "Answer the bits of anInteger associated with base format number exclusive of capability bits" ^ anInteger bitAnd: BaseVersionMask! ----- Method: ImageFormat>>description (in category 'printing') ----- description "(ImageFormat fromInteger: 6502) description" ^String streamContents: [:s | self printDescriptionOn: s] ! ----- Method: ImageFormat>>fromInteger: (in category 'initialize-release') ----- fromInteger: anInteger "Initialize a new instance from anInteger obtained from an image file header." | baseVersion capabilitiesBits | (anInteger bitAnd: ReservedBitsMask) ~= 0 ifTrue: [self error: 'invalid format number ', anInteger printString]. baseVersion := self baseVersionBitsOf: anInteger. ((baseVersion = 6504 or: [baseVersion = 68002]) or: [baseVersion = 68004]) ifTrue: [requiresClosureSupport := true]. (baseVersion = 6502 or: [baseVersion = 6504]) ifTrue: [wordSize := 4] ifFalse: [((baseVersion = 68000 or: [baseVersion = 68002]) or: [baseVersion = 68004]) ifTrue: [wordSize := 8. baseVersion = 68004 ifTrue: [self setRequiresNewSpur64TagAssignmentRequirement: true]] ifFalse: [self error: 'invalid format number ', anInteger printString]]. capabilitiesBits := anInteger bitAnd: CapabilitiesBitsMask. (capabilitiesBits bitAt: PlatformByteOrderBit) = 1 ifTrue: [requiresNativeFloatWordOrder := true. requiresClosureSupport ifFalse: [self error: 'Images requiring platform byte order also require closure support (Cog)']. capabilitiesBits := capabilitiesBits bitAt: PlatformByteOrderBit put: 0]. (capabilitiesBits bitAt: SpurObjectBit) = 1 ifTrue: [requiresSpurSupport := true. requiresClosureSupport ifFalse: [self error: 'Images requiring Spur also require closure support']. requiresNativeFloatWordOrder ifFalse: [self error: 'Images requiring Spur also require native float word order support']. capabilitiesBits := capabilitiesBits bitAt: SpurObjectBit put: 0]. "add additional capability bit handling here" capabilitiesBits == 0 ifFalse: [self error: 'invalid format number ', anInteger printString] ! ----- Method: ImageFormat>>hash (in category 'comparing') ----- hash ^self asInteger hash! ----- Method: ImageFormat>>initialize (in category 'initialize-release') ----- initialize requiresClosureSupport := false. requiresNativeFloatWordOrder := false. requiresSpurSupport := false. requiresNewSpur64TagAssignment := false.! ----- Method: ImageFormat>>is32Bit (in category 'testing') ----- is32Bit "True if the image uses 4 byte object memory words and 4 byte object pointers." ^wordSize = 4! ----- Method: ImageFormat>>is64Bit (in category 'testing') ----- is64Bit "True if the image uses 8 byte object memory words and 8 byte object pointers." ^wordSize = 8! ----- Method: ImageFormat>>isValidVersionNumber (in category 'private') ----- isValidVersionNumber "True if the version number uses a known base version number and does not use any reserved bits. Used only for unit tests, by definition this must always be true." ^(BaseVersionNumbers includes: self baseVersionBits) and: [(self asInteger bitAnd: ReservedBitsMask) = 0]! ----- Method: ImageFormat>>printDescriptionOn: (in category 'printing') ----- printDescriptionOn: stream " The classic squeak image, aka V3, is 32-bit with magic 6502. The first 64-bit Squeak image was generated from V3 image made by Dan Ingalls and Ian Piumarta in 2005. Later, the magic code was changed to 68000. After full closure support came to Squeak, the magic code changed to 6504 for 32-bit and 68002 for 64-bit images by setting a capability bit. Cog VM introduced a native order for floats under 6505 magic code. Its corresponding 64b code would have been 68003 but no such image was produced. Older Interpreter VMs would simply load 6505 by flipping word order back. Cog VM also introduced a new object layout for 64-bit images called Spur layout under a new magic code - 68021. A few images were also generated with 68019, but this magic is now considered obsolete and deprecated. " stream nextPutAll: 'a '; nextPutAll: (wordSize * 8) asString; nextPutAll: '-bit '; nextPutAll: (self requiresSpurSupport ifTrue: [ 'Spur' ] ifFalse: [ 'V3' ]); nextPutAll: ' image with '. self requiresClosureSupport ifFalse: [stream nextPutAll: 'no ']. stream nextPutAll: 'closure support and '. self requiresNativeFloatWordOrder ifTrue: [stream nextPutAll: 'float words stored in native platform order'] ifFalse: [stream nextPutAll: 'no native platform float word order requirement']. self requiresSpurSupport ifTrue: [stream nextPutAll: ' using Spur object format'. (self is64Bit and: [self requiresNewSpur64TagAssignment not]) ifTrue: [stream nextPutAll: ' (obsolete)']]. stream nextPutAll: ' ('; nextPutAll: self asInteger asString; nextPut: $). ^ stream ! ----- Method: ImageFormat>>printOn: (in category 'printing') ----- printOn: aStream aStream nextPutAll: 'ImageFormat fromInteger: ', self asInteger asString ! ----- Method: ImageFormat>>printTerseDescriptionOn: (in category 'printing') ----- printTerseDescriptionOn: stream "Shortened description as may be required for unix magic file entries" stream nextPutAll: self simpleName; nextPutAll: ' image '. self requiresClosureSupport ifTrue: [stream nextPutAll: '+C']. self requiresNativeFloatWordOrder ifTrue: [stream nextPutAll: '+NF']. self requiresNewSpur64TagAssignment ifTrue: [stream nextPutAll: '+Tag' ]. stream nextPutAll: ' (%d)'. ^ stream ! ----- Method: ImageFormat>>requiresClosureSupport (in category 'testing') ----- requiresClosureSupport "True if this image contains closure bytecodes that must be supported by the virtual machine." ^requiresClosureSupport! ----- Method: ImageFormat>>requiresNativeFloatWordOrder (in category 'testing') ----- requiresNativeFloatWordOrder "True if this image requires a Cog VM (stack VM possibly including a Cog jitter)" ^requiresNativeFloatWordOrder! ----- Method: ImageFormat>>requiresNewSpur64TagAssignment (in category 'testing') ----- requiresNewSpur64TagAssignment "True if this is a 64 bit Spur image with immediate tag assigments redefined as of VMMaker.oscog-eem.1722" ^requiresNewSpur64TagAssignment! ----- Method: ImageFormat>>requiresSpurSupport (in category 'testing') ----- requiresSpurSupport "True if this image uses the Spur object format." ^requiresSpurSupport! ----- Method: ImageFormat>>setClosureSupportRequirement: (in category 'initialize-release') ----- setClosureSupportRequirement: aBoolean "If true, the image expects the virtual machine to be able to provide support for closure bytecodes that are present in the image. If false, the image does not require this support, although the virtual machine is free to provide it." requiresClosureSupport := aBoolean ! ----- Method: ImageFormat>>setCogSupportRequirement: (in category 'initialize-release') ----- setCogSupportRequirement: aBoolean "If true, the image expects the virtual machine to be able to provide Cog support, either in the form of a Stack VM or a Cog VM. If false, the image does not require this support, although the virtual machine is free to provide it." aBoolean ifTrue: [requiresClosureSupport := true]. "required in all Cog images" self setNativeFloatWordOrderRequirement: aBoolean ! ----- Method: ImageFormat>>setNativeFloatWordOrderRequirement: (in category 'initialize-release') ----- setNativeFloatWordOrderRequirement: aBoolean "If true, certain objects are implemented in native platform word order. On a little endian platform, access to the two words of a 64 bit float object is more efficient if the words are stored in native word order. On a big endian platform, platform word order is the same as object memory word order and this setting has no effect. The StackInterpreter and Cog make use of this for performance reasons." requiresNativeFloatWordOrder := aBoolean ! ----- Method: ImageFormat>>setRequiresNewSpur64TagAssignmentRequirement: (in category 'initialize-release') ----- setRequiresNewSpur64TagAssignmentRequirement: aBoolean "Applicable only to 64-bit Spur images. If true, the updated tag assignment definitions are required. Earlier Spur 64 bit images use tag assignment for immediates that conflict with the Spur 32 bit image definition. " requiresNewSpur64TagAssignment := aBoolean ! ----- Method: ImageFormat>>setSpurSupportRequirement: (in category 'initialize-release') ----- setSpurSupportRequirement: aBoolean "If true, the image expects the virtual machine to be able to provide support for the Spur object format. If false, the image does not require this support, although the virtual machine is free to provide it." requiresSpurSupport := aBoolean ! ----- Method: ImageFormat>>simpleName (in category 'printing') ----- simpleName "Return a simple name for the format, suitable for use as filename or mimetype. (ImageFormat fromInteger: 6505) simpleName." ^String streamContents: [:s | self requiresSpurSupport ifTrue: [ s nextPutAll: 'spur'] ifFalse: [s nextPutAll: 'squeak']. self is64Bit ifTrue: [ s nextPutAll: '64']]! ----- Method: ImageFormat>>storeOn: (in category 'printing') ----- storeOn: aStream "Append to the argument aStream a sequence of characters that is an expression whose evaluation creates an object similar to the receiver." aStream nextPutAll: self class name; nextPutAll: ' fromInteger: '; nextPutAll: self asInteger asString! ----- Method: ImageFormat>>wordSize (in category 'accessing') ----- wordSize ^ wordSize! TestCase subclass: #ImageFileHeaderTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ImageFormat-Tests'! !ImageFileHeaderTest commentStamp: 'dtl 10/31/2012 20:26' prior: 0! ImageFileHeaderTest provides unit tests for ImageFileHeader and CogImageFileHeader. These tests verify conversion to and from disk file format for various word sizes, platform endianness, and image formats.! ----- Method: ImageFileHeaderTest>>sample6504HeaderData (in category 'running') ----- sample6504HeaderData "First 200 bytes of an image file saved by an interpreter VM, an ImageFileHeader for a 32-bit image with closure support and no native platform float word order requirement (6504)" ^#[104 25 0 0 64 0 0 0 4 127 88 8 16 0 0 0 196 175 67 5 175 67 0 0 151 3 160 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 209 143 131 0 5 0 0 30 89 145 131 0 5 0 160 24 149 144 131 0 5 0 12 23 15 129 56 0 140 122 24 0 12 22 0 0 4 1 0 0 36 49 132 0 0 50 188 26 88 198 24 0 3 0 0 0 8 197 24 0 3 0 0 0 64 188 24 0 3 0 0 0 88 188 24 0 3 0 0 0 76 188 24 0 3 0 0 0 52 188 24 0 3 0 0 0 72 124 24 0 3 0 0 0 112 129 24 0 3 0 0 0 36 199 24 0 3 0 0 0 100 199 24 0 3 0 0 0 132 197 24 0 3 0 0 0]! ----- Method: ImageFileHeaderTest>>sample6505HeaderData (in category 'running') ----- sample6505HeaderData "First 200 bytes of an image file saved by a Cog VM, an ImageFileHeader for a 32-bit image with closure support and float words stored in native platform order (6505)" ^#[105 25 0 0 64 0 0 0 28 181 88 8 0 224 70 183 180 143 138 188 71 229 231 47 151 3 160 4 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 193 111 202 183 5 0 0 30 73 113 202 183 5 0 160 24 133 112 202 183 5 0 12 23 15 129 56 0 124 90 95 183 252 245 70 183 4 1 0 0 20 17 203 183 0 50 188 26 72 166 95 183 3 0 0 0 248 164 95 183 3 0 0 0 48 156 95 183 3 0 0 0 72 156 95 183 3 0 0 0 60 156 95 183 3 0 0 0 36 156 95 183 3 0 0 0 56 92 95 183 3 0 0 0 96 97 95 183 3 0 0 0 20 167 95 183 3 0 0 0 84 167 95 183 3 0 0 0 116 165 95 183 3 0 0 0]! ----- Method: ImageFileHeaderTest>>sample68002HeaderData (in category 'running') ----- sample68002HeaderData "First 200 bytes of a 64-bit image file saved by an interpreter VM, an ImageFileHeader for a 64-bit image with closure support and no native platform float word order requirement (68002)" ^#[162 9 1 0 0 0 0 0 128 0 0 0 0 0 0 0 200 95 202 11 0 0 0 0 0 160 102 243 128 127 0 0 168 160 102 243 128 127 0 0 76 217 0 0 0 0 0 0 148 3 192 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 73 187 102 243 128 127 0 0 9 0 12 23 0 0 0 0 177 187 102 243 128 127 0 0 9 0 160 24 0 0 0 0 57 160 102 243 128 127 0 0 9 0 0 30 0 0 0 0 25 188 102 243 128 127 0 0 97 1 12 30 0 0 0 0 88 188 102 243 128 127 0 0]! ----- Method: ImageFileHeaderTest>>testAsByteArray (in category 'testing') ----- testAsByteArray "Read and write with data in all byte positions" | hdr ws b1 b2 | b1 := self sample6505HeaderData. hdr := ImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ByteArray new. hdr writeTo: ws littleEndian: true. b2 := ws contents. self assert: hdr asByteArray = b2.! ----- Method: ImageFileHeaderTest>>testCogStoreOn (in category 'testing') ----- testCogStoreOn "Read and write with data in all byte positions" | hdr ws b1 b2 hdr2 | b1 := ByteArray new: 64. b1 at: 1 put: 104; at: 2 put: 25; at: 3 put: 0; at: 4 put: 0. "a valid image format number" b1 at: 5 put: 64; at: 6 put: 0; at: 7 put: 0; at: 8 put: 0. "header size 64" 9 to: 64 do: [ :i | b1 at: i put: i ]. hdr := CogImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ''. hdr storeOn: ws. hdr2 := Compiler evaluate: ws contents. ws := WriteStream on: ByteArray new. hdr2 writeTo: ws littleEndian: true. b2 := ws contents. self assert: (b2 first: 46) = (b1 first: 46). self assert: (b2 last: (64 - 46)) asSet size = 1. "all zeros"! ----- Method: ImageFileHeaderTest>>testReadWrite64BitBigEndian (in category 'testing') ----- testReadWrite64BitBigEndian "Read and write with data in all byte positions" | hdr ws b1 b2 | b1 := ByteArray new: 128. #[0 0 0 0 0 1 9 162 0 0 0 0 0 0 0 128] withIndexDo: [ :e :i | b1 at: i put: e]. 17 to: 128 do: [ :i | b1 at: i put: i ]. hdr := ImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ByteArray new. hdr writeTo: ws littleEndian: false. b2 := ws contents. self assert: (b2 first: 72) = (b1 first: 72). self assert: (b2 last: (128 - 72)) asSet size = 1. "all zeros"! ----- Method: ImageFileHeaderTest>>testReadWrite64BitCogBigEndian (in category 'testing') ----- testReadWrite64BitCogBigEndian "Read and write with data in all byte positions" | hdr ws b1 b2 | b1 := ByteArray new: 128. #[0 0 0 0 0 1 9 162 0 0 0 0 0 0 0 128] withIndexDo: [ :e :i | b1 at: i put: e]. 17 to: 128 do: [ :i | b1 at: i put: i ]. hdr := CogImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ByteArray new. hdr writeTo: ws littleEndian: false. b2 := ws contents. self assert: (b2 first: 92) = (b1 first: 92). self assert: (b2 last: (128 - 92)) asSet size = 1. "all zeros"! ----- Method: ImageFileHeaderTest>>testReadWrite64BitCogLittleEndian (in category 'testing') ----- testReadWrite64BitCogLittleEndian "Read and write with data in all byte positions" | hdr ws b1 b2 | b1 := ByteArray new: 128. #[162 9 1 0 0 0 0 0 128 0 0 0 0 0 0 0] withIndexDo: [ :e :i | b1 at: i put: e]. 17 to: 128 do: [ :i | b1 at: i put: i ]. hdr := CogImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ByteArray new. hdr writeTo: ws littleEndian: true. b2 := ws contents. self assert: (b2 first: 92) = (b1 first: 92). self assert: (b2 last: (128 - 92)) asSet size = 1. "all zeros"! ----- Method: ImageFileHeaderTest>>testReadWrite64BitLittleEndian (in category 'testing') ----- testReadWrite64BitLittleEndian "Read and write with data in all byte positions" | hdr ws b1 b2 | b1 := ByteArray new: 128. #[162 9 1 0 0 0 0 0 128 0 0 0 0 0 0 0] withIndexDo: [ :e :i | b1 at: i put: e]. 17 to: 128 do: [ :i | b1 at: i put: i ]. hdr := ImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ByteArray new. hdr writeTo: ws littleEndian: true. b2 := ws contents. self assert: (b2 first: 72) = (b1 first: 72). self assert: (b2 last: (128 - 72)) asSet size = 1. "all zeros"! ----- Method: ImageFileHeaderTest>>testReadWriteBigEndian (in category 'testing') ----- testReadWriteBigEndian "Read and write with data in all byte positions" | hdr ws b1 b2 | b1 := ByteArray new: 64. b1 at: 4 put: 104; at: 3 put: 25; at: 2 put: 0; at: 1 put: 0. "a valid image format number" b1 at: 8 put: 64; at: 7 put: 0; at: 6 put: 0; at: 5 put: 0. "header size 64" 9 to: 64 do: [ :i | b1 at: i put: i ]. hdr := ImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ByteArray new. hdr writeTo: ws littleEndian: false. b2 := ws contents. self assert: (b2 first: 36) = (b1 first: 36). self assert: (b2 last: (64 - 36)) asSet size = 1. "all zeros"! ----- Method: ImageFileHeaderTest>>testReadWriteCogBigEndian (in category 'testing') ----- testReadWriteCogBigEndian "Read and write with data in all byte positions" | hdr ws b1 b2 | b1 := ByteArray new: 64. b1 at: 4 put: 104; at: 3 put: 25; at: 2 put: 0; at: 1 put: 0. "a valid image format number" b1 at: 8 put: 64; at: 7 put: 0; at: 6 put: 0; at: 5 put: 0. "header size 64" 9 to: 64 do: [ :i | b1 at: i put: i ]. hdr := CogImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ByteArray new. hdr writeTo: ws littleEndian: false. b2 := ws contents. self assert: (b2 first: 46) = (b1 first: 46). self assert: (b2 last: (64 - 46)) asSet size = 1. "all zeros"! ----- Method: ImageFileHeaderTest>>testReadWriteCogLittleEndian (in category 'testing') ----- testReadWriteCogLittleEndian "Read and write with data in all byte positions" | hdr ws b1 b2 | b1 := ByteArray new: 64. b1 at: 1 put: 104; at: 2 put: 25; at: 3 put: 0; at: 4 put: 0. "a valid image format number" b1 at: 5 put: 64; at: 6 put: 0; at: 7 put: 0; at: 8 put: 0. "header size 64" 9 to: 64 do: [ :i | b1 at: i put: i ]. hdr := CogImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ByteArray new. hdr writeTo: ws littleEndian: true. b2 := ws contents. self assert: (b2 first: 46) = (b1 first: 46). self assert: (b2 last: (64 - 46)) asSet size = 1. "all zeros"! ----- Method: ImageFileHeaderTest>>testReadWriteLittleEndian (in category 'testing') ----- testReadWriteLittleEndian "Read and write with data in all byte positions" | hdr ws b1 b2 | b1 := ByteArray new: 64. b1 at: 1 put: 104; at: 2 put: 25; at: 3 put: 0; at: 4 put: 0. "a valid image format number" b1 at: 5 put: 64; at: 6 put: 0; at: 7 put: 0; at: 8 put: 0. "header size 64" 9 to: 64 do: [ :i | b1 at: i put: i ]. hdr := ImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ByteArray new. hdr writeTo: ws littleEndian: true. b2 := ws contents. self assert: (b2 first: 36) = (b1 first: 36). self assert: (b2 last: (64 - 36)) asSet size = 1. "all zeros"! ----- Method: ImageFileHeaderTest>>testSample6504Header (in category 'testing') ----- testSample6504Header "Using data from a real file header, verify conversions" | hdr ws b1 b2 | b1 := self sample6504HeaderData. hdr := ImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ByteArray new. hdr writeTo: ws littleEndian: true. b2 := ws contents. self assert: b2 = (b1 first: 64).! ----- Method: ImageFileHeaderTest>>testSample6505Header (in category 'testing') ----- testSample6505Header "Using data from a real file header, verify conversions" | hdr ws b1 b2 | b1 := self sample6505HeaderData. hdr := ImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ByteArray new. hdr writeTo: ws littleEndian: true. b2 := ws contents. self assert: b2 = (b1 first: 64).! ----- Method: ImageFileHeaderTest>>testSample68002Header (in category 'testing') ----- testSample68002Header "Using data from a real file header, verify conversions" | hdr ws b1 b2 | b1 := self sample68002HeaderData. hdr := ImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ByteArray new. hdr writeTo: ws littleEndian: true. b2 := ws contents. self assert: b2 = (b1 first: 128).! ----- Method: ImageFileHeaderTest>>testStoreOn (in category 'testing') ----- testStoreOn "Read and write with data in all byte positions" | hdr ws b1 b2 hdr2 | b1 := ByteArray new: 64. b1 at: 1 put: 104; at: 2 put: 25; at: 3 put: 0; at: 4 put: 0. "a valid image format number" b1 at: 5 put: 64; at: 6 put: 0; at: 7 put: 0; at: 8 put: 0. "header size 64" 9 to: 64 do: [ :i | b1 at: i put: i ]. hdr := ImageFileHeader readFrom: (ReadStream on: b1). ws := WriteStream on: ''. hdr storeOn: ws. hdr2 := Compiler evaluate: ws contents. ws := WriteStream on: ByteArray new. hdr2 writeTo: ws littleEndian: true. b2 := ws contents. self assert: (b2 first: 36) = (b1 first: 36). self assert: (b2 last: (64 - 36)) asSet size = 1. "all zeros"! TestCase subclass: #ImageFormatTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ImageFormat-Tests'! !ImageFormatTest commentStamp: 'dtl 9/5/2010 13:41' prior: 0! Verify and document the values of ImageFormat. The image format is an integer value that identifies the format of an image snapshot and the capabilities that the image expects of the virtual machine.! ----- Method: ImageFormatTest>>testAsInteger (in category 'testing') ----- testAsInteger self assert: (ImageFormat fromInteger: 6502) asInteger = 6502. self assert: (ImageFormat fromInteger: 6504) asInteger = 6504. self assert: (ImageFormat fromInteger: 68000) asInteger = 68000. self assert: (ImageFormat fromInteger: 68002) asInteger = 68002. self assert: (ImageFormat fromInteger: 6521) asInteger = 6521. self assert: (ImageFormat fromInteger: 68019) asInteger = 68019. self assert: (ImageFormat fromInteger: 68021) asInteger = 68021. ! ----- Method: ImageFormatTest>>testBaseVersionBits (in category 'testing') ----- testBaseVersionBits self assert: ImageFormat baseVersionMask = 16r119EE. self assert: (ImageFormat wordSize: 4) baseVersionBits = 6502. self assert: (ImageFormat new fromInteger: 6504) baseVersionBits = 6504. self assert: (ImageFormat wordSize: 8) baseVersionBits = 68000. self assert: (ImageFormat new fromInteger: 68002) baseVersionBits = 68002. ! ----- Method: ImageFormatTest>>testBit17AsTestFor64BitImages (in category 'testing') ----- testBit17AsTestFor64BitImages "If bit 17 of the version number is 1, then the image is a 64-bit image." ImageFormat knownVersionNumbers do: [ :versionNumber | | is64 bit17 | is64 := (ImageFormat fromInteger: versionNumber) is64Bit. bit17 := versionNumber bitAt: 17. self assert: bit17 = 1 equals:is64 ]. ! ----- Method: ImageFormatTest>>testBitsInUse (in category 'testing') ----- testBitsInUse "Ensure that the list of known version numbers is kept up to date with the bit allocation" | allocatedBitsInUse calculatedBitsInUse | calculatedBitsInUse := ImageFormat knownVersionNumbers inject: 0 into: [ :e :a | a bitOr: e] . allocatedBitsInUse := ImageFormat baseVersionMask bitOr: ImageFormat capabilitiesBitsMask. self assert: calculatedBitsInUse = allocatedBitsInUse ! ----- Method: ImageFormatTest>>testDefaultImageFormats (in category 'testing') ----- testDefaultImageFormats "Original 32-bit image format, and the original 64-bit image format, prior to introduction of block closure support." self assert: (6502 = (ImageFormat wordSize: 4) asInteger). self assert: (68000 = (ImageFormat wordSize: 8) asInteger). self should: [ImageFormat wordSize: 0] raise: Error. self should: [ImageFormat wordSize: 12] raise: Error! ----- Method: ImageFormatTest>>testFormat6502 (in category 'testing') ----- testFormat6502 self assert: ImageFormat default asInteger = 6502. self assert: (ImageFormat wordSize: 4) asInteger = 6502. self assert: (ImageFormat wordSize: 4 closures: false) asInteger = 6502. self assert: (ImageFormat fromInteger: 6502) asInteger = 6502. self assert: ImageFormat default wordSize = 4. self deny: ImageFormat default requiresClosureSupport. self deny: ImageFormat default requiresNativeFloatWordOrder. self assert: ImageFormat default is32Bit. self deny: ImageFormat default is64Bit. self assert: (ImageFormat fromInteger: 6502) asInteger = 6502 ! ----- Method: ImageFormatTest>>testFormat6504 (in category 'testing') ----- testFormat6504 | defaultWithClosures | defaultWithClosures := ImageFormat default setClosureSupportRequirement: true. self assert: defaultWithClosures asInteger = 6504. self assert: (ImageFormat wordSize: 4 closures: true) asInteger = 6504. self assert: (ImageFormat fromInteger: 6504) asInteger = 6504. self assert: defaultWithClosures wordSize = 4. self assert: defaultWithClosures requiresClosureSupport. self deny: defaultWithClosures requiresNativeFloatWordOrder. self assert: defaultWithClosures is32Bit. self deny: defaultWithClosures is64Bit. self assert: (ImageFormat fromInteger: 6504) asInteger = 6504 ! ----- Method: ImageFormatTest>>testFormat6505 (in category 'testing') ----- testFormat6505 | cog32 | cog32 := ImageFormat default setCogSupportRequirement: true; setClosureSupportRequirement: true. self assert: cog32 asInteger = 6505. self assert: (ImageFormat wordSize: 4 cog: true) asInteger = 6505. self assert: (ImageFormat fromInteger: 6505) asInteger = 6505. self assert: cog32 wordSize = 4. self assert: cog32 requiresClosureSupport. self assert: cog32 requiresNativeFloatWordOrder. self assert: cog32 is32Bit. self deny: cog32 is64Bit. self assert: (ImageFormat fromInteger: 6505) asInteger = 6505! ----- Method: ImageFormatTest>>testFormat6521 (in category 'testing') ----- testFormat6521 | spur | spur := ImageFormat fromInteger: 6521. self assert: spur asInteger = 6521. self assert: (ImageFormat wordSize: 4 spur: true) asInteger = 6521. self assert: (ImageFormat fromInteger: 6521) asInteger = 6521. self assert: spur wordSize = 4. self assert: spur requiresClosureSupport. self assert: spur requiresNativeFloatWordOrder. self assert: spur is32Bit. self deny: spur is64Bit. self assert: spur requiresSpurSupport. self assert: (ImageFormat fromInteger: 6521) asInteger = 6521! ----- Method: ImageFormatTest>>testFormat68000 (in category 'testing') ----- testFormat68000 | closures64 | closures64 := ImageFormat wordSize: 8. self assert: closures64 asInteger = 68000. self assert: (ImageFormat wordSize: 8 closures: false) asInteger = 68000. self assert: (ImageFormat fromInteger: 68000) asInteger = 68000. self assert: closures64 wordSize = 8. self deny: closures64 requiresClosureSupport. self deny: closures64 requiresNativeFloatWordOrder. self deny: closures64 is32Bit. self assert: closures64 is64Bit. self assert: (ImageFormat fromInteger: 68000) asInteger = 68000 ! ----- Method: ImageFormatTest>>testFormat68002 (in category 'testing') ----- testFormat68002 | closures64 | closures64 := (ImageFormat wordSize: 8) setClosureSupportRequirement: true. self assert: closures64 asInteger = 68002. self assert: (ImageFormat wordSize: 8 closures: true) asInteger = 68002. self assert: (ImageFormat fromInteger: 68002) asInteger = 68002. self assert: closures64 wordSize = 8. self assert: closures64 requiresClosureSupport. self deny: closures64 requiresNativeFloatWordOrder. self deny: closures64 is32Bit. self assert: closures64 is64Bit. self assert: (ImageFormat fromInteger: 68002) asInteger = 68002! ----- Method: ImageFormatTest>>testFormat68003 (in category 'testing') ----- testFormat68003 | cog64 | cog64 := (ImageFormat wordSize: 8) setCogSupportRequirement: true. self assert: cog64 asInteger = 68003. self assert: (ImageFormat wordSize: 8 cog: true) asInteger = 68003. self assert: (ImageFormat fromInteger: 68003) asInteger = 68003. self assert: cog64 wordSize = 8. self assert: cog64 requiresClosureSupport. self assert: cog64 requiresNativeFloatWordOrder. self deny: cog64 is32Bit. self assert: cog64 is64Bit. self assert: (ImageFormat fromInteger: 68003) asInteger = 68003! ----- Method: ImageFormatTest>>testFormat68019 (in category 'testing') ----- testFormat68019 | spur | spur := ImageFormat fromInteger: 68019. self assert: spur asInteger = 68019. self assert: (ImageFormat wordSize: 8 spur: true requiresNewSpur64TagAssignment: false) asInteger = 68019. self assert: (ImageFormat fromInteger: 68019) asInteger = 68019. self assert: spur wordSize = 8. self assert: spur requiresClosureSupport. self assert: spur requiresNativeFloatWordOrder. self deny: spur is32Bit. self assert: spur is64Bit. self assert: spur requiresSpurSupport. self assert: (ImageFormat fromInteger: 68019) asInteger = 68019! ----- Method: ImageFormatTest>>testFormat68021 (in category 'testing') ----- testFormat68021 | spur | spur := ImageFormat fromInteger: 68021. self assert: spur asInteger = 68021. self assert: (ImageFormat wordSize: 8 spur: true) asInteger = 68021. self assert: (ImageFormat fromInteger: 68021) asInteger = 68021. self assert: spur wordSize = 8. self assert: spur requiresClosureSupport. self assert: spur requiresNativeFloatWordOrder. self deny: spur is32Bit. self assert: spur is64Bit. self assert: spur requiresSpurSupport. self assert: (ImageFormat fromInteger: 68021) asInteger = 68021! ----- Method: ImageFormatTest>>testIs32Bit (in category 'testing') ----- testIs32Bit self assert: (ImageFormat wordSize: 4) is32Bit. self assert: (ImageFormat new fromInteger: 6504) is32Bit. self deny: (ImageFormat wordSize: 8) is32Bit. self deny: (ImageFormat new fromInteger: 68002) is32Bit. self deny: (ImageFormat fromInteger: 6521) is64Bit. self assert: (ImageFormat new fromInteger: 68019) is64Bit. self assert: (ImageFormat new fromInteger: 68021) is64Bit. ! ----- Method: ImageFormatTest>>testIs64Bit (in category 'testing') ----- testIs64Bit self deny: (ImageFormat wordSize: 4) is64Bit. self deny: (ImageFormat new fromInteger: 6504) is64Bit. self assert: (ImageFormat wordSize: 8) is64Bit. self assert: (ImageFormat new fromInteger: 68002) is64Bit. self deny: (ImageFormat fromInteger: 6521) is64Bit. self assert: (ImageFormat new fromInteger: 68019) is64Bit. self assert: (ImageFormat new fromInteger: 68021) is64Bit. ! ----- Method: ImageFormatTest>>testIsValidVersionNumber (in category 'testing') ----- testIsValidVersionNumber self should: [ImageFormat fromInteger: 0] raise: Error. self should: [ImageFormat fromInteger: (6502 bitAnd: 16r80000000)] raise: Error. self should: [ImageFormat fromInteger: (6502 bitAt: 31 put: 1)] raise: Error. self should: [ImageFormat fromInteger: 6500] raise: Error. self should: [ImageFormat fromInteger: 6501] raise: Error. self should: [ImageFormat fromInteger: 6503] raise: Error. "Cog requires both capabilities" self should: [ImageFormat fromInteger: 68001] raise: Error. "Cog requires both capabilities" self assert: ImageFormat default isValidVersionNumber. self assert: (ImageFormat wordSize: 4 closures: false) isValidVersionNumber. self assert: (ImageFormat wordSize: 4 closures: true) isValidVersionNumber. self assert: (ImageFormat wordSize: 8 closures: false) isValidVersionNumber. self assert: (ImageFormat wordSize: 8 closures: true) isValidVersionNumber. self assert: (ImageFormat fromInteger: 6502) isValidVersionNumber. self assert: (ImageFormat fromInteger: (6502 bitAt: 31 put: 0)) isValidVersionNumber. self assert: (ImageFormat fromInteger: 6521) isValidVersionNumber. self assert: (ImageFormat fromInteger:68000) isValidVersionNumber. self assert: (ImageFormat fromInteger:68002) isValidVersionNumber. self assert: (ImageFormat fromInteger:68004) isValidVersionNumber. self assert: (ImageFormat fromInteger:68003) isValidVersionNumber. "valid but unused, as with 68019" self assert: (ImageFormat fromInteger: 68019) isValidVersionNumber. self assert: (ImageFormat fromInteger: 68021) isValidVersionNumber. ! ----- Method: ImageFormatTest>>testRequiresClosureSupport (in category 'testing') ----- testRequiresClosureSupport | v | v := ImageFormat wordSize: 4. self deny: v requiresClosureSupport. v setClosureSupportRequirement: false. self assert: v asInteger = 6502. self deny: v requiresClosureSupport. v setClosureSupportRequirement: true. self assert: v asInteger = 6504. self assert: v requiresClosureSupport. v := ImageFormat wordSize: 8. self deny: v requiresClosureSupport. v setClosureSupportRequirement: false. self assert: v asInteger = 68000. self deny: v requiresClosureSupport. v setClosureSupportRequirement: true. self assert: v asInteger = 68002. self assert: v requiresClosureSupport. self deny: (ImageFormat wordSize: 4 closures: false) requiresClosureSupport. self assert: (ImageFormat wordSize: 4 closures: true) requiresClosureSupport. self deny: (ImageFormat wordSize: 8 closures: false) requiresClosureSupport. self assert: (ImageFormat wordSize: 8 closures: true) requiresClosureSupport. ! ----- Method: ImageFormatTest>>testRequiresNativeFloatWordOrder (in category 'testing') ----- testRequiresNativeFloatWordOrder "Required for Cog and StackInterpreter" | v | v := ImageFormat wordSize: 4. self deny: v requiresNativeFloatWordOrder. v setCogSupportRequirement: false. self assert: v asInteger = 6502. self deny: v requiresNativeFloatWordOrder. v setCogSupportRequirement: true. self assert: v asInteger = 6505. self assert: v requiresNativeFloatWordOrder. v setSpurSupportRequirement: true. self assert: v asInteger = 6521. v := ImageFormat wordSize: 8. self deny: v requiresNativeFloatWordOrder. v setCogSupportRequirement: false. self assert: v asInteger = 68000. self deny: v requiresNativeFloatWordOrder. v setCogSupportRequirement: true. self assert: v asInteger = 68003. self assert: v requiresNativeFloatWordOrder. v setSpurSupportRequirement: true. self assert: v asInteger = 68019. self deny: (ImageFormat wordSize: 4 cog: false) requiresNativeFloatWordOrder. self deny: (ImageFormat wordSize: 4 cog: false) requiresClosureSupport. self deny: (ImageFormat wordSize: 8 cog: false) requiresNativeFloatWordOrder. self deny: (ImageFormat wordSize: 8 cog: false) requiresClosureSupport. self assert: (ImageFormat wordSize: 4 cog: true) requiresNativeFloatWordOrder. self assert: (ImageFormat wordSize: 4 cog: true) requiresClosureSupport. self assert: (ImageFormat wordSize: 8 cog: true) requiresNativeFloatWordOrder. self assert: (ImageFormat wordSize: 8 cog: true) requiresClosureSupport. self assert: (ImageFormat fromInteger: 6521) requiresNativeFloatWordOrder. self assert: (ImageFormat fromInteger: 6521) requiresClosureSupport. self assert: (ImageFormat fromInteger: 68019) requiresNativeFloatWordOrder. self assert: (ImageFormat fromInteger: 68019) requiresClosureSupport. self assert: (ImageFormat fromInteger: 68021) requiresNativeFloatWordOrder. self assert: (ImageFormat fromInteger: 68021) requiresClosureSupport. !

2 3

VM Maker: ImageFormat-kks.34.mcz
by commits＠source.squeak.org 10 Apr '19

10 Apr '19

David T. Lewis uploaded a new version of ImageFormat to project VM Maker: http://source.squeak.org/VMMaker/ImageFormat-kks.34.mcz ==================== Summary ==================== Name: ImageFormat-kks.34 Author: kks Time: 10 April 2019, 10:43:56.983339 pm UUID: b6d8d060-b305-437e-93b7-68e5427a76e0 Ancestors: ImageFormat-dtl.33 Added support for images whose header begins 512 bytes into the file. Expanded comments to explain magic file use. =============== Diff against ImageFormat-dtl.33 =============== Item was changed: ----- Method: ImageFormat class>>unixMagicFileEntries (in category 'unix magic file entries') ----- unixMagicFileEntries + "Answer a string that can be appended to /etc/magic on a Unix system to support the file(1) utility. + For example, the file magic produced by + (FileStream newFileNamed: 'magic') in: [:fs | + [fs nextPutAll: ImageFormat unixMagicFileEntries ] ensure: [ fs close ]] + can be appended to $HOME/.magic and then + $ file squeak.image pharo.image ... + will describe the given image files precisely" - "Answer a string that can be appended to /etc/magic on a Unix system to support the file(1) utility" - "ImageFormat unixMagicFileEntries" - - " | fs | - fs := FileStream newFileNamed: 'magic'. - [ fs nextPutAll: ImageFormat unixMagicFileEntries ] - ensure: [ fs close ] " - ^String streamContents: [:s | s nextPutAll: '# Smalltalk image file formats'; lf. KnownVersionNumbers do: [ :num | | fmt | #( 'le' 'be' ) do: [ :endian | + #(0 512) do: [ :offset | + fmt := self fromInteger: num. + (fmt is64Bit and: [ endian = 'be' ]) + ifTrue: [ s nextPutAll: (offset+4) asString ] + ifFalse: [ s nextPutAll: offset asString ]. + s tab; + nextPutAll: endian; + nextPutAll: 'long'; + tab; + nextPutAll: num asString; + tab; + nextPutAll: 'Smalltalk '. + fmt printTerseDescriptionOn: s. + s lf. + s nextPutAll: '!!:mime application/'; + nextPutAll: fmt simpleName; + nextPutAll: '-image'; + lf + ] - fmt := self fromInteger: num. - (fmt is64Bit and: [ endian = 'be' ]) - ifTrue: [ s nextPut: $4 ] - ifFalse: [ s nextPut: $0 ]. - s tab; - nextPutAll: endian; - nextPutAll: 'long'; - tab; - nextPutAll: num asString; - tab; - nextPutAll: 'Smalltalk '. - fmt printTerseDescriptionOn: s. - s lf. - s nextPutAll: '!!:mime application/'; - nextPutAll: fmt simpleName; - nextPutAll: '-image'; - lf ] ]. s lf. ]!

1 0

SmallIntPair as immediate word
by K K Subbu 10 Apr '19

10 Apr '19

All, Squeak release image contains around 15k Points with none using more than 24 bits per coordinate. On 64-bit machines, it should be possible to pack two integers of a pair into a single immediate word - 30+30. Has anyone tried to do this? It would save space and eliminate object alloc. But I am not sure about the overall performance hit. Regards .. Subbu

4 5

Re: [Vm-dev] [Pharo-users] ARM vm limitations ?
by Mariano Martinez Peck 09 Apr '19

09 Apr '19

On Mon, Mar 18, 2019 at 8:26 AM Albrecht Baur via Pharo-users < pharo-users(a)lists.pharo.org> wrote: > Hi, I'd like to play around with pharo on ARM devices (like a > HummingBoard, the ones from ODROID or one of the beagleboards). But I am > not sure if I have to take care of the ARM architecture version (ARMv6 / > ARMv7 / ARMv8) when choosing my toy. > > I found this vm: > http://files.pharo.org/vm/pharo-spur32/linux/armv6/ > Is it only for armv6 like the folder name says or is ARMv7 and ARMv8 > working too? > > Are there any limitations I should know before choosing a ARM device? > > Is there a vm for 64bit (aarch64)? > Hi Albrecht, I am also interested in this answer. In general, I am interested in IoT support for Smalltalk. The only thing I found aside from ARMv6 is this: https://github.com/OpenSmalltalk/opensmalltalk-vm/tree/Cog/build.linux32ARM… But I don't know what's the status of it. You may have more chances to get an answer with the vm list: <vm-dev(a)lists.squeakfoundation.org> Or maybe Pharo dev list. Cheers, -- Mariano Martinez Peck Email: marianopeck(a)gmail.com Twitter: @MartinezPeck LinkedIn: https://www.linkedin.com/in/mariano-mart%C3%ADnez-peck/

1 0

tempVectors use case and current issues
by Denis Kudriashov 08 Apr '19

08 Apr '19

Hi. I found interesting case where tempVectors can be used in remote scenarios. The store into remote temp can be really remote (not just about outer context). I played with following example: | temp | temp := 10. remote evaluate: [temp := temp + 1]. temp. For the moment forget about remote thing and look into it as a normal local case: temp var here is managed indirectly through tempVector. You can see it using expression after first assignment: thisContext at: 1 "=>#(10)" So the value in fact is stored in the array instance and read from it. But because of optimization it happens out of the array control. No #at: and #at:put: messages are sent during this code. VM magically changes the state of this array (there are special bytecodes for this). Now my remote use case. Imagine that vm actually sends #at: and #at:put: messages to tempVector. Then remoting engine can transfer temp vector (as part of context) as a proxy. So on remote side the block [temp := temp + 1] will actually ask the sender (client) for the value and for the storage. So all block semantics will be supported. Temp in remote outer context will be modified. I think it would be super cool if such transparency would be possible. I played with this example using Seamless in Pharo. It already works in the way I described but due to VM optimization it does not provide expected behavior. And worse than that it actually corrupts transferred proxy because in place of array the proxy instance is materialized. This leads us to the issue with safety of tempVector operations. Following example shows how we can affect the state of tempVector using reflection: | temp | temp := 10. (thisContext at: 1) at: 1 put: 50. [temp := temp + 1] value. temp. "==>51" It is cool that we can do it. But there is no any safety check in the VM level over tempVector object: | temp | temp := 10. thisContext at: 1 put: Object new. [temp := temp + 1] value. temp. It breaks with DNU: #+ is sent to nil. Temp became nil. | temp | temp := 10. thisContext at: 1 put: #() copy. [temp := temp + 1] value. temp. Sometimes it breaks with same error. Sometimes it returns random number. I guess in these cases VM breaks memory boundary of tempVector. And two exotic cases: | temp | temp := 10. (thisContext at: 1) beReadOnlyObject. [temp := temp + 1] value. temp. It silently return 11. It does not break read only protection. But no error is signalled. | temp | temp := 10. (thisContext at: 1) become: #() copy. [temp := temp + 1] value. temp. It returns #(). (In Pharo #() + 1 = #() ). I use become to check how forwarding is working in that case. (it works fine when array has correct size) How we can improve this behavior? How it would effect performance? My proposal is to send real messages to tempVector when it is not an array instance. Then image will decide what to do. Best regards, Denis

5 10

Alien/FFI issue with large struct passed as value and how to load vmmaker?
by Holger Freyther 04 Apr '19

04 Apr '19

Hi, Sorry if this sounds ignorant but I am not sure how to do this with Opensmalltalk VM. How do I get a working VMMaker loaded into a Pharo image these days? It was quite simple in the pharo-vm days but now I am not even sure where to start looking? I want to debug a FFI problem I see with Ben's clang-c bindings. I get a callback from C with three arguments and one of them is of type CXCursor (it needs to be passed on the stack): struct CXCursor { int enum void *ptr[3]; }; It's represented as FFIExternalStructure subclass: #CXCursor. In the case of the callback the handle is an instance of FFIExternalStructureReferenceHandle with an Alien embedded into it. I am trying to understand if the bug is on handling the callback when the CXCursor is created or when trying to push it onto the stack when making a call. The memory on the stack is turned into an Alien. And Alien>>#referenceStructAt:length: doesn't return a ByteArray but the FFIExternalStructureReferenceHandle with the Alien in it. At the same time I think FFIPlugin>>#ffiPushStructureContentsOf: doesn't seem to deal with FFIExternalStructureReferencehandle (or handle being an Alien). Or do I chase it from the wrong end? cheers holger

3 5

FFIExternalStructureReferenceHandle and pushing it to the stack
by Holger Freyther 04 Apr '19

04 Apr '19

In addition to my mail from yesterday to vm-dev I want to share the following example to illustrate the problem. I have taken StructA and StructNested from the FFIExternalStructureReferenceHandle class comment and put it into Unclassified.st that is attached to this mail. I am also making a call to LibC's getpid and try to push StructNested to the stack. The ffiCall is failing before getpid is called (Bad argument to external function). The reproducer is: StructA new theNest anyCall. StructA has a ByteArray handle of the full struct. theNest returns an instance of StructNested with a FFIExternalStructureReferenceHandle. This makes sense as well. It can't be a copy of the ByteArray (or else updates would be invisible to the outer struct) and it can't be an ExternalAddress as StructA's handle might move in the Smalltalk heap. I am not entirely sure how this is should work but what do you think of: 1st) Extending ExternalStructure class comment to list FFIExternalStructureReferenceHandle as possible handle type? I think we would only describe the reality. 2nd) ThreadedFFIPlugin>>#ffiPushStructureContentsOf: should be aware of FFIExternalStructureReferenceHandle and know how to reach the handle. Or should there be something in the image converting this to a ByteArray when being pushed as value in a ffiCall? comments/ideas?

2 4

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev April 2019