Squeak-dev December 2017

squeak-dev@lists.squeakfoundation.org

34 participants
159 discussions

The Inbox: Morphic-dtl.1376.mcz
by commits＠source.squeak.org 17 Dec '17

17 Dec '17

David T. Lewis uploaded a new version of Morphic to project The Inbox: http://source.squeak.org/inbox/Morphic-dtl.1376.mcz ==================== Summary ==================== Name: Morphic-dtl.1376 Author: dtl Time: 10 December 2017, 2:04:07.58309 pm UUID: eaa7809b-73bf-4643-b2a1-3d9d7ac54362 Ancestors: Morphic-nice.1375 Call super in finalExitActions: in order to clear the EmergencyRecoveryRequested guard. =============== Diff against Morphic-nice.1375 =============== Item was changed: ----- Method: MorphicProject>>finalExitActions: (in category 'enter') ----- finalExitActions: enteringProject + super finalExitActions: enteringProject. world triggerClosingScripts. - "Pause sound players, subject to preference settings" (world hasProperty: #letTheMusicPlay) ifTrue: [world removeProperty: #letTheMusicPlay] ifFalse: [SoundService stop]. world sleep. (world findA: ProjectNavigationMorph) ifNotNil: [:navigator | navigator retractIfAppropriate]. self clearGlobalState. Sensor flushAllButDandDEvents. !

3 12

The Trunk: System-eem.984.mcz
by commits＠source.squeak.org 16 Dec '17

16 Dec '17

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!

3 2

The Trunk: System-eem.988.mcz
by commits＠source.squeak.org 16 Dec '17

16 Dec '17

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.988.mcz ==================== Summary ==================== Name: System-eem.988 Author: eem Time: 15 December 2017, 3:09:47.548729 pm UUID: d167e6c2-1ca3-4f91-b856-189fa213889c Ancestors: System-eem.987 Spur Image Segment Loading across word sizes. Reduce LargePositiveIntegers and BoxedFloat64 to SmallInteger and SmallFloat64 immediates when in range and loading 32-bit segments into 64-bit systems. Fix the word order of BoxedFloat64 which are typically in little-endian order internally but big-endian order externally. =============== Diff against System-eem.987 =============== Item was changed: SpurImageSegmentLoader subclass: #Spur32BitImageSegmentLoader + instanceVariableNames: 'rangeMappings' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Object Storage'! Item was changed: ----- Method: Spur32BitImageSegmentLoader>>allocateObject:classIndex:slots: (in category 'reading') ----- allocateObject: format classIndex: classIndex slots: numSlots "Allocate an instance of the class referenced by classIndex, with the size computed from numSlots and format." + | class obj | - | 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 * 4 - (format bitAnd: 3). format >= 24 ifTrue: [^self allocateCompiledCode: class size: nBytes]. + obj := self allocate8BitObject: class size: nBytes. + (nBytes <= 8 and: [obj isInteger and: [rangeMappings notNil]]) ifTrue: + [rangeMappings addLast: obj]. + ^obj]. - ^self allocate8BitObject: class size: nBytes]. format >= 12 ifTrue: [| nShorts | nShorts := numSlots * 2 - (format bitAnd: 1). ^self allocate16BitObject: class size: nShorts]. format >= 10 ifTrue: + [obj := self allocate32BitObject: class size: numSlots. + (numSlots = 2 and: [obj isFloat and: [rangeMappings notNil]]) ifTrue: + [rangeMappings addLast: obj]. + ^obj]. - [^self allocate32BitObject: class size: numSlots]. format = 9 ifTrue: [^self allocate64BitObject: class size: numSlots * 2]. format = 33 ifTrue: [^self allocateAndPartFillClassObject: class size: numSlots]. self error: 'Unknown object format'! Item was added: + ----- Method: Spur32BitImageSegmentLoader>>loadSegmentFrom:outPointers: (in category 'loading') ----- + loadSegmentFrom: segmentWordArray outPointers: outPointerArray + "Override to initialize rangeMappings if loading a 32-bit segment into a 64-bit system" + + | result | + Smalltalk wordSize = 8 ifTrue: + [rangeMappings := OrderedCollection new]. + result := super loadSegmentFrom: segmentWordArray outPointers: outPointerArray. + self maybeMapRanges. + ^result! Item was added: + ----- Method: Spur32BitImageSegmentLoader>>maybeMapRanges (in category 'private') ----- + maybeMapRanges + "If loading a 32-bit segment into a 64-bit segment then map LargePositiveIntegers or BoxedFloat64 + instances that can be expressed as SmallInteger or SmallFloat64 immediates respectively. + Implement as a bulk become for speed." + + | ins outs | + rangeMappings ifNil: [^self]. + ins := WriteStream on: (Array new: rangeMappings size). + outs := WriteStream on: (Array new: rangeMappings size). + rangeMappings do: + [:numeric| | mapping | + (numeric isInteger + ifTrue: + [mapping := numeric normalize. + mapping ~~ numeric] + ifFalse: + [mapping := numeric * 1.0. + mapping class ~~ numeric class]) ifTrue: + [ins nextPut: numeric. + outs nextPut: mapping]]. + ins position > 0 ifTrue: + [ins contents elementsForwardIdentityTo: outs contents copyHash: false]! Item was changed: ----- Method: SpurImageSegmentLoader>>fillWords:oop: (in category 'reading') ----- fillWords: object oop: oop + | size | + size := object basicSize. + (size = 2 and: [object isFloat]) + ifTrue: "boxed floats are in platform order internally (hence in platform order in the segment) but in big-endian order externally" + [object + basicAt: 2 put: self readUint32; + basicAt: 1 put: self readUint32] + ifFalse: + [1 to: object basicSize do: + [:i | + object basicAt: i put: self readUint32]]. - 1 to: object basicSize do: - [:i | - object basicAt: i put: self readUint32]. ^object!

1 0

The Trunk: System-eem.987.mcz
by commits＠source.squeak.org 15 Dec '17

15 Dec '17

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.987.mcz ==================== Summary ==================== Name: System-eem.987 Author: eem Time: 15 December 2017, 2:19:51.532605 pm UUID: 5f61563a-54e7-4ec7-a2dc-8bd71ce75760 Ancestors: System-eem.986 Spur Image Segments. Fix mapping of out pointer oops in 32-bit segment loads. Fix typos & tweak comments. Nuke an inadvertent halt. =============== Diff against System-eem.986 =============== Item was changed: ----- Method: Spur32BitImageSegmentLoader>>mapPC:in: (in category 'private') ----- mapPC: pc in: compiledCode + "Assuming the word size of compiledCode is 8, and that the pc is one for a word size of 4, + map the pc from 4 to 8 byte literals. The filter is in updatePCDependentObjects." - "Assuming the word size of compiledCode is 8, and that the pc is one for a word size of 4, map the pc from 4 to 8. - The filter is in updatePCDependentObjects." ^pc + (compiledCode numLiterals + 1 * 4)! Item was changed: ----- 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 / 4 + 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 changed: ----- Method: Spur64BitImageSegmentLoader>>mapPC:in: (in category 'private') ----- mapPC: pc in: compiledCode + "Assuming the word size of compiledCode is 4, and that the pc is one for a word size of 8, + map the pc from 8 to 4 byte literals. The filter is in updatePCDependentObjects." - "Assuming the word size of compiledCode is 4, and that the pc is one for a word size of 8, map the pc from 8 to 4. - The filter is in updatePCDependentObjects." ^pc - (compiledCode numLiterals + 1 * 4)! Item was changed: ----- 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 changed: ----- 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) - [^(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 "& reduce to SmallFloat64 if possible"]]} - * 1.0]]} otherwise: [self error: 'unrecognized tag pattern']! Item was changed: ----- Method: SpurImageSegmentLoader>>oopIndexForClassIndex: (in category 'private') ----- oopIndexForClassIndex: classIndex + "When a classIndex doesn't have the topBit set it maps to an oop in the segment thusly:" - "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"!

1 0

The Trunk: System-eem.986.mcz
by commits＠source.squeak.org 15 Dec '17

15 Dec '17

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.986.mcz ==================== Summary ==================== Name: System-eem.986 Author: eem Time: 15 December 2017, 1:20:51.087309 pm UUID: c2b6f9bb-8a44-41c6-ada3-41bdff1b0676 Ancestors: System-eem.985 Doh! PCs in contexts and blocks must also be mapped when moving between word sizes. This fixes loading 64-bit projects into 32-bits. Still seem to be issues going the other way. Also eliminate an activation by inlining uint32At: into readUint32. =============== Diff against System-eem.985 =============== Item was added: + ----- Method: Spur32BitImageSegmentLoader>>mapPC:in: (in category 'private') ----- + mapPC: pc in: compiledCode + "Assuming the word size of compiledCode is 8, and that the pc is one for a word size of 4, map the pc from 4 to 8. + The filter is in updatePCDependentObjects." + ^pc + (compiledCode numLiterals + 1 * 4)! Item was added: + ----- Method: Spur32BitImageSegmentLoader>>updatePCDependentObjects (in category 'reading') ----- + updatePCDependentObjects + Smalltalk wordSize ~= 4 ifTrue: + [super updatePCDependentObjects]! Item was added: + ----- Method: Spur64BitImageSegmentLoader>>mapPC:in: (in category 'private') ----- + mapPC: pc in: compiledCode + "Assuming the word size of compiledCode is 4, and that the pc is one for a word size of 8, map the pc from 8 to 4. + The filter is in updatePCDependentObjects." + ^pc - (compiledCode numLiterals + 1 * 4)! Item was added: + ----- Method: Spur64BitImageSegmentLoader>>updatePCDependentObjects (in category 'filling') ----- + updatePCDependentObjects + Smalltalk wordSize ~= 8 ifTrue: + [super updatePCDependentObjects]! Item was changed: Object subclass: #SpurImageSegmentLoader + instanceVariableNames: 'segment outPointers oopMap position pcDependentObjects' - 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 changed: ----- Method: SpurImageSegmentLoader>>fillObject:oop: (in category 'filling') ----- fillObject: object oop: oop + "Fill the object's inst vars with data/other objects. Remember any pc-dependent objects (contexts + and blocks) so that their pcs can be updated when their methods have been brought in as well." - "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: + [pcDependentObjects addLast: object. + ^self fillContext: object oop: oop]. + object isBlock ifTrue: + [pcDependentObjects addLast: object]. - [^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 changed: ----- 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. + pcDependentObjects := OrderedCollection 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]]. + self updatePCDependentObjects. "Answer list of all objects (unlike primitive, which returned the first object and relied on other objects being consecutive in memory)" ^memory! Item was changed: ----- Method: SpurImageSegmentLoader>>readUint32 (in category 'reading') ----- readUint32 + ^segment at: (position := position + 4) // 4! - ^self uint32At: (position := position + 4)! Item was removed: - ----- 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>>updatePCDependentObjects (in category 'filling') ----- + updatePCDependentObjects + pcDependentObjects do: + [:contextOrBlock| + + contextOrBlock isContext ifTrue: + [contextOrBlock pc ifNotNil: + [:pc| contextOrBlock pc: (self mapPC: pc in: contextOrBlock method)]]. + + (contextOrBlock isBlock + and: [contextOrBlock isFullBlock not])ifTrue: + [contextOrBlock instVarNamed: 'startpc' put: (self mapPC: contextOrBlock startpc in: contextOrBlock method)]]!

1 0

The Trunk: Kernel-eem.1131.mcz
by commits＠source.squeak.org 15 Dec '17

15 Dec '17

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1131.mcz ==================== Summary ==================== Name: Kernel-eem.1131 Author: eem Time: 15 December 2017, 12:54:29.762591 pm UUID: abc9b3f5-c437-49fd-ac81-a04779514f5b Ancestors: Kernel-eem.1130 PC mapping on loading different word size segments needs to differentiate between BlockClosure and FullBlockClosure. Fix some typos in Float>>basicAt:[put:] =============== Diff against Kernel-eem.1130 =============== Item was added: + ----- Method: BlockClosure>>isFullBlock (in category 'testing') ----- + isFullBlock + ^false! Item was changed: ----- Method: Float>>basicAt: (in category 'accessing') ----- basicAt: index "Primitive. Assumes receiver is indexable. Answer the value of an indexable element in the receiver. Fail if the argument index is not an Integer or is out of bounds. Essential. Do not override in a subclass. See Object documentation whatIsAPrimitive. This version of basicAt: is specifically for floats, answering the most significant + word for index 1 and the least significant word for index 2. This allows the VM - word for index 1 and the least significant word for index 2. This alows the VM to store floats in whatever order it chooses while it appears to the image that they are always in big-endian/PowerPC order." <primitive: 38 error: ec> + ec ifNil: "primitive not implemented; floats are in big-endian/PowerPC order." - ec == nil ifTrue: "primitive not implemented; floats are in big-endian/PowerPC order." [^super basicAt: index]. index isInteger ifTrue: [self errorSubscriptBounds: index]. index isNumber ifTrue: [^self basicAt: index asInteger] ifFalse: [self errorNonIntegerIndex]! Item was changed: ----- Method: Float>>basicAt:put: (in category 'accessing') ----- basicAt: index put: value "Primitive. Assumes receiver is indexable. Store the second argument value in the indexable element of the receiver indicated by index. Fail if the index is not an Integer or is out of bounds. Or fail if the value is not of the right type for this kind of collection. Answer the value that was stored. Essential. Do not override in a subclass. See Object documentation whatIsAPrimitive. This version of basicAt: is specifically for floats, answering the most significant + word for index 1 and the least significant word for index 2. This allows the VM - word for index 1 and the least significant word for index 2. This alows the VM to store floats in whatever order it chooses while it appears to the image that they are always in big-endian/PowerPC order." <primitive: 39 error: ec> + ec ifNil: "primitive not implemented; floats are in big-endian/PowerPC order." - ec == nil ifTrue: "primitive not implemented; floats are in big-endian/PowerPC order." [^super basicAt: index put: value]. index isInteger ifTrue: [(index >= 1 and: [index <= self size]) ifTrue: [self errorImproperStore] ifFalse: [self errorSubscriptBounds: index]]. index isNumber ifTrue: [^self basicAt: index asInteger put: value] ifFalse: [self errorNonIntegerIndex]! Item was added: + ----- Method: FullBlockClosure>>isFullBlock (in category 'testing') ----- + isFullBlock + ^true!

1 0

The Trunk: System-eem.985.mcz
by commits＠source.squeak.org 15 Dec '17

15 Dec '17

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.985.mcz ==================== Summary ==================== Name: System-eem.985 Author: eem Time: 15 December 2017, 12:39:23.474652 pm UUID: ab9f2a41-0c2e-43b9-a6e5-666d9ffb9a10 Ancestors: System-eem.984 For loading 32-bit projects on 64-bits allocateObject:classIndex:slots: must be implemented in Spur32BitImageSegmentLoader and the delta for CompiledCode computed correctly. =============== Diff against System-eem.984 =============== Item was changed: ----- 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 * 4. - delta := (header bitAnd: 32767) + 1 * 8. ^class newMethod: nBytes - delta header: header! Item was added: + ----- Method: Spur32BitImageSegmentLoader>>allocateObject:classIndex:slots: (in category 'reading') ----- + allocateObject: format classIndex: classIndex slots: numSlots + "Allocate an instance of the class referenced by classIndex, with the size computed from numSlots and format." + | 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 * 4 - (format bitAnd: 3). + format >= 24 ifTrue: + [^self allocateCompiledCode: class size: nBytes]. + ^self allocate8BitObject: class size: nBytes]. + format >= 12 ifTrue: + [| nShorts | + nShorts := numSlots * 2 - (format bitAnd: 1). + ^self allocate16BitObject: class size: nShorts]. + format >= 10 ifTrue: + [^self allocate32BitObject: class size: numSlots]. + format = 9 ifTrue: + [^self allocate64BitObject: class size: numSlots * 2]. + format = 33 ifTrue: + [^self allocateAndPartFillClassObject: class size: numSlots]. + self error: 'Unknown object format'! Item was added: + ----- Method: Spur64BitImageSegmentLoader>>allocateObject:classIndex:slots: (in category 'reading') ----- + allocateObject: format classIndex: classIndex slots: numSlots + "Allocate an instance of the class referenced by classIndex, with the size computed from numSlots and format." + | 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 changed: ----- Method: SpurImageSegmentLoader>>allocateObject:classIndex:slots: (in category 'reading') ----- allocateObject: format classIndex: classIndex slots: numSlots + "Allocate an instance of the class referenced by classIndex, with the size computed from numSlots and format." + self subclassResponsibility! - | 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'!

1 0

The Trunk: MorphicTests-mt.45.mcz
by commits＠source.squeak.org 15 Dec '17

15 Dec '17

Marcel Taeumel uploaded a new version of MorphicTests to project The Trunk: http://source.squeak.org/trunk/MorphicTests-mt.45.mcz ==================== Summary ==================== Name: MorphicTests-mt.45 Author: mt Time: 15 December 2017, 2:41:31.499738 pm UUID: b37c9408-de4e-c241-97ea-ca024031cf67 Ancestors: MorphicTests-dtl.44 Adds test for focus events and reject bug. =============== Diff against MorphicTests-dtl.44 =============== Item was changed: Morph subclass: #MorphForEventTests + instanceVariableNames: 'eventsDuringCapture eventsDuringBubble eventsRejected eventsFiltered handlesMouseDown keyStrokesReceived fullFocusDispatch' - instanceVariableNames: 'eventsDuringCapture eventsDuringBubble eventsRejected eventsFiltered handlesMouseDown keyStrokesReceived' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Events'! Item was added: + ----- Method: MorphForEventTests>>fullFocusDispatch (in category 'accessing') ----- + fullFocusDispatch + ^ fullFocusDispatch ifNil: [false]! Item was added: + ----- Method: MorphForEventTests>>fullFocusDispatch: (in category 'accessing') ----- + fullFocusDispatch: aBoolean + fullFocusDispatch := aBoolean.! Item was added: + ----- Method: MorphForEventTests>>processFocusEvent:using: (in category 'events-processing') ----- + processFocusEvent: anEvent using: defaultDispatcher + + ^ self fullFocusDispatch + ifTrue: [defaultDispatcher dispatchFocusEventFully: anEvent with: self] + ifFalse: [defaultDispatcher dispatchFocusEvent: anEvent with: self] + + + ! Item was added: + ----- Method: MorphicEventDispatcherTests>>test11FocusEventReject (in category 'tests') ----- + test11FocusEventReject + "If a morph with mouse focus or keyboard focus rejects the event, that focus should be cleared." + + | m1 m2 | + m1 := MorphForEventTests new. + m1 fullFocusDispatch: false. + m1 on: #mouseDown send: #hide to: m1. + m1 on: #keyStroke send: #hide to: m1. + m1 openInWorld: world. + + hand newMouseFocus: m1. + hand handleEvent: (self redMouseDownAt: m1 center). + self assert: hand mouseFocus isNil. + + hand newKeyboardFocus: m1. + hand handleEvent: (self keystroke: $x at: m1 center). + self assert: hand keyboardFocus isNil. + + m2 := MorphForEventTests new. + m2 bounds: m1 bounds. + m1 addMorph: m2. + m1 fullFocusDispatch: true. + + hand newMouseFocus: m1. + hand handleEvent: (self redMouseDownAt: m2 center). + self assert: hand mouseFocus isNil. + + hand newKeyboardFocus: m2. + hand handleEvent: (self keystroke: $x at: m2 center). + self assert: hand keyboardFocus isNil. + !

1 0

The Trunk: Morphic-mt.1377.mcz
by commits＠source.squeak.org 15 Dec '17

15 Dec '17

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1377.mcz ==================== Summary ==================== Name: Morphic-mt.1377 Author: mt Time: 15 December 2017, 2:18:43.656611 pm UUID: 9a7a0a92-9e24-b844-a5ab-d1f0e2ffa7af Ancestors: Morphic-mt.1376 Fixes a bug in Morphic event dispatcher that affects focus events. For example, hiding a morph on #mouseDown: would render the environment unresponsive until something clears the mouse focus again. =============== Diff against Morphic-mt.1376 =============== Item was changed: ----- Method: MorphicEventDispatcher>>dispatchFocusEvent:with: (in category 'focus events') ----- dispatchFocusEvent: anEventWithGlobalPosition with: focusMorph "Dispatch the given event to the given morph. Simulate capturing phase, handle the event, then do bubbling." | currentEvent | "1) Capturing phase." currentEvent := self doCapturingForFocusEvent: anEventWithGlobalPosition with: focusMorph. + currentEvent == #rejected ifTrue: [ + "See implementors of #rejectsEvent:, which is usually based on receiver state and not event state. Thus, reset foci to avoid unresponsive environment." + anEventWithGlobalPosition hand + releaseKeyboardFocus: focusMorph; + releaseMouseFocus: focusMorph. + ^ #rejected]. + "No need to reset foci here for ignored events because not all events might be ignored. Unlike #rejected." - currentEvent == #rejected ifTrue: [^ #rejected]. currentEvent wasIgnored ifTrue: [^ currentEvent]. "2) No sub-tree processing here. Use #dispatchFocusEventFully:with: if you want that, too." "3) Let the focus morph handle the event." currentEvent := self doHandlingForFocusEvent: currentEvent with: focusMorph. currentEvent wasIgnored ifTrue: [^ currentEvent]. "4) Bubbling phase" ^ self doBubblingForFocusEvent: currentEvent with: focusMorph! Item was changed: ----- Method: MorphicEventDispatcher>>dispatchFocusEventFully:with: (in category 'focus events') ----- dispatchFocusEventFully: anEventWithGlobalPosition with: focusMorph "Dispatch the given event to the given morph. Do capturing, processing in sub-tree, and bubbling." | currentEvent | "1) Capturing phase." currentEvent := self doCapturingForFocusEvent: anEventWithGlobalPosition with: focusMorph. + currentEvent == #rejected ifTrue: [ + "See implementors of #rejectsEvent:, which is usually based on receiver state and not event state. Thus, reset foci to avoid unresponsive environment." + anEventWithGlobalPosition hand + releaseKeyboardFocus: focusMorph; + releaseMouseFocus: focusMorph. + ^ #rejected]. + "No need to reset foci here for ignored events because not all events might be ignored. Unlike #rejected." - currentEvent == #rejected ifTrue: [^ #rejected]. currentEvent wasIgnored ifTrue: [^ currentEvent]. "2) Sub-tree processing." currentEvent := self doProcessingForFocusEvent: currentEvent with: focusMorph. currentEvent wasIgnored ifTrue: [^ currentEvent]. "3) Let the focus morph handle the event. Usually no effect because previous sub-tree processing involved the focus morph already -- at least in the bubbling phase. Skip it?" currentEvent := self doHandlingForFocusEvent: currentEvent with: focusMorph. currentEvent wasIgnored ifTrue: [^ currentEvent]. "4) Bubbling phase." ^ self doBubblingForFocusEvent: currentEvent with: focusMorph!

1 0

The Inbox: System-dtl.985.mcz
by commits＠source.squeak.org 15 Dec '17

15 Dec '17

David T. Lewis uploaded a new version of System to project The Inbox: http://source.squeak.org/inbox/System-dtl.985.mcz ==================== Summary ==================== Name: System-dtl.985 Author: dtl Time: 14 December 2017, 6:56:38.560599 pm UUID: e4a2ebbf-bb5c-43f3-8ffb-a967644e1794 Ancestors: System-dtl.984, System-eem.983 Clear the EmergencyRecoveryRequested recursion guard in enter:revert:saveForRevert: rather than in finalExitActions:. This removes Morphic and ST80 dependencies and clears the flag at the single point of normal project entry. Merge with System-eem.983. =============== Diff against System-dtl.984 =============== Item was added: + ----- Method: Object>>isPrimitiveOSError (in category '*System-Support-error handling') ----- + isPrimitiveOSError + ^false! Item was added: + Object subclass: #PrimitiveOSError + instanceVariableNames: 'errorName errorCode' + classVariableNames: '' + poolDictionaries: '' + category: 'System-Support'! + + !PrimitiveOSError commentStamp: 'eem 12/7/2017 19:31' prior: 0! + A PrimitiveOSError is used to answer a primitive failure code that has an associated operating system/library error. + + Instance Variables + errorName: <Symbol> + errorValue: <Integer> + + errorName + - typically #'operating system error' + + errorValue + - the value of the error, a signed 64-bit value, a representation imposed by the VM; specific clients must map this error value into an unsigned value as appropriate if required! Item was added: + ----- Method: PrimitiveOSError>>errorCode (in category 'accessing') ----- + errorCode + + ^errorCode! Item was added: + ----- Method: PrimitiveOSError>>errorCode: (in category 'accessing') ----- + errorCode: anObject + + errorCode := anObject! Item was added: + ----- Method: PrimitiveOSError>>errorName (in category 'accessing') ----- + errorName + + ^errorName! Item was added: + ----- Method: PrimitiveOSError>>errorName: (in category 'accessing') ----- + errorName: anObject + + errorName := anObject! Item was added: + ----- Method: PrimitiveOSError>>isPrimitiveOSError (in category 'testing') ----- + isPrimitiveOSError + ^true! Item was changed: ----- Method: Project>>enter:revert:saveForRevert: (in category 'enter') ----- enter: returningFlag revert: revertFlag saveForRevert: saveForRevert "Install my ChangeSet, Transcript, and scheduled views as current globals. If returningFlag is true, we will return to the project from whence the current project was entered; don't change its previousProject link in this case. If saveForRevert is true, save the ImageSegment of the project being left. If revertFlag is true, make stubs for the world of the project being left. If revertWithoutAsking is true in the project being left, then always revert." | leavingProject forceRevert response seg | self isIncompletelyLoaded ifTrue: [^ self loadFromServer: true]. self isCurrentProject ifTrue: [^ self]. + EmergencyRecoveryRequested := false. "normal project entry clears recursion guard" forceRevert := false. CurrentProject rawParameters ifNil: [revertFlag ifTrue: [^ self inform: 'nothing to revert to' translated]] ifNotNil: [saveForRevert ifFalse: [ forceRevert := CurrentProject projectParameters at: #revertWithoutAsking ifAbsent: [false]]]. forceRevert not & revertFlag ifTrue: [ response := (UIManager default chooseFrom: { 'Revert to saved version' translated. 'Cancel' translated. } title: 'Are you sure you want to destroy this Project\ and revert to an older version?\\(From the parent project, click on this project''s thumbnail.)' translated withCRs) = 1. response ifFalse: [^ self]]. revertFlag | forceRevert ifTrue: [seg := CurrentProject projectParameters at: #revertToMe ifAbsent: [ ^ self inform: 'nothing to revert to' translated]] ifFalse: [ CurrentProject makeThumbnail. returningFlag == #specialReturn ifTrue: [ProjectHistory forget: CurrentProject. "this guy is irrelevant" Project forget: CurrentProject] ifFalse: [ProjectHistory remember: CurrentProject]]. (revertFlag | saveForRevert | forceRevert) ifFalse: [ (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [ self inform: 'Project serialization via image segments\does not work at the moment. Disabling the\preference #projectsSentToDisk now...' withCRs. Preferences disable: #projectsSentToDisk. "self storeToMakeRoom"]]. "Update display depth for leaving and entring project." CurrentProject displayDepth: Display depth. displayDepth == nil ifTrue: [displayDepth := Display depth]. self installNewDisplay: Display extent depth: displayDepth. returningFlag == #specialReturn ifTrue: [ CurrentProject removeChangeSetIfPossible. "keep this stuff from accumulating" nextProject := nil ] ifFalse: [ returningFlag ifTrue: [nextProject := CurrentProject] ifFalse: [previousProject := CurrentProject]. ]. CurrentProject world triggerEvent: #aboutToLeaveWorld. CurrentProject abortResourceLoading. CurrentProject finalExitActions: self. CurrentProject saveState. "********** SWITCHING CURRENT PROJECT **********" leavingProject := CurrentProject. CurrentProject := self. ProjectHistory remember: self. "********** SWITCHING CURRENT PROJECT **********" self loadState. self finalEnterActions: leavingProject. self addDeferredUIMessage: [self startResourceLoading]. self world triggerEvent: #aboutToEnterWorld. "Save project for revert." saveForRevert ifTrue: [ Smalltalk garbageCollect. "let go of pointers" leavingProject storeSegment. "result :=" leavingProject world isInMemory ifTrue: ['Can''t seem to write the project.'] ifFalse: [leavingProject projectParameters at: #revertToMe put: leavingProject world xxxSegment shallowCopy]. 'Project written.']. "original is for coming back in and continuing." revertFlag | forceRevert ifTrue: [ seg shallowCopy revert]. "non-cloned one is for reverting again later" self removeParameter: #exportState. "Now that everything is set up, we can show zoom animation." self showZoom ifTrue: [self displayZoom: leavingProject parent ~~ self "Entering?"] ifFalse: [self restore]. "Update processes at last." self scheduleProcessForEnter. leavingProject terminateProcessForLeave. ! Item was changed: ----- Method: Project>>enterForEmergencyRecovery (in category 'enter - recovery') ----- enterForEmergencyRecovery "Stripped down verion of #enter:revert:saveForRevert:. More error handling. Less features." | leavingProject process titleForDebuggerWindow | self isCurrentProject ifTrue: [^ self]. EmergencyRecoveryRequested == true ifTrue: [^ self]. + EmergencyRecoveryRequested := true. "set recursion guard" - EmergencyRecoveryRequested := true. titleForDebuggerWindow := 'FATAL PROJECT ERROR: Project was ''', CurrentProject name, ''''. ProjectHistory remember: CurrentProject. nextProject := CurrentProject. [ CurrentProject world triggerEvent: #aboutToLeaveWorld. CurrentProject abortResourceLoading. CurrentProject finalExitActions: self. CurrentProject saveState ] on: Error do: [:ex | "Ignore." ]. "********** SWITCHING CURRENT PROJECT **********" leavingProject := CurrentProject. CurrentProject := self. ProjectHistory remember: self. "********** SWITCHING CURRENT PROJECT **********" self loadState. self finalEnterActions: leavingProject. self addDeferredUIMessage: [self startResourceLoading]. self world triggerEvent: #aboutToEnterWorld. "Now that everything is set up, we can show zoom animation. Do we really need this in case of an emergency?" self showZoom ifTrue: [self displayZoom: leavingProject parent ~~ self "Entering?"] ifFalse: [self restore]. "Update processes at last." self scheduleProcessForEnter. "Do not terminate but suspend the projects ui process to support debugging." process := leavingProject uiProcess. self addDeferredUIMessage: [process debugWithTitle: titleForDebuggerWindow]. leavingProject suspendProcessForDebug.! Item was changed: ----- Method: Project>>finalExitActions: (in category 'enter') ----- finalExitActions: enteringProject + SoundService stop.! - EmergencyRecoveryRequested := false. "clear fence variable if previously set due to error" - ! Item was changed: ----- Method: Project>>storeOnServer (in category 'file in/out') ----- storeOnServer "Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded." world setProperty: #optimumExtentFromAuthor toValue: world extent. self validateProjectNameIfOK: [:details | + details ifNotNil: [self acceptProjectDetails: details]. - self acceptProjectDetails: details. self isCurrentProject ifTrue: ["exit, then do the command" ^ self armsLengthCommand: #storeOnServerAssumingNameValid withDescription: 'Publishing' translated ]. self storeOnServerWithProgressInfo. ].! Item was changed: ----- Method: SmalltalkImage>>recreateSpecialObjectsArray (in category 'special objects') ----- recreateSpecialObjectsArray "Smalltalk recreateSpecialObjectsArray" "To external package developers: **** DO NOT OVERRIDE THIS METHOD. ***** If you are writing a plugin and need additional special object(s) for your own use, use addGCRoot() function and use own, separate special objects registry " "The Special Objects Array is an array of objects used by the Squeak virtual machine. Its contents are critical and accesses to it by the VM are unchecked, so don't even think of playing here unless you know what you are doing." | newArray | newArray := Array new: 60. + "Nil false and true get used throughout the VM" - "Nil false and true get used throughout the interpreter" newArray at: 1 put: nil. newArray at: 2 put: false. newArray at: 3 put: true. "This association holds the active process (a ProcessScheduler)" newArray at: 4 put: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias". "Numerous classes below used for type checking and instantiation" newArray at: 5 put: Bitmap. newArray at: 6 put: SmallInteger. newArray at: 7 put: ByteString. newArray at: 8 put: Array. newArray at: 9 put: Smalltalk. newArray at: 10 put: BoxedFloat64. newArray at: 11 put: (self globals at: #Context). newArray at: 12 put: nil. "was BlockContext." newArray at: 13 put: Point. newArray at: 14 put: LargePositiveInteger. newArray at: 15 put: Display. newArray at: 16 put: Message. newArray at: 17 put: CompiledMethod. newArray at: 18 put: ((self specialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore" newArray at: 19 put: Semaphore. newArray at: 20 put: Character. newArray at: 21 put: #doesNotUnderstand:. newArray at: 22 put: #cannotReturn:. newArray at: 23 put: nil. "This is the process signalling low space." "An array of the 32 selectors that are compiled as special bytecodes, paired alternately with the number of arguments each takes." newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1 #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1 #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0 #~~ 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ). "An array of the 255 Characters in ascii order. Cog inlines table into machine code at: prim so do not regenerate it. This is nil in Spur, which has immediate Characters." newArray at: 25 put: (self specialObjectsArray at: 25). newArray at: 26 put: #mustBeBoolean. newArray at: 27 put: ByteArray. newArray at: 28 put: Process. "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur" newArray at: 29 put: self compactClassesArray. newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore" newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore" "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization" newArray at: 32 put: nil. "was the prototype Float" newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger" newArray at: 34 put: nil. "was the prototype Point" newArray at: 35 put: #cannotInterpret:. newArray at: 36 put: nil. "was the prototype MethodContext" newArray at: 37 put: BlockClosure. newArray at: 38 put: nil. "was the prototype BlockContext" "array of objects referred to by external code" newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores" newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs" newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT" newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore" newArray at: 43 put: LargeNegativeInteger. "External objects for callout. Note: Written so that one can actually completely remove the FFI." newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []). newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []). newArray at: 46 put: (self at: #ExternalData ifAbsent: []). newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []). newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []). newArray at: 49 put: #aboutToReturn:through:. newArray at: 50 put: #run:with:in:. "51 reserved for immutability message" newArray at: 51 put: #attemptToAssign:withIndex:. newArray at: 52 put: #(nil "nil => generic error" #'bad receiver' #'bad argument' #'bad index' #'bad number of arguments' #'inappropriate operation' #'unsupported operation' #'no modification' #'insufficient object memory' #'insufficient C memory' #'not found' #'bad method' #'internal error in named primitive machinery' #'object may move' #'resource limit exceeded' #'object is pinned' #'primitive write beyond end of object' + #'object moved' #'object not pinned' #'callback error'), + {PrimitiveOSError new errorName: #'operating system error'; yourself}. - #'object moved' #'object not pinned' #'callback error'). "53 to 55 are for Alien" newArray at: 53 put: (self at: #Alien ifAbsent: []). newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks." newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []). "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support." newArray at: 56 put: nil. "reserved for foreign callback process" newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []). newArray at: 58 put: #unusedBytecode. "59 reserved for Sista counter tripped message" newArray at: 59 put: #conditionalBranchCounterTrippedOn:. "60 reserved for Sista class trap message" newArray at: 60 put: #classTrapFor:. + "Now replace the virtual machine's reference in one atomic operation" - "Now replace the interpreter's reference in one atomic operation" self specialObjectsArray becomeForward: newArray! Item was changed: + (PackageInfo named: 'System') postscript: '(Smalltalk specialSelectorNames includes: #~~) ifFalse: + ["Re-create the specialObjectsArray to let the jit optimize #~~. Also add the new primitive error codes if they are not there yet." + | senders | + senders := #(#~~ #blockCopy:) gather: [ :selector | + "Recompile senders blockCopy: too, just in case." + SystemNavigation default allCallsOn: selector ]. + Smalltalk recreateSpecialObjectsArray. + VariableNode initialize. + Decompiler initialize. + senders + do: [ :methodReference | + | class | + class := methodReference actualClass. + class recompile: methodReference selector from: class ] + displayingProgress: ''Recompiling...'']. + "If PrimitiveOSError is not in the primitiveErrorTable, add it." + Smalltalk primitiveErrorTable size < 21 ifTrue: + [Smalltalk recreateSpecialObjectsArray]'! - (PackageInfo named: 'System') postscript: '| senders | - "Re-create the specialObjectsArray to let the jit optimize #~~. Also add the new primitive error codes if they are not there yet." - senders := #(#~~ #blockCopy:) gather: [ :selector | - "Recompile senders blockCopy: too, just in case." - SystemNavigation default allCallsOn: selector ]. - Smalltalk recreateSpecialObjectsArray. - VariableNode initialize. - Decompiler initialize. - senders - do: [ :methodReference | - | class | - class := methodReference actualClass. - class recompile: methodReference selector from: class ] - displayingProgress: ''Recompiling...''.'!

1 0

← Newer
1
...
7
8
9
10
11
12
13
...
16
Older →

Jump to page: