[squeak-dev] The Trunk: System-eem.984.mczcommits at source.squeak.org commits at source.squeak.orgFri Dec 15 20:20:49 UTC 2017
Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.984.mcz ==================== Summary ==================== Name: System-eem.984 Author: eem Time: 15 December 2017, 12:20:37.361387 pm UUID: d83e303e-6de0-4579-8931-2fa6d97999b0 Ancestors: System-eem.983 Support for loading Spur projects between 32-bit and 64-bit versions, closely following Bert's legacy ImageSegmentLoader scheme. While one can load projects one gets an error due to method trailers. I'm not sure what the right thing to do is. I don't think it's the Spur image segment loader's job to nil trailer bytes in loaded compiled methods. So I'm comitting and will discuss with others as to where the right point to nil trailers on project loading is. =============== Diff against System-eem.983 =============== Item was changed: ----- Method: NativeImageSegment>>loadSegmentFrom:outPointers: (in category 'read/write segment primitives') ----- loadSegmentFrom: segmentWordArray outPointers: outPointerArray "Load segmentWordArray into the memory. Adapt the primitive to the new API, which is to answer the array of loaded objects, the first of which should be the array of roots. The primitive will install a binary image segment and return as its value the array of roots of the tree of objects represented. Upon successful completion, the + wordArray will have been becomed into anArray of the loaded objects. So simply answer the segmentWordArray which will have becommed." - wordArray will have been becomed into anArray of the loaded objects. So simply answer the segmentWordArray which will have becommed ." + | segmentFormat | + segmentFormat := segmentWordArray first bitAnd: 16rFFFFFF. + segmentFormat = Smalltalk imageFormatVersion ifTrue: + [^(self primitiveLoadSegmentFrom: segmentWordArray outPointers: outPointerArray) + ifNil: [self error: 'segment load failed'] + ifNotNil: [segmentWordArray]]. + segmentFormat >= 68000 + ifTrue: + [Smalltalk wordSize = 4 ifTrue: + [^(Spur64BitImageSegmentLoader new loadSegmentFrom: segmentWordArray outPointers: outPointerArray)]] + ifFalse: + [Smalltalk wordSize = 8 ifTrue: + [^(Spur32BitImageSegmentLoader new loadSegmentFrom: segmentWordArray outPointers: outPointerArray)]]. + self error: 'segment version unrecognized'! - ^(self primitiveLoadSegmentFrom: segmentWordArray outPointers: outPointerArray) - ifNil: [self error: 'segment load failed'] - ifNotNil: [segmentWordArray]! Item was added: + SpurImageSegmentLoader subclass: #Spur32BitImageSegmentLoader + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'System-Object Storage'! Item was added: + ----- Method: Spur32BitImageSegmentLoader>>allocateCompiledCode:size: (in category 'reading') ----- + allocateCompiledCode: class size: nBytes + "Allocate a CompiledCode object. nBytes must be reduced + by the number of objects in the method (header and literals)." + | header delta | + class isCompiledMethodClass ifFalse: + [self error: 'compiled code class expected']. + header := self readOop. + delta := (header bitAnd: 32767) + 1 * 8. + ^class newMethod: nBytes - delta header: header! Item was added: + ----- Method: Spur32BitImageSegmentLoader>>readObject (in category 'reading') ----- + readObject + "Read the header and the class of the object, instantiate it, and store it in oopMap at its oop." + | headerLo headerHi oop numSlots classIndex format rawNumSlots | + "the oop is the address of the two byte header (which follows the overflow size word, if there is one)." + oop := position - 8. "compensate for 64-bit version stamp" + headerLo := self readUint32. + headerHi := self readUint32. + rawNumSlots := headerHi bitShift: -24. + rawNumSlots = 255 + ifTrue: "128-bit header; overflow slots in least significant 32 bits of first 64-bit header word" + [numSlots := headerLo. + oop := position - 8. "compensate for 64-bit version stamp" + headerLo := self readUint32. + headerHi := self readUint32] + ifFalse: "64-bit header" + [numSlots := rawNumSlots]. + "N.B. The format field is a 5 bit field, but immediately above it is the + remembered bit which is used to mark classes is the segment." + self checkValidFormat: (format := (headerLo bitShift: -24) bitAnd: 63). + classIndex := headerLo bitAnd: 16r3FFFFF. + ^[oopMap at: oop ifAbsentPut: + [self allocateObject: format classIndex: classIndex slots: numSlots]] + ensure: "Spur objects have at least one slot and are rounded up to a multiple of 64-bits/8 bytes in length" + [position := oop + 16 + ((numSlots max: 1) + 1 // 2 * 8)]! Item was added: + ----- Method: Spur32BitImageSegmentLoader>>readOop (in category 'reading') ----- + readOop + "Read an oop and map it to an object: + - The oop may be immediate in which case its tag indicates its class and the remeaining bits its value. + - the oop may have its top bit set in which case it is an index into the outPointers + - otherwise the oop is a byte offset from the start of the first object in the segment and is in oopMap" + | oop topBit | + oop := self readUint32. + topBit := oop bitShift: -31. + ^(oop bitAnd: 3) caseOf: { + [0] -> [topBit = 1 + ifTrue: [outPointers at: oop - 16r80000000 / 8 + 1] + ifFalse: [oopMap at: oop]]. + [1] -> [(oop bitShift: -1) - (topBit = 1 ifTrue: [16r80000000] ifFalse: [0])]. + [3] -> [(oop bitShift: -1) - (topBit = 1 ifTrue: [16r80000000] ifFalse: [0])]. + [2] -> [Character value: (oop bitShift: -2)]}! Item was added: + ----- Method: Spur32BitImageSegmentLoader>>validImageSegmentVersion: (in category 'private') ----- + validImageSegmentVersion: threeByteInteger + ^threeByteInteger = 6521! Item was added: + SpurImageSegmentLoader subclass: #Spur64BitImageSegmentLoader + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'System-Object Storage'! Item was added: + ----- Method: Spur64BitImageSegmentLoader>>allocateCompiledCode:size: (in category 'reading') ----- + allocateCompiledCode: class size: nBytes + "Allocate a CompiledCode object. nBytes must be reduced + by the number of objects in the method (header and literals)." + | header delta | + class isCompiledMethodClass ifFalse: + [self error: 'compiled code class expected']. + header := self readOop. + delta := (header bitAnd: 32767) + 1 * 8. + ^class newMethod: nBytes - delta header: header! Item was added: + ----- Method: Spur64BitImageSegmentLoader>>readObject (in category 'reading') ----- + readObject + "Read the header and the class of the object, instantiate it, and store it in oopMap at its oop." + | headerLo headerHi oop numSlots classIndex format rawNumSlots | + "the oop is the address of the two byte header (which follows the overflow size word, if there is one)." + oop := position - 8. "compensate for 64-bit version stamp" + oop = 1390072 ifTrue: [self halt]. + headerLo := self readUint32. + headerHi := self readUint32. + rawNumSlots := headerHi bitShift: -24. + rawNumSlots = 255 + ifTrue: "128-bit header; overflow slots in least significant 32 bits of first 64-bit header word" + [numSlots := headerLo. + oop := position - 8. "compensate for 64-bit version stamp" + headerLo := self readUint32. + headerHi := self readUint32] + ifFalse: "64-bit header" + [numSlots := rawNumSlots]. + "N.B. The format field is a 5 bit field, but immediately above it is the + remembered bit which is used to mark classes is the segment." + self checkValidFormat: (format := (headerLo bitShift: -24) bitAnd: 63). + classIndex := headerLo bitAnd: 16r3FFFFF. + ^[oopMap at: oop ifAbsentPut: + [self allocateObject: format classIndex: classIndex slots: numSlots]] + ensure: "Spur objects have at least one slot" + [position := oop + 16 + ((numSlots max: 1) * 8)]! Item was added: + ----- Method: Spur64BitImageSegmentLoader>>readOop (in category 'reading') ----- + readOop + "Read an oop and map it to an object: + - The oop may be immediate in which case its tag indicates its class and the remeaining bits its value. + - the oop may have its top bit set in which case it is an index into the outPointers + - otherwise the oop is a byte offset from the start of the first object in the segment and is in oopMap. + The method is written to avoid large integer arithmetic as much as possible." + | lo hi topBit oop | + lo := self readUint32. + hi := self readUint32. + topBit := hi bitShift: -31. + ^(lo bitAnd: 7) caseOf: { + [0] -> [topBit = 1 + ifTrue: + [oop := (hi - 16r80000000 bitShift: 32) + lo. + outPointers at: oop / 8 + 1] + ifFalse: + [oop := (hi bitShift: 32) + lo. + oopMap at: oop]]. + [1] -> [(lo bitShift: -3) bitOr: (hi - (topBit = 1 ifTrue: [16r100000000] ifFalse: [0]) bitShift: 29)]. + [2] -> [Character value: ((lo bitShift: -3) bitOr: (hi bitShift: 29))]. + [4] -> [(hi = 0 and: [lo <= 15]) "+ve & -ve zero" + ifTrue: [lo <= 7 ifTrue: [0.0] ifFalse: [-0.0]] + ifFalse: "convert lo: | tag | sign | mantissa low 28 bits | hi: | mantissa high 24 bits | exponent - 896 | + to hi: | mantissa high 20 bits | exponent 11 bits | sign | lo: | mantissa low 32 bits |" + [^(BoxedFloat64 basicNew: 2) + basicAt: 1 put: ((lo bitAnd: 8) bitShift: 28) + ((hi bitShift: -4) + (896 bitShift: 20)); + basicAt: 2 put: (lo bitShift: -4) + ((hi bitAnd: 15) bitShift: 28); + * 1.0]]} + otherwise: [self error: 'unrecognized tag pattern']! Item was added: + ----- Method: Spur64BitImageSegmentLoader>>validImageSegmentVersion: (in category 'private') ----- + validImageSegmentVersion: threeByteInteger + ^threeByteInteger = 68021! Item was added: + Object subclass: #SpurImageSegmentLoader + instanceVariableNames: 'segment outPointers oopMap position' + classVariableNames: 'TopHashBit' + poolDictionaries: '' + category: 'System-Object Storage'! + + !SpurImageSegmentLoader commentStamp: 'eem 12/15/2017 11:20' prior: 0! + SpurImageSegmentLoader is the abstract class for loaders of 32-bit and 64-bit Spur image segments. The VM has both storing and loading primitives and the store primitive is always used. The load primitive is used when the word size of the current system matches that of the stored segment (orf the word size of the system in which the segment was stored). A word on encoding. The keys in oopMap are byte positions of the start of the object, offset by the 64-bit version stamp. So the first object, which has oop 0, is in the map at 0, and corresponds to index 3 in the segment data. + + position starts at zero and readUInt32 increments position by 4 before using uint32At: to access segment. Hence the first access via readUInt32 is of index 1 in segment data. Later on position is reset to 8 bytes beyond the oop to access the data. + + Instance Variables + oopMap: <Dictionary of: oop (Integer) -> object> + outPointers: <Array> + position: <Integer> + segment: <WordArrayForSegment> + + oopMap + - the map from the oop of an object to the object with that oop + + outPointers + - the array of imported objects, objects not in the segment but referred to by the segment + + position + - the current position when parsing the segment + + segment + - the segment data, which starts with 64-bits of version stamp, so the first object starts at index 3, and has oop 0. + ! Item was added: + ----- Method: SpurImageSegmentLoader>>allocate16BitObject:size: (in category 'reading') ----- + allocate16BitObject: class size: nShorts + (class isBits and: [class isShorts]) ifFalse: + [self error: 'shorts class expected']. + ^class basicNew: nShorts! Item was added: + ----- Method: SpurImageSegmentLoader>>allocate32BitObject:size: (in category 'reading') ----- + allocate32BitObject: class size: nWords + (class isBits and: [class isWords]) ifFalse: + [self error: 'words class expected']. + ^class basicNew: nWords! Item was added: + ----- Method: SpurImageSegmentLoader>>allocate64BitObject:size: (in category 'reading') ----- + allocate64BitObject: class size: nLongs + (class isBits and: [class isLongs]) ifFalse: + [self error: 'longs class expected']. + ^class basicNew: nLongs! Item was added: + ----- Method: SpurImageSegmentLoader>>allocate8BitObject:size: (in category 'reading') ----- + allocate8BitObject: class size: nBytes + class isBytes ifFalse: + [self error: 'bytes class expected']. + ^class basicNew: nBytes! Item was added: + ----- Method: SpurImageSegmentLoader>>allocateCompiledCode:size: (in category 'reading') ----- + allocateCompiledCode: class size: nBytes + "Allocate a CompiledCode object. nBytes must be reduced + by the number of objects in the method (header and literals)." + self subclassResponsibility! Item was added: + ----- Method: SpurImageSegmentLoader>>allocateFixedAndVariableObject:size: (in category 'reading') ----- + allocateFixedAndVariableObject: class size: nSlots + (class isPointers and: [class isVariable]) ifFalse: + [self error: 'variable pointers class expected']. + ^class basicNew: nSlots - class instSize! Item was added: + ----- Method: SpurImageSegmentLoader>>allocateFixedSizeObject:size: (in category 'reading') ----- + allocateFixedSizeObject: class size: instSize + (class isPointers and: [class isFixed]) ifFalse: + [self error: 'fixed pointers class expected']. + class instSize = instSize ifFalse: [self halt]. + ^class basicNew! Item was added: + ----- Method: SpurImageSegmentLoader>>allocateObject:classIndex:slots: (in category 'reading') ----- + allocateObject: format classIndex: classIndex slots: numSlots + | class | + class := (self classIndexInOutPointers: classIndex) + ifTrue: [outPointers at: (self outPointerIndexForClassIndex: classIndex)] + ifFalse: [oopMap at: (self oopIndexForClassIndex: classIndex)]. + (format <= 1 or: [format = 5"ephemerons"]) ifTrue: + [^self allocateFixedSizeObject: class size: numSlots]. + format = 2 ifTrue: + [^self allocateVariableSizeObject: class size: numSlots]. + (format between: 3 and: 4) ifTrue: + [^self allocateFixedAndVariableObject: class size: numSlots]. + format >= 16 ifTrue: + [| nBytes | + nBytes := numSlots * 8 - (format bitAnd: 7). + format >= 24 ifTrue: + [^self allocateCompiledCode: class size: nBytes]. + ^self allocate8BitObject: class size: nBytes]. + format >= 12 ifTrue: + [| nShorts | + nShorts := numSlots * 4 - (format bitAnd: 3). + ^self allocate16BitObject: class size: nShorts]. + format >= 10 ifTrue: + [| nWords | + nWords := numSlots * 2 - (format bitAnd: 1). + ^self allocate32BitObject: class size: nWords]. + format = 9 ifTrue: + [^self allocate64BitObject: class size: numSlots]. + format = 33 ifTrue: + [^self allocateAndPartFillClassObject: class size: numSlots]. + self error: 'Unknown object format'! Item was added: + ----- Method: SpurImageSegmentLoader>>allocateVariableSizeObject:size: (in category 'reading') ----- + allocateVariableSizeObject: class size: numSlots + (class isPointers and: [class isVariable]) ifFalse: + [self error: 'variable pointers class expected']. + ^class basicNew: numSlots! Item was added: + ----- Method: SpurImageSegmentLoader>>checkValidFormat: (in category 'private') ----- + checkValidFormat: formatPlusRememberedBit + "valid formats: + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 unused, reserved for exotic pointer objects? + 7 Forwarded Object, 1st field is pointer, rest of fields are ignored + 8 unused, reserved for exotic non-pointer objects? + 9 64-bit indexable + 10 - 11 32-bit indexable (11 unused in 32 bits) + 12 - 15 16-bit indexable (14 & 15 unused in 32-bits) + 16 - 23 byte indexable (20-23 unused in 32-bits) + 24 - 31 compiled method (28-31 unused in 32-bits)" + self assert: (formatPlusRememberedBit between: 6 and: 8) not. + self assert: (formatPlusRememberedBit < 32 + or: [formatPlusRememberedBit = 33 "classes are non-indexable"])! Item was added: + ----- Method: SpurImageSegmentLoader>>classIndexInOutPointers: (in category 'private') ----- + classIndexInOutPointers: classIndex + "If the top bit of a classIndex is set it is that of a class imported from outPointers" + ^classIndex anyMask: 16r200000! Item was added: + ----- Method: SpurImageSegmentLoader>>fillBytes:oop: (in category 'filling') ----- + fillBytes: object oop: oop + | word | + word := self readUint32. + 1 to: object basicSize do: + [:i | object basicAt: i put: (word bitAnd: 16rFF). + word := (i bitAnd: 3) = 0 + ifTrue: [self readUint32] + ifFalse: [word >> 8]]. + ^object! Item was added: + ----- Method: SpurImageSegmentLoader>>fillCompiledCode:oop: (in category 'filling') ----- + fillCompiledCode: codeObject oop: oop + | header startMinusOne numBytes word | + header := self readOop. + 1 to: codeObject numLiterals do: + [:i | codeObject literalAt: i put: self readOop]. + startMinusOne := codeObject initialPC - 1. + numBytes := codeObject basicSize - startMinusOne. + word := self readUint32. + 1 to: numBytes do: + [:i | + codeObject basicAt: startMinusOne + i put: (word bitAnd: 16rFF). + word := (i bitAnd: 3) = 0 + ifTrue: [self readUint32] + ifFalse: [word >> 8]]. + ^codeObject! Item was added: + ----- Method: SpurImageSegmentLoader>>fillContext:oop: (in category 'filling') ----- + fillContext: ctx oop: oop + 1 to: ctx class instSize do: + [:i | ctx instVarAt: i put: self readOop]. + 1 to: ctx stackPtr do: + [:i | ctx basicAt: i put: self readOop]. + ^ctx! Item was added: + ----- Method: SpurImageSegmentLoader>>fillObject:oop: (in category 'filling') ----- + fillObject: object oop: oop + "Fill the object's inst vars with data/other objects." + | class | + "First set position to 4 bytes before the first field, in readiness to read the object's data" + position := oop + 16. "8 bytes of version stamp + 8 bytes of object header - 4 bytes of preincrement + 4 bytes 0->1 relative index" + class := object class. + class isPointers ifTrue: + [class isVariable ifTrue: + [object isContext ifTrue: + [^self fillContext: object oop: oop]. + ^self fillVariablePointers: object oop: oop]. + object isBehavior ifTrue: + [^self fillBehavior: object oop: oop]. + ^self fillPointers: object oop: oop]. + class isBytes ifTrue: + [object isCompiledCode ifTrue: + [^self fillCompiledCode: object oop: oop]. + ^self fillBytes: object oop: oop]. + class isWords ifTrue: + [^self fillWords: object oop: oop]. + class isLongs ifTrue: + [^self fillWords: object oop: oop]. + ^self fillShorts: object oop: oop! Item was added: + ----- Method: SpurImageSegmentLoader>>fillPointers:oop: (in category 'filling') ----- + fillPointers: object oop: objOop + 1 to: object class instSize do: + [:index| + object instVarAt: index put: self readOop]. + ^object! Item was added: + ----- Method: SpurImageSegmentLoader>>fillVariablePointers:oop: (in category 'filling') ----- + fillVariablePointers: object oop: objOop + 1 to: object class instSize do: + [:index| + object instVarAt: index put: self readOop]. + 1 to: object basicSize do: + [:index| + object basicAt: index put: self readOop]. + ^object! Item was added: + ----- Method: SpurImageSegmentLoader>>fillWords:oop: (in category 'reading') ----- + fillWords: object oop: oop + 1 to: object basicSize do: + [:i | + object basicAt: i put: self readUint32]. + ^object! Item was added: + ----- Method: SpurImageSegmentLoader>>ignoringAccessToWordAfterSegmentDo: (in category 'filling') ----- + ignoringAccessToWordAfterSegmentDo: aBlock + "Both fillBytes:oop: and fillShorts:oop: may read an extra word beyond the end of data. + If the object is the last in the segment this will cause an out-of-bounds error. + Squash this error." + ^aBlock + on: Error "Why do we still not have SubscriptOutOfBounds or some such??" + do: [:ex| + ex messageText = ('subscript is out of bounds: ', (segment size + 1) printString) ifFalse: + [ex pass]. + ex + searchFrom: (ex signalerContext findContextSuchThat: [:ctxt| ctxt selector == #uint32At:]); + resumeUnchecked: 0]! Item was added: + ----- Method: SpurImageSegmentLoader>>loadSegmentFrom:outPointers: (in category 'loading') ----- + loadSegmentFrom: segmentWordArray outPointers: outPointerArray + | version end memory | + segment := segmentWordArray. + outPointers := outPointerArray. + position := 0. + version := self readUint32. + (self validImageSegmentVersion: (version bitAnd: 16rFFFFFF)) ifFalse: + [^self error: 'Cannot read this segment (endianness?)']. + "First allocate all objects, then fill in their fields via oopMap" + memory := OrderedCollection new: 1000. + oopMap := Dictionary new. + end := segment size * 4. + position := 8. + [position < end] whileTrue: + [memory addLast: self readObject]. + self ignoringAccessToWordAfterSegmentDo: + [oopMap keysAndValuesDo: + [:oop :obj | self fillObject: obj oop: oop]]. + "Answer list of all objects (unlike primitive, which returned the first object and relied on other objects being consecutive in memory)" + ^memory! Item was added: + ----- Method: SpurImageSegmentLoader>>oopIndexForClassIndex: (in category 'private') ----- + oopIndexForClassIndex: classIndex + "Whebn a classIndex doesn't have the topBit set it maps to an oop in the segment thusly:" + ^classIndex - 16 "self firstClassIndexPun" * 8 "self allocationUnit"! Item was added: + ----- Method: SpurImageSegmentLoader>>outPointerIndexForClassIndex: (in category 'private') ----- + outPointerIndexForClassIndex: classIndex + "If the top bit of a classIndex is set it is that of a class imported from outPointers" + ^classIndex - 16r1FFFFF "a.k.a. classIndex - 16r200000 + 1"! Item was added: + ----- Method: SpurImageSegmentLoader>>readObject (in category 'reading') ----- + readObject + "Read the header and the class of the object, instantiate it, and store it in oopMap at its oop." + self subclassResponsibility! Item was added: + ----- Method: SpurImageSegmentLoader>>readOop (in category 'reading') ----- + readOop + "Read an oop and map it to an object: + - The oop may be immediate in which case its tag indicates its class and the remeaining bits its value. + - the oop may have its top bit set in which case it is an index into the outPointers + - otherwise the oop is a byte offset from the start of the first object in the segment and is in oopMap." + self subclassResponsibility! Item was added: + ----- Method: SpurImageSegmentLoader>>readUint32 (in category 'reading') ----- + readUint32 + ^self uint32At: (position := position + 4)! Item was added: + ----- Method: SpurImageSegmentLoader>>uint32At: (in category 'reading') ----- + uint32At: addr + "TODO: do endian conversion here" + "also read the class comment" + ^segment at: addr // 4! Item was added: + ----- Method: SpurImageSegmentLoader>>validImageSegmentVersion: (in category 'private') ----- + validImageSegmentVersion: threeByteInteger + self subclassResponsibility!
More information about the Squeak-dev mailing list |